A lot of working components of the new layout

1 files changed, 343 insertions, 1027 deletions

diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 7fef7a1..0b615c4 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -1,12 +1,12 @@
 # gWidgetsWWW2 GUI for mkin {{{1

 

-# Copyright (C) 2013,2014 Johannes Ranke

+# Copyright (C) 2013,2014,2015 Johannes Ranke

 # Portions of this file are copyright (C) 2013 Eurofins Regulatory AG, Switzerland

 # Contact: jranke@uni-bremen.de

 

-# This file is part of the R package mkin

+# This file is part of the R package gmkin

 

-# mkin is free software: you can redistribute it and/or modify it under the

+# gmkin is free software: you can redistribute it and/or modify it under the

 # terms of the GNU General Public License as published by the Free Software

 # Foundation, either version 3 of the License, or (at your option) any later

 # version.

@@ -20,1061 +20,377 @@
 # this program. If not, see <http://www.gnu.org/licenses/>

 

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

-w      <- gwindow("gmkin - Browser based GUI for kinetic evaluations using mkin")

-sb     <- gstatusbar(paste("Powered by gWidgetsWWW2 (ExtJS, Rook)",

-                           "and mkin (FME, deSolve and minpack.lm)",

-                           "--- Working directory is", getwd()), cont = w)

-pg     <- gpanedgroup(cont = w, default.size = 260)

-center <- gnotebook(cont = pg)

-left   <- gvbox(cont = pg, use.scrollwindow = TRUE)

-# Set initial values {{{1

-# Initial project workspace contents {{{2

-project_name <- "FOCUS_2006_gmkin"

-project_file <- paste0(project_name, ".RData")

-workspace <- get(project_name)     # From dataset distributed with mkin

-studies.df <- workspace$studies.df # dataframe containing study titles

-ds <- workspace$ds                 # list of datasets

-ds.cur <- workspace$ds.cur         # current dataset index

-m <- workspace$m                   # list with mkinmod models, amended with mkinmod$name

-m.cur <- workspace$m.cur           # m.cur current model index

-f <- workspace$f                   # f list of fitted mkinfit objects

-f.cur <- workspace$f.cur           # current fit index

-s <- workspace$s                   # list of summaries of the fitted mkinfit objects

-# Initialise meta data objects so assignments within functions using <<- will {{{2

-# update them in the right environment

-observed.all <- vector()           # vector of names of observed variables in datasets

-ds.df <- data.frame()

-m.df <- data.frame()

-f.df <- data.frame()

-# Empty versions of meta data {{{2

-f.df.empty <- data.frame(Fit = as.integer(0), 

-                         Dataset = "", 

-                         Model = "",

-                         stringsAsFactors = FALSE)

+# Configuration {{{2

+left_width = 250

+right_width = 500

+save_keybinding = "Ctrl-X"

+# Widgets {{{2

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

+                       "- Browser based GUI for kinetic evaluations using mkin")

+w  <- gwindow(window_title)

+sb <- gstatusbar(paste("Powered by gWidgetsWWW2 (ExtJS, Rook)",

+                       "and mkin (FME, deSolve and minpack.lm)",

+                       "--- 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))

+

+bl$set_panel_size("west", left_width)

+bl$set_panel_size("east", right_width)

+

+center <- gnotebook(cont = bl, where = "center")

+left   <- gvbox(cont = bl, use.scrollwindow = TRUE, where = "west")

+right   <- gnotebook(cont = bl, use.scrollwindow = TRUE, where = "east")

+

 # Helper functions {{{1

 # Override function for making it possible to override original data points using the GUI {{{2

 override <- function(d) {

-  data.frame(name = d$name, time = d$time, 

-             value = ifelse(is.na(d$override), d$value, d$override),

-             err = d$err)

+  if (!is.null(d$override)) {

+    d_new <- data.frame(name = d$name, time = d$time, 

+                        value = ifelse(is.na(d$override), d$value, d$override),

+                        err = d$err)

+    return(d_new)

+  } else {

+    return(d)

+  }

+}

+# Update dataframe with projects {{{2

+update_p.df <- function() {

+  wd_projects <- gsub(".gmkinws", "", dir(pattern = ".gmkinws$"))

+  if (length(wd_projects) > 0) {

+    p.df.wd <- data.frame(Name = wd_projects, 

+                          Source = rep("working directory",

+                                       length(wd_projects)),

+                          stringsAsFactors = FALSE)

+    p.df <<- rbind(p.df.package, p.df.wd)

+  } else {

+    p.df <<- p.df.package

+  }

 }

 # Update dataframe with datasets {{{2

 update_ds.df <- function() {

-  ds.n <- length(ds)

-  ds.df <<- data.frame(Index = 1:ds.n, 

-                       Title = character(ds.n),

-                       Study = character(ds.n), 

-                       stringsAsFactors = FALSE)

-  for (i in 1:ds.n)

-  {

-    ds.index <- names(ds)[[i]]

-    ds.df[i, "Title"] <<- ds[[ds.index]]$title

-    ds.df[i, "Study"] <<- ds[[ds.index]]$study_nr

-    observed = as.character(unique(ds[[ds.index]]$data$name))

-    observed.all <<- union(observed, observed.all)

-  }

+  ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title))

 }

 # Update dataframe with models {{{2

 update_m.df <- function() {

-  m.n <- length(m)

-  m.df <<- data.frame(Index = 1:m.n, 

-                      Name = character(m.n),

-                      stringsAsFactors = FALSE)

-  for (i in 1:m.n) {

-    m.index <- names(m)[[i]]

-    m.df[i, "Name"] <<- m[[m.index]]$name

-  }

+  m.df <<- data.frame(Name = names(ws$m))

 }

 # Update dataframe with fits {{{2

 update_f.df <- function() {

-  f.df <<- f.df.empty

-  f.count <- 0

-  for (fit.index in names(f)) {

-    f.count <- f.count + 1

-    ftmp <- f[[fit.index]]

-    f.df[f.count, "Fit"] <<- as.integer(f.count)

-    f.df[f.count, c("Dataset", "Model")] <<- c(ftmp$ds.index, ftmp$mkinmod$name)

-  }

-}

-# Initialise meta data objects {{{1

-update_ds.df()

-update_m.df()

