diff options
Diffstat (limited to 'inst/GUI')
| -rw-r--r-- | inst/GUI/gmkin.R | 214 |
1 files 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("<pre>", capture.output(stmp), "</pre>")
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("<pre>", capture.output(stmp), "</pre>")
}
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("<pre>", capture.output(stmp), "</pre>"),
+ 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("<img width='", imgwidth, "' height='", imgheight,
- "' src='", get_tempfile_url(tf2), "' />"),
- cont = pwg)
+ svalue(f.gg.summary) <- c("<pre>", capture.output(stmp), "</pre>")
}
# vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1
|