diff options
| -rw-r--r-- | inst/GUI/mkinGUI.R | 445 |
1 files changed, 445 insertions, 0 deletions
diff --git a/inst/GUI/mkinGUI.R b/inst/GUI/mkinGUI.R new file mode 100644 index 0000000..cf66b01 --- /dev/null +++ b/inst/GUI/mkinGUI.R @@ -0,0 +1,445 @@ +# $Id: mkinGUI.R 122 2013-10-21 20:19:57Z jranke $ {{{1
+
+# gWidgetsWWW2 GUI for mkin
+
+# Copyright (C) 2013 Johannes Ranke
+# Contact: jranke@uni-bremen.de, johannesranke@eurofins.com
+
+# This file is part of the R package mkin
+
+# mkin 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.
+
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+# details.
+
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>
+require(mkin) # {{{1
+# Set the GUI title and create the basic widget layout {{{1
+w <- gwindow("Browser based GUI for kinetic evaluations using mkin")
+sb <- gstatusbar("Powered by gWidgetsWWW2 and Rook", cont = w)
+pg <- gpanedgroup(cont = w, default.size = 400)
+center <- gnotebook(cont = pg)
+left <- gvbox(cont = pg)
+# Helper functions {{{1
+# Override function for making it possible to override original data in 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)
+}
+# Set default values for project data {{{1
+# Initial project file name {{{2
+project_file <- "mkin_FOCUS_2006.RData"
+# Initial studies {{{2
+studies.df <- data.frame(Index = as.integer(1),
+ Author = "FOCUS kinetics workgroup",
+ Year = "2006",
+ Title = "FOCUS Kinetics",
+ stringsAsFactors = FALSE)
+# Initial datasets {{{2
+ds <- list()
+observed.all <- vector()
+for (i in 1:2) {
+ ds.letter = LETTERS[i + 2]
+ ds.index <- as.character(i)
+ ds.name = paste0("FOCUS_2006_", ds.letter)
+ ds[[ds.index]] <- list(
+ study_nr = 1,
+ title = paste("FOCUS example dataset", ds.letter),
+ sampling_times = unique(get(ds.name)$time),
+ time_unit = "",
+ observed = as.character(unique(get(ds.name)$name)),
+ unit = "% AR",
+ replicates = 1,
+ data = get(ds.name)
+ )
+ ds[[ds.index]]$data$name <- as.character(ds[[ds.index]]$data$name)
+ ds[[ds.index]]$data$override = as.numeric(NA)
+ ds[[ds.index]]$data$err = 1
+}
+# Dataframe with datasets for selection {{{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()
+update_ds.df()
+ds.cur = "1"
+# Initial models {{{2
+m <- list()
+m[["1"]] <- mkinmod(parent = list(type = "SFO"))
+m[["1"]]$name = "SFO"
+m[["2"]] <- mkinmod(parent = list(type = "FOMC"))
+m[["2"]]$name = "FOMC"
+m[["3"]] <- mkinmod(parent = list(type = "DFOP"))
+m[["3"]]$name = "DFOP"
+m[["4"]] <- mkinmod(parent = list(type = "SFO", to = "m1"),
+ m1 = list(type = "SFO"),
+ use_of_ff = "max")
+m[["4"]]$name = "SFO_SFO"
+# Dataframe with models for selection {{{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()
+update_m.df()
+m.cur = "1"
+# Widgets and handlers for project data {{{1
+prg <- gexpandgroup("Project file management", cont = left, horizontal = FALSE)
+visible(prg) <- FALSE
+# Project data management handler functions {{{2
+upload_file_handler <- function(h, ...)
+{
+ tmpfile <- normalizePath(svalue(h$obj), winslash = "/")
+ try(load(tmpfile))
+ project_file <<- pr.gf$filename
+ svalue(pr.ge) <- project_file
+ studies.gdf[,] <- studies.df
+ ds.cur <<- "1"
+ ds <<- ds
+ update_ds.df()
+ ds.gtable[,] <- ds.df
+ update_ds_editor()
+ m.cur <<- "1"
+ m <<- m
+ update_m.df()
+ m.gtable[,] <- m.df
+ update_m_editor()
+}
+save_to_file_handler <- function(h, ...)
+{
+ studies.df <- data.frame(studies.gdf[,], stringsAsFactors = FALSE)
+ save(studies.df, ds, m, file = project_file)
+ galert(paste("Saved project contents to", project_file), parent = w)
+}
+change_project_file_handler = function(h, ...) {
+ project_file <<- as.character(svalue(h$obj))
+}
+# Project data management GUI elements {{{2
+pr.gf <- gfile(text = "Select project file", cont = prg,
+ handler = upload_file_handler)
+pr.ge <- gedit(project_file, cont = prg,
+ handler = change_project_file_handler)
+# The save button is always visible {{{1
+gbutton("Save current project contents", cont = left,
+ handler = save_to_file_handler)
+
+# GUI widgets and a function 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 = 390, height = 200, cont = stg)
+studies.gdf$set_column_width(1, 35)
+studies.gdf$set_column_width(2, 150)
+studies.gdf$set_column_width(3, 40)
+addHandlerChanged(studies.gdf, update_study_selector)
+# Datasets and models {{{1
+dsm <- gframe("Datasets and models", cont = left, horizontal = FALSE)
+# Dataset table with handler {{{2
+ds.switcher <- function(h, ...) {
+ ds.cur <<- as.character(svalue(h$obj))
+ update_ds_editor()
+ svalue(center) <- 1
+}
+ds.gtable <- gtable(ds.df, width = 390, multiple = TRUE, cont = dsm)
+addHandlerDoubleClick(ds.gtable, ds.switcher)
+size(ds.gtable) <- list(columnWidths = c(40, 300, 40))
+
+# Model table with handler {{{2
+m.switcher <- function(h, ...) {
+ m.cur <<- as.character(svalue(h$obj))
+ update_m_editor()
+ svalue(center) <- 2
+}
+m.gtable <- gtable(m.df, width = 390, multiple = TRUE, cont = dsm)
+addHandlerDoubleClick(m.gtable, m.switcher)
+size(m.gtable) <- list(columnWidths = c(40, 340))
+
+# Dataset editor {{{1
+ds.editor <- gframe("Dataset 1", horizontal = FALSE, cont = center, label = "Dataset editor")
+# Handler functions {{{3
+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, ...) {
+ ds[[ds.cur]] <<- NULL
+ names(ds) <<- names(plots) <<- names(prows) <<- as.character(1:length(ds))
+ ds.cur <<- names(ds)[[1]]
+ update_ds.df()
+ ds.gtable[,] <- ds.df
+ update_ds_editor()
+}
+
+new_dataset_handler <- function(h, ...) {
+ ds.cur <<- as.character(1 + length(ds))
+ ds[[ds.cur]] <<- list(
+ study_nr = 1,
+ title = "",
+ sampling_times = c(0, 1),
+ time_unit = "NA",
+ observed = "parent",
+ unit = "NA",
+ replicates = 1,
+ data = data.frame(
+ name = "parent",
+ time = c(0, 1),
+ value = c(100, NA),
+ override = "NA",
+ err = 1,
+ stringsAsFactors = FALSE
+ )
+ )
+ update_ds.df()
+ ds.gtable[,] <- ds.df
+ update_ds_editor()
+}
+
+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 = rep(sampling_times, each = replicates, times = length(obs)),
+ value = NA,
+ override = NA,
+ err = 1
+ )
+ ds.e.gdf[,] <- new.data
+}
+
+save_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()
+ update_plot()
+}
+
+# Widget setup {{{3
+# Line 1 {{{4
+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 {{{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)
+
+# Line 3 with forms {{{4
+ds.e.forms <- ggroup(cont= ds.editor, 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)
+gbutton("Generate empty grid for kinetic data", cont = ds.e.3b,
+ handler = empty_grid_handler)
+
+# Save button {{{4
+gbutton("Save changes", cont = ds.editor, handler = save_ds_changes_handler)
+
+# Kinetic Data {{{4
+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
+
+ 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, ...) {
+ m[[m.cur]] <<- NULL
+ names(m) <<- as.character(1:length(m))
+ m.cur <<- "1"
+ update_m.df()
+ m.gtable[,] <- m.df
+ update_m_editor()
+}
+
+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", "FOMC", "DFOP", "HS", "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("", 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_compound_handler,
+ action = obs.i, cont = m.e.rows[[obs.i]])
+}
+
+remove_compound_handler <- function(h, ...) {
+ m[[m.cur]]$spec[[h$action]] <<- NULL
+ update_m_editor()
+}
+
+save_m_changes_handler <- function(h, ...) {
+ spec <- list()
+ for (obs.i in 1:length(m.e.rows)) {
+ spec[[obs.i]] <- list(type = svalue(m.e.type[[obs.i]]),
+ to = svalue(m.e.to[[obs.i]]),
+ sink = svalue(m.e.sink[[obs.i]]))
+ if(spec[[obs.i]]$to == "") spec[[obs.i]]$to = NULL
+ names(spec)[[obs.i]] <- svalue(m.e.obs[[obs.i]])
+ }
+ 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 transformation product", cont = m.e.b,
+ handler = add_observed_handler)
+gbutton("Save changes", cont = m.e.b, handler = save_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.observed)) {
+ 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", "FOMC", "DFOP", "HS", "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), "",
+ m[[m.cur]]$spec[[obs.i]]$to)
+ m.e.to[[obs.i]] <<- gedit(obs.to, cont = m.e.rows[[obs.i]])
+ m.e.sink[[obs.i]] <<- gcheckbox("Path to sink", checked = m[[m.cur]]$spec[[obs.i]]$sink,
+ cont = m.e.rows[[obs.i]])
+ if (obs.i > 1) {
+ gbutton("Remove compound", handler = remove_compound_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}}}
+# 1}}}
+
+# vim: set foldmethod=marker ts=2 sw=2 expandtab:
|