aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2013-11-13 20:30:11 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2013-11-13 20:30:11 +0100
commit8f1bae2142b37a0ff6b8989b2d1569686937f68e (patch)
tree205132dc3d5c8457a523a54a63b57502492b6fe5
parentc99b5c298713a7c14e8ab5604c68613d0b7af27a (diff)
Add initial weighting choice to GUI
-rw-r--r--inst/GUI/mkinGUI.R19
1 files changed, 16 insertions, 3 deletions
diff --git a/inst/GUI/mkinGUI.R b/inst/GUI/mkinGUI.R
index fb8f22ab..d6fb82e3 100644
--- a/inst/GUI/mkinGUI.R
+++ b/inst/GUI/mkinGUI.R
@@ -235,7 +235,8 @@ gbutton("Configure fit for selected model and dataset", cont = dsm,
stmp <<- summary(ftmp)
svalue(pf) <- paste0("Dataset ", ds.i, ", Model ", m[[m.i]]$name)
show_plot("Initial", default = TRUE)
- svalue(f.gg.opts.st) <<- "auto"
+ svalue(f.gg.opts.st) <<- ftmp$solution_type
+ svalue(f.gg.opts.weight) <<- "manual"
f.gg.parms[,] <- get_Parameters(stmp, FALSE)
svalue(f.gg.summary) <- capture.output(stmp)
svalue(center) <- 3
@@ -568,7 +569,6 @@ show_plot <- function(type, default = FALSE) {
ftmp$ds <<- ds[[ds.i]]
}
- #tmp <- get_tempfile(ext=".svg")
svg(tf, width = 7, height = 5)
plot(ftmp, main = ftmp$ds$title,
xlab = ifelse(ftmp$ds$time_unit == "", "Time",
@@ -608,18 +608,26 @@ run_fit <- function() {
iniparms <- Parameters.ini$Initial
names(iniparms) <- sub("_0", "", Parameters.ini$Name)
inifixed <- names(iniparms[Parameters.ini$Fixed])
+ weight <- svalue(f.gg.opts.weight)
+ if (weight == "manual") {
+ err = "err"
+ } else {
+ err = NULL
+ }
ftmp <<- mkinfit(ftmp$mkinmod, override(ds[[ds.i]]$data),
state.ini = iniparms,
fixed_initials = inifixed,
parms.ini = deparms,
fixed_parms = defixed,
solution_type = svalue(f.gg.opts.st),
- err = "err")
+ weight = weight,
+ err = err)
ftmp$ds.index <<- ds.i
ftmp$ds <<- ds[[ds.i]]
stmp <<- summary(ftmp)
show_plot("Optimised")
svalue(f.gg.opts.st) <- ftmp$solution_type
+ svalue(f.gg.opts.weight) <- ftmp$weight.ini
f.gg.parms[,] <- get_Parameters(stmp, TRUE)
svalue(f.gg.summary) <- capture.output(stmp)
}
@@ -646,9 +654,13 @@ dev.off()
plot.gs <- gsvg(tf, container = f.gg.mid, width = 490, height = 350)
f.gg.opts <- gformlayout(cont = f.gg.mid)
solution_types <- c("auto", "analytical", "eigen", "deSolve")
+weights <- c("manual", "none", "std", "mean")
f.gg.opts.st <- gcombobox(solution_types, selected = 1,
label = "solution_type", width = 200,
cont = f.gg.opts)
+f.gg.opts.weight <- gcombobox(weights, selected = 1,
+ label = "weight", width = 200,
+ cont = f.gg.opts)
# Dataframe with initial and optimised parameters {{{3
f.gg.parms <- gdf(Parameters, width = 420, height = 300, cont = pf,
@@ -717,6 +729,7 @@ update_plotting_and_fitting <- function() {
", Model ", ftmp$mkinmod$name)
show_plot("Optimised")
svalue(f.gg.opts.st) <- ftmp$solution_type
+ svalue(f.gg.opts.weight) <- ftmp$weight.ini
f.gg.parms[,] <- get_Parameters(stmp, TRUE)
svalue(f.gg.summary) <- capture.output(stmp)
}

Contact - Imprint