- New candidate for release containing the latest changes to the GUI

- Checking and releasing myself as r-forge has a stuffed build pipeline



git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/kinfit/pkg/mkin@139 edb9625f-4e0d-4859-8d74-9fd3b1da38cb

5 files changed, 100 insertions, 724 deletions

diff --git a/inst/GUI/README b/inst/GUI/README
index aa83ea6c..f431c2d1 100644
--- a/inst/GUI/README
+++ b/inst/GUI/README
@@ -1 +1 @@
-These code fragments do not provide a GUI for mkin. They are purely experimental.
+These code fragments are experimental.
diff --git a/inst/GUI/TODO b/inst/GUI/TODO
index e9089eda..c0e822c6 100644
--- a/inst/GUI/TODO
+++ b/inst/GUI/TODO
@@ -1,4 +1,3 @@
 - Import of csv files
-- Create widgets for model configuration only once per dataset, it takes too much time
 - Make summary text file accessible
 - Make plot of fit and residuals accessible
diff --git a/inst/GUI/mkinGUI.R b/inst/GUI/mkinGUI.R
index b418b42d..921daea7 100644
--- a/inst/GUI/mkinGUI.R
+++ b/inst/GUI/mkinGUI.R
@@ -119,10 +119,13 @@ update_f.df <- function() {
   for (fit.index in names(f)) {

     f.count <- f.count + 1

     ftmp <- f[[fit.index]]

-    f.df[f.count, ] <<- c(as.character(f.count), ftmp$ds.index, ftmp$m.name)

+    f.df[f.count, ] <<- c(as.character(f.count), ftmp$ds.index, ftmp$mkinmod$name)

   }

 }

-

+f.df.empty <- f.df <- data.frame(Fit = "0", 

+                               Dataset = "", 

+                               Model = "",

+                               stringsAsFactors = FALSE)

 # Widgets and handlers for project data {{{1

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

 # Project data management handler functions {{{2

@@ -138,31 +141,32 @@ upload_file_handler <- function(h, ...)
   studies.gdf[,] <- studies.df 

 

   # Datasets

-  ds.cur <<- "1"

+  ds.cur <<- ds.cur

   ds <<- ds

   update_ds.df()

   ds.gtable[,] <- ds.df

   update_ds_editor()

 

   # Models

-  m.cur <<- "1"

+  m.cur <<- ds.cur

   m <<- m

   update_m.df()

   m.gtable[,] <- m.df

   update_m_editor()

 

   # Fits

-  f.cur <<- "1"

+  f.cur <<- f.cur

   f <<- f

   s <<- s

-  update_f.df()

+  if (length(f) > 0) update_f.df()

+  else f.df <- f.df.empty

   f.gtable[,] <- f.df

   update_plotting_and_fitting()

 }

 save_to_file_handler <- function(h, ...)

 {

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

-   save(studies.df, ds, m, f, s, file = project_file)

+   save(studies.df, ds, ds.cur, m, m.cur, f, s, f.cur, file = project_file)

    galert(paste("Saved project contents to", project_file), parent = w)

 }

 change_project_file_handler = function(h, ...) {

@@ -219,23 +223,19 @@ gbutton("Configure fit for selected model and dataset", cont = dsm,
         handler = function(h, ...) {

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

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

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

-          f[[f.cur]] <<- suppressWarnings(

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

-                                        err = "err", 

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

-          f[[f.cur]]$ds.index <<- ds.i

-          f[[f.cur]]$ds <<- ds[[ds.i]]

-          f[[f.cur]]$m.index <<- m.i

-          f[[f.cur]]$m.name <<- m[[m.i]]$name

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

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

+                                            err = "err", 

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

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

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

           update_f.df()

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

-          s[[f.cur]] <<- summary(f[[f.cur]])

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

-                               ", Model ", m[[m.i]]$name)

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

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

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

           svalue(center) <- 3

         })

 

@@ -243,15 +243,18 @@ gbutton("Configure fit for selected model and dataset", cont = dsm,
 f.gf <- gframe("Fits", cont = left, horizontal = FALSE)

 # Fit table with handler {{{2

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

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

-  update_plotting_and_fitting()

+  if (svalue(h$obj) != "0") {

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

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

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

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

+    update_plotting_and_fitting()

+  }

   svalue(center) <- 3

 }

-f.df <- data.frame(Fit = "1", Dataset = "1", Model = "SFO", 

-                   stringsAsFactors = FALSE)

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

 addHandlerDoubleClick(f.gtable, f.switcher)

-size(f.gtable) <- list(columnWidths = c(80, 80, 120))

+size(f.gtable) <- list(columnWidths = c(40, 60, 180))

 

 # Dataset editor {{{1

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

@@ -516,15 +519,15 @@ show_plot <- function(type, default = FALSE) {
   deparms <- as.numeric(Parameters.de[[type]])

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

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

-    ftmp <- suppressWarnings(

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

-                                    state.ini = stateparms, parms.ini = deparms,

-                                    err = "err", 

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

-                            )

-  } else {

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

-  }

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

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

+                                      state.ini = stateparms, 

+                                      parms.ini = deparms,

+                                      err = "err", 

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

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

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

+  } 

 

   tmp <- get_tempfile(ext=".svg")

   svg(tmp, width = 7, height = 5)