-update_f.df()

-# Widgets and handlers for project data {{{1

-prg <- gexpandgroup("Project file management", cont = left, horizontal = FALSE)

-# Project data management handler functions {{{2

-upload_file_handler <- function(h, ...)

-{

-  # General

-  tmpfile <- normalizePath(svalue(h$obj), winslash = "/")

-  project_file <<- pr.gf$filename

-  project_name <<- try(load(tmpfile))

-  if (inherits(project_name, "try-error")) {

-    galert(paste("Failed to load", project_file), parent = w)

-  }

-

-  workspace <- get(project_name)

-

-  # Check for old workspaces created using mkin < 0.9-32 that aren't loaded properly

-  workspace_old <- FALSE

-  if (length(workspace$f) > 0) {

-    if (is.null(workspace$f[[1]]$method.modFit)) {

-      stopmessage <- paste("Could not load workspace ",

-                           project_file,

-                           ". It seems it was created using mkin with version < 0.9-32", 

-                           sep = "")

-      galert(stopmessage, parent = w)

-      svalue(sb) <- stopmessage

-      workspace_old <- TRUE

-    }

+  f.df <- f.df.empty

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

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

   }

-

-  if (!workspace_old) {

-    # Update project file name and status bar

-    svalue(pr.ge) <- project_name

-    svalue(sb) <- paste("Loaded project file", project_file)

-

-    # Studies

-    studies.gdf[,] <- studies.df <- workspace$studies.df

-

-    # Datasets

-    ds.cur <<- workspace$ds.cur

-    ds <<- workspace$ds

-    update_ds.df()

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

-    update_ds_editor()

-

-    # Models

-    m.cur <<- workspace$m.cur

-    m <<- workspace$m

-    update_m.df()

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

-    update_m_editor()

-

-    # Fits

-    f.cur <<- workspace$f.cur

-    f <<- workspace$f

-    s <<- workspace$s

-    if (length(f) > 0) {

-      update_f.df()

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

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

-      ds.i <<- ds.cur

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

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

-                                       checked = TRUE)

-      update_plotting_and_fitting()

-    } else {

-      f.df <<- f.df.empty

-      update_ds_editor()

-      svalue(center) <- 1

-    }

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

+  if (!is.na(ws$f)) {

+    f.df.ws <- data.frame(Name = names(ws$f), stringsAsFactors = FALSE)

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

   }

+  f.df <<- f.df

 }

-save_to_file_handler <- function(h, ...)

-{

-  studies.df <- data.frame(studies.gdf[,], stringsAsFactors = FALSE)

-  workspace <- list(

-                    studies.df = studies.df,

-

-                    ds = ds,

-                    ds.cur = ds.cur,

-

-                    m = m,

-                    m.cur = m.cur,

-

-                    f = f,

-                    f.cur = f.cur,

-

-                    s = s)

-  assign(project_name, workspace)

-  save(list = project_name, file = project_file)

-  svalue(sb) <- paste("Saved project contents to", project_file, "in working directory", getwd())

-}

-change_project_name_handler = function(h, ...) {

-  project_name <<- as.character(svalue(h$obj))

-  project_file <<- paste0(project_name, ".RData")

-}

-# Project data management GUI elements {{{2

-pr.gf <- gfile(text = "Select project file", cont = prg,

-               handler = upload_file_handler)

-pr.ge <- gedit(project_name, cont = prg, label = "Project",

-               handler = change_project_name_handler)

-# The save button is always visible {{{2

-gbutton("Save current project contents", cont = left,

-        handler = save_to_file_handler)

-

-# Widget and handler for Studies {{{1

-stg <- gexpandgroup("Studies", cont = left)

-visible(stg) <- FALSE

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

-  delete(ds.e.1, ds.study.gc)

-  ds.study.gc <<- gcombobox(paste("Study", studies.gdf[,1]), cont = ds.e.1) 

-  svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr

-}

-studies.gdf <- gdf(studies.df, name = "Edit studies in the project",

-                   width = 235,

-                   height = 180, cont = stg)

-studies.gdf$set_column_width(1, 40)

-addHandlerChanged(studies.gdf, update_study_selector)

-# Widgets and handlers for datasets and models {{{1

-dsm <- gframe("Datasets and models", cont = left, horizontal = FALSE)

-# Widget for dataset table with handler {{{2

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

-  ds.cur <<- as.character(svalue(h$obj))

-  update_ds_editor()

+# Generate the initial workspace {{{1

+ws <- gmkinws$new()

+ws.import <- NA

+# Initialise meta data objects so assignments within functions using <<- will {{{2

+# update them in the right environment.

+# Also create initial versions of meta data in order to be able to clear the workspace

+p.df <- p.df.package <- data.frame(Name = c("FOCUS_2006", "FOCUS_2006_Z"),

+                                   Source = rep("gmkin package", 2), stringsAsFactors = FALSE)

+

+update_p.df()

+ds.df <- ds.df.empty <- data.frame(Title = "", stringsAsFactors = FALSE)

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

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

+ftmp <- NA

+# left: Explorer tables {{{1

+# Frames {{{2

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

+ds.gf <- gframe("Datasets", cont = left)

+m.gf <-  gframe("Models", cont = left)

+c.gf <-  gframe("Configuration", cont = left, horizontal = FALSE)

+f.gf <-  gframe("Results", cont = left)

+

+# Project explorer {{{2

+# Initialize project list from the gmkin package and the current working directory

+# The former must be manually amended if additional workspaces should be available

+p.gtable <- gtable(p.df, cont = p.gf, width = left_width - 10, height = 120)

+size(p.gtable) <- list(columnWidths = c(130, 100))

+p.switcher <- function(h, ...) {

+  p.cur <- h$row_index

+  Name <- p.df[p.cur, "Name"]

+  if (p.df[p.cur, "Source"] == "working directory") {

+    load(paste0(Name, ".gmkinws"))

+    ws <<- ws

+  } else {

+    ws <<-  get(Name)

+  }

   svalue(center) <- 1

+  svalue(c.ds) <- empty_conf_labels[1]

+  svalue(c.m) <- empty_conf_labels[2]

+  update_p_editor(p.cur)

+  update_ds.df()

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

+  update_m.df()

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

+  update_f.df()

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

 }

