From ffcd126b35a1ad48c8064f52f3dd4eb9c3f86876 Mon Sep 17 00:00:00 2001 From: jranke Date: Thu, 7 Nov 2013 13:00:20 +0000 Subject: - Added additional plots, including residual plots git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/kinfit/pkg/mkin@148 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- inst/GUI/mkinGUI.R | 82 +++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 75 insertions(+), 7 deletions(-) diff --git a/inst/GUI/mkinGUI.R b/inst/GUI/mkinGUI.R index c939f700..0bfe175c 100644 --- a/inst/GUI/mkinGUI.R +++ b/inst/GUI/mkinGUI.R @@ -474,8 +474,10 @@ remove_compound_handler <- function(h, ...) { keep_m_changes_handler <- function(h, ...) { spec <- list() for (obs.i in 1:length(m.e.rows)) { + to_vector = strsplit(svalue(m.e.to[[obs.i]]), ", ")[[1]] + if (length(to_vector) == 0) to_vector = "" spec[[obs.i]] <- list(type = svalue(m.e.type[[obs.i]]), - to = svalue(m.e.to[[obs.i]]), + to = to_vector, 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]]) @@ -521,7 +523,7 @@ show_m_spec <- function() { 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) + paste(m[[m.cur]]$spec[[obs.i]]$to, collapse = ", ")) 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]]) @@ -566,15 +568,15 @@ show_plot <- function(type, default = FALSE) { ftmp$ds <<- ds[[ds.i]] } - tmp <- get_tempfile(ext=".svg") - svg(tmp, width = 7, height = 5) + #tmp <- get_tempfile(ext=".svg") + 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) <<- tmp + svalue(plot.gs) <<- tf } get_Parameters <- function(stmp, optimised) { @@ -677,8 +679,15 @@ 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" -# Area for summary -f.gg.summary <- gtext(capture.output(stmp), cont = pf, use.codemirror = TRUE) +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) + delete.fit.gb <- gbutton("Delete", handler = function(h, ...) { if (length(f) > 0) { @@ -711,4 +720,63 @@ update_plotting_and_fitting <- function() { 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) +} # vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1 -- cgit v1.2.1