From ebf00aeb389424b09be4a1051044291b01555153 Mon Sep 17 00:00:00 2001 From: jranke Date: Wed, 16 Oct 2013 15:18:14 +0000 Subject: - 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 --- ChangeLog | 5 ++ DESCRIPTION | 2 +- R/mkinfit.R | 13 +++-- inst/GUI/simple.R | 145 ++++++++++++++++++++++++++++++++++++------------------ 4 files changed, 112 insertions(+), 53 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3aabc99..a53ea24 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2013-10-16 Johannes Ranke 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 for mkin (0.9-22) * Show the weighting method for residuals in the summary diff --git a/DESCRIPTION b/DESCRIPTION index 30ca612..f7a293d 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 b46184b..70ca9c0 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 ab9d8d9..91b23d1 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 -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]]) -- cgit v1.2.1