aboutsummaryrefslogtreecommitdiff
path: root/inst
diff options
context:
space:
mode:
Diffstat (limited to 'inst')
-rw-r--r--inst/GUI/gmkin.R127
-rw-r--r--inst/GUI/png/DFOP,_no_mets.pngbin1696 -> 1548 bytes
-rw-r--r--inst/GUI/png/DFOP,_one_met.pngbin2299 -> 2069 bytes
-rw-r--r--inst/GUI/png/FOMC,_no_mets.pngbin1745 -> 1672 bytes
-rw-r--r--inst/GUI/png/FOMC,_one_met.pngbin2335 -> 2164 bytes
-rw-r--r--inst/GUI/png/FOMC,_two_sequential,_one_parallel_met.pngbin2989 -> 2912 bytes
-rw-r--r--inst/GUI/png/HS,_no_mets.pngbin1880 -> 1392 bytes
-rw-r--r--inst/GUI/png/HS,_one_met.pngbin2295 -> 1918 bytes
-rw-r--r--inst/GUI/png/SFO,_no_mets.pngbin1871 -> 1572 bytes
-rw-r--r--inst/GUI/png/SFO,_one_met.pngbin2224 -> 2074 bytes
10 files changed, 86 insertions, 41 deletions
diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 751ffa9..bbce29b 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -57,6 +57,12 @@ bl$set_panel_size("west", left_width)
bl$set_panel_size("east", right_width)
center <- gnotebook(cont = bl, where = "center")
+center$add_handler("tabchange",
+ function(h, ...) {
+ if (svalue(h$obj) == 1) {
+ svalue(right) <<- 1
+ }
+ })
left <- gvbox(cont = bl, use.scrollwindow = TRUE, where = "west", spacing = 0)
right <- gnotebook(cont = bl, use.scrollwindow = TRUE, where = "east")
right$add_handler("tabchange",
@@ -99,7 +105,6 @@ update_ds.df <- function() {
if (is.na(ws$ds[1])) ds.df <<- ds.df.empty
else ds.df <<- data.frame(Title = sapply(ws$ds, function(x) x$title), stringsAsFactors = FALSE)
ds.gtable[,] <- ds.df
- update_ds_editor()
ds.delete$call_Ext("disable")
ds.copy$call_Ext("disable")
}
@@ -204,6 +209,7 @@ p.switcher <- function(h, ...) {
})
} else {
switch_project()
+ svalue(right) <<- 1
}
# We can reset the selection only if the project was not
# switched. The following code gets executed during the confirmation dialogue,
@@ -372,8 +378,11 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3
}
svalue(center) <- 4
}
-f.conf <- gbutton("Configure fit",
- cont = c.gf, # cont = f.buttons,
+f.conf.line <- ggroup(cont = c.gf,
+ ext.args = list(layout = list(type = "vbox", align = "center")))
+f.conf <- gbutton("<b>Configure fit</b>",
+ width = 100,
+ cont = f.conf.line,
handler = configure_fit_handler,
ext.args = list(disabled = TRUE))
@@ -464,15 +473,19 @@ update_p_editor <- function(p.cur) {
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)
+ if (!dir.exists(target_wd)) {
+ gmessage(paste("Directory", target_wd, "does not exist"), parent = w)
} else {
- svalue(sb) <- paste("Changed working directory to", wd)
- update_p.df()
+ 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 <- gedit(getwd(), cont = p.line.wd, label = "<b>Working directory</b>", 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"
@@ -549,12 +562,6 @@ stage_dataset <- function(ds.new) {
ds.delete$call_Ext("disable")
}
-add_dataset <- function(ds.new) {
- ws$add_ds(list(ds.new))
- update_ds.df()
- p.modified <<- TRUE
-}
-
new_dataset_handler <- function(h, ...) {
ds.new <- ds.empty$clone()
ds.new$title <- "New dataset"
@@ -575,16 +582,34 @@ delete_dataset_handler <- function(h, ...) {
}
keep_ds_changes_handler <- function(h, ...) {
- add_dataset(
- mkinds$new(
- title = svalue(ds.title.ge),
- data = ds.e.gdf[,],
- time_unit = svalue(ds.e.stu),
- unit = svalue(ds.e.obu)))
- update_ds.df()
- ds.gtable$set_index(length(ws$ds))
- update_ds_editor()
- svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+ ds.i <- svalue(ds.gtable, index = TRUE)
+ if (is.null(ds.i)) ds.i <- 1
+
+ editor_title <- svalue(ds.title.ge)
+ editor_ds <- mkinds$new(
+ title = editor_title,
+ data = ds.e.gdf[,],
+ time_unit = svalue(ds.e.stu),
+ unit = svalue(ds.e.obu))
+
+ if (ws$ds[[ds.i]]$title == editor_title) {
+ gconfirm(paste("Do you want to overwrite dataset", editor_title, "?"), parent = w,
+ handler = function(h, ...) {
+ ws$ds[[ds.i]] <<- editor_ds
+ ds.cur <<- editor_ds
+ update_ds.df()
+ svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+ p.modified <<- TRUE
+ update_ds_editor()
+ })
+ } else {
+ ws$add_ds(list(editor_ds))
+ ds.cur <<- editor_ds
+ update_ds.df()
+ svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+ ds.gtable$set_index(length(ws$ds))
+ update_ds_editor()
+ }
}
# For populating the dataset editor {{{3
@@ -692,8 +717,9 @@ ds.e.stu <- gedit(width = 20, label = "Unit", cont = ds.e.gfl)
ds.e.rep <- gedit(width = 20, label = "Replicates", cont = ds.e.gfl)
ds.e.obs <- gedit(width = 60, label = "Observed", cont = ds.e.gfl)
ds.e.obu <- gedit(width = 20, label = "Unit", cont = ds.e.gfl)
-generate_grid.gb <- gbutton("Generate grid for entering kinetic data", cont = ds.editor,
- handler = empty_grid_handler)
+generate_grid.gb.line <- ggroup(cont = ds.editor)
+generate_grid.gb <- gbutton("Generate grid for entering kinetic data", cont = generate_grid.gb.line,
+ width = 250, handler = empty_grid_handler)
tooltip(generate_grid.gb) <- "Overwrites the kinetic data shown to the right"
# Data upload area {{{3
@@ -737,7 +763,7 @@ ds.e.up.long.err <- gedit("err", cont = ds.e.up.long, label = "Relative errors")
svalue(ds.e.up.wlstack) <- 1
# center: Model editor {{{1
-m.editor <- gframe("", horizontal = FALSE, cont = center,
+m.editor <- gframe("", horizontal = FALSE, cont = center, width = 600,
label = "Model")
# Handler functions {{{2
# For top row buttons {{{3
@@ -748,12 +774,6 @@ stage_model <- function(m.new) {
m.delete$call_Ext("disable")
}
-add_model <- function(m.new) {
- ws$add_m(list(m.new))
- update_m.df()
- p.modified <<- TRUE
-}
-
new_model_handler <- function(h, ...) {
m.new <- m.empty
m.new$name <- "New model"
@@ -774,6 +794,7 @@ delete_model_handler <- function(h, ...) {
}
keep_m_changes_handler <- function(h, ...) {
+
spec <- list()
for (obs.i in 1:length(m.e.rows)) {
to_string <- svalue(m.e.to[[obs.i]])
@@ -784,11 +805,27 @@ keep_m_changes_handler <- function(h, ...) {
sink = svalue(m.e.sink[[obs.i]]))
names(spec)[[obs.i]] <- svalue(m.e.obs[[obs.i]])
}
+
m.cur <<- mkinmod(use_of_ff = svalue(m.ff.gc),
speclist = spec)
m.cur$name <<- svalue(m.name.ge)
- add_model(m.cur)
- svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+
+ m.i <- svalue(m.gtable, index = TRUE)
+ if (is.null(m.i)) m.i <- 1
+ if (ws$m[[m.i]]$name == m.cur$name) {
+ gconfirm(paste("Do you want to overwrite model", m.cur$name, "?"), parent = w,
+ handler = function(h, ...) {
+ ws$m[[m.i]] <- m.cur
+ update_m.df()
+ p.modified <<- TRUE
+ svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+ })
+ } else {
+ ws$add_m(list(m.cur))
+ update_m.df()
+ p.modified <<- TRUE
+ svalue(p.observed) <- paste(ws$observed, collapse = ", ")
+ }
}
# Add and remove observed variables {{{3
add_observed <- function(obs.i) {
@@ -807,6 +844,7 @@ add_observed <- function(obs.i) {
glabel("to", cont = m.e.rows[[obs.i]])
m.e.to[[obs.i]] <<- gcombobox(ws$observed, selected = 0L,
width = gcb_to_width,
+ editable = TRUE,
ext.args = list(multiSelect = TRUE),
cont = m.e.rows[[obs.i]])
m.e.sink[[obs.i]] <<- gcheckbox("Sink", width = gcb_sink_width,
@@ -859,7 +897,10 @@ m.name.ge <- gedit(label = "<b>Model name</b>", width = 60, cont = m.e.gfl)
m.ff.gc <- gcombobox(c("min", "max"), label = "Use of formation fractions",
cont = m.e.gfl)
svalue(m.ff.gc) <- m.cur$use_of_ff
-m.add_observed <- gbutton("Add observed variable", cont = m.editor,
+m.add_observed.line <- ggroup(cont = m.editor)
+m.add_observed <- gbutton("Add observed variable",
+ width = 150,
+ cont = m.add_observed.line,
handler = add_observed_handler)
m.add_observed$call_Ext("disable")
@@ -1057,8 +1098,10 @@ show_plot <- function(type) {
}
# Widget setup {{{2
# Line 1 with buttons {{{3
-f.run <- gbutton("Run fit",
- cont = f.config,
+f.run.line <- ggroup(cont = f.config)
+f.run <- gbutton("<b>Run fit</b>",
+ width = 100,
+ cont = f.run.line,
handler = run_fit_handler,
ext.args = list(disabled = TRUE))
@@ -1245,6 +1288,7 @@ workflow.gi <- gimage(workflow_url, size = c(434, 569), label = "Workflow", cont
# Data editor {{{2
ds.e.gdf <- gdf(ds.cur$data, label = "Data", name = "Kinetic data",
+ do_add_remove_buttons = FALSE,
width = 488, height = 577, cont = right)
# Model Gallery {{{2
@@ -1286,7 +1330,7 @@ create_model_gallery <- function() {
model <- UBA_model_gallery[[i]][[j]]
m.url = paste0("/custom/gmkin_png/", gsub(" ", "_", model$name), ".png")
m.g.fields[[i]][[j]] <<- gimage(m.url, width = 110,
- height = if (i == 1) 135 else 220,
+ height = if (i == 1) 80 else if (i == 2) 160 else 220,
cont = m.g.rows[[i]])
m.g.buttons[[i]][[j]] <<- gbutton(model$name, width = 110,
cont = m.g.buttonrows[[i]],
@@ -1372,7 +1416,8 @@ plot.ftmp.savebutton <- gbutton("Save plot", cont = plot.ftmp.saveline,
plot_ftmp_save(filename)
}
})
-plot.space <- ggroup(cont = plot.gg, horizontal = FALSE, height = 18)
+plot.space <- ggroup(cont = plot.gg, horizontal = FALSE, height = 8)
+plot.confint.label <- glabel("<b>Parameter confidence intervals</b>", cont = plot.gg)
plot.confint.gi <- gimage(NA, container = plot.gg, width = 400, height = 400)
# Manual {{{2
manual_html <- readLines(system.file("GUI/manual.html", package = "gmkin"))
diff --git a/inst/GUI/png/DFOP,_no_mets.png b/inst/GUI/png/DFOP,_no_mets.png
index c80c17c..fa3b082 100644
--- a/inst/GUI/png/DFOP,_no_mets.png
+++ b/inst/GUI/png/DFOP,_no_mets.png
Binary files differ
diff --git a/inst/GUI/png/DFOP,_one_met.png b/inst/GUI/png/DFOP,_one_met.png
index ff923d1..7a218fa 100644
--- a/inst/GUI/png/DFOP,_one_met.png
+++ b/inst/GUI/png/DFOP,_one_met.png
Binary files differ
diff --git a/inst/GUI/png/FOMC,_no_mets.png b/inst/GUI/png/FOMC,_no_mets.png
index a1d4158..bc25d69 100644
--- a/inst/GUI/png/FOMC,_no_mets.png
+++ b/inst/GUI/png/FOMC,_no_mets.png
Binary files differ
diff --git a/inst/GUI/png/FOMC,_one_met.png b/inst/GUI/png/FOMC,_one_met.png
index f1d0c5f..f01c0d4 100644
--- a/inst/GUI/png/FOMC,_one_met.png
+++ b/inst/GUI/png/FOMC,_one_met.png
Binary files differ
diff --git a/inst/GUI/png/FOMC,_two_sequential,_one_parallel_met.png b/inst/GUI/png/FOMC,_two_sequential,_one_parallel_met.png
index 74a23db..9096acd 100644
--- a/inst/GUI/png/FOMC,_two_sequential,_one_parallel_met.png
+++ b/inst/GUI/png/FOMC,_two_sequential,_one_parallel_met.png
Binary files differ
diff --git a/inst/GUI/png/HS,_no_mets.png b/inst/GUI/png/HS,_no_mets.png
index 21c10fe..61b2d3a 100644
--- a/inst/GUI/png/HS,_no_mets.png
+++ b/inst/GUI/png/HS,_no_mets.png
Binary files differ
diff --git a/inst/GUI/png/HS,_one_met.png b/inst/GUI/png/HS,_one_met.png
index 279867b..ebb89d5 100644
--- a/inst/GUI/png/HS,_one_met.png
+++ b/inst/GUI/png/HS,_one_met.png
Binary files differ
diff --git a/inst/GUI/png/SFO,_no_mets.png b/inst/GUI/png/SFO,_no_mets.png
index c36ce14..1f37d1a 100644
--- a/inst/GUI/png/SFO,_no_mets.png
+++ b/inst/GUI/png/SFO,_no_mets.png
Binary files differ
diff --git a/inst/GUI/png/SFO,_one_met.png b/inst/GUI/png/SFO,_one_met.png
index a1e001b..80e43a0 100644
--- a/inst/GUI/png/SFO,_one_met.png
+++ b/inst/GUI/png/SFO,_one_met.png
Binary files differ

Contact - Imprint