@@ -566,42 +569,39 @@ run_fit <- function() {
   iniparms <- Parameters.ini$Initial

   names(iniparms) <- sub("_0", "", Parameters.ini$Name)

   inifixed <- names(iniparms[Parameters.ini$Fixed])

-  f[[f.cur]] <<- mkinfit(m[[m.i]], 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")

-  f[[f.cur]]$ds.index <<- ds.i

-  f[[f.cur]]$ds <<- ds[[ds.i]]

-  f[[f.cur]]$m.index <<- m.i

-  f[[f.cur]]$m.name <<- m[[m.i]]$name

-  s[[f.cur]] <<- summary(f[[f.cur]])

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

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

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

+  stmp <<- summary(ftmp)

   show_plot("Optimised")

-  svalue(f.gg.opts.st) <- f[[f.cur]]$solution_type

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

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

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

 }

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

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

+f.cur <- "0"

 

 # GUI widgets {{{2

-pf <- gframe("Fit 1: Dataset 1, Model SFO", horizontal = FALSE, 

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

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

 

 # Mid group with plot and options {{{3

 f.gg.mid <- ggroup(cont = pf)

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

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

                                  err = "err", 

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

-f[[f.cur]]$ds.index = ds.i

-f[[f.cur]]$ds = ds[[ds.i]]

-f[[f.cur]]$m.index = m.i

-f[[f.cur]]$m.name = m[[m.i]]$name

-s[[f.cur]] <- summary(f[[f.cur]])

-Parameters <- get_Parameters(s[[f.cur]], FALSE)

+ftmp$ds.index = ds.i

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

+stmp <- summary(ftmp)

+Parameters <- get_Parameters(stmp, FALSE)

 tf <- get_tempfile(ext=".svg")

 svg(tf, width = 7, height = 5)

-plot(f[[f.cur]])

+plot(ftmp)

 dev.off()

 plot.gs <- gsvg(tf, container = f.gg.mid, width = 490, height = 350)

 f.gg.opts <- gformlayout(cont = f.gg.mid)

@@ -621,27 +621,52 @@ f.gg.parms$set_column_width(5, 60)
 

 # Row with buttons {{{3

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

-gbutton("Show initial", 

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

-        cont = f.gg.buttons)

-gbutton("Run", handler = function(h, ...) run_fit(),

-        cont = f.gg.buttons)

-gbutton("Delete", handler = function(h, ...) {

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

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

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

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

-          update_f.df()

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

+run.fit.gb <- gbutton("Run", 

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

+                       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

+                          }, 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.gb <- gbutton("Delete", handler = function(h, ...) {

+          if (length(f) > 0) {

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

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

+          }

+          if(length(f) > 1) {

+            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 <<- f[[f.cur]]

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

+            update_plotting_and_fitting()

+          } else {

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

+            f.cur <<- "0"

+          }

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

-          f.cur <<- "1"

         }, cont = f.gg.buttons)

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

 

 # Update the plotting and fitting area {{{3

 update_plotting_and_fitting <- function() {

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

-                       ", Model ", f[[f.cur]]$m.name)

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

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

   show_plot("Optimised")  

-  svalue(f.gg.opts.st) <- f[[f.cur]]$solution_type

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

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

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

 }

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

diff --git a/inst/GUI/run_simple.R b/inst/GUI/run_simple.R
deleted file mode 100644
index 49af7682..00000000
--- a/inst/GUI/run_simple.R
+++ /dev/null
@@ -1,3 +0,0 @@
-require(gWidgetsWWW2)

-load_app("simple.R")

-# vim: set filetype=r:

diff --git a/inst/GUI/simple.R b/inst/GUI/simple.R
deleted file mode 100644
index e53ffa18..00000000
--- a/inst/GUI/simple.R
+++ /dev/null
@@ -1,645 +0,0 @@
-# $Id$ {{{1

-

-# Simple gWidgetsWWW2 GUI for mkin

-

-# Copyright (C) 2013 Johannes Ranke

-# Contact: jranke@uni-bremen.de, johannesranke@eurofins.com

-

-# This file is part of the R package mkin

-

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

-

-# This program is distributed in the hope that it will be useful, but WITHOUT

-# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS

-# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more

-# details.

-

-# You should have received a copy of the GNU General Public License along with

-# this program. If not, see <http://www.gnu.org/licenses/>

-require(mkin) # {{{1

-# Set the GUI title and create the parent frame {{{1

-GUI_title <- "Simple Browser based GUI for kinetic evaluations using mkin"

-w <- gwindow(GUI_title)

-sb <- gstatusbar("Powered by gWidgetsWWW2 and Rook", cont = w)

-g <- gframe(GUI_title, cont = w, use.scrollwindow = TRUE, horizontal = FALSE)

-# Set default values for project data {{{1

-# Initial project file name {{{2

-project_file <- "mkin_FOCUS_2006.RData"

-# Initial studies {{{2

-studies.df <- data.frame(Index = as.integer(1), 

-                         Author = "FOCUS kinetics workgroup",

-                         Year = "2006", 

-                         Title = "FOCUS Kinetics",

-                         stringsAsFactors = FALSE)

-

-# Initial datasets {{{2

-ds <- list()

-observed.all <- vector()

-for (i in 1:2) {

-  ds.letter = LETTERS[i + 2]

-  ds.index <- as.character(i)

-  ds.name = paste0("FOCUS_2006_", ds.letter)

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

-    study_nr = 1,

-    title = paste("FOCUS example dataset", ds.letter),

-    sampling_times = unique(get(ds.name)$time),

-    time_unit = "",

-    observed = as.character(unique(get(ds.name)$name)),

-    unit = "% AR",

-    replicates = 1,

-    data = get(ds.name)

-  )

-  ds[[ds.index]]$data$name <- as.character(ds[[ds.index]]$data$name)

-  ds[[ds.index]]$data$override = as.numeric(NA)

-  ds[[ds.index]]$data$err = 1

-}

-# Initial models {{{2

-m <- list()

-m[["1"]] <- mkinmod(parent = list(type = "SFO"))

-m[["1"]]$name = "SFO"

-m[["2"]] <- mkinmod(parent = list(type = "FOMC"))

-m[["2"]]$name = "FOMC"

-m[["3"]] <- mkinmod(parent = list(type = "DFOP"))

-m[["3"]]$name = "DFOP"

-m[["4"]] <- mkinmod(parent = list(type = "SFO", to = "m1"),

-                          m1 = list(type = "SFO"),

-                          use_of_ff = "max")

-m[["4"]]$name = "SFO_SFO"

-# Initial fit lists {{{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)

-}

-# The GUI elements for each dataset are kept in lists

-f.gg <- f.gg.sel <- f.gg.parms <- f.gg.opts <- list()

-# The fits and summaries are collected in a list of lists

-f <- s <- list()

-for (ds.i in 1:length(ds)) {

-  f[[as.character(ds.i)]] <- list()

-  s[[as.character(ds.i)]] <- list()

-}

-# Data frames with datasets, models and fits to be continuosly updated {{{1

-# Dataframe with datasets for selection {{{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()

-update_ds.df()

-ds.cur = "1"

-# Dataframe with models for selection {{{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()

-update_m.df()

-m.cur = "1"

-# Expandable group for project data management {{{1

-prg <- gexpandgroup("Project file management", cont = g)

-# Project data management handler functions {{{2

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

-{

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

-  try(load(tmpfile))

-  project_file <<- pr.gf$filename

-  svalue(wf.ge) <- project_file

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

-  ds.cur <<- "1"

-  ds <<- ds

-  update_ds.df()

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

-  update_ds_editor()

-  m.cur <<- "1"

-  m <<- m

-  update_m.df()

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

-  update_m_editor()

-}

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

-{

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

-   save(studies.df, ds, m, file = project_file)

-   galert(paste("Saved project contents to", project_file), parent = w)

-}

-# Project data management GUI elements {{{2

-pr.vg <- ggroup(cont = prg, horizontal = FALSE)

-pr.hg <- ggroup(cont = pr.vg, horizontal = TRUE)

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

-               handler = upload_file_handler)

