- Added the possibility to specify the observed variable in mkinmod in a checklist

- Added the spec list the the mkinmod objects
- It seems that the GUI model editor is fully functional
- Version bump due to the changes in the mkinmod function arguments, thought they are backward compatible

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

4 files changed, 141 insertions, 18 deletions

diff --git a/DESCRIPTION b/DESCRIPTION
index 21a5428..4c6f2a4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,8 +2,8 @@ Package: mkin
 Type: Package
 Title: Routines for fitting kinetic models with one or more state
   variables to chemical degradation data
-Version: 0.9-20
-Date: 2013-09-25
+Version: 0.9-21
+Date: 2013-10-08
 Author: Johannes Ranke, with contributions from Katrin Lindenberger, René Lehmann
 Maintainer: Johannes Ranke <jranke@uni-bremen.de>
 Description: Calculation routines based on the FOCUS Kinetics Report (2006).
diff --git a/R/mkinmod.R b/R/mkinmod.R
index 09deea4..c743777 100644
--- a/R/mkinmod.R
+++ b/R/mkinmod.R
@@ -18,9 +18,10 @@
 # You should have received a copy of the GNU General Public License along with

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

 

-mkinmod <- function(..., use_of_ff = "min")

+mkinmod <- function(..., use_of_ff = "min", speclist = NULL)

 {

-  spec <- list(...)

+  if (is.null(speclist)) spec <- list(...)

+  else spec <- speclist

   obs_vars <- names(spec)

 

   # Check if any of the names of the observed variables contains any other

@@ -185,7 +186,7 @@ mkinmod <- function(..., use_of_ff = "min")
     } #}}}

   } #}}}

 

-  model <- list(diffs = diffs, parms = parms, map = map, use_of_ff = use_of_ff)

+  model <- list(diffs = diffs, parms = parms, map = map, spec = spec, use_of_ff = use_of_ff)

 

   # Create coefficient matrix if appropriate#{{{

   if (mat) {

diff --git a/inst/GUI/simple.R b/inst/GUI/simple.R
index 201f9c6..54fea68 100644
--- a/inst/GUI/simple.R
+++ b/inst/GUI/simple.R
@@ -60,20 +60,31 @@ update_ds.df()
 ds.cur = "1"

 # Models {{{2

 m <- list()

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

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

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

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

 # Dataframe with models for selection with the gtable widget {{{2

 update_m.df <- function() { # {{{3

   m.n <- length(m)

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

-                      Name = names(m),

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

 

-# Set the initial model number

+# Set initial model number, and specification

 m.cur = "1"

 

 # Project data management {{{1

@@ -89,11 +100,16 @@ upload_file_handler <- function(h, ...)  # {{{2
   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, ...) # {{{2

 {

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

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

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

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

 }

 

@@ -301,14 +317,117 @@ update_ds_editor <- function() {
 me <- gexpandgroup("Model editor", cont = g, horizontal = FALSE)

 visible(me) <- FALSE

 

-m.e.rows <- list()

-m.e.obs <- list()

-m.e.rows[[1]] <- ggroup(cont = me, horizontal = TRUE)

-m.e.obs[[1]] <- gcombobox(observed.all, cont = m.e.rows[[1]])

+# 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_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}}}

diff --git a/man/mkinmod.Rd b/man/mkinmod.Rd
index b528d83..76127c5 100644
--- a/man/mkinmod.Rd
+++ b/man/mkinmod.Rd
@@ -9,7 +9,7 @@
   kinetic model type and reaction or transfer to other observed compartments.

 }

 \usage{

-mkinmod(..., use_of_ff = "min")

+mkinmod(..., use_of_ff = "min", speclist = NULL)

 }

 \arguments{

   \item{...}{

@@ -33,6 +33,10 @@ mkinmod(..., use_of_ff = "min")
     fractions is made in order to avoid fitting the product of formation fractions 

     and rate constants. If "max", formation fractions are always used.

   }

+  \item{speclist}{

+    The specification of the observed variables and their submodel types and 

+    pathways can be given as a single list using this argument. Default is NULL.

+  }

 }

 \value{

   A list of class \code{mkinmod} for use with \code{\link{mkinfit}}, containing 

@@ -55,6 +59,5 @@ SFO <- mkinmod(parent = list(type = "SFO"))
 SFO_SFO <- mkinmod(

   parent = list(type = "SFO", to = "m1"),

   m1 = list(type = "SFO"))

-

 }

 \keyword{ models }