aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjranke <jranke@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>2013-10-16 15:18:14 +0000
committerjranke <jranke@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>2013-10-16 15:18:14 +0000
commitebf00aeb389424b09be4a1051044291b01555153 (patch)
treeccd63de4f9afbb2012d2c24fb0a06836c1d555f0
parentb85eb94988f28eb2a096c377470f39e752e466d0 (diff)
- More consistent output regarding optimised and fixed parameters (see ChangeLog)
- Switch from gcanvas to gsvg - Start setting up the fits in the GUI - add files for testing gWidgetsWWW2 functionality git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/kinfit/pkg/mkin@115 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
-rw-r--r--ChangeLog5
-rw-r--r--DESCRIPTION2
-rw-r--r--R/mkinfit.R13
-rw-r--r--inst/GUI/simple.R145
4 files changed, 112 insertions, 53 deletions
diff --git a/ChangeLog b/ChangeLog
index 3aabc99d..a53ea241 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2013-10-16 Johannes Ranke<jranke@uni-bremen.de> for mkin (0.9-22)
+
+ * Unify naming of initial values of state variables
+ * Unify naming in dataframes of optimised and fixed parameters in the summary
+
2013-10-10 Johannes Ranke<jranke@uni-bremen.de> for mkin (0.9-22)
* Show the weighting method for residuals in the summary
diff --git a/DESCRIPTION b/DESCRIPTION
index 30ca6121..f7a293d3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -13,7 +13,7 @@ Description: Calculation routines based on the FOCUS Kinetics Report (2006).
(default is a Levenberg-Marquardt variant). Please note that no warranty is
implied for correctness of results or fitness for a particular purpose.
Depends: FME, deSolve, minpack.lm
-Suggests: RUnit, gWidgetsWWW2, canvas
+Suggests: RUnit, gWidgetsWWW2, RSVGTipsDevice
License: GPL
LazyLoad: yes
LazyData: yes
diff --git a/R/mkinfit.R b/R/mkinfit.R
index b46184b7..70ca9c0e 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -89,11 +89,16 @@ mkinfit <- function(mkinmod, observed,
state.ini.fixed <- state.ini[fixed_initials]
state.ini.optim <- state.ini[setdiff(names(state.ini), fixed_initials)]
- # Preserve names of state variables before renaming initial state variable parameters
+ # Preserve names of state variables before renaming initial state variable
+ # parameters
state.ini.optim.boxnames <- names(state.ini.optim)
+ state.ini.fixed.boxnames <- names(state.ini.fixed)
if(length(state.ini.optim) > 0) {
names(state.ini.optim) <- paste(names(state.ini.optim), "0", sep="_")
}
+ if(length(state.ini.fixed) > 0) {
+ names(state.ini.fixed) <- paste(names(state.ini.fixed), "0", sep="_")
+ }
# Decide if the solution of the model can be based on a simple analytical
# formula, the spectral decomposition of the matrix (fundamental system)
@@ -138,8 +143,8 @@ mkinfit <- function(mkinmod, observed,
if(length(state.ini.optim) > 0) {
odeini <- c(P[1:length(state.ini.optim)], state.ini.fixed)
- names(odeini) <- c(state.ini.optim.boxnames, names(state.ini.fixed))
- } else odeini <- state.ini.fixed
+ names(odeini) <- c(state.ini.optim.boxnames, state.ini.fixed.boxnames)
+ } else odeini <- state.ini.fixed.boxnames
odeparms <- c(P[(length(state.ini.optim) + 1):length(P)], parms.fixed)
@@ -235,7 +240,7 @@ mkinfit <- function(mkinmod, observed,
fit$predicted <- mkin_wide_to_long(out_predicted, time = "time")
# Collect initial parameter values in two dataframes
- fit$start <- data.frame(initial = c(state.ini.optim,
+ fit$start <- data.frame(value = c(state.ini.optim,
backtransform_odeparms(parms.optim, mod_vars)))
fit$start$type = c(rep("state", length(state.ini.optim)),
rep("deparm", length(parms.optim)))
diff --git a/inst/GUI/simple.R b/inst/GUI/simple.R
index ab9d8d90..91b23d10 100644
--- a/inst/GUI/simple.R
+++ b/inst/GUI/simple.R
@@ -19,7 +19,7 @@
# 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); require(canvas) # {{{1
+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)
@@ -54,7 +54,7 @@ for (i in 1:5) {
)
ds[[ds.index]]$data$name <- as.character(ds[[ds.index]]$data$name)
ds[[ds.index]]$data$override = as.numeric(NA)
- ds[[ds.index]]$data$weight = 1
+ ds[[ds.index]]$data$err = 1
}
# Initial models {{{2
m <- list()
@@ -68,16 +68,18 @@ m[["4"]] <- mkinmod(parent = list(type = "SFO", to = "m1"),
m1 = list(type = "SFO"),
use_of_ff = "max")
m[["4"]]$name = "SFO_SFO"
-# Initial fits {{{2
-f <- list()
+# 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),
- weight = d$weight)
+ err = d$err)
+}
+f <- f.gg <- s <- list()
+for (ds.i in 1:length(ds)) {
+ f[[as.character(ds.i)]] <- list()
+ f.gg[[as.character(ds.i)]] <- list()
+ s[[as.character(ds.i)]] <- list()
}
-f[["1"]] <- mkinfit(m[["1"]], override(ds[["1"]]$data), err = "weight")
-f[["1"]]$dataset_title = ds[["1"]]$title
-f[["1"]]$model_name = m[["1"]]$name
# Data frames with datasets, models and fits to be continuosly updated {{{1
# Dataframe with datasets for selection {{{2
update_ds.df <- function() {
@@ -113,21 +115,21 @@ m.df <- data.frame()
update_m.df()
m.cur = "1"
# Dataframe with fits for selection {{{2
-update_f.df <- function() {
- f.n <- length(f)
- f.df <<- data.frame(Index = 1:f.n,
- Dataset = character(f.n),
- Model = character(f.n),
- stringsAsFactors = FALSE)
- for (i in 1:f.n) {
- f.index <- names(f)[[i]]
- f.df[i, "Dataset"] <<- f[[f.index]]$dataset_title
- f.df[i, "Model"] <<- f[[f.index]]$model_name
- }
-}
-f.df <- data.frame()
-update_f.df()
-f.cur = "1"
+#update_f.df <- function() {
+# f.n <- length(f)
+# f.df <<- data.frame(Index = 1:f.n,
+# Dataset = character(f.n),
+# Model = character(f.n),
+# stringsAsFactors = FALSE)
+# for (i in 1:f.n) {
+# f.index <- names(f)[[i]]
+# f.df[i, "Dataset"] <<- f[[f.index]]$dataset_title
+# f.df[i, "Model"] <<- f[[f.index]]$model_name
+# }
+#}
+#f.df <- data.frame()
+#update_f.df()
+#f.cur = "1"
# Expandable group for project data management {{{1
prg <- gexpandgroup("Project file management", cont = g)
# Project data management handler functions {{{2
@@ -213,29 +215,22 @@ size(m.gtable) <- list(columnWidths = c(40, 200))
# Section for selecting datasets and model {{{2
dsmsel <- gvbox(cont = dsm)
-ds_plot_handler <- function(h, ...) {
- ds.sel <- svalue(ds.gtable)
- n.ds.sel <- length(ds.sel)
- for (i in 1:n.ds.sel) {
- prows[[i]] <<- ggroup(cont = pfv)
- d <- ds[[ds.sel[[i]]]]
-
- f <- tempfile()
- canvas(f, width = 500, height = 350)
- plot(0, type = "n",
- xlim = c(0, max(d$data$time, na.rm = TRUE)),
- ylim = c(0, max(d$data$value, na.rm = TRUE)),
- main = d$title)
- for (obs_var in d$observed) {
- points(subset(d$data, name == obs_var, c(time, value)))
- }
- dev.off()
- plots[[i]] <- gcanvas(f, cont = prows[[i]], width = 500, 350)
+configure_fits_handler <- function(h, ...) {
+ ds.sel <- as.character(svalue(ds.gtable))
+ m.sel <- as.character(svalue(m.gtable))
+ for (ds.i in ds.sel) {
+ for (m.i in m.sel) {
+ f.gg[[ds.i]][[m.i]] <- ggroup(cont = f.gn[[ds.i]], label = m[[m.i]]$name)
+ f[[ds.i]][[m.i]] <- mkinfit(m[[m.i]], override(ds[[ds.i]]$data),
+ err = "err", control.modFit = list(maxiter = 0))
+ s[[ds.i]][[m.i]] <- summary(f[[ds.i]][[m.i]])
+ glabel(s[[ds.i]][[m.i]]$date.fit, cont = f.gg[[ds.i]][[m.i]])
+ }
}
}
-dsplot <- gbutton("Plot selected datasets", cont = dsmsel,
- handler = ds_plot_handler)
+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)
@@ -249,11 +244,16 @@ copy_dataset_handler <- function(h, ...) {
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
- names(ds) <<- as.character(1:length(ds))
+ 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
@@ -275,13 +275,17 @@ new_dataset_handler <- function(h, ...) {
time = c(0, 1),
value = c(100, NA),
override = "NA",
- weight = 1,
+ 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, ...) {
@@ -293,7 +297,7 @@ empty_grid_handler <- function(h, ...) {
time = rep(sampling_times, each = replicates, times = length(obs)),
value = NA,
override = NA,
- weight = 1
+ err = 1
)
ds.e.gdf[,] <- new.data
}
@@ -312,6 +316,7 @@ save_ds_changes_handler <- function(h, ...) {
ds[[ds.cur]]$replicates <<- max(aggregate(tmpd$time,
list(tmpd$time, tmpd$name), length)$x)
update_ds_editor()
+ update_plot()
}
@@ -464,6 +469,7 @@ 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)
@@ -501,12 +507,55 @@ update_m_editor <- function() {
# 3}}}
# 2}}}
-# Plots and fitting {{{1
+# Plots and fits {{{1
pf <- gframe("Plots and fitting", cont = g)
pfv <- gvbox(cont = pf)
-prows <- plots <- list()
+prows <- plots <- f.gn <- 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 notebooks for the fits
+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.gn[[ds.plot]] <- gnotebook(cont = prows[[ds.plot]], width = 600,
+ handler = function(h, ...) galert("test", parent = w))
+}
+
+update_plot <- function() {
+ svalue(plots[[ds.cur]]) <<- svg_plot(ds.cur)
+}
# Show the fits {{{1
+#f[["1"]][["1"]] <- mkinfit(m[["1"]], override(ds[["1"]]$data), err = "err")
+#f[["1"]][["1"]]$dataset_title = ds[["1"]]$title
+#f[["1"]][["1"]]$model_name = m[["1"]]$name
#mf <- gnotebook(cont = g)
# s <- s.gt <- list()
#s[[1]] <- summary(fits[[1]])

Contact - Imprint