-pr.vg2 <- ggroup(cont = pr.hg, horizontal = FALSE)

-pr.hg2 <- ggroup(cont = pr.vg2, horizontal = TRUE)

-glabel("Current project file name is", cont = pr.hg2)

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

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

-}

-wf.ge <- gedit(project_file, cont = pr.hg2, 

-               handler = change_project_file_handler)

-

-gbutton("Save current project contents to this file", cont = pr.vg2,

-        handler = save_to_file_handler)

-

-# Expandable group for studies {{{1

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

-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 = "Studies in the project",

-                   width = 500, height = 200, cont = stg)

-studies.gdf$set_column_width(1, 40)

-studies.gdf$set_column_width(2, 200)

-addHandlerChanged(studies.gdf, update_study_selector)

-

-# Datasets and models {{{1

-dsm <- gframe("Datasets and models - double click to edit", cont = g,

-              horizontal = TRUE)

- 

-# Dataset table with handler {{{2

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

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

-  update_ds_editor()

-  visible(dse) <- TRUE

-  visible(me) <- FALSE

-}

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

-addHandlerDoubleClick(ds.gtable, ds.switcher)

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

-

-# Model table with handler {{{2

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

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

-  update_m_editor()

-  visible(dse) <- FALSE

-  visible(me) <- TRUE