-ds.gtable <- gtable(ds.df, cont = dsm)

-addHandlerDoubleClick(ds.gtable, ds.switcher)

-size(ds.gtable) <- list(columnWidths = c(40, 150, 30))

-ds.gtable$value <- 1

-

-# Model table with handler {{{2

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

-  m.cur <<- as.character(svalue(h$obj))

-  update_m_editor()

+addHandlerClicked(p.gtable, p.switcher)

+# Dataset explorer {{{2

+ds.switcher <- function(h, ...) {

+  ws$ds.cur <<- h$row_index

+  svalue(c.ds) <- ds.df[ws$ds.cur, "Title"]

+  #update_ds_editor()

   svalue(center) <- 2

 }

-m.gtable <- gtable(m.df, cont = dsm)

-addHandlerDoubleClick(m.gtable, m.switcher)

-m.gtable$set_column_width(1, 40)

-m.gtable$value <- 1

-

-# Button for setting up a fit for the selected dataset and model {{{2

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

-          ds.i <<- as.character(svalue(ds.gtable))

-          m.i <<- as.character(svalue(m.gtable))

-          ftmp <<- suppressWarnings(mkinfit(m[[m.i]],

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

-                                            method.modFit = "Marq",

-                                            err = "err", 

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

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

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

-          stmp <<- summary(ftmp)

-          svalue(pf) <- paste0("Dataset ", ds.i, ", Model ", m[[m.i]]$name)

-          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.method.modFit) <<- "Port"

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

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

-          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(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name,

-                                               ".", plot_format, sep = "")

-          oldwidth <<- options()$width

-          options(width = 90)

-          svalue(f.gg.summary.filename) <<- ""

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

-          options(width = oldwidth)

-          svalue(center) <- 3

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

+addHandlerClicked(ds.gtable, ds.switcher)

+# Model explorer {{{2

+m.switcher <- function(h, ...) {

+  ws$m.cur <<- h$row_index

+  svalue(c.m) <- m.df[ws$m.cur, "Name"]

+  #update_m_editor()

+  svalue(center) <- 3

 }

-gbutton("Configure fit for selected model and dataset", cont = dsm, 

-        handler = configure_fit_handler)

-

-# Widget and handler for fits {{{1

-f.gf <- gframe("Fits", cont = left, horizontal = FALSE)

+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, ...) {

-  if (svalue(h$obj) != 0) {

-    f.cur <<- svalue(h$obj)

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

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

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

-    update_plotting_and_fitting()

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

+  if (ws$f.cur > 0) {

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

+    stmp <<- ws$s[[ws$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$m$name, "</font>"), FALSE)

   }

-  svalue(center) <- 3

-}

-f.gtable <- gtable(f.df, cont = f.gf)

-addHandlerDoubleClick(f.gtable, f.switcher)

-f.gtable$set_column_width(1, 40)

-f.gtable$set_column_width(2, 60)

-

-# Dataset editor {{{1

-ds.editor <- gframe("Dataset 1", horizontal = FALSE, cont = center, 

-                    label = "Dataset editor")

-# Handler functions {{{2

-ds.empty <- list(

-                 study_nr = 1,

-                 title = "",

-                 sampling_times = c(0, 1),

-                 time_unit = "",

-                 observed = "parent",

-                 unit = "",

-                 replicates = 1,

-                 data = data.frame(

-                                   name = "parent",

-                                   time = c(0, 1),

-                                   value = c(100, NA),

-                                   override = "NA",

-                                   err = 1,

-                                   stringsAsFactors = FALSE))

-

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

-  ds.old <- ds.cur

-  ds.cur <<- as.character(1 + length(ds))

-  svalue(ds.editor) <- paste("Dataset", ds.cur)

-  ds[[ds.cur]] <<- ds[[ds.old]]

-  update_ds.df()

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

-}

- 

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

-  if (length(ds) > 1) {

-    ds[[ds.cur]] <<- NULL

-    names(ds) <<- as.character(1:length(ds))

-    ds.cur <<- names(ds)[[1]]

-    update_ds.df()

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

-    update_ds_editor()

+  #update_f_conf()

+  #update_f_results()

+  svalue(center) <- 5

+}

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

+addHandlerClicked(f.gtable, f.switcher)

+# Configuration {{{2

+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 = function(h, ...) svalue(center) <- 4)

+# center: Project editor {{{1

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

+                     label = "Project")

+# Working directory {{{2

+p.line.wd <- ggroup(cont = p.editor, horizontal = TRUE)

+wd_handler <- function(h, ...) {

+ target_wd <- svalue(p.wde)

+ wd <- try(setwd(target_wd))

+ if (inherits(wd, "try-error")) {

+   gmessage(paste("Could not set working directory to", target_wd), parent = w)

+ } else {

+   svalue(sb) <- paste("Changed working directory to", wd)

+   update_p.df()

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

+   p.line.import.p[,] <- c("", p.df$Name)

+ }

+}

+p.wde <- gedit(getwd(), cont = p.line.wd, label = "Working directory", width = 50)

+p.wde$add_handler_enter(wd_handler)

+p.wdb <- gbutton("Change", cont = p.line.wd, handler = wd_handler)

+tooltip(p.wdb) <- "Edit the box on the left and press enter to change"

+# Project name {{{2

+p.line.name <- ggroup(cont = p.editor, horizontal = TRUE)

+p.name  <- gedit("New project", label = "Project name",

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

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

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

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

+                    try_to_save <- function (filename) {

+                      if (!inherits(try(save(ws, file = filename)),

+                                    "try-error")) {

+                        svalue(sb) <- paste("Saved project to file", filename,

+                                            "in working directory", getwd())

+                        update_p.df()

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

+                      } else {

+                        gmessage("Saving failed for an unknown reason", parent = w)

+                      }

+                    }

+                    if (file.exists(filename)) {

+                      gconfirm(paste("File", filename, "exists. Overwrite?"),

+                               parent = w, 

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

+                        try_to_save(filename)

+                      })

+                    } else {

+                      try_to_save(filename)

+                    }

+                  })

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

+p.save$add_keybinding(save_keybinding)

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

+

