From c737c606058cb4c2a0805e2bec8ce356d01a627a Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Thu, 22 Oct 2015 17:30:09 +0200 Subject: A lot of working components of the new layout --- inst/GUI/gmkin.R | 1370 ++++++++++++++---------------------------------------- 1 file changed, 343 insertions(+), 1027 deletions(-) (limited to 'inst/GUI/gmkin.R') diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 7fef7a1..0b615c4 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -1,12 +1,12 @@ # gWidgetsWWW2 GUI for mkin {{{1 -# Copyright (C) 2013,2014 Johannes Ranke +# Copyright (C) 2013,2014,2015 Johannes Ranke # Portions of this file are copyright (C) 2013 Eurofins Regulatory AG, Switzerland # Contact: jranke@uni-bremen.de -# This file is part of the R package mkin +# This file is part of the R package gmkin -# mkin is free software: you can redistribute it and/or modify it under the +# gmkin is free software: you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation, either version 3 of the License, or (at your option) any later # version. @@ -20,1061 +20,377 @@ # this program. If not, see # Set the GUI title and create the basic widget layout {{{1 -w <- gwindow("gmkin - Browser based GUI for kinetic evaluations using mkin") -sb <- gstatusbar(paste("Powered by gWidgetsWWW2 (ExtJS, Rook)", - "and mkin (FME, deSolve and minpack.lm)", - "--- Working directory is", getwd()), cont = w) -pg <- gpanedgroup(cont = w, default.size = 260) -center <- gnotebook(cont = pg) -left <- gvbox(cont = pg, use.scrollwindow = TRUE) -# Set initial values {{{1 -# Initial project workspace contents {{{2 -project_name <- "FOCUS_2006_gmkin" -project_file <- paste0(project_name, ".RData") -workspace <- get(project_name) # From dataset distributed with mkin -studies.df <- workspace$studies.df # dataframe containing study titles -ds <- workspace$ds # list of datasets -ds.cur <- workspace$ds.cur # current dataset index -m <- workspace$m # list with mkinmod models, amended with mkinmod$name -m.cur <- workspace$m.cur # m.cur current model index -f <- workspace$f # f list of fitted mkinfit objects -f.cur <- workspace$f.cur # current fit index -s <- workspace$s # list of summaries of the fitted mkinfit objects -# Initialise meta data objects so assignments within functions using <<- will {{{2 -# update them in the right environment -observed.all <- vector() # vector of names of observed variables in datasets -ds.df <- data.frame() -m.df <- data.frame() -f.df <- data.frame() -# Empty versions of meta data {{{2 -f.df.empty <- data.frame(Fit = as.integer(0), - Dataset = "", - Model = "", - stringsAsFactors = FALSE) +# Configuration {{{2 +left_width = 250 +right_width = 500 +save_keybinding = "Ctrl-X" +# Widgets {{{2 +window_title <- paste0("gmkin ", packageVersion("gmkin"), + "- Browser based GUI for kinetic evaluations using mkin") +w <- gwindow(window_title) +sb <- gstatusbar(paste("Powered by gWidgetsWWW2 (ExtJS, Rook)", + "and mkin (FME, deSolve and minpack.lm)", + "--- Working directory is", getwd()), cont = w) + +bl <- gborderlayout(cont = w, + #title = list(center = "Work", east = "Results"), + panels = c("center", "west", "east"), + collapsible = list(west = FALSE)) + +bl$set_panel_size("west", left_width) +bl$set_panel_size("east", right_width) + +center <- gnotebook(cont = bl, where = "center") +left <- gvbox(cont = bl, use.scrollwindow = TRUE, where = "west") +right <- gnotebook(cont = bl, use.scrollwindow = TRUE, where = "east") + # Helper functions {{{1 # Override function for making it possible to override original data points using the GUI {{{2 override <- function(d) { - data.frame(name = d$name, time = d$time, - value = ifelse(is.na(d$override), d$value, d$override), - err = d$err) + if (!is.null(d$override)) { + d_new <- data.frame(name = d$name, time = d$time, + value = ifelse(is.na(d$override), d$value, d$override), + err = d$err) + return(d_new) + } else { + return(d) + } +} +# Update dataframe with projects {{{2 +update_p.df <- function() { + wd_projects <- gsub(".gmkinws", "", dir(pattern = ".gmkinws$")) + if (length(wd_projects) > 0) { + p.df.wd <- data.frame(Name = wd_projects, + Source = rep("working directory", + length(wd_projects)), + stringsAsFactors = FALSE) + p.df <<- rbind(p.df.package, p.df.wd) + } else { + p.df <<- p.df.package + } } # Update dataframe with datasets {{{2 update_ds.df <- function() { - ds.n <- length(ds) - ds.df <<- data.frame(Index = 1:ds.n, - Title = character(ds.n), - Study = character(ds.n), - stringsAsFactors = FALSE) - for (i in 1:ds.n) - { - ds.index <- names(ds)[[i]] - ds.df[i, "Title"] <<- ds[[ds.index]]$title - ds.df[i, "Study"] <<- ds[[ds.index]]$study_nr - observed = as.character(unique(ds[[ds.index]]$data$name)) - observed.all <<- union(observed, observed.all) - } + ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title)) } # Update dataframe with models {{{2 update_m.df <- function() { - m.n <- length(m) - m.df <<- data.frame(Index = 1:m.n, - Name = character(m.n), - stringsAsFactors = FALSE) - for (i in 1:m.n) { - m.index <- names(m)[[i]] - m.df[i, "Name"] <<- m[[m.index]]$name - } + m.df <<- data.frame(Name = names(ws$m)) } # Update dataframe with fits {{{2 update_f.df <- function() { - f.df <<- f.df.empty - f.count <- 0 - for (fit.index in names(f)) { - f.count <- f.count + 1 - ftmp <- f[[fit.index]] - f.df[f.count, "Fit"] <<- as.integer(f.count) - f.df[f.count, c("Dataset", "Model")] <<- c(ftmp$ds.index, ftmp$mkinmod$name) - } -} -# Initialise meta data objects {{{1 -update_ds.df() -update_m.df() -update_f.df() -# Widgets and handlers for project data {{{1 -prg <- gexpandgroup("Project file management", cont = left, horizontal = FALSE) -# Project data management handler functions {{{2 -upload_file_handler <- function(h, ...) -{ - # General - tmpfile <- normalizePath(svalue(h$obj), winslash = "/") - project_file <<- pr.gf$filename - project_name <<- try(load(tmpfile)) - if (inherits(project_name, "try-error")) { - galert(paste("Failed to load", project_file), parent = w) - } - - workspace <- get(project_name) - - # Check for old workspaces created using mkin < 0.9-32 that aren't loaded properly - workspace_old <- FALSE - if (length(workspace$f) > 0) { - if (is.null(workspace$f[[1]]$method.modFit)) { - stopmessage <- paste("Could not load workspace ", - project_file, - ". It seems it was created using mkin with version < 0.9-32", - sep = "") - galert(stopmessage, parent = w) - svalue(sb) <- stopmessage - workspace_old <- TRUE - } + f.df <- f.df.empty + if (!is.na(ftmp[1])) { + f.df[1, "Name"] <- c("Temporary (not fitted)") } - - if (!workspace_old) { - # Update project file name and status bar - svalue(pr.ge) <- project_name - svalue(sb) <- paste("Loaded project file", project_file) - - # Studies - studies.gdf[,] <- studies.df <- workspace$studies.df - - # Datasets - ds.cur <<- workspace$ds.cur - ds <<- workspace$ds - update_ds.df() - ds.gtable[,] <- ds.df - update_ds_editor() - - # Models - m.cur <<- workspace$m.cur - m <<- workspace$m - update_m.df() - m.gtable[,] <- m.df - update_m_editor() - - # Fits - f.cur <<- workspace$f.cur - f <<- workspace$f - s <<- workspace$s - if (length(f) > 0) { - update_f.df() - ftmp <<- f[[f.cur]] - stmp <<- s[[f.cur]] - ds.i <<- ds.cur - delete(f.gg.plotopts, f.gg.po.obssel) - f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, - checked = TRUE) - update_plotting_and_fitting() - } else { - f.df <<- f.df.empty - update_ds_editor() - svalue(center) <- 1 - } - f.gtable[,] <- f.df + if (!is.na(ws$f)) { + f.df.ws <- data.frame(Name = names(ws$f), stringsAsFactors = FALSE) + f.df <- rbind(f.df, f.df.ws) } + f.df <<- f.df } -save_to_file_handler <- function(h, ...) -{ - studies.df <- data.frame(studies.gdf[,], stringsAsFactors = FALSE) - workspace <- list( - studies.df = studies.df, - - ds = ds, - ds.cur = ds.cur, - - m = m, - m.cur = m.cur, - - f = f, - f.cur = f.cur, - - s = s) - assign(project_name, workspace) - save(list = project_name, file = project_file) - svalue(sb) <- paste("Saved project contents to", project_file, "in working directory", getwd()) -} -change_project_name_handler = function(h, ...) { - project_name <<- as.character(svalue(h$obj)) - project_file <<- paste0(project_name, ".RData") -} -# Project data management GUI elements {{{2 -pr.gf <- gfile(text = "Select project file", cont = prg, - handler = upload_file_handler) -pr.ge <- gedit(project_name, cont = prg, label = "Project", - handler = change_project_name_handler) -# The save button is always visible {{{2 -gbutton("Save current project contents", cont = left, - handler = save_to_file_handler) - -# Widget and handler for Studies {{{1 -stg <- gexpandgroup("Studies", cont = left) -visible(stg) <- FALSE -update_study_selector <- function(h, ...) { - delete(ds.e.1, ds.study.gc) - ds.study.gc <<- gcombobox(paste("Study", studies.gdf[,1]), cont = ds.e.1) - svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr -} -studies.gdf <- gdf(studies.df, name = "Edit studies in the project", - width = 235, - height = 180, cont = stg) -studies.gdf$set_column_width(1, 40) -addHandlerChanged(studies.gdf, update_study_selector) -# Widgets and handlers for datasets and models {{{1 -dsm <- gframe("Datasets and models", cont = left, horizontal = FALSE) -# Widget for dataset table with handler {{{2 -ds.switcher <- function(h, ...) { - ds.cur <<- as.character(svalue(h$obj)) - update_ds_editor() +# Generate the initial workspace {{{1 +ws <- gmkinws$new() +ws.import <- NA +# Initialise meta data objects so assignments within functions using <<- will {{{2 +# update them in the right environment. +# Also create initial versions of meta data in order to be able to clear the workspace +p.df <- p.df.package <- data.frame(Name = c("FOCUS_2006", "FOCUS_2006_Z"), + Source = rep("gmkin package", 2), stringsAsFactors = FALSE) + +update_p.df() +ds.df <- ds.df.empty <- data.frame(Title = "", stringsAsFactors = FALSE) +m.df <- m.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) +f.df <- f.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) +ftmp <- NA +# left: Explorer tables {{{1 +# Frames {{{2 +p.gf <- gframe("Projects", cont = left, horizontal = FALSE) +ds.gf <- gframe("Datasets", cont = left) +m.gf <- gframe("Models", cont = left) +c.gf <- gframe("Configuration", cont = left, horizontal = FALSE) +f.gf <- gframe("Results", cont = left) + +# Project explorer {{{2 +# Initialize project list from the gmkin package and the current working directory +# The former must be manually amended if additional workspaces should be available +p.gtable <- gtable(p.df, cont = p.gf, width = left_width - 10, height = 120) +size(p.gtable) <- list(columnWidths = c(130, 100)) +p.switcher <- function(h, ...) { + p.cur <- h$row_index + Name <- p.df[p.cur, "Name"] + if (p.df[p.cur, "Source"] == "working directory") { + load(paste0(Name, ".gmkinws")) + ws <<- ws + } else { + ws <<- get(Name) + } svalue(center) <- 1 + svalue(c.ds) <- empty_conf_labels[1] + svalue(c.m) <- empty_conf_labels[2] + update_p_editor(p.cur) + update_ds.df() + ds.gtable[,] <<- ds.df + update_m.df() + m.gtable[,] <<- m.df + update_f.df() + f.gtable[,] <<- f.df } -ds.gtable <- gtable(ds.df, cont = dsm) -addHandlerDoubleClick(ds.gtable, ds.switcher) -size(ds.gtable) <- list(columnWidths = c(40, 150, 30)) -ds.gtable$value <- 1 - -# Model table with handler {{{2 -m.switcher <- function(h, ...) { - m.cur <<- as.character(svalue(h$obj)) - update_m_editor() +addHandlerClicked(p.gtable, p.switcher) +# Dataset explorer {{{2 +ds.switcher <- function(h, ...) { + ws$ds.cur <<- h$row_index + svalue(c.ds) <- ds.df[ws$ds.cur, "Title"] + #update_ds_editor() svalue(center) <- 2 } -m.gtable <- gtable(m.df, cont = dsm) -addHandlerDoubleClick(m.gtable, m.switcher) -m.gtable$set_column_width(1, 40) -m.gtable$value <- 1 - -# Button for setting up a fit for the selected dataset and model {{{2 -configure_fit_handler = function(h, ...) { - ds.i <<- as.character(svalue(ds.gtable)) - m.i <<- as.character(svalue(m.gtable)) - ftmp <<- suppressWarnings(mkinfit(m[[m.i]], - override(ds[[ds.i]]$data), - method.modFit = "Marq", - err = "err", - control.modFit = list(maxiter = 0))) - ftmp$ds.index <<- ds.i - ftmp$ds <<- ds[[ds.i]] - stmp <<- summary(ftmp) - svalue(pf) <- paste0("Dataset ", ds.i, ", Model ", m[[m.i]]$name) - svalue(f.gg.opts.plot) <<- FALSE - svalue(f.gg.opts.st) <<- ftmp$solution_type - svalue(f.gg.opts.weight) <<- ftmp$weight - svalue(f.gg.opts.atol) <<- ftmp$atol - svalue(f.gg.opts.rtol) <<- ftmp$rtol - svalue(f.gg.opts.transform_rates) <<- ftmp$transform_rates - svalue(f.gg.opts.transform_fractions) <<- ftmp$transform_fractions - svalue(f.gg.opts.reweight.method) <<- ifelse( - is.null(ftmp$reweight.method), - "none", ftmp$reweight.method) - svalue(f.gg.opts.reweight.tol) <<- ftmp$reweight.tol - svalue(f.gg.opts.reweight.max.iter) <<- ftmp$reweight.max.iter - svalue(f.gg.opts.method.modFit) <<- "Port" - svalue(f.gg.opts.maxit.modFit) <<- ftmp$maxit.modFit - f.gg.parms[,] <- get_Parameters(stmp, FALSE) - delete(f.gg.plotopts, f.gg.po.obssel) - f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, - checked = TRUE) - show_plot("Initial", default = TRUE) - svalue(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name, - ".", plot_format, sep = "") - oldwidth <<- options()$width - options(width = 90) - svalue(f.gg.summary.filename) <<- "" - svalue(f.gg.summary.listing) <<- c("
", capture.output(stmp), "
") - options(width = oldwidth) - svalue(center) <- 3 +ds.gtable <- gtable(ds.df, cont = ds.gf, width = left_width - 10, height = 160) +addHandlerClicked(ds.gtable, ds.switcher) +# Model explorer {{{2 +m.switcher <- function(h, ...) { + ws$m.cur <<- h$row_index + svalue(c.m) <- m.df[ws$m.cur, "Name"] + #update_m_editor() + svalue(center) <- 3 } -gbutton("Configure fit for selected model and dataset", cont = dsm, - handler = configure_fit_handler) - -# Widget and handler for fits {{{1 -f.gf <- gframe("Fits", cont = left, horizontal = FALSE) +m.gtable <- gtable(m.df, cont = m.gf, width = left_width - 10, height = 160) +addHandlerClicked(m.gtable, m.switcher) +# Fit explorer {{{2 f.switcher <- function(h, ...) { - if (svalue(h$obj) != 0) { - f.cur <<- svalue(h$obj) - ftmp <<- f[[f.cur]] - stmp <<- s[[f.cur]] - ds.i <<- ftmp$ds.index - update_plotting_and_fitting() + ws$f.cur <<- h$row_index - 1 + if (ws$f.cur > 0) { + ftmp <<- ws$f[[ws$f.cur]] + stmp <<- ws$s[[ws$f.cur]] + c.ds$call_Ext("setText", + paste0("", ftmp$ds$title, ""), FALSE) + c.m$call_Ext("setText", + paste0("", ftmp$m$name, ""), FALSE) } - svalue(center) <- 3 -} -f.gtable <- gtable(f.df, cont = f.gf) -addHandlerDoubleClick(f.gtable, f.switcher) -f.gtable$set_column_width(1, 40) -f.gtable$set_column_width(2, 60) - -# Dataset editor {{{1 -ds.editor <- gframe("Dataset 1", horizontal = FALSE, cont = center, - label = "Dataset editor") -# Handler functions {{{2 -ds.empty <- list( - study_nr = 1, - title = "", - sampling_times = c(0, 1), - time_unit = "", - observed = "parent", - unit = "", - replicates = 1, - data = data.frame( - name = "parent", - time = c(0, 1), - value = c(100, NA), - override = "NA", - err = 1, - stringsAsFactors = FALSE)) - -copy_dataset_handler <- function(h, ...) { - ds.old <- ds.cur - ds.cur <<- as.character(1 + length(ds)) - svalue(ds.editor) <- paste("Dataset", ds.cur) - ds[[ds.cur]] <<- ds[[ds.old]] - update_ds.df() - ds.gtable[,] <- ds.df -} - -delete_dataset_handler <- function(h, ...) { - if (length(ds) > 1) { - ds[[ds.cur]] <<- NULL - names(ds) <<- as.character(1:length(ds)) - ds.cur <<- names(ds)[[1]] - update_ds.df() - ds.gtable[,] <- ds.df - update_ds_editor() + #update_f_conf() + #update_f_results() + svalue(center) <- 5 +} +f.gtable <- gtable(f.df, cont = f.gf, width = left_width - 10, height = 160) +addHandlerClicked(f.gtable, f.switcher) +# Configuration {{{2 +empty_conf_labels <- paste0("Current ", c("dataset", "model"), "") +c.ds <- glabel(empty_conf_labels[1], cont = c.gf) +c.m <- glabel(empty_conf_labels[2], cont = c.gf) +c.conf <- gbutton("Configure fit", cont = c.gf, handler = function(h, ...) svalue(center) <- 4) +# center: Project editor {{{1 +p.editor <- gframe("", horizontal = FALSE, cont = center, + label = "Project") +# Working directory {{{2 +p.line.wd <- ggroup(cont = p.editor, horizontal = TRUE) +wd_handler <- function(h, ...) { + target_wd <- svalue(p.wde) + wd <- try(setwd(target_wd)) + if (inherits(wd, "try-error")) { + gmessage(paste("Could not set working directory to", target_wd), parent = w) + } else { + svalue(sb) <- paste("Changed working directory to", wd) + update_p.df() + p.gtable[,] <- p.df + p.line.import.p[,] <- c("", p.df$Name) + } +} +p.wde <- gedit(getwd(), cont = p.line.wd, label = "Working directory", width = 50) +p.wde$add_handler_enter(wd_handler) +p.wdb <- gbutton("Change", cont = p.line.wd, handler = wd_handler) +tooltip(p.wdb) <- "Edit the box on the left and press enter to change" +# Project name {{{2 +p.line.name <- ggroup(cont = p.editor, horizontal = TRUE) +p.name <- gedit("New project", label = "Project name", + width = 50, cont = p.line.name) +p.save <- gaction("Save", parent = w, + handler = function(h, ...) { + filename <- paste0(svalue(p.name), ".gmkinws") + try_to_save <- function (filename) { + if (!inherits(try(save(ws, file = filename)), + "try-error")) { + svalue(sb) <- paste("Saved project to file", filename, + "in working directory", getwd()) + update_p.df() + p.gtable[,] <- p.df + } else { + gmessage("Saving failed for an unknown reason", parent = w) + } + } + if (file.exists(filename)) { + gconfirm(paste("File", filename, "exists. Overwrite?"), + parent = w, + handler = function(h, ...) { + try_to_save(filename) + }) + } else { + try_to_save(filename) + } + }) +p.save.button <- gbutton(action = p.save, cont = p.line.name) +p.save$add_keybinding(save_keybinding) +tooltip(p.save.button) <- paste("Press", save_keybinding, "to save") + +update_p_editor <- function(p.cur) { + project_name <- as.character(p.df[p.cur, "Name"]) + svalue(p.name) <- project_name + if (p.df[p.cur, "Source"] == "gmkin package") { + svalue(p.filename) <- "" + p.delete$call_Ext("disable") } else { - galert("Deleting the last dataset is not supported", parent = w) + svalue(p.filename) <- file.path(getwd(), paste0(project_name, ".gmkinws")) + p.delete$call_Ext("enable") } } - -new_dataset_handler <- function(h, ...) { - ds.cur <<- as.character(1 + length(ds)) - ds[[ds.cur]] <<- ds.empty - update_ds.df() - ds.gtable[,] <- ds.df - update_ds_editor() -} - -tmptextheader <- character(0) -load_text_file_with_data <- function(h, ...) { - tmptextfile <<- normalizePath(svalue(h$obj), winslash = "/") - tmptext <- readLines(tmptextfile, warn = FALSE) - tmptextskip <<- 0 - for (tmptextline in tmptext) { - if (grepl(":|#|/", tmptextline)) tmptextskip <<- tmptextskip + 1 - else break() - } - svalue(ds.e.up.skip) <- tmptextskip - if (svalue(ds.e.up.header)) { - tmptextheader <<- strsplit(tmptext[tmptextskip + 1], - " |\t|;|,")[[1]] - } - svalue(ds.e.up.wide.time) <- tmptextheader[[1]] - svalue(ds.e.up.long.time) <- tmptextheader[[2]] - svalue(ds.e.up.text) <- c("
", tmptext, "
") - svalue(ds.e.stack) <- 2 -} - -new_ds_from_csv_handler <- function(h, ...) { - tmpd <- try(read.table(tmptextfile, - skip = as.numeric(svalue(ds.e.up.skip)), - dec = svalue(ds.e.up.dec), - sep = switch(svalue(ds.e.up.sep), - whitespace = "", - ";" = ";", - "," = ","), - header = svalue(ds.e.up.header), - stringsAsFactors = FALSE)) - if(svalue(ds.e.up.widelong) == "wide") { - tmpdl <- mkin_wide_to_long(tmpd, time = as.character(svalue(ds.e.up.wide.time))) - } else { - tmpdl <- data.frame( - name = tmpd[[svalue(ds.e.up.long.name)]], - time = tmpd[[svalue(ds.e.up.long.time)]], - value = tmpd[[svalue(ds.e.up.long.value)]]) - tmpderr <- tmpd[[svalue(ds.e.up.long.err)]] - if (!is.null(tmpderr)) tmpdl$err <- tmpderr - } - if (class(tmpd) != "try-error") { - ds.cur <<- as.character(1 + length(ds)) - ds[[ds.cur]] <<- list( - study_nr = NA, - title = "New import", - sampling_times = sort(unique(tmpdl$time)), - time_unit = "", - observed = unique(tmpdl$name), - unit = "", - replicates = max(aggregate(tmpdl$time, - list(tmpdl$time, - tmpdl$name), - length)$x), - data = tmpdl) - ds[[ds.cur]]$data$override <<- as.numeric(NA) - if (is.null(ds[[ds.cur]]$data$err)) ds[[ds.cur]]$data$err <<- 1 +# File name {{{2 +p.line.file <- ggroup(cont = p.editor, horizontal = TRUE) +p.filename.gg <- ggroup(width = 400, cont = p.line.file) +p.filename <- glabel("", cont = p.filename.gg) +p.delete.handler = function(h, ...) { + filename <- file.path(getwd(), paste0(svalue(p.name), ".gmkinws")) + gconfirm(paste0("Are you sure you want to delete ", filename, "?"), + parent = w, + handler = function(h, ...) { + if (inherits(try(unlink(filename)), "try-error")) { + gmessage("Deleting failed for an unknown reason", cont = w) + } else { + svalue(sb) <- paste("Deleted", filename) + svalue(p.filename) <- "" + p.delete$call_Ext("disable") + update_p.df() + p.gtable[,] <- p.df + } + }) +} +p.delete <- gbutton("Delete", cont = p.line.file, + handler = p.delete.handler) +p.delete$call_Ext("disable") +# Import {{{2 +p.line.import <- ggroup(cont = p.editor, horizontal = TRUE) +p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.line.import, + handler = function(h, ...) { + p.import <- svalue(h$obj, index = TRUE) - 1 + Name <- p.df[p.import, "Name"] + if (p.df[p.import, "Source"] == "working directory") { + load(paste0(Name, ".gmkinws")) + ws.import <<- ws + } else { + ws.import <<- get(Name) + } + p.line.import.dst[,] <- data.frame(Title = sapply(ws.import$ds, function(x) x$title), + stringsAsFactors = FALSE) + p.line.import.mt[,] <- data.frame(Name = names(ws.import$m), + stringsAsFactors = FALSE) + }) +p.line.import.frames <- ggroup(cont = p.editor, horizontal = TRUE) + +p.line.import.dsf <- gframe("Datasets for import", cont = p.line.import.frames, horizontal = FALSE) +p.line.import.dst <- gtable(ds.df.empty, cont = p.line.import.dsf, multiple = TRUE, + width = left_width - 10, height = 160) +p.line.import.dsb <- gbutton("Import selected", cont = p.line.import.dsf, + handler = function(h, ...) { + i <- svalue(p.line.import.dst, index = TRUE) + ws$ds <<- append(ws$ds, ws.import$ds[i]) update_ds.df() ds.gtable[,] <- ds.df - update_ds_editor() - } else { - galert("Uploading failed", parent = "w") } -} - -empty_grid_handler <- function(h, ...) { - obs <- strsplit(svalue(ds.e.obs), ", ")[[1]] - sampling_times <- strsplit(svalue(ds.e.st), ", ")[[1]] - replicates <- as.numeric(svalue(ds.e.rep)) - new.data = data.frame( - name = rep(obs, each = replicates * length(sampling_times)), - time = as.numeric(rep(sampling_times, each = replicates, times = length(obs))), - value = as.numeric(NA), - override = as.numeric(NA), - err = 1, - stringsAsFactors = FALSE - ) - ds.e.gdf[,] <- new.data -} - -keep_ds_changes_handler <- function(h, ...) { - ds[[ds.cur]]$title <<- svalue(ds.title.ge) - ds[[ds.cur]]$study_nr <<- as.numeric(gsub("Study ", "", svalue(ds.study.gc))) - update_ds.df() - ds.gtable[,] <- ds.df - tmpd <- ds.e.gdf[,] - ds[[ds.cur]]$data <<- tmpd - ds[[ds.cur]]$sampling_times <<- sort(unique(tmpd$time)) - ds[[ds.cur]]$time_unit <<- svalue(ds.e.stu) - ds[[ds.cur]]$observed <<- unique(tmpd$name) - ds[[ds.cur]]$unit <<- svalue(ds.e.obu) - ds[[ds.cur]]$replicates <<- max(aggregate(tmpd$time, - list(tmpd$time, tmpd$name), length)$x) - update_ds_editor() - observed.all <<- union(observed.all, ds[[ds.cur]]$observed) - update_m_editor() -} - -# Widget setup {{{2 -# Line 1 {{{3 -ds.e.1 <- ggroup(cont = ds.editor, horizontal = TRUE) -glabel("Title: ", cont = ds.e.1) -ds.title.ge <- gedit(ds[[ds.cur]]$title, cont = ds.e.1) -glabel(" from ", cont = ds.e.1) -ds.study.gc <- gcombobox(paste("Study", studies.gdf[,1]), cont = ds.e.1) - -# Line 2 {{{3 -ds.e.2 <- ggroup(cont = ds.editor, horizontal = TRUE) -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) - -ds.e.2b <- ggroup(cont = ds.e.2) -tmptextfile <- "" # Initialize file name for imported data -tmptextskip <- 0 # Initialize number of lines to be skipped -tmptexttime <- "V1" # Initialize name of time variable if no header row -upload_dataset.gf <- gfile(text = "Upload text file", cont = ds.e.2b, - handler = load_text_file_with_data) - -gbutton("Keep changes", cont = ds.e.2, handler = keep_ds_changes_handler) - -# Line 3 with forms or upload area {{{3 -ds.e.stack <- gstackwidget(cont = ds.editor) -# Forms for meta data {{{4 -ds.e.forms <- ggroup(cont = ds.e.stack, horizontal = TRUE) - -ds.e.3a <- gvbox(cont = ds.e.forms) -ds.e.3a.gfl <- gformlayout(cont = ds.e.3a) -ds.e.st <- gedit(paste(ds[[ds.cur]]$sampling_times, collapse = ", "), - width = 40, - label = "Sampling times", - cont = ds.e.3a.gfl) -ds.e.stu <- gedit(ds[[ds.cur]]$time_unit, - width = 20, - label = "Unit", cont = ds.e.3a.gfl) -ds.e.rep <- gedit(ds[[ds.cur]]$replicates, - width = 20, - label = "Replicates", cont = ds.e.3a.gfl) - -ds.e.3b <- gvbox(cont = ds.e.forms) -ds.e.3b.gfl <- gformlayout(cont = ds.e.3b) -ds.e.obs <- gedit(paste(ds[[ds.cur]]$observed, collapse = ", "), - width = 50, - label = "Observed", cont = ds.e.3b.gfl) -ds.e.obu <- gedit(ds[[ds.cur]]$unit, - width = 20, label = "Unit", - cont = ds.e.3b.gfl) -generate_grid.gb <- gbutton("Generate empty grid for kinetic data", cont = ds.e.3b, - handler = empty_grid_handler) -tooltip(generate_grid.gb) <- "Overwrites the kinetic data shown below" -# Data upload area {{{4 -ds.e.upload <- ggroup(cont = ds.e.stack, horizontal = TRUE) -ds.e.up.text <- ghtml("
", cont = ds.e.upload, width = 400, height = 400)
-ds.e.up.options <- ggroup(cont = ds.e.upload, horizontal = FALSE)
-ds.e.up.import <- gbutton("Import using options specified below", cont = ds.e.up.options,
-                          handler = new_ds_from_csv_handler)
-ds.e.up.skip <- gedit(tmptextskip, label = "Comment lines", cont = ds.e.up.options)
-ds.e.up.header <- gcheckbox(cont = ds.e.up.options, label = "Column names", 
-                            checked = TRUE)
-ds.e.up.sep <- gcombobox(c("whitespace", ";", ","), cont = ds.e.up.options,
-                         selected = 1, label = "Separator")
-ds.e.up.dec <- gcombobox(c(".", ","), cont = ds.e.up.options,
-                         selected = 1, label = "Decimal")
-ds.e.up.widelong <- gradio(c("wide", "long"), horizontal = TRUE, 
-                           label = "Format", cont = ds.e.up.options,
-                           handler = function(h, ...) {
-                             widelong = svalue(h$obj, index = TRUE)
-                             svalue(ds.e.up.wlstack) <- widelong
-                           })
-ds.e.up.wlstack <- gstackwidget(cont = ds.e.up.options)
-ds.e.up.wide <- ggroup(cont = ds.e.up.wlstack, horizontal = FALSE, width = 300)
-ds.e.up.wide.time <- gedit(tmptexttime, cont = ds.e.up.wide, label = "Time column")
-ds.e.up.long <- ggroup(cont = ds.e.up.wlstack, horizontal = FALSE, width = 300)
-ds.e.up.long.name <- gedit("name", cont = ds.e.up.long, label = "Observed variables")
-ds.e.up.long.time <- gedit(tmptexttime, cont = ds.e.up.long, label = "Time column")
-ds.e.up.long.value <- gedit("value", cont = ds.e.up.long, label = "Value column")
-ds.e.up.long.err <- gedit("err", cont = ds.e.up.long, label = "Relative errors")
-svalue(ds.e.up.wlstack) <- 1
-
-svalue(ds.e.stack) <- 1
-
-# Kinetic Data {{{3
-ds.e.gdf <- gdf(ds[[ds.cur]]$data, name = "Kinetic data", 
-                width = 500, height = 700, cont = ds.editor)
-ds.e.gdf$set_column_width(2, 70)
-
-# Update the dataset editor {{{3
-update_ds_editor <- function() {
-  svalue(ds.editor) <- paste("Dataset", ds.cur)
-  svalue(ds.title.ge) <- ds[[ds.cur]]$title
-  svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr
-
-  svalue(ds.e.st) <- paste(ds[[ds.cur]]$sampling_times, collapse = ", ")
-  svalue(ds.e.stu) <- ds[[ds.cur]]$time_unit
-  svalue(ds.e.obs) <- paste(ds[[ds.cur]]$observed, collapse = ", ")
-  svalue(ds.e.obu) <- ds[[ds.cur]]$unit
-  svalue(ds.e.rep) <- ds[[ds.cur]]$replicates
-  svalue(ds.e.stack) <- 1
-  ds.e.gdf[,] <- ds[[ds.cur]]$data
-}
-# Model editor {{{1
-m.editor <- gframe("Model 1", horizontal = FALSE, cont = center, label = "Model editor")
-# Handler functions {{{3
-copy_model_handler <- function(h, ...) {
-  m.old <- m.cur
-  m.cur <<- as.character(1 + length(m))
-  svalue(m.editor) <- paste("Model", m.cur)
-  m[[m.cur]] <<- m[[m.old]]
-  update_m.df()
-  m.gtable[,] <- m.df
-}
- 
-delete_model_handler <- function(h, ...) {
-  if (length(m) > 1) {
-    m[[m.cur]] <<- NULL
-    names(m) <<- as.character(1:length(m))
-    m.cur <<- "1"
+)
+
+p.line.import.mf <- gframe("Models for import", cont = p.line.import.frames, horizontal = FALSE)
+p.line.import.mt <- gtable(m.df.empty, cont = p.line.import.mf, multiple = TRUE,
+                            width = left_width - 10, height = 160)
+p.line.import.mb <- gbutton("Import selected", cont = p.line.import.mf,
+  handler = function(h, ...) {
+    i <- svalue(p.line.import.mt, index = TRUE)
+    ws$m <<- append(ws$m, ws.import$m[i])
     update_m.df()
     m.gtable[,] <- m.df
-    update_m_editor()
-  } else {
-    galert("Deleting the last model is not supported", parent = w)
-  }
-}
-
-add_observed_handler <- function(h, ...) {
-  obs.i <- length(m.e.rows) + 1
-  m.e.rows[[obs.i]] <<- ggroup(cont = m.editor, horizontal = TRUE)
-  m.e.obs[[obs.i]] <<- gcombobox(observed.all, selected = obs.i, 
-                                cont = m.e.rows[[obs.i]])
-  m.e.type[[obs.i]] <<- gcombobox(c("SFO", "SFORB"),
-                                 cont = m.e.rows[[obs.i]])
-  svalue(m.e.type[[obs.i]]) <- "SFO"
-  glabel("to", cont = m.e.rows[[obs.i]]) 
-  m.e.to[[obs.i]] <<- gedit("",
-                            initial.msg = "Optional list of target variables, e.g. 'm1, m2'",
-                            width = 40, cont = m.e.rows[[obs.i]])
-  m.e.sink[[obs.i]] <<- gcheckbox("Path to sink", 
-                                  checked = TRUE, cont = m.e.rows[[obs.i]]) 
-  gbutton("Remove compound", handler = remove_observed_handler, 
-          action = obs.i, cont = m.e.rows[[obs.i]])
-}
-
-remove_observed_handler <- function(h, ...) {
-  m[[m.cur]]$spec[[h$action]] <<- NULL
-  update_m_editor()
-}
-
-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 = to_vector,
-                          sink = svalue(m.e.sink[[obs.i]]))
-    if(spec[[obs.i]]$to[[1]] == "") spec[[obs.i]]$to = NULL
-    names(spec)[[obs.i]] <- svalue(m.e.obs[[obs.i]])
-  }
-  m[[m.cur]] <<- mkinmod(use_of_ff = svalue(m.ff.gc), 
-                         speclist = spec)
-  m[[m.cur]]$name <<- svalue(m.name.ge) 
-  update_m.df()
-  m.gtable[,] <- m.df
-}
- 
-# Widget setup {{{3
-m.e.0 <- ggroup(cont = m.editor, horizontal = TRUE)
-glabel("Model name: ", cont = m.e.0) 
-m.name.ge <- gedit(m[[m.cur]]$name, cont = m.e.0) 
-glabel("Use of formation fractions: ", cont = m.e.0) 
-m.ff.gc <- gcombobox(c("min", "max"), cont = m.e.0)
-svalue(m.ff.gc) <- m[[m.cur]]$use_of_ff
-
-# Model handling buttons {{{4
-m.e.b <- ggroup(cont = m.editor, horizontal = TRUE)
-gbutton("Copy model", cont = m.e.b, handler = copy_model_handler)
-gbutton("Delete model", cont = m.e.b, handler = delete_model_handler)
-gbutton("Add observed variable", cont = m.e.b, 
-        handler = add_observed_handler)
-gbutton("Keep changes", cont = m.e.b, handler = keep_m_changes_handler)
-
-
-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[[m.cur]]$spec)) {
-    obs.name <- names(m[[m.cur]]$spec)[[obs.i]]
-    m.e.rows[[obs.i]] <<- ggroup(cont = m.editor, horizontal = TRUE)
-    m.e.obs[[obs.i]] <<- gcombobox(observed.all, selected = 0, 
-                                  cont = m.e.rows[[obs.i]])
-    svalue(m.e.obs[[obs.i]]) <<- obs.name
-    if (obs.i == 1) {
-      m.e.type[[obs.i]] <<- gcombobox(c("SFO", "FOMC", "DFOP", "HS", "SFORB"),
-                                     cont = m.e.rows[[obs.i]])
-    } else {
-      m.e.type[[obs.i]] <<- gcombobox(c("SFO", "SFORB"),
-                                     cont = m.e.rows[[obs.i]])
-    }
-    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), "",
-                 paste(m[[m.cur]]$spec[[obs.i]]$to, collapse = ", "))
-    m.e.to[[obs.i]] <<- gedit(obs.to, 
-                              initial.msg = "Optional list of target variables, e.g. 'm1, m2'",
-                              width = 40, 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]]) 
-    if (obs.i > 1) {
-      gbutton("Remove observed variable", handler = remove_observed_handler, 
-              action = obs.i, cont = m.e.rows[[obs.i]])
-    }
-  }
-}
-show_m_spec()
-
-# Update the model editor {{{3
-update_m_editor <- function() {
-  svalue(m.editor) <- paste("Model", m.cur)
-  svalue(m.name.ge) <- m[[m.cur]]$name
-  svalue(m.ff.gc) <- m[[m.cur]]$use_of_ff
-  for (oldrow.i in 1:length(m.e.rows)) {
-    delete(m.editor, m.e.rows[[oldrow.i]])
-  }
-  m.observed <<- names(m[[m.cur]]$spec)
-  m.e.rows <<- m.e.obs <<- m.e.type <<- m.e.to <<- m.e.sink <<- list()
-  show_m_spec()
-}
-
-# 3}}}
-# 2}}}
-# Plotting and fitting {{{1
-show_plot <- function(type, default = FALSE) {
-  Parameters <- f.gg.parms[,]
-  Parameters.de <- subset(Parameters, Type == "deparm", type)
-  stateparms <- subset(Parameters, Type == "state")[[type]]
-  deparms <- as.numeric(Parameters.de[[type]])
-  names(deparms) <- rownames(Parameters.de)
-  if (type == "Initial" & default == FALSE) {
-    ftmp <<- suppressWarnings(mkinfit(ftmp$mkinmod, 
-                                      override(ds[[ds.i]]$data),
-                                      parms.ini = deparms,
-                                      state.ini = stateparms, 
-                                      fixed_parms = names(deparms),
-                                      fixed_initials = names(stateparms),
-                                      err = "err", 
-                                      method.modFit = "Marq",
-                                      control.modFit = list(maxiter = 0)))
-    ftmp$ds.index <<- ds.i
-    ftmp$ds <<- ds[[ds.i]]
-  } 
-  svalue(plot.ftmp.gi) <<- plot_ftmp_png()
-  svalue(plot.confint.gi) <<- plot_confint_png()
-}
-get_Parameters <- function(stmp, optimised)
-{
-  pars <- rbind(stmp$start[1:2], stmp$fixed)
-
-  pars$fixed <- c(rep(FALSE, length(stmp$start$value)),
-                  rep(TRUE, length(stmp$fixed$value)))
-  pars$name <- rownames(pars)
-  Parameters <- data.frame(Name = pars$name,
-                           Type = pars$type,
-                           Initial = pars$value,
-                           Fixed = pars$fixed,
-                           Optimised = as.numeric(NA))
-  Parameters <- rbind(subset(Parameters, Type == "state"),
-                      subset(Parameters, Type == "deparm"))
-  rownames(Parameters) <- Parameters$Name
-  if (optimised) {
-    Parameters[rownames(stmp$bpar), "Optimised"] <- stmp$bpar[, "Estimate"]
-  }
-  return(Parameters)
-}
-run_fit <- function() {
-  Parameters <- f.gg.parms[,]
-  Parameters.de <- subset(Parameters, Type == "deparm")
-  deparms <- Parameters.de$Initial
-  names(deparms) <- Parameters.de$Name
-  defixed <- names(deparms[Parameters.de$Fixed])
-  Parameters.ini <- subset(Parameters, Type == "state")
-  iniparms <- Parameters.ini$Initial
-  names(iniparms) <- sub("_0", "", Parameters.ini$Name)
-  inifixed <- names(iniparms[Parameters.ini$Fixed])
-  weight <- svalue(f.gg.opts.weight)
-  if (weight == "manual") {
-    err = "err"
-  } else {
-    err = NULL
   }
-  reweight.method <- svalue(f.gg.opts.reweight.method)
-  if (reweight.method == "none") reweight.method = NULL
-  ftmp <<- mkinfit(ftmp$mkinmod, override(ds[[ds.i]]$data),
-                   state.ini = iniparms,
-                   fixed_initials = inifixed,
-                   parms.ini = deparms, 
-                   fixed_parms = defixed,
-                   plot = svalue(f.gg.opts.plot),
-                   solution_type = svalue(f.gg.opts.st),
-                   atol = as.numeric(svalue(f.gg.opts.atol)),
-                   rtol = as.numeric(svalue(f.gg.opts.rtol)),
-                   transform_rates = svalue(f.gg.opts.transform_rates),
-                   transform_fractions = svalue(f.gg.opts.transform_fractions),
-                   weight = weight,
-                   err = err,
-                   reweight.method = reweight.method,
-                   reweight.tol = as.numeric(svalue(f.gg.opts.reweight.tol)),
-                   reweight.max.iter = as.numeric(svalue(f.gg.opts.reweight.max.iter)),
-                   method.modFit = svalue(f.gg.opts.method.modFit),
-                   maxit.modFit = svalue(f.gg.opts.maxit.modFit)
-                   )
-  ftmp$ds.index <<- ds.i
-  ftmp$ds <<- ds[[ds.i]]
-  stmp <<- summary(ftmp)
-  show_plot("Optimised")
-  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.filename) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name, ".txt", sep = "")
-  svalue(f.gg.summary.listing) <<- c("
", capture.output(stmp), "
")
-}
-ds.i <- m.i <- "1"
-f.cur <- "0"
+)
+
+
+# center: Dataset editor {{{1
+ds.editor <- gframe("", horizontal = FALSE, cont = center, 
+                     label = "Dataset editor")
+m.editor  <- gframe("", horizontal = FALSE, cont = center, 
+                    label = "Model editor")
+f.config  <- gframe("", horizontal = FALSE, cont = center, 
+                    label = "Fit configuration")
+r.viewer  <- gframe("", horizontal = FALSE, cont = center, 
+                    label = "Result viewer")
+svalue(center) <- 1
+# right: Viewing area {{{1
+# Workflow {{{2
+workflow.gg <- ggroup(cont = right, label = "Workflow", width = 480,  height = 600,
+                      ext.args = list(layout = list(type="vbox", align = "center")))
+
+workflow.png <- get_tempfile(ext = ".png")
+file.copy(system.file("GUI/gmkin_workflow_434x569.png", package = "gmkin"), workflow.png)
+workflow.gi <- gimage(workflow.png, size = c(434, 569), label = "Workflow", cont = workflow.gg)
+
+# Manual {{{2
+gmkin_manual <- readLines(system.file("GUI/gmkin_manual.html", package = "gmkin"))
+gmb_start <- grep("", gmkin_manual)
+gmb_end <- grep("", gmkin_manual)
+gmkin_manual_body <- gmkin_manual[gmb_start:gmb_end]
+
+manual.gh <- ghtml(label = "Manual", paste0("

+
+", paste(gmkin_manual_body, collapse = '\n'), "
+
"), width = 460, cont = right)
+
+# Changes {{{2
+gmkin_news <- markdownToHTML(system.file("NEWS.md", package = "gmkin"), 
+                             fragment.only = TRUE,
+                             )
+
+changes.gh <- ghtml(label = "Changes", paste0("

+
+", gmkin_news, "
+
"), width = 460, cont = right)
+
+svalue(right) <- 1
 
-# GUI widgets {{{2
-pf <- gframe("Dataset 1, Model SFO", horizontal = TRUE, 
-             cont = center, label = "Plotting and fitting")
 
-# Plot area to the left {{{3
-pf.p <- ggroup(cont = pf, horizontal = FALSE)
-ftmp <- suppressWarnings(mkinfit(m[[m.cur]], override(ds[[ds.i]]$data), 
-                                 err = "err", 
-                                 method.modFit = "Marq",
-                                 control.modFit = list(maxiter = 0)))
-ftmp$ds.index = ds.i
-ftmp$ds = ds[[ds.i]]
-stmp <- summary(ftmp)
-Parameters <- get_Parameters(stmp, FALSE)
-
-plot_ftmp <- function() {
-  if(exists("f.gg.po.obssel")) {
-    obs_vars_plot = svalue(f.gg.po.obssel)
-  } else {
-    obs_vars_plot = names(ftmp$mkinmod$spec)
-  }
-  if(exists("f.gg.po.legend")) {
-    plot_legend = svalue(f.gg.po.legend)
-  } else {
-    plot_legend = TRUE
-  }
-  plot(ftmp, main = ftmp$ds$title, obs_vars = obs_vars_plot,
-       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)),
-       legend = plot_legend,
-       show_residuals = TRUE)
-}
-
-plot_ftmp_png <- function() {
-  tf <- get_tempfile(ext=".png")
-  png(tf, width = 400, height = 400)
-  plot_ftmp()
-  dev.off()
-  return(tf)
-}
-
-plot_ftmp_save <- function(filename) {
-  switch(plot_format,
-         png = png(filename, width = 400, height = 400),
-         pdf = pdf(filename),
-         wmf = win.metafile(filename))
-  plot_ftmp()
-  dev.off()
-  svalue(sb) <- paste("Saved plot to", filename, "in working directory", getwd())
-}
-
-plot_confint_png <- function() {
-  tf <- get_tempfile(ext=".png")
-  png(tf, width = 400, height = 400)
-  mkinparplot(ftmp) 
-  dev.off()
-  return(tf)
-}
-
-plot_formats <- c("png", "pdf")
-if (exists("win.metafile", "package:grDevices", inherits = FALSE)) {
-  plot_formats = c("wmf", plot_formats)
-}
-plot_format <- plot_formats[[1]]
-
-plot.ftmp.gi <- gimage(plot_ftmp_png(), container = pf.p, width = 400, height = 400)
-plot.ftmp.saveline <- ggroup(cont = pf.p, horizontal = TRUE)
-plot.ftmp.savefile <- gedit(paste(ds[[ds.cur]]$title, "_", m[[m.cur]]$name, ".",
-                                     plot_format, sep = ""),
-                               width = 40, cont = plot.ftmp.saveline)
-plot.ftmp.savebutton <-  gbutton("Save plot", cont = plot.ftmp.saveline,
-                                    handler = function(h, ...) {
-                                      filename <- svalue(plot.ftmp.savefile)
-                                      if (file.exists(filename))
-                                      {
-                                        gconfirm(paste("File", filename, 
-                                                       "exists. Overwrite?"),
-                                                 parent = w,
-                                                 handler = function(h, ...) {
-                                            plot_ftmp_save(filename)
-                                          }
-                                        )
-                                      } else {
-                                        plot_ftmp_save(filename)
-                                      }
-                                    })
-plot.space <- ggroup(cont = pf.p, horizontal = TRUE, height = 18)
-plot.confint.gi <- gimage(plot_confint_png(), container = pf.p, width = 400, height = 400)
-
-# Buttons and notebook area to the right {{{3
-p.gg <- ggroup(cont = pf, horizontal = FALSE)
-# Row with buttons {{{4
-f.gg.buttons <- ggroup(cont = p.gg)
-run.fit.gb <- gbutton("Run", width = 100,
-                      handler = function(h, ...) run_fit(), cont =
-                      f.gg.buttons)
-tooltip(run.fit.gb) <- "Fit with current settings on the current dataset, with the original model"
-
-keep.fit.gb <- gbutton("Keep fit", 
-                       handler = function(h, ...) {
-                            f.cur <<- as.character(length(f) + 1)
-                            f[[f.cur]] <<- ftmp
-                            s[[f.cur]] <<- stmp
-                            update_f.df()
-                            f.gtable[,] <<- f.df
-                            delete(f.gg.plotopts, f.gg.po.obssel)
-                            f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), 
-                                                              cont = f.gg.plotopts, 
-                                                              checked = TRUE)
-                            delete(f.gg.buttons, get.initials.gc)
-                            get.initials.gc <<- gcombobox(paste("Fit", f.df$Fit), 
-                                                          cont = f.gg.buttons)
-                          }, cont = f.gg.buttons)
-tooltip(keep.fit.gb) <- "Store the optimised model with all settings and the current dataset in the fit list"
-
-delete_fit_handler <- function(h, ...) {
-  if (length(f) > 0) {
-    f[[f.cur]] <<- NULL
-    s[[f.cur]] <<- NULL
-  }
-  if (length(f) > 0) {
-    names(f) <<- as.character(1:length(f))
-    names(s) <<- as.character(1:length(f))
-    update_f.df()
-    f.cur <<- "1"
-    ftmp <<- f[[f.cur]]
-    stmp <<- s[[f.cur]]
-    ds.i <<- ftmp$ds.index
-    update_plotting_and_fitting()
-  } else {
-    f.df <<- f.df.empty
-    f.cur <<- "0"
-  }
-  f.gtable[,] <<- f.df
-}
-
-delete.fit.gb <- gbutton("Delete fit", handler = delete_fit_handler,
-                         cont = f.gg.buttons)
-tooltip(delete.fit.gb) <- "Delete the currently loaded fit from the fit list"
-
-show.initial.gb <- gbutton("Show initial", 
-                           handler = function(h, ...) show_plot("Initial"),
-                           cont = f.gg.buttons)
-tooltip(show.initial.gb) <- "Show model with current inital settings for current dataset"
-
-get_initials_handler <- function(h, ...)
-{
-  f.i <- svalue(get.initials.gc, index = TRUE)
-  if (length(f) > 0) {
-    got_initials <- c(f[[f.i]]$bparms.fixed, f[[f.i]]$bparms.optim)
-    parnames <- f.gg.parms[,"Name"]
-    newparnames <- names(got_initials)
-    commonparnames <- intersect(parnames, newparnames)
-    f.gg.parms[commonparnames, "Initial"] <<- got_initials[commonparnames]
-  }
-}
-get.initials.gb <- gbutton("Get initials from", cont = f.gg.buttons,
-                           handler = get_initials_handler)
-get.initials.gc <- gcombobox(paste("Fit", f.df$Fit), cont = f.gg.buttons)
-
-# Notebook to the right {{{3
-f.gn <- gnotebook(cont = p.gg, width = 680, height = 790)
-# Dataframe with initial and optimised parameters {{{4
-f.gg.parms <- gdf(Parameters, cont = f.gn, 
-                 width = 670, height = 750,
-                 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.plot <- gcheckbox("plot",
-                         cont = f.gg.opts, checked = FALSE)
-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)
-f.gg.opts.transform_rates <- gcheckbox("transform_rates",
-                         cont = f.gg.opts, checked = TRUE)
-f.gg.opts.transform_fractions <- gcheckbox("transform_fractions",
-                         cont = f.gg.opts, checked = TRUE)
-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)
-optimisation_methods <- c("Port", "Marq", "SANN")
-f.gg.opts.method.modFit <- gcombobox(optimisation_methods, selected = 1,
-                                     label = "method.modFit",
-                                     width = 200,
-                                     cont = f.gg.opts)
-f.gg.opts.maxit.modFit <- gedit("auto", label = "maxit.modFit",
-                                 width = 20, cont = f.gg.opts)
-
-# Summary {{{3
-oldwidth <- options()$width
-options(width = 90)
-f.gg.summary <- ggroup(label = "Summary", cont = f.gn, horizontal = FALSE)
-f.gg.summary.topline <- ggroup(cont = f.gg.summary, horizontal = TRUE)
-f.gg.summary.filename <- gedit(paste(ds[[ds.cur]]$title, "_", m[[m.cur]]$name,
-                                     ".txt", sep = ""),
-                               width = 50, cont = f.gg.summary.topline)
-f.gg.summary.savebutton <-  gbutton("Save summary", cont = f.gg.summary.topline,
-                                    handler = function(h, ...) {
-                                      filename <- svalue(f.gg.summary.filename)
-                                      if (file.exists(filename))
-                                      {
-                                        gconfirm(paste("File", filename, "exists. Overwrite?"),
-                                                 parent = w,
-                                                 handler = function(h, ...) {
-                                                   capture.output(stmp,  file = filename)
-                                                 })
-                                      } else {
-                                        capture.output(stmp,  file = filename)
-                                      }
-                                    })
-f.gg.summary.listing <- ghtml(c("
", capture.output(stmp), "
"),
-                        cont = f.gg.summary, label = "Summary")
-options(width = oldwidth)
-
-# Plot options {{{4
-f.gg.plotopts <- ggroup(cont = f.gn, label = "Plot options", horizontal = FALSE,
-                        width = 200)
-
-f.gg.po.format <- gcombobox(plot_formats, selected = 1, label = "File format",
-                  cont = f.gg.plotopts,
-                  handler = function(h, ...) {
-                    plot_format <<- svalue(h$obj)
-                    svalue(plot.ftmp.savefile) <<- gsub("...$", plot_format,
-                                                       svalue(plot.ftmp.savefile))
-                  })
-plot_format <- svalue(f.gg.po.format)
-f.gg.po.legend <- gcheckbox("legend", cont = f.gg.plotopts, checked = TRUE)
-f.gg.po.update <- gbutton("Update plot",
-                          handler = function(h, ...) show_plot("Optimised"), 
-                          cont = f.gg.plotopts)
-f.gg.po.obssel <- gcheckboxgroup(names(m[[m.cur]]$spec), cont = f.gg.plotopts, 
-                                 checked = TRUE)
-svalue(f.gn) <- 1
-
-# Update the plotting and fitting area {{{3
-update_plotting_and_fitting <- function() {
-  svalue(pf) <- paste0("Fit ", f.cur, ": Dataset ", ftmp$ds.index, 
-                       ", Model ", ftmp$mkinmod$name)
-  # Parameters
-  f.gg.parms[,] <- get_Parameters(stmp, TRUE)
-
-  # Fit options
-  delete(f.gg.buttons, get.initials.gc)
-  get.initials.gc <<- gcombobox(paste("Fit", f.df$Fit), cont = f.gg.buttons)
-
-  svalue(f.gg.opts.st) <- ftmp$solution_type
-  svalue(f.gg.opts.atol) <- ftmp$atol
-  svalue(f.gg.opts.rtol) <- ftmp$rtol
-  svalue(f.gg.opts.transform_rates) <- ftmp$transform_rates
-  svalue(f.gg.opts.transform_fractions) <- ftmp$transform_fractions
-  svalue(f.gg.opts.weight) <- ftmp$weight.ini
-  svalue(f.gg.opts.reweight.method) <- ifelse(is.null(ftmp$reweight.method),
-                                                      "none", 
-                                                      ftmp$reweight.method)
-  svalue(f.gg.opts.reweight.tol) <- ftmp$reweight.tol
-  svalue(f.gg.opts.reweight.max.iter) <- ftmp$reweight.max.iter
-  svalue(f.gg.opts.method.modFit) <- ftmp$method.modFit
-  svalue(f.gg.opts.maxit.modFit) <- ftmp$maxit.modFit
-
-  # Summary
-  oldwidth <<- options()$width
-  options(width = 90)
-  svalue(f.gg.summary.filename) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name, ".txt", sep = "")
-  svalue(f.gg.summary.listing) <<- c("
", capture.output(stmp), "
")
-  options(width = oldwidth)
-
-  # Plot options
-  delete(f.gg.plotopts, f.gg.po.obssel)
-  f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec), cont = f.gg.plotopts, 
-                                   checked = TRUE)
-  # Plot
-  svalue(plot.ftmp.savefile) <<- paste(ftmp$ds$title, "_", ftmp$mkinmod$name,
-                                       ".", plot_format, sep = "")
-  show_plot("Optimised")  
- 
-}
 # vim: set foldmethod=marker ts=2 sw=2 expandtab: {{{1
-- 
cgit v1.2.1