-}

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

-addHandlerDoubleClick(m.gtable, m.switcher)

-size(m.gtable) <- list(columnWidths = c(40, 200))

-

-# Section for selecting datasets and model {{{2

-dsmsel <- gvbox(cont = dsm)

-show_plot <- function(ds.i, type) {

-  m.i <- as.character(svalue(f.gg.sel[[ds.i]], index = TRUE))

-  ow <- options("warn")

-  options(warn = -1)

-  Parameters <- f.gg.parms[[ds.i]][,]

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

-    f[[ds.i]][[m.i]] <- mkinfit(m[[m.i]], override(ds[[ds.i]]$data),

-                                 state.ini = stateparms,

-                                 parms.ini = deparms,

-                                 err = "err", control.modFit = list(maxiter = 0))

-  }

-

-  options(ow)

-  tmp <- get_tempfile(ext=".svg")

-  svg(tmp, width = 7, height = 5)

-  plot(f[[ds.i]][[m.i]], main = ds[[ds.i]]$title,

-       xlab = ifelse(ds[[ds.i]]$time_unit == "", "Time", 

-                     paste("Time in", ds[[ds.i]]$time_unit)),

-       ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", 

-                     paste("Observed in", ds[[ds.i]]$unit)))

-  dev.off()

-  svalue(plots[[ds.i]]) <<- tmp

-}

-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(ds.i) {

-  m.i <- as.character(svalue(f.gg.sel[[ds.i]], index = TRUE))

-  Parameters <- f.gg.parms[[ds.i]][,]

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

-  deparms <- Parameters.de$Initial

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

-  f[[ds.i]][[m.i]] <- mkinfit(m[[m.i]], override(ds[[ds.i]]$data),

-                              state.ini = subset(Parameters,

-                                                 Type == "state")$Initial,

-                              parms.ini = deparms, 

-                              err = "err")

-  s[[ds.i]][[m.i]] <- summary(f[[ds.i]][[m.i]])

-  f.gg.parms[[ds.i]][,] <- get_Parameters(s[[ds.i]][[m.i]], TRUE)

-  show_plot(ds.i, "Optimised")

-}

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

