From 3ee9215cf50e9a5cf81195f051fdd8a9ae68dad8 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Sat, 26 Apr 2014 03:06:11 +0200 Subject: New layout for plotting and fitting, add residual plot --- inst/GUI/gmkin.R | 214 ++++++++++++++++++++++++------------------------------- 1 file changed, 92 insertions(+), 122 deletions(-) diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 2be7970..6a2bb9a 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -272,7 +272,7 @@ gbutton("Configure fit for selected model and dataset", cont = dsm, svalue(f.gg.opts.reweight.tol) <<- ftmp$reweight.tol svalue(f.gg.opts.reweight.max.iter) <<- ftmp$reweight.max.iter f.gg.parms[,] <- get_Parameters(stmp, FALSE) - svalue(f.gg.summary) <- capture.output(stmp) + svalue(f.gg.summary) <- c("
", capture.output(stmp), "
") svalue(center) <- 3 }) @@ -408,13 +408,17 @@ 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) +ds.e.2a <- ggroup(cont = ds.e.2, horizontal = FALSE) +gbutton("Copy dataset", cont = ds.e.2a, handler = copy_dataset_handler) +gbutton("Delete dataset", cont = ds.e.2a, handler = delete_dataset_handler) +gbutton("New dataset", cont = ds.e.2a, handler = new_dataset_handler) -upload_dataset.gf <- gfile(text = "Upload text file", cont = ds.e.2, +ds.e.2b <- ggroup(cont = ds.e.2) +upload_dataset.gf <- gfile(text = "Upload text file", cont = ds.e.2b, handler = new_ds_from_csv_handler) +gbutton("Keep changes", cont = ds.e.2, handler = keep_ds_changes_handler) + # Line 3 with forms {{{4 ds.e.forms <- ggroup(cont= ds.editor, horizontal = TRUE) @@ -443,8 +447,6 @@ generate_grid.gb <- gbutton("Generate empty grid for kinetic data", cont = ds.e. handler = empty_grid_handler) tooltip(generate_grid.gb) <- "Overwrites the kinetic data shown below" -# Keep button {{{4 -gbutton("Keep changes", cont = ds.editor, handler = keep_ds_changes_handler) # Kinetic Data {{{4 ds.e.gdf <- gdf(ds[[ds.cur]]$data, name = "Kinetic data", @@ -603,15 +605,24 @@ show_plot <- function(type, default = FALSE) { ftmp$ds.index <<- ds.i ftmp$ds <<- ds[[ds.i]] } - - svg(tf, width = 7, height = 5) - plot(ftmp, main = ftmp$ds$title, - xlab = ifelse(ftmp$ds$time_unit == "", "Time", - paste("Time in", ftmp$ds$time_unit)), - ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", - paste("Observed in", ftmp$ds$unit))) - dev.off() - svalue(plot.gs) <<- tf +# tf <- get_tempfile(ext=".png") +# png(tf, width = 525, height = 600) +# layout(matrix(c(1, 2), 2, 1), heights = c(2, 1.3)) +# par(mar = c(3, 4, 4, 2) + 0.1) +# plot(ftmp, main = ftmp$ds$title, +# xlab = ifelse(ftmp$ds$time_unit == "", "Time", +# paste("Time in", ftmp$ds$time_unit)), +# ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", +# paste("Observed in", ftmp$ds$unit))) +# par(mar = c(5, 4, 0, 2) + 0.1) +# mkinresplot(ftmp, legend = FALSE, +# xlab = ifelse(ftmp$ds$time_unit == "", "Time", +# paste("Time in", ftmp$ds$time_unit)), +# ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", +# paste("Observed in", ftmp$ds$unit))) +# dev.off() + #plot.gi <- gimage(tf, container = pf, width = 525, height = 600) + svalue(plot.gi) <<- plot_ftmp_png() } get_Parameters <- function(stmp, optimised) { @@ -672,17 +683,16 @@ run_fit <- function() { svalue(f.gg.opts.st) <- ftmp$solution_type svalue(f.gg.opts.weight) <- ftmp$weight.ini f.gg.parms[,] <- get_Parameters(stmp, TRUE) - svalue(f.gg.summary) <- capture.output(stmp) + svalue(f.gg.summary) <- c("
", capture.output(stmp), "
") } ds.i <- m.i <- "1" f.cur <- "0" # GUI widgets {{{2 -pf <- gframe("Dataset 1, Model SFO", horizontal = FALSE, +pf <- gframe("Dataset 1, Model SFO", horizontal = TRUE, cont = center, label = "Plotting and fitting") -# Mid group with plot and options {{{3 -f.gg.mid <- ggroup(cont = pf) +# Plot area {{{3 ftmp <- suppressWarnings(mkinfit(m[[m.cur]], override(ds[[ds.i]]$data), err = "err", control.modFit = list(maxiter = 0))) @@ -690,43 +700,33 @@ 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(ftmp) -dev.off() -plot.gs <- gsvg(tf, container = f.gg.mid, width = 420, height = 300) -f.gg.opts <- gformlayout(cont = f.gg.mid) -solution_types <- c("auto", "analytical", "eigen", "deSolve") -f.gg.opts.st <- gcombobox(solution_types, selected = 1, - label = "solution_type", width = 200, - cont = f.gg.opts) -f.gg.opts.atol <- gedit(ftmp$atol, label = "atol", width = 20, - cont = f.gg.opts) -f.gg.opts.rtol <- gedit(ftmp$rtol, label = "rtol", width = 20, - cont = f.gg.opts) -weights <- c("manual", "none", "std", "mean") -f.gg.opts.weight <- gcombobox(weights, selected = 1, label = "weight", - width = 200, cont = f.gg.opts) -f.gg.opts.reweight.method <- gcombobox(c("none", "obs"), selected = 1, - label = "reweight.method", - width = 200, - cont = f.gg.opts) -f.gg.opts.reweight.tol <- gedit(1e-8, label = "reweight.tol", - width = 20, cont = f.gg.opts) -f.gg.opts.reweight.max.iter <- gedit(10, label = "reweight.max.iter", - width = 20, cont = f.gg.opts) -# Dataframe with initial and optimised parameters {{{3 -f.gg.parms <- gdf(Parameters, width = 420, height = 300, cont = pf, - do_add_remove_buttons = FALSE) -f.gg.parms$set_column_width(1, 200) -f.gg.parms$set_column_width(2, 50) -f.gg.parms$set_column_width(3, 60) -f.gg.parms$set_column_width(4, 50) -f.gg.parms$set_column_width(5, 60) +plot_ftmp_png <- function() { + tf <- get_tempfile(ext=".png") + png(tf, width = 525, height = 600) + layout(matrix(c(1, 2), 2, 1), heights = c(2, 1.3)) + par(mar = c(3, 4, 4, 2) + 0.1) + plot(ftmp, main = ftmp$ds$title, + xlab = ifelse(ftmp$ds$time_unit == "", "Time", + paste("Time in", ftmp$ds$time_unit)), + ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", + paste("Observed in", ftmp$ds$unit))) + par(mar = c(5, 4, 0, 2) + 0.1) + mkinresplot(ftmp, legend = FALSE, + xlab = ifelse(ftmp$ds$time_unit == "", "Time", + paste("Time in", ftmp$ds$time_unit)), + ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", + paste("Observed in", ftmp$ds$unit))) + dev.off() + return(tf) +} -# Row with buttons {{{3 -f.gg.buttons <- ggroup(cont = pf) +plot.gi <- gimage(plot_ftmp_png(), container = pf, width = 525, height = 600) + +# Buttons and notebook area to the left {{{3 +p.gg <- ggroup(cont = pf, horizontal = FALSE) +# Row with buttons {{{4 +f.gg.buttons <- ggroup(cont = p.gg) show.initial.gb <- gbutton("Show initial", handler = function(h, ...) show_plot("Initial"), cont = f.gg.buttons) @@ -745,15 +745,43 @@ keep.fit.gb <- gbutton("Keep", }, cont = f.gg.buttons) tooltip(keep.fit.gb) <- "Store the optimised model with all settings and the current dataset in the fit list" -show.plots.gb <- gbutton("Show plots", - handler = function(h, ...) show_plot_window(), - cont = f.gg.buttons) -tooltip(show.plots.gb) <- "Show a window with plots including residual plots" -# Summary {{{3 -f.gg.summary <- gtext(capture.output(stmp), cont = pf, - use.codemirror = TRUE) +# Notebook to the right {{{3 +f.gn <- gnotebook(cont = p.gg, width = 800, height = 700) +# Dataframe with initial and optimised parameters {{{4 +f.gg.parms <- gdf(Parameters, cont = f.gn, width = 780, height = 660, + do_add_remove_buttons = FALSE, label = "Parameters") +f.gg.parms$set_column_width(1, 200) +f.gg.parms$set_column_width(2, 50) +f.gg.parms$set_column_width(3, 60) +f.gg.parms$set_column_width(4, 50) +f.gg.parms$set_column_width(5, 60) + +# Fit options form {{{4 +f.gg.opts <- gformlayout(cont = f.gn, label = "Fit options") +solution_types <- c("auto", "analytical", "eigen", "deSolve") +f.gg.opts.st <- gcombobox(solution_types, selected = 1, + label = "solution_type", width = 200, + cont = f.gg.opts) +f.gg.opts.atol <- gedit(ftmp$atol, label = "atol", width = 20, + cont = f.gg.opts) +f.gg.opts.rtol <- gedit(ftmp$rtol, label = "rtol", width = 20, + cont = f.gg.opts) +weights <- c("manual", "none", "std", "mean") +f.gg.opts.weight <- gcombobox(weights, selected = 1, label = "weight", + width = 200, cont = f.gg.opts) +f.gg.opts.reweight.method <- gcombobox(c("none", "obs"), selected = 1, + label = "reweight.method", + width = 200, + cont = f.gg.opts) +f.gg.opts.reweight.tol <- gedit(1e-8, label = "reweight.tol", + width = 20, cont = f.gg.opts) +f.gg.opts.reweight.max.iter <- gedit(10, label = "reweight.max.iter", + width = 20, cont = f.gg.opts) +# Summary {{{3 +f.gg.summary <- ghtml(c("
", capture.output(stmp), "
"), + cont = f.gn, label = "Summary") delete.fit.gb <- gbutton("Delete", handler = function(h, ...) { if (length(f) > 0) { @@ -776,6 +804,7 @@ delete.fit.gb <- gbutton("Delete", handler = function(h, ...) { f.gtable[,] <<- f.df }, cont = f.gg.buttons) tooltip(delete.fit.gb) <- "Delete the currently loaded fit from the fit list" +svalue(f.gn) <- 1 # Update the plotting and fitting area {{{3 update_plotting_and_fitting <- function() { @@ -790,65 +819,6 @@ update_plotting_and_fitting <- function() { svalue(f.gg.opts.reweight.tol) <- ftmp$reweight.tol svalue(f.gg.opts.reweight.max.iter) <- ftmp$reweight.max.iter f.gg.parms[,] <- get_Parameters(stmp, TRUE) - svalue(f.gg.summary) <- capture.output(stmp) -} - -# Show plot window with residual plots {{{3 -show_plot_window <- function(h, ...) { - n.obs = length(ftmp$mkinmod$spec) - obs.vars = names(ftmp$mkinmod$spec) - parent = obs.vars[1] - if(n.obs == 1) { - n.rows = 1 - ps = 7 - } else { - n.rows = 1 + ceiling(n.obs / 2) - ps = 10 - } - imgwidth = 800 - imgheight = 360 * n.rows - pw <- gwindow("Plot window", parent = w, - width = imgwidth + 20, height = imgheight + 100) - pwg <- ggroup(cont = pw, horizontal = FALSE) - make_plots <- function() { - par(mfrow = c(n.rows, 2)) - plot(ftmp, main = ftmp$ds$title, - xlab = ifelse(ftmp$ds$time_unit == "", "Time", - paste("Time in", ftmp$ds$time_unit)), - ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", - paste("Observed in", ftmp$ds$unit))) - if (n.obs > 1) { - plot(ftmp, legend = FALSE, - main = paste0("Zoomed in on metabolite", - ifelse(n.obs > 2, "s", "")), - xlab = ifelse(ftmp$ds$time_unit == "", "Time", - paste("Time in", ftmp$ds$time_unit)), - ylab = ifelse(ds[[ds.i]]$unit == "", "Observed", - paste("Observed in", ftmp$ds$unit)), - ylim = c(0, max(subset(ftmp$data, - variable != parent)$observed))) - for (met in obs.vars[-1]) { - mkinresplot(ftmp, met, legend = FALSE, - main = paste("Residual plot for", met)) - } - } else { - mkinresplot(ftmp, parent, legend = FALSE, - main = paste("Residual plot for", parent), - xlab = ifelse(ftmp$ds$time_unit == "", "Time", - paste("Time in", ftmp$ds$time_unit)), - ylab = ifelse(ds[[ds.i]]$unit == "", "Residuals", - paste("Residuals in", ftmp$ds$unit))) - } - } - - tf2 <- get_tempfile(ext = ".png") - png(tf2, width = imgwidth / 50 , height = imgheight / 50, - units = "cm", res = 300, pointsize = ps) - make_plots() - dev.off() - - ghtml(paste0(""), - cont = pwg) + svalue(f.gg.summary) <- c("
", capture.output(stmp), "
") } # vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1 -- cgit v1.2.1