From 46a092c54133fb1d1d2fafb356d8605789d7100d Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 23 Oct 2015 16:59:17 +0200 Subject: Hard work to make the project management safe At the moment it is distracting, as modification tracking of projects is not implemented yet --- DESCRIPTION | 4 +- NAMESPACE | 4 +- R/gmkinws.R | 78 ++++++++---- data/FOCUS_2006.RData | Bin 19055 -> 21120 bytes data/FOCUS_2006_Z.RData | Bin 83304 -> 51043 bytes inst/GUI/gmkin.R | 332 ++++++++++++++++++++++++++---------------------- 6 files changed, 240 insertions(+), 178 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 853236a..e6980ca 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: gmkin Type: Package Title: Graphical User Interface for Fitting Kinetic Models to Chemical Degradation Data Version: 0.6-00.9000 -Date: 2015-10-19 +Date: 2015-10-23 Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre", "cph"), email = "jranke@uni-bremen.de"), person("Eurofins Regulatory AG", role = "cph")) @@ -10,7 +10,7 @@ Description: Browser based graphical user interface for R package mkin, based on the gWidgetsWWW2 package. Both gmkin and gWidgetsWWW2 are developed on GitHub, but are also available from the R-Forge repository. Depends: mkin (> 0.9-40), gWidgetsWWW2 (>= 0.4-6) -Imports: R6, markdown +Imports: R6, markdown, plyr Suggests: knitr, rmarkdown License: GPL LazyLoad: yes diff --git a/NAMESPACE b/NAMESPACE index ca61543..4673d9a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Export all names -export("gmkin") +export("gmkin", "gmkinws") +S3method("print", "gmkinws") # Import all packages listed as Imports or Depends import(mkin, gWidgetsWWW2, R6, markdown) +importFrom(plyr, compact) diff --git a/R/gmkinws.R b/R/gmkinws.R index dcc15d5..d40294d 100644 --- a/R/gmkinws.R +++ b/R/gmkinws.R @@ -3,7 +3,7 @@ # 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. @@ -18,9 +18,11 @@ #' A workspace class for gmkin #' +#' Datasets, models and fits are stored in lists. +#' #' @docType class #' @importFrom R6 R6Class -#' @importFrom mkin mkinws +#' @importFrom plyr compact #' @export #' @format An \code{\link{R6Class}} generator object. #' @field observed Names of the observed variables in the datasets, named @@ -28,36 +30,33 @@ #' @field ds A list of datasets compatible with mkinfit (long format) #' @field m A list of mkinmod models #' @field f A list of mkinfit objects -#' @field s The summaries of the mkinfit objects in field f gmkinws <- R6Class("gmkinws", public = list( observed = NULL, - ds = list(), - m = list(), - f = list(), - s = NA, + ds = NA, + m = NA, + f = NA, - initialize = function(ds, m, f, ds.cur = NA, m.cur = NA, f.cur = NA) { + initialize = function(ds, m, f) { ## Datasets if (!missing(ds)) { self$check_ds(ds) - self$ds = ds + self$ds = plyr::compact(ds) - # Collect names of observed variables - self$observed <- unique(sapply(ds, function(x) x$observed)) + self$update_observed() } ## Models if (!missing(m)) { self$check_m(m) - self$m <- m + self$m <- plyr::compact(m) } ## Fits if (!missing(f)) { - self$f <- f + self$f <- plyr::compact(f) } invisible(self) @@ -75,14 +74,27 @@ gmkinws <- R6Class("gmkinws", add_ds = function(ds) { self$check_ds(ds) - common_names = intersect(names(self$ds), names(ds)) - if (length(common_names) > 0) stop("Dataset name(s) ", paste(common_names, collapse = ", "), " already used.") - else self$ds <- append(self$ds, ds) + if (is.na(self$ds)) self$ds <- plyr::compact(ds) + else self$ds <- append(self$ds, plyr::compact(ds)) + + self$update_observed() + + invisible(self) + }, + + update_observed = function() { + if (is.na(self$ds[1])) self$observed = NULL + else self$observed = na.omit(unique(unlist(sapply(self$ds, function(x) + x$observed)))) + }, - # Update names of observed variables - observed <- unique(sapply(ds, function(x) x$observed)) - self$observed <- union(self$observed, observed) + delete_ds = function(i) { + if (any(sapply(self$ds[i], is.null))) + stop("Could not delete dataset(s) ", paste(i, collapse = ", ")) + self$ds <- self$ds[-i] + if (length(self$ds) == 0) self$ds <- NA + self$update_observed() invisible(self) }, @@ -98,9 +110,26 @@ gmkinws <- R6Class("gmkinws", add_m = function(m) { self$check_m(m) - common_names = intersect(names(self$m), names(m)) - if (length(common_names) > 0) stop("Model name(s) ", paste(common_names, collapse = ", "), " already used.") - else self$m = c(self$m, m) + if (is.na(self$m)) self$m <- plyr::compact(m) + else self$m = append(self$m, plyr::compact(m)) + invisible(self) + }, + + delete_m = function(i) { + if (any(sapply(self$m[i], is.null))) + stop("Could not delete model(s) ", paste(i, collapse = ", ")) + + self$m <- self$m[-i] + if (length(self$m) == 0) self$m <- NA + invisible(self) + }, + + delete_f = function(i) { + if (any(sapply(self$f[i], is.null))) + stop("Could not delete fit(s) ", paste(i, collapse = ", ")) + + self$f <- self$f[-i] + if (length(self$f) == 0) self$f <- NA invisible(self) } ) @@ -109,10 +138,13 @@ gmkinws <- R6Class("gmkinws", #' @export print.gmkinws <- function(x, ...) { cat(" workspace object\n") + cat("Observed variables:\n") + print(x$observed) cat("\nDatasets:\n") print(x$ds) cat("\nModels:\n") print(x$m) cat("\nNames of fits:\n") - print(names(x$f)) + if (is.na(x$f[1])) print(NA) + else print(sapply(x$f, function(x) x$name)) } diff --git a/data/FOCUS_2006.RData b/data/FOCUS_2006.RData index ded499a..9d27ed8 100644 Binary files a/data/FOCUS_2006.RData and b/data/FOCUS_2006.RData differ diff --git a/data/FOCUS_2006_Z.RData b/data/FOCUS_2006_Z.RData index 6171241..cd5defb 100644 Binary files a/data/FOCUS_2006_Z.RData and b/data/FOCUS_2006_Z.RData differ diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 45d04ad..bcf2b68 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -24,7 +24,7 @@ left_width = 250 right_width = 500 save_keybinding = "Ctrl-X" -# Widgets {{{2 +# Three panel layout {{{2 window_title <- paste0("gmkin ", packageVersion("gmkin"), "- Browser based GUI for kinetic evaluations using mkin") w <- gwindow(window_title) @@ -68,14 +68,21 @@ update_p.df <- function() { } else { p.df <<- p.df.package } + p.gtable[,] <- p.df + p.line.import.p[,] <- c("", p.df$Name) } # Update dataframe with datasets {{{2 update_ds.df <- function() { - ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title)) + if (is.na(ws$ds[1])) ds.df <<- ds.df.empty + else ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title)) + ds.gtable[,] <- ds.df + update_ds_editor() + ds.delete$call_Ext("disable") } # Update dataframe with models {{{2 update_m.df <- function() { - m.df <<- data.frame(Name = names(ws$m)) + if (is.na(ws$m[1])) m.df <<- m.df.empty + else m.df <<- data.frame(Name = sapply(ws$m, function(x) x$name)) } # Update dataframe with fits {{{2 update_f.df <- function() { @@ -84,12 +91,14 @@ update_f.df <- function() { f.df[1, "Name"] <- c("Temporary (not fitted)") } if (!is.na(ws$f[1])) { - f.df.ws <- data.frame(Name = names(ws$f), stringsAsFactors = FALSE) + f.df.ws <- data.frame(Name = sapply(ws$f, function(x) x$name), + stringsAsFactors = FALSE) f.df <- rbind(f.df, f.df.ws) } f.df <<- f.df } # Generate the initial workspace {{{1 +# Project workspace {{{2 ws <- gmkinws$new() ws.import <- NA # Initialise meta data objects so assignments within functions using <<- will {{{2 @@ -97,10 +106,19 @@ ws.import <- NA # 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() +# Datasets {{{2 +ds.cur <- ds.empty <- mkinds$new( + title = "", time_unit = "", unit = "", + data = data.frame( + name = "parent", + time = c(0, 1), + value = c(100, NA), + override = "NA", err = 1, + stringsAsFactors = FALSE)) ds.df <- ds.df.empty <- data.frame(Title = "", stringsAsFactors = FALSE) +# Models {{{2 m.df <- m.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) +# Fits {{{2 f.df <- f.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) ftmp <- NA # left: Explorer tables {{{1 @@ -116,31 +134,58 @@ f.gf <- gframe("Results", cont = left) # 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.loaded <- NA # The index of the loaded project. We reset the selection to this when the user + # does not confirm +p.modified <- TRUE # Keep track of modifications after loading 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 + p.cur <- h$row_index # h$row_index for clicked or doubleclick handlers, h$value for change + project_switched <- FALSE + switch_project <- function() { + 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() + update_m.df() + m.gtable[,] <<- m.df + update_f.df() + f.gtable[,] <<- f.df + p.loaded <<- p.cur + project_switched <- TRUE + p.gtable$set_index(p.cur) + } + if (p.modified) { + gconfirm("When you switch projects, you loose any unsaved changes. Proceed to switch?", + handler = function(h, ...) { + switch_project() + }) } else { - ws <<- get(Name) + switch_project() + } + # We can reset the selection only if the project was not + # switched. The following code gets executed during the confirmation dialogue, + # i.e. before the potential switching + if (!project_switched) { + if (is.na(p.loaded)) { + p.gtable$clear_selection() + } else { + p.gtable$set_index(p.loaded) + } } - 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 } 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"] + ds.i <- h$row_index + svalue(c.ds) <- ds.df[ds.i, "Title"] + ds.cur <<- ws$ds[[ds.i]] update_ds_editor() svalue(center) <- 2 } @@ -148,8 +193,8 @@ 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"] + m.i <- h$row_index + svalue(c.m) <- m.df[m.i, "Name"] #update_m_editor() svalue(center) <- 3 } @@ -157,8 +202,8 @@ 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, ...) { - ws$f.cur <<- h$row_index - 1 - if (ws$f.cur > 0) { + f.cur <<- h$row_index - 1 + if (f.cur > 0) { ftmp <<- ws$f[[ws$f.cur]] stmp <<- ws$s[[ws$f.cur]] c.ds$call_Ext("setText", @@ -181,8 +226,8 @@ c.conf <- gbutton("Configure fit", cont = c.gf, handler = function(h, ...) svalu p.editor <- gframe("", horizontal = FALSE, cont = center, label = "Project") # New project {{{2 -p.line.clear <- ggroup(cont = p.editor, horizontal = TRUE) -p.line.clear.b <- gbutton("New project", cont = p.line.clear, +p.line.buttons <- ggroup(cont = p.editor, horizontal = TRUE) +p.new <- gbutton("New project", cont = p.line.buttons, handler = function(h, ...) { project_name <- "New project" svalue(p.name) <- project_name @@ -190,61 +235,59 @@ p.line.clear.b <- gbutton("New project", cont = p.line.clear, p.delete$call_Ext("disable") ws <<- gmkinws$new() update_ds.df() - ds.gtable[,] <- ds.df update_m.df() m.gtable[,] <- m.df update_f.df() f.gtable[,] <- f.df }) -# 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.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.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" +p.delete <- gbutton("Delete project", cont = p.line.buttons, + handler = p.delete.handler, + ext.args = list(disabled = TRUE)) # Project name {{{2 p.line.name <- ggroup(cont = p.editor, horizontal = TRUE) -p.name <- gedit("New project", label = "Project name", +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") +p.save.action <- 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() + } 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.action$add_keybinding(save_keybinding) +p.save <- gbutton(action = p.save.action, cont = p.line.name) +tooltip(p.save) <- paste("Press", save_keybinding, "to save") update_p_editor <- function(p.cur) { project_name <- as.character(p.df[p.cur, "Name"]) @@ -257,29 +300,27 @@ update_p_editor <- function(p.cur) { p.delete$call_Ext("enable") } } +# 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.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" # 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") +p.filename.gg <- ggroup(width = 105, cont = p.line.file) # for spacing +p.filename.label <- glabel("Project file:", cont = p.filename.gg) +p.filename <- glabel("", cont = p.line.file) # 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, @@ -294,54 +335,41 @@ p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.l } 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), + p.line.import.mt[,] <- data.frame(Name = sapply(ws.import$m, function(x) x$name), 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) + width = left_width - 10, height = 160, + handler = function(h, ...) p.line.import.dsb$call_Ext("enable")) p.line.import.dsb <- gbutton("Import selected", cont = p.line.import.dsf, + ext.args = list(disabled = TRUE), handler = function(h, ...) { i <- svalue(p.line.import.dst, index = TRUE) - ws$ds <<- append(ws$ds, ws.import$ds[i]) + ws$add_ds(ws.import$ds[i]) update_ds.df() - ds.gtable[,] <- ds.df } ) 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) + width = left_width - 10, height = 160, + handler = function(h, ...) p.line.import.mb$call_Ext("enable")) p.line.import.mb <- gbutton("Import selected", cont = p.line.import.mf, + ext.args = list(disabled = TRUE), handler = function(h, ...) { i <- svalue(p.line.import.mt, index = TRUE) - ws$m <<- append(ws$m, ws.import$m[i]) + ws$add_m(ws.import$m[i]) update_m.df() m.gtable[,] <- m.df } ) # center: Dataset editor {{{1 ds.editor <- gframe("", 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)) - + label = "Dataset") +# Handler functions {{{2 # copy_dataset_handler <- function(h, ...) { # ds.old <- ds.cur # ds.cur <<- as.character(1 + length(ds)) @@ -350,27 +378,23 @@ ds.editor <- gframe("", horizontal = FALSE, cont = center, # 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() -# } else { -# galert("Deleting the last dataset is not supported", parent = w) -# } -# } -# -# 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() -# } + +delete_dataset_handler <- function(h, ...) { + ds.i <- svalue(ds.gtable, index = TRUE) + ws$delete_ds(ds.i) + update_ds.df() +} + +new_dataset_handler <- function(h, ...) { + ds.new <- ds.empty + ds.new$title <- "New dataset" + ws$add_ds(list(ds.new)) + ds.i <- length(ws$ds) + ds.cur <<- ws$ds[[ds.i]] + update_ds.df() + ds.gtable[,] <- ds.df + update_ds_editor() +} # tmptextheader <- character(0) # load_text_file_with_data <- function(h, ...) { @@ -471,15 +495,17 @@ ds.editor <- gframe("", horizontal = FALSE, cont = center, # # Widget setup {{{2 # Line 1 {{{3 -ds.e.1 <- ggroup(cont = ds.editor, horizontal = TRUE) -ds.title.ge <- gedit("", label = "Title", width = 50, cont = ds.e.1) +ds.e.buttons <- ggroup(cont = ds.editor, horizontal = TRUE) +ds.e.new <- gbutton("New dataset", cont = ds.e.buttons, handler = new_dataset_handler) +#gbutton("Copy dataset", cont = ds.e.1, handler = copy_dataset_handler) +ds.delete <- gbutton("Delete dataset", cont = ds.e.buttons, + handler = delete_dataset_handler, ext.args = list(disabled = TRUE)) +ds.e.2 <- ggroup(cont = ds.editor, horizontal = TRUE) +ds.title.ge <- gedit("", label = "Dataset title", width = 50, cont = ds.e.2) # # 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 @@ -557,7 +583,8 @@ ds.title.ge <- gedit("", label = "Title", width = 50, cont = ds.e.1) # # Update the dataset editor {{{3 update_ds_editor <- function() { - svalue(ds.title.ge) <- ws$ds[[ws$ds.cur]]$title + svalue(ds.title.ge) <- ds.cur$title + ds.delete$call_Ext("enable") # svalue(ds.study.gc, index = TRUE) <- ds[[ds.cur]]$study_nr # svalue(ds.e.st) <- paste(ds[[ds.cur]]$sampling_times, collapse = ", ") @@ -570,13 +597,13 @@ update_ds_editor <- function() { } # center: Model editor {{{1 m.editor <- gframe("", horizontal = FALSE, cont = center, - label = "Model editor") + label = "Model") # center: Fit configuration {{{1 f.config <- gframe("", horizontal = FALSE, cont = center, - label = "Fit configuration") + label = "Configuration") # center: Results viewer {{{1 r.viewer <- gframe("", horizontal = FALSE, cont = center, - label = "Result viewer") + label = "Result") svalue(center) <- 1 # right: Viewing area {{{1 # Workflow {{{2 @@ -652,5 +679,6 @@ changes.gh <- ghtml(label = "Changes", paste0("