+update_p_editor <- function(p.cur) {

+  project_name <-  as.character(p.df[p.cur, "Name"])

+  svalue(p.name)  <- project_name

+  if (p.df[p.cur, "Source"] == "gmkin package") {

+    svalue(p.filename) <- ""

+    p.delete$call_Ext("disable")

   } else {

-    galert("Deleting the last dataset is not supported", parent = w)

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

+    p.delete$call_Ext("enable")

   }

 }

- 

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

-  ds.cur <<- as.character(1 + length(ds))

-  ds[[ds.cur]] <<- ds.empty

-  update_ds.df()

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

-  update_ds_editor()

-}

-

-tmptextheader <- character(0)

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

-  tmptextfile <<- normalizePath(svalue(h$obj), winslash = "/")

-  tmptext <- readLines(tmptextfile, warn = FALSE)

-  tmptextskip <<- 0

-  for (tmptextline in tmptext) {

-    if (grepl(":|#|/", tmptextline)) tmptextskip <<- tmptextskip + 1

-    else break()

-  }

-  svalue(ds.e.up.skip) <- tmptextskip

-  if (svalue(ds.e.up.header)) {

-    tmptextheader <<- strsplit(tmptext[tmptextskip + 1], 

-                             " |\t|;|,")[[1]]

-  }

-  svalue(ds.e.up.wide.time) <- tmptextheader[[1]]

-  svalue(ds.e.up.long.time) <- tmptextheader[[2]]

-  svalue(ds.e.up.text) <- c("<pre>", tmptext, "</pre>")

-  svalue(ds.e.stack) <- 2

-}

- 

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

-   tmpd <- try(read.table(tmptextfile,

-                          skip = as.numeric(svalue(ds.e.up.skip)), 

-                          dec = svalue(ds.e.up.dec),

-                          sep = switch(svalue(ds.e.up.sep), 

-                                       whitespace = "", 

-                                       ";" = ";",

-                                       "," = ","),

-                          header = svalue(ds.e.up.header),

-                          stringsAsFactors = FALSE))

-  if(svalue(ds.e.up.widelong) == "wide") {

-    tmpdl <- mkin_wide_to_long(tmpd, time = as.character(svalue(ds.e.up.wide.time)))

-  } else {

-    tmpdl <- data.frame(

-      name = tmpd[[svalue(ds.e.up.long.name)]],

-      time = tmpd[[svalue(ds.e.up.long.time)]],

-      value = tmpd[[svalue(ds.e.up.long.value)]])

-    tmpderr <- tmpd[[svalue(ds.e.up.long.err)]]

-    if (!is.null(tmpderr)) tmpdl$err <- tmpderr

-  }

-  if (class(tmpd) != "try-error") {

-    ds.cur <<- as.character(1 + length(ds))

-    ds[[ds.cur]] <<- list(

-                          study_nr = NA,

-                          title = "New import",

-                          sampling_times = sort(unique(tmpdl$time)),

-                          time_unit = "",

-                          observed = unique(tmpdl$name),

-                          unit = "",

-                          replicates = max(aggregate(tmpdl$time,

-                                                       list(tmpdl$time,

-                                                            tmpdl$name),

-                                                     length)$x),

-                          data = tmpdl)

-    ds[[ds.cur]]$data$override <<- as.numeric(NA)

-    if (is.null(ds[[ds.cur]]$data$err)) ds[[ds.cur]]$data$err <<- 1

+# File name {{{2

+p.line.file <- ggroup(cont = p.editor, horizontal = TRUE)

+p.filename.gg  <- ggroup(width = 400, cont = p.line.file)

+p.filename  <- glabel("", cont = p.filename.gg)

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

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

+  gconfirm(paste0("Are you sure you want to delete ", filename, "?"),

+           parent = w,

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

+             if (inherits(try(unlink(filename)), "try-error")) {

+               gmessage("Deleting failed for an unknown reason", cont = w)

+             } else {

+               svalue(sb) <- paste("Deleted", filename)

+               svalue(p.filename) <- ""

+               p.delete$call_Ext("disable")

+               update_p.df()

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

+             }

+           })

+}

+p.delete <- gbutton("Delete", cont = p.line.file,

+                    handler = p.delete.handler)

+p.delete$call_Ext("disable")

+# Import {{{2

+p.line.import <- ggroup(cont = p.editor, horizontal = TRUE)

+p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.line.import,

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

+    p.import <- svalue(h$obj, index = TRUE) - 1

+    Name <- p.df[p.import, "Name"]

+    if (p.df[p.import, "Source"] == "working directory") {

+      load(paste0(Name, ".gmkinws"))

+      ws.import <<- ws

+    } else {

+      ws.import <<- get(Name)

+    }

+    p.line.import.dst[,] <- data.frame(Title = sapply(ws.import$ds, function(x) x$title),

+                                       stringsAsFactors = FALSE)

+    p.line.import.mt[,] <- data.frame(Name = names(ws.import$m),

+                                      stringsAsFactors = FALSE)

+  })

+p.line.import.frames <- ggroup(cont = p.editor, horizontal = TRUE)

+

+p.line.import.dsf <- gframe("Datasets for import", cont = p.line.import.frames, horizontal = FALSE)

+p.line.import.dst <- gtable(ds.df.empty, cont = p.line.import.dsf, multiple = TRUE,

+                            width = left_width - 10, height = 160)

+p.line.import.dsb <- gbutton("Import selected", cont = p.line.import.dsf,

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

+    i <- svalue(p.line.import.dst, index = TRUE)

+    ws$ds <<- append(ws$ds, ws.import$ds[i])

     update_ds.df()

     ds.gtable[,] <- ds.df

-    update_ds_editor()

-  } else {

-    galert("Uploading failed", parent = "w")

   }

-}

- 

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

-  obs <- strsplit(svalue(ds.e.obs), ", ")[[1]]

-  sampling_times <- strsplit(svalue(ds.e.st), ", ")[[1]]

-  replicates <- as.numeric(svalue(ds.e.rep))

-  new.data = data.frame(

-    name = rep(obs, each = replicates * length(sampling_times)),

-    time = as.numeric(rep(sampling_times, each = replicates, times = length(obs))),

-    value = as.numeric(NA),

-    override = as.numeric(NA),

-    err = 1,

-    stringsAsFactors = FALSE

-  )

-  ds.e.gdf[,] <- new.data

-}

-

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