-  m.i <- as.character(svalue(h$obj, index = TRUE))

-  if (is.null(f[[ds.i]][[m.i]])) {

-    f[[ds.i]][[m.i]] <<- mkinfit(m[[m.i]], override(ds[[ds.i]]$data),

-                                err = "err", control.modFit = list(maxiter = 0))

-  }

-  if (is.na(f.gg.parms[[ds.i]][1, "Optimised"])) {

-    f.gg.parms[[ds.i]][,] <- get_Parameters(summary(f[[ds.i]][[m.i]]), FALSE)

-    show_plot(ds.i, "Initial")

-  } else {

-    f.gg.parms[[ds.i]][,] <- get_Parameters(s[[ds.i]][[m.i]], TRUE)

-    show_plot(ds.i, "Optimised")

-  }

-}

-show_fit_config <- function(ds.i) {

-  ftmp <- f[[ds.i]][["1"]]

-  stmp <- summary(ftmp)

-  Parameters <- get_Parameters(stmp, FALSE)

-  f.gg[[ds.i]] <<- gvbox(cont = prows[[ds.i]])

-

-  f.gg.head <- ggroup(cont = f.gg[[ds.i]])

-  f.gg.sel[[ds.i]] <- gcombobox(m.df$Name, sel = 1, cont = f.gg.head,

-                                handler = select_model_handler)

-  gbutton("Show initial", 

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

-          cont = f.gg.head)

-  gbutton("Run", handler = function(h, ...) run_fit(ds.i),

-          cont = f.gg.head)

-

-  f.gg.rest <- ggroup(cont = f.gg[[ds.i]])

-  f.gg.parms[[ds.i]] <<- gdf(Parameters, width = 420, height = 300,

-                             cont = f.gg.rest, 

-                             do_add_remove_buttons = FALSE)

-  f.gg.parms[[ds.i]]$set_column_width(1, 200)

-  f.gg.parms[[ds.i]]$set_column_width(2, 50)

-  f.gg.parms[[ds.i]]$set_column_width(3, 60)

-  f.gg.parms[[ds.i]]$set_column_width(4, 50)

-  f.gg.parms[[ds.i]]$set_column_width(5, 60)

-

-  f.gg.opts[[ds.i]] <<- gformlayout(cont = f.gg.rest)

-  solution_types <- character()

-  if (length(ftmp$mkinmod$map) == 1) solution_types <- "analytical"

-  if (is.matrix(ftmp$mkinmod$coefmat)) solution_types <- c(solution_types, "eigen")

-  solution_types <- c(solution_types, "deSolve")

-

-  gcombobox(solution_types, selected = 1, 

-            label = "solution_type", 

-            cont = f.gg.opts[[ds.i]])

-}

-#configure_fits_handler <- function(h, ...) {

-#  ds.sel <- as.character(svalue(ds.gtable))

-#  m.sel <- as.character(svalue(m.gtable))

-#}

-#dsconfig <- gbutton("Configure fits for selections", cont = dsmsel, 

-#                  handler = configure_fits_handler)

- 

-# Expandable group for the dataset editor {{{1

-dse <- gexpandgroup("Dataset editor", cont = g, horizontal = FALSE)

-visible(dse) <- FALSE

-

-# Handler functions {{{3

-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

-  prows[[ds.cur]] <<- ggroup(cont = pfv)

-  plots[[ds.cur]] <<- gsvg(svg_plot(ds.cur), 

-                        container = prows[[ds.cur]], 

-                        width = 490, height = 350)

-}

- 

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

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

-  delete(pfv, prows[[ds.cur]])

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

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

-  update_ds.df()

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

-  update_ds_editor()

-}

- 

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

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

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

-                        study_nr = 1,

-                        title = "",

-                        sampling_times = c(0, 1),

-                        time_unit = "NA",

-                        observed = "parent",

-                        unit = "NA",

-                        replicates = 1,

-                        data = data.frame(

-                                          name = "parent",

-                                          time = c(0, 1),

-                                          value = c(100, NA),

-                                          override = "NA",

-                                          err = 1,

-                                          stringsAsFactors = FALSE

-                                          )

