aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--R/gmkinws.R15
-rw-r--r--data/FOCUS_2006.RDatabin8362 -> 19055 bytes
-rw-r--r--data/FOCUS_2006_Z.RDatabin71960 -> 83304 bytes
-rw-r--r--inst/GUI/gmkin.R268
4 files changed, 266 insertions, 17 deletions
diff --git a/R/gmkinws.R b/R/gmkinws.R
index c6f1ec5..dcc15d5 100644
--- a/R/gmkinws.R
+++ b/R/gmkinws.R
@@ -26,22 +26,16 @@
#' @field observed Names of the observed variables in the datasets, named
#' by the names used in the models contained in field m
#' @field ds A list of datasets compatible with mkinfit (long format)
-#' @field ds.cur Index of the currently selected dataset
#' @field m A list of mkinmod models
-#' @field m.cur Index of the currently selected model
#' @field f A list of mkinfit objects
-#' @field f.cur Index of the currently selected fit
#' @field s The summaries of the mkinfit objects in field f
gmkinws <- R6Class("gmkinws",
public = list(
observed = NULL,
ds = list(),
- ds.cur = NULL,
m = list(),
- m.cur = NULL,
f = list(),
- f.cur = NULL,
s = NA,
initialize = function(ds, m, f, ds.cur = NA, m.cur = NA, f.cur = NA) {
@@ -50,7 +44,6 @@ gmkinws <- R6Class("gmkinws",
if (!missing(ds)) {
self$check_ds(ds)
self$ds = ds
- self$ds.cur = ds.cur
# Collect names of observed variables
self$observed <- unique(sapply(ds, function(x) x$observed))
@@ -61,13 +54,11 @@ gmkinws <- R6Class("gmkinws",
self$check_m(m)
self$m <- m
}
- self$m.cur = m.cur
## Fits
if (!missing(f)) {
self$f <- f
}
- self$f.cur = f.cur
invisible(self)
},
@@ -86,7 +77,7 @@ gmkinws <- R6Class("gmkinws",
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 append(self$ds, ds)
+ else self$ds <- append(self$ds, ds)
# Update names of observed variables
observed <- unique(sapply(ds, function(x) x$observed))
@@ -122,8 +113,6 @@ print.gmkinws <- function(x, ...) {
print(x$ds)
cat("\nModels:\n")
print(x$m)
- cat("Current selections:\n")
- cat("Dataset ", x$ds.cur, ", Model ", x$m.cur, ", Fit ", x$f.cur, "\n", sep = "")
- cat("\nFits:\n")
+ cat("\nNames of fits:\n")
print(names(x$f))
}
diff --git a/data/FOCUS_2006.RData b/data/FOCUS_2006.RData
index 4587396..ded499a 100644
--- a/data/FOCUS_2006.RData
+++ b/data/FOCUS_2006.RData
Binary files differ
diff --git a/data/FOCUS_2006_Z.RData b/data/FOCUS_2006_Z.RData
index a65884b..6171241 100644
--- a/data/FOCUS_2006_Z.RData
+++ b/data/FOCUS_2006_Z.RData
Binary files differ
diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 0b615c4..45d04ad 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -83,7 +83,7 @@ update_f.df <- function() {
if (!is.na(ftmp[1])) {
f.df[1, "Name"] <- c("Temporary (not fitted)")
}
- if (!is.na(ws$f)) {
+ if (!is.na(ws$f[1])) {
f.df.ws <- data.frame(Name = names(ws$f), stringsAsFactors = FALSE)
f.df <- rbind(f.df, f.df.ws)
}
@@ -141,7 +141,7 @@ addHandlerClicked(p.gtable, p.switcher)
ds.switcher <- function(h, ...) {
ws$ds.cur <<- h$row_index
svalue(c.ds) <- ds.df[ws$ds.cur, "Title"]
- #update_ds_editor()
+ update_ds_editor()
svalue(center) <- 2
}
ds.gtable <- gtable(ds.df, cont = ds.gf, width = left_width - 10, height = 160)
@@ -180,6 +180,22 @@ c.conf <- gbutton("Configure fit", cont = c.gf, handler = function(h, ...) svalu
# center: Project editor {{{1
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,
+ handler = function(h, ...) {
+ project_name <- "New project"
+ svalue(p.name) <- project_name
+ svalue(p.filename) <- file.path(getwd(), paste0(project_name, ".gmkinws"))
+ 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, ...) {
@@ -306,15 +322,259 @@ p.line.import.mb <- gbutton("Import selected", cont = p.line.import.mf,
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))
+
+# 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()
+# } 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()
+# }
+
+# 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("<pre>", tmptext, "</pre>")
+# 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
+# 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)
+ds.title.ge <- gedit("", label = "Title", width = 50, 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("<pre></pre>", 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.title.ge) <- ws$ds[[ws$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
+}
+# center: Model editor {{{1
m.editor <- gframe("", horizontal = FALSE, cont = center,
label = "Model editor")
+# center: Fit configuration {{{1
f.config <- gframe("", horizontal = FALSE, cont = center,
label = "Fit configuration")
+# center: Results viewer {{{1
r.viewer <- gframe("", horizontal = FALSE, cont = center,
label = "Result viewer")
svalue(center) <- 1

Contact - Imprint