-  ds[[ds.cur]]$title <<- svalue(ds.title.ge)

-  ds[[ds.cur]]$study_nr <<- as.numeric(gsub("Study ", "", svalue(ds.study.gc)))

-  update_ds.df()

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

-  tmpd <- ds.e.gdf[,]

-  ds[[ds.cur]]$data <<- tmpd

-  ds[[ds.cur]]$sampling_times <<- sort(unique(tmpd$time))

-  ds[[ds.cur]]$time_unit <<- svalue(ds.e.stu)

-  ds[[ds.cur]]$observed <<- unique(tmpd$name)

-  ds[[ds.cur]]$unit <<- svalue(ds.e.obu)

-  ds[[ds.cur]]$replicates <<- max(aggregate(tmpd$time, 

-                                            list(tmpd$time, tmpd$name), length)$x)

-  update_ds_editor()

-  observed.all <<- union(observed.all, ds[[ds.cur]]$observed)

-  update_m_editor()

-}

- 

-# Widget setup {{{2

-# Line 1 {{{3

-ds.e.1 <- ggroup(cont = ds.editor, horizontal = TRUE)

-glabel("Title: ", cont = ds.e.1) 

-ds.title.ge <- gedit(ds[[ds.cur]]$title, cont = ds.e.1) 

-glabel(" from ", cont = ds.e.1) 

-ds.study.gc <- gcombobox(paste("Study", studies.gdf[,1]), cont = ds.e.1) 

-

-# Line 2 {{{3

-ds.e.2 <- ggroup(cont = ds.editor, horizontal = TRUE)

-ds.e.2a <- ggroup(cont = ds.e.2, horizontal = FALSE)

-gbutton("Copy dataset", cont = ds.e.2a, handler = copy_dataset_handler)

-gbutton("Delete dataset", cont = ds.e.2a, handler = delete_dataset_handler)

-gbutton("New dataset", cont = ds.e.2a, handler = new_dataset_handler)

-

-ds.e.2b <- ggroup(cont = ds.e.2)

-tmptextfile <- "" # Initialize file name for imported data

-tmptextskip <- 0 # Initialize number of lines to be skipped

-tmptexttime <- "V1" # Initialize name of time variable if no header row

-upload_dataset.gf <- gfile(text = "Upload text file", cont = ds.e.2b,

-        handler = load_text_file_with_data)

-

-gbutton("Keep changes", cont = ds.e.2, handler = keep_ds_changes_handler)

-

-# Line 3 with forms or upload area {{{3

-ds.e.stack <- gstackwidget(cont = ds.editor)

-# Forms for meta data {{{4

-ds.e.forms <- ggroup(cont = ds.e.stack, horizontal = TRUE)

-

-ds.e.3a <- gvbox(cont = ds.e.forms)

-ds.e.3a.gfl <- gformlayout(cont = ds.e.3a)

-ds.e.st  <- gedit(paste(ds[[ds.cur]]$sampling_times, collapse = ", "),

-                  width = 40,

-                  label = "Sampling times", 

-                  cont = ds.e.3a.gfl)

-ds.e.stu <- gedit(ds[[ds.cur]]$time_unit, 

-                  width = 20,

-                  label = "Unit", cont = ds.e.3a.gfl)

-ds.e.rep <- gedit(ds[[ds.cur]]$replicates, 

-                  width = 20,

-                  label = "Replicates", cont = ds.e.3a.gfl)

-

-ds.e.3b <- gvbox(cont = ds.e.forms)

-ds.e.3b.gfl <- gformlayout(cont = ds.e.3b)

-ds.e.obs <- gedit(paste(ds[[ds.cur]]$observed, collapse = ", "),

-                  width = 50,

-                  label = "Observed", cont = ds.e.3b.gfl)

-ds.e.obu <- gedit(ds[[ds.cur]]$unit,

-                  width = 20, label = "Unit", 

-                  cont = ds.e.3b.gfl)

-generate_grid.gb <- gbutton("Generate empty grid for kinetic data", cont = ds.e.3b, 

-        handler = empty_grid_handler)

-tooltip(generate_grid.gb) <- "Overwrites the kinetic data shown below"

-# Data upload area {{{4

-ds.e.upload <- ggroup(cont = ds.e.stack, horizontal = TRUE)

-ds.e.up.text <- ghtml("<pre></pre>", cont = ds.e.upload, width = 400, height = 400)

-ds.e.up.options <- ggroup(cont = ds.e.upload, horizontal = FALSE)

-ds.e.up.import <- gbutton("Import using options specified below", cont = ds.e.up.options,

-                          handler = new_ds_from_csv_handler)

-ds.e.up.skip <- gedit(tmptextskip, label = "Comment lines", cont = ds.e.up.options)

-ds.e.up.header <- gcheckbox(cont = ds.e.up.options, label = "Column names", 

-                            checked = TRUE)

-ds.e.up.sep <- gcombobox(c("whitespace", ";", ","), cont = ds.e.up.options,

-                         selected = 1, label = "Separator")

-ds.e.up.dec <- gcombobox(c(".", ","), cont = ds.e.up.options,

-                         selected = 1, label = "Decimal")

-ds.e.up.widelong <- gradio(c("wide", "long"), horizontal = TRUE, 

-                           label = "Format", cont = ds.e.up.options,

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

-                             widelong = svalue(h$obj, index = TRUE)

-                             svalue(ds.e.up.wlstack) <- widelong

-                           })

-ds.e.up.wlstack <- gstackwidget(cont = ds.e.up.options)

-ds.e.up.wide <- ggroup(cont = ds.e.up.wlstack, horizontal = FALSE, width = 300)

-ds.e.up.wide.time <- gedit(tmptexttime, cont = ds.e.up.wide, label = "Time column")

-ds.e.up.long <- ggroup(cont = ds.e.up.wlstack, horizontal = FALSE, width = 300)

-ds.e.up.long.name <- gedit("name", cont = ds.e.up.long, label = "Observed variables")

-ds.e.up.long.time <- gedit(tmptexttime, cont = ds.e.up.long, label = "Time column")

-ds.e.up.long.value <- gedit("value", cont = ds.e.up.long, label = "Value column")

-ds.e.up.long.err <- gedit("err", cont = ds.e.up.long, label = "Relative errors")

-svalue(ds.e.up.wlstack) <- 1

-

-svalue(ds.e.stack) <- 1

-

-# Kinetic Data {{{3

-ds.e.gdf <- gdf(ds[[ds.cur]]$data, name = "Kinetic data", 

-                width = 500, height = 700, cont = ds.editor)

-ds.e.gdf$set_column_width(2, 70)

-

-# Update the dataset editor {{{3

-update_ds_editor <- function() {

-  svalue(ds.editor) <- paste("Dataset", ds.cur)

-  svalue(ds.title.ge) <- ds[[ds.cur]]$title

-  svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr

-

-  svalue(ds.e.st) <- paste(ds[[ds.cur]]$sampling_times, collapse = ", ")

-  svalue(ds.e.stu) <- ds[[ds.cur]]$time_unit

-  svalue(ds.e.obs) <- paste(ds[[ds.cur]]$observed, collapse = ", ")

-  svalue(ds.e.obu) <- ds[[ds.cur]]$unit

-  svalue(ds.e.rep) <- ds[[ds.cur]]$replicates

-  svalue(ds.e.stack) <- 1

-  ds.e.gdf[,] <- ds[[ds.cur]]$data

-}

-# Model editor {{{1

-m.editor <- gframe("Model 1", horizontal = FALSE, cont = center, label = "Model editor")

-# Handler functions {{{3

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

-  m.old <- m.cur

-  m.cur <<- as.character(1 + length(m))

-  svalue(m.editor) <- paste("Model", m.cur)

-  m[[m.cur]] <<- m[[m.old]]

-  update_m.df()

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

-}

- 

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

-  if (length(m) > 1) {

-    m[[m.cur]] <<- NULL

-    names(m) <<- as.character(1:length(m))

-    m.cur <<- "1"

+)

+

+p.line.import.mf <- gframe("Models for import", cont = p.line.import.frames, horizontal = FALSE)

+p.line.import.mt <- gtable(m.df.empty, cont = p.line.import.mf, multiple = TRUE,

+                            width = left_width - 10, height = 160)

+p.line.import.mb <- gbutton("Import selected", cont = p.line.import.mf,

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

+    i <- svalue(p.line.import.mt, index = TRUE)

+    ws$m <<- append(ws$m, ws.import$m[i])

     update_m.df()

     m.gtable[,] <- m.df

-    update_m_editor()

-  } else {

-    galert("Deleting the last model is not supported", parent = w)

-  }

-}

-

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

-  obs.i <- length(m.e.rows) + 1

-  m.e.rows[[obs.i]] <<- ggroup(cont = m.editor, horizontal = TRUE)

-  m.e.obs[[obs.i]] <<- gcombobox(observed.all, selected = obs.i, 

-                                cont = m.e.rows[[obs.i]])

-  m.e.type[[obs.i]] <<- gcombobox(c("SFO", "SFORB"),

-                                 cont = m.e.rows[[obs.i]])

-  svalue(m.e.type[[obs.i]]) <- "SFO"

-  glabel("to", cont = m.e.rows[[obs.i]]) 

-  m.e.to[[obs.i]] <<- gedit("",

-                            initial.msg = "Optional list of target variables, e.g. 'm1, m2'",

-                            width = 40, cont = m.e.rows[[obs.i]])

-  m.e.sink[[obs.i]] <<- gcheckbox("Path to sink", 

-                                  checked = TRUE, cont = m.e.rows[[obs.i]]) 

-  gbutton("Remove compound", handler = remove_observed_handler, 

-          action = obs.i, cont = m.e.rows[[obs.i]])

-}

-

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

-  m[[m.cur]]$spec[[h$action]] <<- NULL

-  update_m_editor()

-}

-

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

-  spec <- list()

-  for (obs.i in 1:length(m.e.rows)) {

-    to_vector = strsplit(svalue(m.e.to[[obs.i]]), ", ")[[1]]

-    if (length(to_vector) == 0) to_vector = ""

-    spec[[obs.i]] <- list(type = svalue(m.e.type[[obs.i]]),

-                          to = to_vector,

-                          sink = svalue(m.e.sink[[obs.i]]))

-    if(spec[[obs.i]]$to[[1]] == "") spec[[obs.i]]$to = NULL

-    names(spec)[[obs.i]] <- svalue(m.e.obs[[obs.i]])

-  }

-  m[[m.cur]] <<- mkinmod(use_of_ff = svalue(m.ff.gc), 

-                         speclist = spec)

-  m[[m.cur]]$name <<- svalue(m.name.ge) 

-  update_m.df()

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

-}

- 

-# Widget setup {{{3

-m.e.0 <- ggroup(cont = m.editor, horizontal = TRUE)

-glabel("Model name: ", cont = m.e.0) 

-m.name.ge <- gedit(m[[m.cur]]$name, cont = m.e.0) 

-glabel("Use of formation fractions: ", cont = m.e.0) 

-m.ff.gc <- gcombobox(c("min", "max"), cont = m.e.0)

-svalue(m.ff.gc) <- m[[m.cur]]$use_of_ff

-

-# Model handling buttons {{{4

-m.e.b <- ggroup(cont = m.editor, horizontal = TRUE)

-gbutton("Copy model", cont = m.e.b, handler = copy_model_handler)

-gbutton("Delete model", cont = m.e.b, handler = delete_model_handler)

-gbutton("Add observed variable", cont = m.e.b, 

-        handler = add_observed_handler)

-gbutton("Keep changes", cont = m.e.b, handler = keep_m_changes_handler)

-

-

-m.observed <- names(m[[m.cur]]$spec)

-m.e.rows <- m.e.obs <- m.e.type <- m.e.to <- m.e.sink <- list()

-obs.to <- ""

-

-# Show the model specification {{{4

-show_m_spec <- function() {

-  for (obs.i in 1:length(m[[m.cur]]$spec)) {

-    obs.name <- names(m[[m.cur]]$spec)[[obs.i]]

-    m.e.rows[[obs.i]] <<- ggroup(cont = m.editor, horizontal = TRUE)

-    m.e.obs[[obs.i]] <<- gcombobox(observed.all, selected = 0, 

-                                  cont = m.e.rows[[obs.i]])

-    svalue(m.e.obs[[obs.i]]) <<- obs.name

-    if (obs.i == 1) {

-      m.e.type[[obs.i]] <<- gcombobox(c("SFO", "FOMC", "DFOP", "HS", "SFORB"),

-                                     cont = m.e.rows[[obs.i]])

-    } else {

-      m.e.type[[obs.i]] <<- gcombobox(c("SFO", "SFORB"),

-                                     cont = m.e.rows[[obs.i]])

-    }

-    svalue(m.e.type[[obs.i]]) <<- m[[m.cur]]$spec[[obs.i]]$type

-    glabel("to", cont = m.e.rows[[obs.i]]) 

-    obs.to <<- ifelse(is.null(m[[m.cur]]$spec[[obs.i]]$to), "",

-                 paste(m[[m.cur]]$spec[[obs.i]]$to, collapse = ", "))

-    m.e.to[[obs.i]] <<- gedit(obs.to, 

-                              initial.msg = "Optional list of target variables, e.g. 'm1, m2'",

-                              width = 40, cont = m.e.rows[[obs.i]])

-    m.e.sink[[obs.i]] <<- gcheckbox("Path to sink", checked = m[[m.cur]]$spec[[obs.i]]$sink,

-              cont = m.e.rows[[obs.i]]) 

-    if (obs.i > 1) {

-      gbutton("Remove observed variable", handler = remove_observed_handler, 

-              action = obs.i, cont = m.e.rows[[obs.i]])

-    }

-  }

-}

-show_m_spec()

-

-# Update the model editor {{{3

-update_m_editor <- function() {

-  svalue(m.editor) <- paste("Model", m.cur)

-  svalue(m.name.ge) <- m[[m.cur]]$name

-  svalue(m.ff.gc) <- m[[m.cur]]$use_of_ff

-  for (oldrow.i in 1:length(m.e.rows)) {

-    delete(m.editor, m.e.rows[[oldrow.i]])

-  }

-  m.observed <<- names(m[[m.cur]]$spec)

-  m.e.rows <<- m.e.obs <<- m.e.type <<- m.e.to <<- m.e.sink <<- list()

-  show_m_spec()

-}

-

-# 3}}}

-# 2}}}

-# Plotting and fitting {{{1

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

-}

-get_Parameters <- function(stmp, optimised)

-{

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

-}

-run_fit <- function() {

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

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

-}

-ds.i <- m.i <- "1"

-f.cur <- "0"

+)

+

+

+# center: Dataset editor {{{1

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

+                     label = "Dataset editor")

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

+                    label = "Model editor")

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

+                    label = "Fit configuration")

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

+                    label = "Result viewer")

+svalue(center) <- 1

+# right: Viewing area {{{1

+# Workflow {{{2

+workflow.gg <- ggroup(cont = right, label = "Workflow", width = 480,  height = 600,

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

+

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

+

+# Manual {{{2

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

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

+gmb_end <- grep("</body>", gmkin_manual)

+gmkin_manual_body <- gmkin_manual[gmb_start:gmb_end]

+

+manual.gh <- ghtml(label = "Manual", paste0("<div class = 'manual' style = 'margin: 20px'>

+<style>

+.manual h1{

+  font-size: 14px;

+  line-height: 20px;

+}

+.manual h2{

+  font-size: 14px;

+  line-height: 20px;

+}

+.manual h3{

+  font-size: 12px;

+  line-height: 18px;

+}

+.manual ul{

+  font-size: 12px;

+  line-height: 12px;

+}

+.manual li{

+  font-size: 12px;

+  line-height: 12px;

+}

+</style>

+", paste(gmkin_manual_body, collapse = '\n'), "

+</div>"), width = 460, cont = right)

+

+# Changes {{{2

+gmkin_news <- markdownToHTML(system.file("NEWS.md", package = "gmkin"), 

+                             fragment.only = TRUE,

+                             )

+

+changes.gh <- ghtml(label = "Changes", paste0("<div class = 'news' style = 'margin: 20px'>

+<style>

+.news h1{

+  font-size: 14px;

+  line-height: 20px;

+}

+.news h2{

+  font-size: 14px;

+  line-height: 20px;

+}

+.news h3{

+  font-size: 12px;

+  line-height: 18px;

+}

+.news ul{

+  font-size: 12px;

+  line-height: 12px;

+}

+.news li{

+  font-size: 12px;

+  line-height: 12px;

+}

+</style>

+", gmkin_news, "

+</div>"), width = 460, cont = right)

+

+svalue(right) <- 1

 

-# GUI widgets {{{2

-pf <- gframe("Dataset 1, Model SFO", horizontal = TRUE, 

-             cont = center, label = "Plotting and fitting")

 

-# Plot area to the left {{{3

-pf.p <- ggroup(cont = pf, horizontal = FALSE)

-ftmp <- suppressWarnings(mkinfit(m[[m.cur]], override(ds[[ds.i]]$data), 

-                                 err = "err", 

-                                 method.modFit = "Marq",

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

-ftmp$ds.index = ds.i

-ftmp$ds = ds[[ds.i]]

-stmp <- summary(ftmp)

-Parameters <- get_Parameters(stmp, FALSE)

-

-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 = ftmp$ds$title, obs_vars = obs_vars_plot,

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

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

-       ylab = ifelse(ds[[ds.i]]$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_formats <- c("png", "pdf")

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

-  plot_formats = c("wmf", plot_formats)

-}

-plot_format <- plot_formats[[1]]

-

-plot.ftmp.gi <- gimage(plot_ftmp_png(), container = pf.p, width = 400, height = 400)

-plot.ftmp.saveline <- ggroup(cont = pf.p, horizontal = TRUE)

-plot.ftmp.savefile <- gedit(paste(ds[[ds.cur]]$title, "_", m[[m.cur]]$name, ".",

-                                     plot_format, sep = ""),

-                               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 = pf.p, horizontal = TRUE, height = 18)

-plot.confint.gi <- gimage(plot_confint_png(), container = pf.p, width = 400, height = 400)

-

-# Buttons and notebook area to the right {{{3

-p.gg <- ggroup(cont = pf, horizontal = FALSE)

-# Row with buttons {{{4

-f.gg.buttons <- ggroup(cont = p.gg)

-run.fit.gb <- gbutton("Run", width = 100,

-                      handler = function(h, ...) run_fit(), cont =

-                      f.gg.buttons)

-tooltip(run.fit.gb) <- "Fit with current settings on the current dataset, with the original model"

-

-keep.fit.gb <- gbutton("Keep fit", 

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

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

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

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

-                            update_f.df()

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

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

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

-                                                              cont = f.gg.plotopts, 

-                                                              checked = TRUE)

-                            delete(f.gg.buttons, get.initials.gc)

-                            get.initials.gc <<- gcombobox(paste("Fit", f.df$Fit), 

-                                                          cont = f.gg.buttons)

-                          }, cont = f.gg.buttons)

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

-

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

-  if (length(f) > 0) {

-    f[[f.cur]] <<- NULL

-    s[[f.cur]] <<- NULL

-  }

-  if (length(f) > 0) {

-    names(f) <<- as.character(1:length(f))

-    names(s) <<- as.character(1:length(f))

-    update_f.df()

-    f.cur <<- "1"

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

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

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

-    update_plotting_and_fitting()

-  } else {

-    f.df <<- f.df.empty

-    f.cur <<- "0"

-  }

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

-}

-

-delete.fit.gb <- gbutton("Delete fit", handler = delete_fit_handler,

-                         cont = f.gg.buttons)

-tooltip(delete.fit.gb) <- "Delete the currently loaded fit from the fit list"

-

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

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

-                           cont = f.gg.buttons)

-tooltip(show.initial.gb) <- "Show model with current inital settings for current dataset"

-

-get_initials_handler <- function(h, ...)

-{

-  f.i <- svalue(get.initials.gc, index = TRUE)

-  if (length(f) > 0) {

-    got_initials <- c(f[[f.i]]$bparms.fixed, f[[f.i]]$bparms.optim)

-    parnames <- f.gg.parms[,"Name"]

-    newparnames <- names(got_initials)

-    commonparnames <- intersect(parnames, newparnames)

-    f.gg.parms[commonparnames, "Initial"] <<- got_initials[commonparnames]

-  }

-}

-get.initials.gb <- gbutton("Get initials from", cont = f.gg.buttons,

-                           handler = get_initials_handler)

-get.initials.gc <- gcombobox(paste("Fit", f.df$Fit), cont = f.gg.buttons)

-

-# Notebook to the right {{{3

-f.gn <- gnotebook(cont = p.gg, width = 680, height = 790)

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

-f.gg.parms <- gdf(Parameters, cont = f.gn, 

-                 width = 670, height = 750,

-                 do_add_remove_buttons = FALSE, label = "Parameters")

-f.gg.parms$set_column_width(1, 200)

-f.gg.parms$set_column_width(2, 50)

-f.gg.parms$set_column_width(3, 60)

-f.gg.parms$set_column_width(4, 50)

-f.gg.parms$set_column_width(5, 60)

-

-# Fit options form {{{4

-f.gg.opts <- gformlayout(cont = f.gn, label = "Fit options")

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

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

-                         cont = f.gg.opts, checked = FALSE)

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

-                          label = "solution_type", width = 200,

-                          cont = f.gg.opts)

-f.gg.opts.atol <- gedit(ftmp$atol, label = "atol", width = 20,

-                         cont = f.gg.opts)

-f.gg.opts.rtol <- gedit(ftmp$rtol, label = "rtol", width = 20,

-                         cont = f.gg.opts)

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

-                         cont = f.gg.opts, checked = TRUE)

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

