diff options
| -rw-r--r-- | DESCRIPTION | 4 | ||||
| -rw-r--r-- | R/mkinmod.R | 7 | ||||
| -rw-r--r-- | inst/GUI/simple.R | 141 | ||||
| -rw-r--r-- | man/mkinmod.Rd | 7 |
4 files changed, 141 insertions, 18 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 21a54286..4c6f2a4b 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 09deea44..c743777b 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 201f9c68..54fea680 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 b528d834..76127c58 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 }
|