-                        )

-  update_ds.df()

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

-  update_ds_editor()

-  prows[[ds.cur]] <<- ggroup(cont = pfv)

-  plots[[ds.cur]] <<- gsvg(svg_plot(ds.cur), 

-                        container=prows[[ds.cur]], 

-                        width = 490, height = 350)

-}

-

-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 = rep(sampling_times, each = replicates, times = length(obs)),

-    value = NA,

-    override = NA,

-    err = 1

-  )

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

-}

-

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

-  update_plot()

-}

- 

-

-# Widget setup {{{3

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

-# Line 1 {{{4

-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 {{{4

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

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

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

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

-

-# Line 3 with forms {{{4

-ds.e.forms <- ggroup(cont= ds.editor, 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 = 50,

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

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

-        handler = empty_grid_handler)

-

-# Save button {{{4

-gbutton("Save changes", cont = ds.editor, handler = save_ds_changes_handler)

-

-# Kinetic Data {{{4

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

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

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

-enter_next_value_handler <- function(h, ...) galert("next value", parent = w)

-addHandlerChanged(ds.e.gdf, enter_next_value_handler)

-

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

-

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

-}

-

-# Expandable group for the model editor {{{1

-me <- gexpandgroup("Model editor", cont = g, horizontal = FALSE)

-visible(me) <- FALSE

-

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

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

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

-  m.cur <<- "1"

-  update_m.df()

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

-  update_m_editor()

-}

-

-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", "FOMC", "DFOP", "HS", "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("", 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_compound_handler, 

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

-}

-

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

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

-  update_m_editor()

-}

-

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

-  spec <- list()

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

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

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

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

-    if(spec[[obs.i]]$to == "") 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.editor <- gframe("Model 1", horizontal = FALSE, cont = me)

-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 transformation product", cont = m.e.b, 

-        handler = add_observed_handler)

-gbutton("Save changes", cont = m.e.b, handler = save_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.observed)) {

-    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", "FOMC", "DFOP", "HS", "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), "",

-                 m[[m.cur]]$spec[[obs.i]]$to)

-    m.e.to[[obs.i]] <<- gedit(obs.to, 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 compound", handler = remove_compound_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}}}

-# Plots and fits {{{1

-pf <- gframe("Plots and fitting", cont = g)

-pfv <- gvbox(cont = pf)

-prows <- plots <- list()

-

-svg_plot <- function(ds.i) {

-    d <- ds[[ds.i]]

-

-    f <- get_tempfile(ext=".svg")

-    svg(f, width = 7, height = 5)

-      plot(0, type = "n",

-           xlim = c(0, max(d$data$time, na.rm = TRUE)),

-           xlab = ifelse(d$time_unit == "", "Time",

-                         paste("Time in", d$time_unit)),

-           ylim = c(0, max(d$data$value, na.rm = TRUE)),

-           ylab = ifelse(d$unit == "", "Observed", 

-                         paste("Observed in", d$unit)),

-           main = d$title)

-      pointcolor = 1

-      for (obs_var in d$observed) {

-        points(subset(d$data, name == obs_var, c(time, value)), 

-               col = pointcolor)

-        pointcolor = pointcolor + 1

-      }

-      legend("topright", inset = c(0.05, 0.05), legend = d$observed,

-             pch = 1, col = 1:length(d$observed))

-    dev.off()

-    return(f)

-}

-

-# Show the plots and the fit configuration

-for (ds.i in 1:length(ds)) {

-  ds.plot <- as.character(ds.i)

-  prows[[ds.plot]] <- ggroup(cont = pfv)

-  plots[[ds.plot]] <- gsvg(svg_plot(ds.plot), 

-                        container=prows[[ds.plot]], 

-                        width = 490, height = 350)

-

- f[[ds.plot]][["1"]] <- mkinfit(m[["1"]], override(ds[[ds.plot]]$data), 

-                                 err = "err", control.modFit = list(maxiter = 0))

- show_fit_config(ds.i)

-}

-

-update_plot <- function() {

-  svalue(plots[[ds.cur]]) <<- svg_plot(ds.cur)

-}

-

-# 1}}}

-# vim: set foldmethod=marker foldlevel=0 ts=2 sw=2 expandtab: