Working state

- Added add_f method to gmkinws
- Showing the plot works
- delete and keep fit buttons in Results
- Add result naming
- Improve plot title

1 files changed, 336 insertions, 130 deletions

diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 1655505..e282e2e 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -20,6 +20,7 @@
 # this program. If not, see <http://www.gnu.org/licenses/>

 

 # Configuration {{{1

+# Widgets {{{2

 left_width = 250

 right_width = 500

 save_keybinding = "Ctrl-X"

@@ -28,6 +29,13 @@ gcb_type_width = 70
 gcb_to_width = 160 

 gcb_sink_width = 70

 

+# Plotting {{{2

+plot_formats <- c("png", "pdf")

+if (exists("win.metafile", "package:grDevices", inherits = FALSE)) {

+  plot_formats = c("wmf", plot_formats)

+}

+plot_format <- plot_formats[[1]]

+

 # Set the GUI title and create the basic widget layout {{{1

 # Three panel layout {{{2

 window_title <- paste0("gmkin ", packageVersion("gmkin"),

@@ -38,7 +46,6 @@ sb <- gstatusbar(paste("Powered by gWidgetsWWW2 (ExtJS, Rook)",
                        "--- Working directory is", getwd()), cont = w)

 

 bl <- gborderlayout(cont = w,

-                    #title = list(center = "Work", east = "Results"),

                     panels = c("center", "west", "east"),

                     collapsible = list(west = FALSE))

 

@@ -97,15 +104,14 @@ update_m.df <- function() {
 # Update dataframe with fits {{{2

 update_f.df <- function() {

   f.df <- f.df.empty

-  if (!is.na(ftmp[1])) {

-    f.df[1, "Name"] <- c("Temporary (not fitted)")

-  }

   if (!is.na(ws$f[1])) {

     f.df.ws <- data.frame(Name = sapply(ws$f, function(x) x$name),

                           stringsAsFactors = FALSE)

     f.df <- rbind(f.df, f.df.ws)

   }

   f.df <<- f.df

+  f.gtable[,] <- f.df

+  f.delete$call_Ext("disable")  

 }

 # Generate the initial workspace {{{1

 # Project workspace {{{2

@@ -135,7 +141,7 @@ m.cur <- m.empty
 m.df <- m.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE)

 # Fits {{{2

 f.df <- f.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE)

-ftmp <- NA

+ftmp <- stmp <- NA

 # left: Explorer tables {{{1

 # Frames {{{2

 p.gf  <- gframe("Projects", cont = left, horizontal = FALSE)

@@ -169,9 +175,7 @@ p.switcher <- function(h, ...) {
     update_p_editor(p.cur)

     update_ds.df()

     update_m.df()

-    m.gtable[,] <<- m.df

     update_f.df()

-    f.gtable[,] <<- f.df

     p.loaded <<- p.cur

     project_switched <- TRUE

     p.gtable$set_index(p.cur)

@@ -205,7 +209,7 @@ ds.switcher <- function(h, ...) {
   update_ds_editor()

   ds.delete$call_Ext("enable")  

   ds.copy$call_Ext("enable")  

-  if (!is.na(svalue(m.gtable))) c.conf$call_Ext("enable")

+  if (!is.na(svalue(m.gtable))) f.conf$call_Ext("enable")

   svalue(center) <- 2

   svalue(right) <- 2

 }

@@ -219,7 +223,7 @@ m.switcher <- function(h, ...) {
   update_m_editor()

   m.delete$call_Ext("enable")  

   m.copy$call_Ext("enable")  

-  if (!is.na(svalue(ds.gtable))) c.conf$call_Ext("enable")

+  if (!is.na(svalue(ds.gtable))) f.conf$call_Ext("enable")

   svalue(center) <- 3

   svalue(right) <- 3

 }

@@ -227,34 +231,76 @@ m.gtable <- gtable(m.df, cont = m.gf, width = left_width - 10, height = 160)
 addHandlerClicked(m.gtable, m.switcher)

 # Fit explorer {{{2

 f.switcher <- function(h, ...) {

-  f.cur <<- h$row_index - 1

-  if (f.cur > 0) {

-    ftmp <<- ws$f[[f.cur]]

-    c.ds$call_Ext("setText", 

-       paste0("<font color='gray'>", ftmp$ds$title, "</font>"), FALSE)

-    c.m$call_Ext("setText", 

-       paste0("<font color='gray'>", ftmp$mkinmod$name, "</font>"), FALSE)

-    c.conf$call_Ext("disable")

+  if (h$row_index > 1) {

+    f.i <<- h$row_index - 1

+    ftmp <<- ws$f[[f.i]]

+    if (is.null(ftmp$optimised)) ftmp$optimised <<- TRUE

+    f.delete$call_Ext("enable")

+    f.keep$call_Ext("disable")

   }

+  c.ds$call_Ext("setText", 

+     paste0("<font color='gray'>", ftmp$ds$title, "</font>"), FALSE)

+  c.m$call_Ext("setText", 

+     paste0("<font color='gray'>", ftmp$mkinmod$name, "</font>"), FALSE)

+  f.conf$call_Ext("disable")

   ds.gtable$clear_selection()

   m.gtable$clear_selection()

-  #update_f_conf()

-  #update_f_results()

+  update_f_conf()

+  update_f_results()

+  show_plot("Optimised")

   svalue(center) <- 5

 }

 f.gtable <- gtable(f.df, cont = f.gf, width = left_width - 10, height = 160)

 addHandlerClicked(f.gtable, f.switcher)

 # Configuration {{{2

-configure_fit_handler <- function(h, ...) {

-

-  svalue(center) <- 4

-}

-

 empty_conf_labels <- paste0("<font color='gray'>Current ", c("dataset", "model"), "</font>")

 c.ds <- glabel(empty_conf_labels[1], cont = c.gf)

 c.m <- glabel(empty_conf_labels[2], cont = c.gf)

-c.conf <- gbutton("Configure fit", cont = c.gf, handler = configure_fit_handler,

+

+update_f_conf <- function() { # {{{3

+  stmp <<- summary(ftmp)

+  svalue(f.gg.opts.plot) <<- FALSE

+  svalue(f.gg.opts.st) <<- ftmp$solution_type

+  svalue(f.gg.opts.weight) <<- ftmp$weight

+  svalue(f.gg.opts.atol) <<- ftmp$atol

+  svalue(f.gg.opts.rtol) <<- ftmp$rtol

+  svalue(f.gg.opts.transform_rates) <<- ftmp$transform_rates

+  svalue(f.gg.opts.transform_fractions) <<- ftmp$transform_fractions

+  svalue(f.gg.opts.reweight.method) <<- ifelse(

+    is.null(ftmp$reweight.method), "none", ftmp$reweight.method)

+  svalue(f.gg.opts.reweight.tol) <<- ftmp$reweight.tol

+  svalue(f.gg.opts.reweight.max.iter) <<- ftmp$reweight.max.iter

+  svalue(f.gg.opts.maxit.modFit) <<- ftmp$maxit.modFit

+  svalue(f.gg.opts.method.modFit) <<- ftmp$method.modFit

+  f.gg.parms[,] <- get_Parameters(stmp, ftmp$optimised)

+}

+update_f_results <- function() { # {{{3

+  svalue(r.name) <- ftmp$name

+}

+configure_fit_handler <- function(h, ...) { # Configure fit button {{{3

+  ftmp <<- suppressWarnings(mkinfit(m.cur,

+                            override(ds.cur$data),

+                            method.modFit = "Marq",

+                            err = "err", quiet = TRUE,

+                            control.modFit = list(maxiter = 0)))

+  ftmp$optimised <<- FALSE

+  ftmp$ds <<- ds.cur

+  f.gtable[1, "Name"] <- c("Temporary (not fitted)")

+  update_f_conf()

+#   delete(f.gg.plotopts, f.gg.po.obssel)

+#   f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, 

+#                                     checked = TRUE)

+  show_plot("Initial", default = TRUE)

+

+  svalue(f.gg.opts.method.modFit) <<- "Port"

+  f.run$call_Ext("enable")

+  svalue(center) <- 4

+}

+f.conf <- gbutton("Configure fit", 

+                  cont = c.gf, # cont = f.buttons,

+                  handler = configure_fit_handler,

                   ext.args = list(disabled = TRUE))

+

 # center: Project editor {{{1

 p.editor  <- gframe("", horizontal = FALSE, cont = center, 

                      label = "Project")

@@ -270,9 +316,7 @@ p.new <- gbutton("New project", cont = p.line.buttons,
     ws <<- gmkinws$new()

     update_ds.df()

     update_m.df()

-    m.gtable[,] <- m.df

     update_f.df()

-    f.gtable[,] <- f.df

   })

 p.delete.handler = function(h, ...) {

   filename <- file.path(getwd(), paste0(svalue(p.name), ".gmkinws"))

@@ -297,7 +341,7 @@ p.delete <- gbutton("Delete project", cont = p.line.buttons,
 p.line.name <- ggroup(cont = p.editor, horizontal = TRUE)

 p.name  <- gedit("New project", label = "<b>Project name</b>",

                  width = 50, cont = p.line.name)

-p.save.action <- gaction("Save", parent = w,

+p.save.action <- gaction("Save project to project file", parent = w,

   handler = function(h, ...) {

     filename <- paste0(svalue(p.name), ".gmkinws")

     try_to_save <- function (filename) {

@@ -322,7 +366,9 @@ p.save.action <- gaction("Save", parent = w,
     }

   })

 p.save.action$add_keybinding(save_keybinding)

-p.save <- gbutton(action = p.save.action, cont = p.line.name)

+p.save <- gbutton(action = p.save.action, 

+                  cont = p.line.buttons)

+#                 cont = p.line.name)

 tooltip(p.save) <- paste("Press", save_keybinding, "to save")

 

 update_p_editor <- function(p.cur) {

@@ -762,69 +808,75 @@ show_m_spec <- function() {
 show_m_spec()

 

 

-# center: Fit configuration {{{1

+# center: Fit manager {{{1

 f.config  <- gframe("", horizontal = FALSE, cont = center, 

                     label = "Configuration")

 # Handler functions {{{2

 run_fit <- function() { #{{{3

-#   Parameters <- f.gg.parms[,]

-#   Parameters.de <- subset(Parameters, Type == "deparm")

-#   deparms <- Parameters.de$Initial

-#   names(deparms) <- Parameters.de$Name

-#   defixed <- names(deparms[Parameters.de$Fixed])

-#   Parameters.ini <- subset(Parameters, Type == "state")

-#   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

-#   }

-#   reweight.method <- svalue(f.gg.opts.reweight.method)

-#   if (reweight.method == "none") reweight.method = NULL

-#   ftmp <<- mkinfit(ftmp$mkinmod, override(ds[[ds.i]]$data),

-#                    state.ini = iniparms,

-#                    fixed_initials = inifixed,

-#                    parms.ini = deparms, 

-#                    fixed_parms = defixed,

-#                    plot = svalue(f.gg.opts.plot),

-#                    solution_type = svalue(f.gg.opts.st),

-#                    atol = as.numeric(svalue(f.gg.opts.atol)),

-#                    rtol = as.numeric(svalue(f.gg.opts.rtol)),

-#                    transform_rates = svalue(f.gg.opts.transform_rates),

-#                    transform_fractions = svalue(f.gg.opts.transform_fractions),

-#                    weight = weight,

-#                    err = err,

-#                    reweight.method = reweight.method,

-#                    reweight.tol = as.numeric(svalue(f.gg.opts.reweight.tol)),

-#                    reweight.max.iter = as.numeric(svalue(f.gg.opts.reweight.max.iter)),

-#                    method.modFit = svalue(f.gg.opts.method.modFit),

-#                    maxit.modFit = svalue(f.gg.opts.maxit.modFit)

-#                    )

-#   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)

+  Parameters <- f.gg.parms[,]

+  Parameters.de <- subset(Parameters, Type == "deparm")

+  deparms <- Parameters.de$Initial

+  names(deparms) <- Parameters.de$Name

+  defixed <- names(deparms[Parameters.de$Fixed])

+  Parameters.ini <- subset(Parameters, Type == "state")

+  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

+  }

+  reweight.method <- svalue(f.gg.opts.reweight.method)

+  if (reweight.method == "none") reweight.method = NULL

+  ftmp <<- mkinfit(m.cur, override(ds.cur$data),

+                   state.ini = iniparms,

+                   fixed_initials = inifixed,

+                   parms.ini = deparms, 

+                   fixed_parms = defixed,

+                   plot = svalue(f.gg.opts.plot),

+                   solution_type = svalue(f.gg.opts.st),

+                   atol = as.numeric(svalue(f.gg.opts.atol)),

+                   rtol = as.numeric(svalue(f.gg.opts.rtol)),

+                   transform_rates = svalue(f.gg.opts.transform_rates),

+                   transform_fractions = svalue(f.gg.opts.transform_fractions),

+                   weight = weight,

+                   err = err,

+                   reweight.method = reweight.method,

+                   reweight.tol = as.numeric(svalue(f.gg.opts.reweight.tol)),

+                   reweight.max.iter = as.numeric(svalue(f.gg.opts.reweight.max.iter)),

+                   method.modFit = svalue(f.gg.opts.method.modFit),

+                   maxit.modFit = svalue(f.gg.opts.maxit.modFit)

+                   )

+  ftmp$optimised <<- TRUE

+  f.gtable[1, "Name"] <<- c("Temporary (fitted)")

+  ftmp$ds <<- ds.cur

+  stmp <<- summary(ftmp)

+  f.gg.parms[,] <- get_Parameters(stmp, TRUE)

+  show_plot("Optimised")

+  svalue(center) <- 5

+  svalue(r.name) <- paste(m.cur$name, "-", ds.cur$title)

+  f.keep$call_Ext("enable")

+  svalue(f.gg.opts.st) <- ftmp$solution_type

+  svalue(f.gg.opts.weight) <- ftmp$weight.ini

 #   svalue(f.gg.summary.filename) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name, ".txt", sep = "")

 #   svalue(f.gg.summary.listing) <<- c("<pre>", capture.output(stmp), "</pre>")

 }

 delete_fit_handler <- function(h, ...) { # {{{3

   f.i <- svalue(f.gtable, index = TRUE)

-  ws$delete_f(f.i)

-  update_f.df()

-  p.modified <<- TRUE

+  if (f.i == 1) {

+    gmessage("Will not delete temporary fit")

+  } else {

+    ws$delete_f(f.i - 1)

+    update_f.df()

+    p.modified <<- TRUE

+  }

 }

 keep_fit_handler <- function(h, ...) { # {{{3

-#   f.cur <<- as.character(length(f) + 1)

-#   f[[f.cur]] <<- ftmp

-#   s[[f.cur]] <<- stmp

-#   update_f.df()

-#   f.gtable[,] <<- f.df

+  ftmp$name <<- svalue(r.name)

+  ws$add_f(list(ftmp))

+  update_f.df()

 #   delete(f.gg.plotopts, f.gg.po.obssel)

 #   f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), 

 #                                     cont = f.gg.plotopts, 

@@ -835,60 +887,143 @@ keep_fit_handler <- function(h, ...) { # {{{3
 }

 get_Parameters <- function(stmp, optimised) # {{{3

 {

-#   pars <- rbind(stmp$start[1:2], stmp$fixed)

-

-#   pars$fixed <- c(rep(FALSE, length(stmp$start$value)),

-#                   rep(TRUE, length(stmp$fixed$value)))

-#   pars$name <- rownames(pars)

-#   Parameters <- data.frame(Name = pars$name,

-#                            Type = pars$type,

-#                            Initial = pars$value,

-#                            Fixed = pars$fixed,

-#                            Optimised = as.numeric(NA))

-#   Parameters <- rbind(subset(Parameters, Type == "state"),

-#                       subset(Parameters, Type == "deparm"))

-#   rownames(Parameters) <- Parameters$Name

-#   if (optimised) {

-#     Parameters[rownames(stmp$bpar), "Optimised"] <- stmp$bpar[, "Estimate"]

-#   }

-#   return(Parameters)

+  pars <- rbind(stmp$start[1:2], stmp$fixed)

+

+  pars$fixed <- c(rep(FALSE, length(stmp$start$value)),

+                  rep(TRUE, length(stmp$fixed$value)))

+  pars$name <- rownames(pars)

+  Parameters <- data.frame(Name = pars$name,

+                           Type = pars$type,

+                           Initial = pars$value,

+                           Fixed = pars$fixed,

+                           Optimised = as.numeric(NA))

+  Parameters <- rbind(subset(Parameters, Type == "state"),

+                      subset(Parameters, Type == "deparm"))

+  rownames(Parameters) <- Parameters$Name

+  if (optimised) {

+    Parameters[rownames(stmp$bpar), "Optimised"] <- stmp$bpar[, "Estimate"]

+  }

+  return(Parameters)

 }

 show_plot <- function(type, default = FALSE) {

-#   Parameters <- f.gg.parms[,]

-#   Parameters.de <- subset(Parameters, Type == "deparm", type)

-#   stateparms <- subset(Parameters, Type == "state")[[type]]

-#   deparms <- as.numeric(Parameters.de[[type]])

-#   names(deparms) <- rownames(Parameters.de)

-#   if (type == "Initial" & default == FALSE) {

-#     ftmp <<- suppressWarnings(mkinfit(ftmp$mkinmod, 

-#                                       override(ds[[ds.i]]$data),

-#                                       parms.ini = deparms,

-#                                       state.ini = stateparms, 

-#                                       fixed_parms = names(deparms),

-#                                       fixed_initials = names(stateparms),

-#                                       err = "err", 

-#                                       method.modFit = "Marq",

-#                                       control.modFit = list(maxiter = 0)))

-#     ftmp$ds.index <<- ds.i

-#     ftmp$ds <<- ds[[ds.i]]

-#   } 

-#   svalue(plot.ftmp.gi) <<- plot_ftmp_png()

-#   svalue(plot.confint.gi) <<- plot_confint_png()

+  Parameters <- f.gg.parms[,]

+  Parameters.de <- subset(Parameters, Type == "deparm", type)

+  stateparms <- subset(Parameters, Type == "state")[[type]]

+  deparms <- as.numeric(Parameters.de[[type]])

+  names(deparms) <- rownames(Parameters.de)

+  if (type == "Initial" & default == FALSE) {

+    ftmp <<- suppressWarnings(mkinfit(m.cur, 

+                                      override(ds.cur$data),

+                                      parms.ini = deparms,

+                                      state.ini = stateparms, 

+                                      fixed_parms = names(deparms),

+                                      fixed_initials = names(stateparms),

+                                      err = "err", quiet = TRUE,

+                                      method.modFit = "Marq",

+                                      control.modFit = list(maxiter = 0)))

+    ftmp$ds <<- ds.cur

+  } 

+  svalue(plot.ftmp.gi) <<- plot_ftmp_png()

+  svalue(plot.ftmp.savefile) <- paste0(ftmp$mkinmod$name, " - ", ftmp$ds$title, ".", plot_format)

+  svalue(plot.confint.gi) <<- if (type == "Initial") NA

+    else  plot_confint_png()

+  svalue(right) <- 4

 }

 # Widget setup {{{2

 # Line 1 with buttons {{{3

-f.buttons <- ggroup(cont = f.config, horizontal = TRUE)

-f.run <- gbutton("Run fit", cont = f.buttons, handler = function(h, ...) run_fit(),

+f.run <- gbutton("Run fit", cont = f.config, handler = function(h, ...) run_fit(),

                  ext.args = list(disabled = TRUE))

-f.delete <- gbutton("Delete fit", cont = f.buttons, 

-  handler = delete_fit_handler, ext.args = list(disabled = TRUE))

-f.keep <- gbutton("Keep fit", cont = f.buttons, handler = keep_fit_handler)

-tooltip(f.keep) <- "Store the optimised model with all settings and the current dataset in the fit list"

-f.keep$call_Ext("disable")

+

+

+# Fit options forms {{{3

+f.gg.opts.g <- ggroup(cont = f.config)

+f.gg.opts.1 <- gformlayout(cont = f.gg.opts.g)

+solution_types <- c("auto", "analytical", "eigen", "deSolve")

+f.gg.opts.plot <- gcheckbox("plot",

+                         cont = f.gg.opts.1, checked = FALSE)

+f.gg.opts.st <- gcombobox(solution_types, selected = 1,

+                          label = "solution_type", width = 200,

+                          cont = f.gg.opts.1)

+f.gg.opts.atol <- gedit(1e-8, label = "atol", width = 20,

+                         cont = f.gg.opts.1)

+f.gg.opts.rtol <- gedit(1e-10, label = "rtol", width = 20,

+                         cont = f.gg.opts.1)

+optimisation_methods <- c("Port", "Marq", "SANN")

+f.gg.opts.method.modFit <- gcombobox(optimisation_methods, selected = 1,

+                                     label = "method.modFit",

+                                     width = 200,

+                                     cont = f.gg.opts.1)

+f.gg.opts.maxit.modFit <- gedit("auto", label = "maxit.modFit",

+                                 width = 20, cont = f.gg.opts.1)

+f.gg.opts.2 <- gformlayout(cont = f.gg.opts.g)

+f.gg.opts.transform_rates <- gcheckbox("transform_rates",

+                         cont = f.gg.opts.2, checked = TRUE)

+f.gg.opts.transform_fractions <- gcheckbox("transform_fractions",

+                         cont = f.gg.opts.2, checked = TRUE)

+weights <- c("manual", "none", "std", "mean")

+f.gg.opts.weight <- gcombobox(weights, selected = 1, label = "weight",

+                              width = 200, cont = f.gg.opts.2)

+f.gg.opts.reweight.method <- gcombobox(c("none", "obs"), selected = 1,

+                                       label = "reweight.method",

+                                       width = 200,

+                                       cont = f.gg.opts.2)

+f.gg.opts.reweight.tol <- gedit(1e-8, label = "reweight.tol",

+                                 width = 20, cont = f.gg.opts.2)

+f.gg.opts.reweight.max.iter <- gedit(10, label = "reweight.max.iter",

+                                 width = 20, cont = f.gg.opts.2)

+

+f.gg.plotopts <- ggroup(cont = f.gg.opts.g, horizontal = FALSE)

+

+f.gg.po.format <- gcombobox(plot_formats, selected = 1, label = "File format",

+                  cont = f.gg.plotopts, width = 150,

+                  handler = function(h, ...) {

+                    plot_format <<- svalue(h$obj)

+                    svalue(plot.ftmp.savefile) <<- gsub("...$", plot_format,

+                                                       svalue(plot.ftmp.savefile))

+                  })

+plot_format <- svalue(f.gg.po.format)

+f.gg.po.legend <- gcheckbox("legend", cont = f.gg.plotopts, checked = TRUE)

+# f.gg.po.update <- gbutton("Update plot",

+#                           handler = function(h, ...) show_plot("Optimised"), 

+#                           cont = f.gg.plotopts)

+# f.gg.po.obssel <- gcheckboxgroup(names(m.cur$spec), cont = f.gg.plotopts, 

+#                                  checked = TRUE)

+# Parameter table {{{3

+f.parameters.line <- ggroup(cont = f.config, horizontal = TRUE)

+show.initial.gb <- gbutton("Show initial", 

+                           handler = function(h, ...) show_plot("Initial"),

+                           cont = f.parameters.line)

+tooltip(show.initial.gb) <- "Show model with inital parameters shown below"

+

+# Empty parameter table

+Parameters <- Parameters.empty <- data.frame(

+  Name = "",

+  Type = factor("state", levels = c("state", "deparm")),

+  Initial = numeric(1),

+  Fixed = logical(1),

+  Optimised = numeric(1))

+# Dataframe with initial and optimised parameters {{{4

+f.gg.parms <- gdf(Parameters, cont = f.config, height = 500, 

+                  name = "Starting parameters",

+                  do_add_remove_buttons = FALSE)

+size(f.gg.parms) <- list(columnWidths = c(220, 50, 65, 50, 65))

+

 

 # center: Results viewer {{{1

 r.viewer  <- gframe("", horizontal = FALSE, cont = center, 

                     label = "Result")

+r.buttons <- ggroup(cont = r.viewer, horizontal = TRUE)

+f.delete <- gbutton("Delete fit", cont = r.buttons, 

+  handler = delete_fit_handler, ext.args = list(disabled = TRUE))

+f.keep <- gbutton("Keep fit", cont = r.buttons, handler = keep_fit_handler)

+tooltip(f.keep) <- "Store the optimised model with all settings and the current dataset in the fit list"

+f.keep$call_Ext("disable")

+r.line.name <- ggroup(cont = r.viewer, horizontal = TRUE)

+r.name  <- gedit("", label = "<b>Result name</b>",

+                 width = 50, cont = r.line.name)

+

+

+

 svalue(center) <- 1

 # right: Viewing area {{{1

 # Workflow {{{2

@@ -899,17 +1034,88 @@ workflow.png <- get_tempfile(ext = ".png")
 file.copy(system.file("GUI/gmkin_workflow_434x569.png", package = "gmkin"), workflow.png)

 workflow.gi <- gimage(workflow.png, size = c(434, 569), label = "Workflow", cont = workflow.gg)

 

-# # Kinetic Data {{{3

+# Data editor {{{2

 ds.e.gdf <- gdf(ds.cur$data, label = "Data editor", name = "Kinetic data", 

                 width = 488, height = 600, cont = right)

 

-workflow.png <- get_tempfile(ext = ".png")

-file.copy(system.file("GUI/gmkin_workflow_434x569.png", package = "gmkin"), workflow.png)

-workflow.gi <- gimage(workflow.png, size = c(434, 569), label = "Workflow", cont = workflow.gg)

-# Model Gallery {{{3

+# Model Gallery {{{2

 m.g.gg <- ggroup(cont = right, label = "Model gallery", width = 480,  height = 570,

                  ext.args = list(layout = list(type="vbox", align = "center")))

 

+# Plots {{{2

+plot.gg <- ggroup(cont = right, label = "Plot", width = 480,  height = 900,

+                      ext.args = list(layout = list(type="vbox", align = "center")))

+

+plot_ftmp <- function() {

+  if(exists("f.gg.po.obssel")) {

+    obs_vars_plot = svalue(f.gg.po.obssel)

+  } else {

+    obs_vars_plot = names(ftmp$mkinmod$spec)

+  }

+  if(exists("f.gg.po.legend")) {

+    plot_legend = svalue(f.gg.po.legend)

+  } else {

+    plot_legend = TRUE

+  }

+  plot(ftmp, main = paste(ftmp$mkinmod$name, "-", ftmp$ds$title), 

+       obs_vars = obs_vars_plot,

+       xlab = ifelse(ftmp$ds$time_unit == "", "Time", 

+                     paste("Time in", ftmp$ds$time_unit)),

+       ylab = ifelse(ftmp$ds$unit == "", "Observed", 

+                     paste("Observed in", ftmp$ds$unit)),

+       legend = plot_legend,

+       show_residuals = TRUE)

+}

+

+plot_ftmp_png <- function() {

+  tf <- get_tempfile(ext=".png")

+  png(tf, width = 400, height = 400)

+  plot_ftmp()

+  dev.off()

+  return(tf)

+}

+

+plot_ftmp_save <- function(filename) {

+  switch(plot_format,

+         png = png(filename, width = 400, height = 400),

+         pdf = pdf(filename),

+         wmf = win.metafile(filename))

+  plot_ftmp()

+  dev.off()

+  svalue(sb) <- paste("Saved plot to", filename, "in working directory", getwd())

+}

+

+plot_confint_png <- function() {

+  tf <- get_tempfile(ext=".png")

+  png(tf, width = 400, height = 400)

+  mkinparplot(ftmp) 

+  dev.off()

+  return(tf)

+}

+

+

+plot.ftmp.gi <- gimage(NA, container = plot.gg, width = 400, height = 400)

+plot.ftmp.saveline <- ggroup(cont = plot.gg, horizontal = TRUE)

+plot.ftmp.savefile <- gedit("", width = 40, cont = plot.ftmp.saveline)

+plot.ftmp.savebutton <-  gbutton("Save plot", cont = plot.ftmp.saveline,

+                                    handler = function(h, ...) {

+                                      filename <- svalue(plot.ftmp.savefile)

+                                      if (file.exists(filename))

+                                      {

+                                        gconfirm(paste("File", filename, 

+                                                       "exists. Overwrite?"),

+                                                 parent = w,

+                                                 handler = function(h, ...) {

+                                            plot_ftmp_save(filename)

+                                          }

+                                        )

+                                      } else {

+                                        plot_ftmp_save(filename)

+                                      }

+                                    })

+plot.space <- ggroup(cont = plot.gg, horizontal = TRUE, height = 18)

+plot.confint.gi <- gimage(NA, container = plot.gg, width = 400, height = 400)

+

 # Manual {{{2

 gmkin_manual <- readLines(system.file("GUI/gmkin_manual.html", package = "gmkin"))

 gmb_start <- grep("<body>", gmkin_manual)