-                         cont = f.gg.opts, checked = TRUE)

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

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

-                              width = 200, cont = f.gg.opts)

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

-                                       label = "reweight.method",

-                                       width = 200,

-                                       cont = f.gg.opts)

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

-                                 width = 20, cont = f.gg.opts)

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

-                                 width = 20, cont = f.gg.opts)

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

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

-                                 width = 20, cont = f.gg.opts)

-

-# Summary {{{3

-oldwidth <- options()$width

-options(width = 90)

-f.gg.summary <- ggroup(label = "Summary", cont = f.gn, horizontal = FALSE)

-f.gg.summary.topline <- ggroup(cont = f.gg.summary, horizontal = TRUE)

-f.gg.summary.filename <- gedit(paste(ds[[ds.cur]]$title, "_", m[[m.cur]]$name,

-                                     ".txt", sep = ""),

-                               width = 50, cont = f.gg.summary.topline)

-f.gg.summary.savebutton <-  gbutton("Save summary", cont = f.gg.summary.topline,

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

-                                      filename <- svalue(f.gg.summary.filename)

-                                      if (file.exists(filename))

-                                      {

-                                        gconfirm(paste("File", filename, "exists. Overwrite?"),

-                                                 parent = w,

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

-                                                   capture.output(stmp,  file = filename)

-                                                 })

-                                      } else {

-                                        capture.output(stmp,  file = filename)

-                                      }

-                                    })

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

-                        cont = f.gg.summary, label = "Summary")

-options(width = oldwidth)

-

-# Plot options {{{4

-f.gg.plotopts <- ggroup(cont = f.gn, label = "Plot options", horizontal = FALSE,

-                        width = 200)

-

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

-                  cont = f.gg.plotopts,

-                  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[[m.cur]]$spec), cont = f.gg.plotopts, 

-                                 checked = TRUE)

-svalue(f.gn) <- 1

-

-# Update the plotting and fitting area {{{3

-update_plotting_and_fitting <- function() {

-  svalue(pf) <- paste0("Fit ", f.cur, ": Dataset ", ftmp$ds.index, 

-                       ", Model ", ftmp$mkinmod$name)

-  # Parameters

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

-

-  # Fit options

-  delete(f.gg.buttons, get.initials.gc)

-  get.initials.gc <<- gcombobox(paste("Fit", f.df$Fit), cont = f.gg.buttons)

-

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

-  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.weight) <- ftmp$weight.ini

-  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.method.modFit) <- ftmp$method.modFit

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

-

-  # Summary

-  oldwidth <<- options()$width

-  options(width = 90)

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

-  options(width = oldwidth)

-

-  # Plot options

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

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

-                                   checked = TRUE)

-  # Plot

-  svalue(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name,

-                                       ".", plot_format, sep = "")

-  show_plot("Optimised")  

- 

-}

 # vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1