diff options
Diffstat (limited to 'inst')
| -rw-r--r-- | inst/GUI/gmkin.R | 214 |
1 files changed, 106 insertions, 108 deletions
diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 3692509..b7ddc13 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -1,6 +1,6 @@ # gWidgetsWWW2 GUI for mkin {{{1
-# Copyright (C) 2013,2014,2015 Johannes Ranke
+# Copyright (C) 2013-2016,2018,2019 Johannes Ranke
# Portions of this file are copyright (C) 2013 Eurofins Regulatory AG, Switzerland
# Contact: jranke@uni-bremen.de
@@ -29,13 +29,13 @@ f_height = 142 save_keybinding = "Shift-F12"
gcb_observed_width = 100
gcb_type_width = 70
-gcb_to_width = 160
+gcb_to_width = 160
gcb_sink_width = 70
# Plotting {{{2
plot_formats <- c("png", "pdf")
-if (exists("win.metafile", "package:grDevices", inherits = FALSE)) {
- plot_formats = c("wmf", plot_formats)
+if (requireNamespace("devEMF", quietly = TRUE)) {
+ plot_formats = c("emf", plot_formats)
}
plot_format <- plot_formats[[1]]
# Options {{{2
@@ -46,7 +46,7 @@ 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)",
+ "and mkin (deSolve, numDeriv)",
"--- Working directory is", getwd()), cont = w)
bl <- gborderlayout(cont = w,
@@ -57,7 +57,7 @@ bl$set_panel_size("west", left_width) bl$set_panel_size("east", right_width)
center <- gnotebook(cont = bl, where = "center")
-center$add_handler("tabchange",
+center$add_handler("tabchange",
function(h, ...) {
if (svalue(h$obj) == 1) {
svalue(right) <<- 1
@@ -65,7 +65,7 @@ center$add_handler("tabchange", })
left <- gvbox(cont = bl, use.scrollwindow = TRUE, where = "west", spacing = 0)
right <- gnotebook(cont = bl, use.scrollwindow = TRUE, where = "east")
-right$add_handler("tabchange",
+right$add_handler("tabchange",
function(h, ...) {
if (svalue(h$obj) == 3 && ! model_gallery_created) {
create_model_gallery()
@@ -77,7 +77,7 @@ right$add_handler("tabchange", # Override function for making it possible to override original data points using the GUI {{{2
override <- function(d) {
if (!is.null(d$override)) {
- d_new <- data.frame(name = d$name, time = d$time,
+ 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)
@@ -89,7 +89,7 @@ override <- function(d) { update_p.df <- function() {
wd_projects <- gsub(".gmkinws", "", dir(pattern = ".gmkinws$"))
if (length(wd_projects) > 0) {
- p.df.wd <- data.frame(Name = wd_projects,
+ p.df.wd <- data.frame(Name = wd_projects,
Source = rep("working directory",
length(wd_projects)),
stringsAsFactors = FALSE)
@@ -105,8 +105,8 @@ 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
- ds.delete$call_Ext("disable")
- ds.copy$call_Ext("disable")
+ ds.delete$call_Ext("disable")
+ ds.copy$call_Ext("disable")
}
# Update dataframe with models {{{2
update_m.df <- function() {
@@ -117,8 +117,8 @@ update_m.df <- function() { else m.df <<- data.frame(Name = sapply(ws$m, function(x) x$name), stringsAsFactors = FALSE)
m.gtable[,] <- m.df
update_m_editor()
- m.delete$call_Ext("disable")
- m.copy$call_Ext("disable")
+ m.delete$call_Ext("disable")
+ m.copy$call_Ext("disable")
}
# Update dataframe with fits {{{2
update_f.df <- function() {
@@ -131,7 +131,7 @@ update_f.df <- function() { f.df <<- f.df
f.gtable[,] <- f.df
get.initials.gc[,] <- paste("Result", f.df$Name)
- f.delete$call_Ext("disable")
+ f.delete$call_Ext("disable")
}
# Generate the initial workspace {{{1
# Project workspace {{{2
@@ -177,7 +177,7 @@ f.gf <- gframe("Results", cont = left, horizontal = FALSE, spacing = 0) p.gtable <- gtable(p.df, cont = p.gf, width = left_width - 10, height = 120,
ext.args = list(resizable = TRUE, resizeHandles = 's'))
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
+p.loaded <- NA # The index of the loaded project. We reset the selection to this when the user
# does not confirm
p.modified <- FALSE # Keep track of modifications after loading
p.switcher <- function(h, ...) {
@@ -209,7 +209,7 @@ p.switcher <- function(h, ...) { }
if (p.modified) {
gconfirm("When you switch projects, you loose any unsaved changes. Proceed to switch?",
- handler = function(h, ...) {
+ handler = function(h, ...) {
switch_project()
})
} else {
@@ -234,8 +234,8 @@ ds.switcher <- function(h, ...) { svalue(c.ds) <- ds.df[ds.i, "Title"]
ds.cur <<- ws$ds[[ds.i]]
update_ds_editor()
- ds.delete$call_Ext("enable")
- ds.copy$call_Ext("enable")
+ ds.delete$call_Ext("enable")
+ ds.copy$call_Ext("enable")
if (!is.null(svalue(m.gtable, index = TRUE))) {
if (length(svalue(m.gtable)) > 0) {
if (!is.na(svalue(m.gtable))) f.conf$call_Ext("enable")
@@ -251,10 +251,10 @@ addHandlerClicked(ds.gtable, ds.switcher) m.switcher <- function(h, ...) {
m.i <- h$row_index
svalue(c.m) <- m.df[m.i, "Name"]
- m.cur <<- ws$m[[m.i]]
+ m.cur <<- ws$m[[m.i]]
update_m_editor()
- m.delete$call_Ext("enable")
- m.copy$call_Ext("enable")
+ m.delete$call_Ext("enable")
+ m.copy$call_Ext("enable")
if (!is.null(svalue(ds.gtable, index = TRUE))) {
if (length(svalue(ds.gtable)) > 0) {
if (!is.na(svalue(ds.gtable))) f.conf$call_Ext("enable")
@@ -276,9 +276,9 @@ f.switcher <- function(h, ...) { } else {
ftmp <<- ws$ftmp
}
- c.ds$call_Ext("setText",
+ c.ds$call_Ext("setText",
paste0("<font color='gray'>", ftmp$ds$title, "</font>"), FALSE)
- c.m$call_Ext("setText",
+ c.m$call_Ext("setText",
paste0("<font color='gray'>", ftmp$mkinmod$name, "</font>"), FALSE)
f.conf$call_Ext("disable")
@@ -300,19 +300,16 @@ c.m <- glabel(empty_conf_labels[2], cont = c.gf, ext.args = list(margin = "0 0 0 update_f_conf <- function() { # {{{3
stmp <<- summary(ftmp)
- 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.error_model) <<- ftmp$error_model
+ svalue(f.gg.opts.error_model_algorithm) <<- ftmp$error_model_algorithm
svalue(f.gg.opts.reweight.tol) <<- ftmp$reweight.tol
svalue(f.gg.opts.reweight.max.iter) <<- ftmp$reweight.max.iter
- svalue(f.gg.opts.maxit.modFit) <<- ftmp$maxit.modFit
- svalue(f.gg.opts.method.modFit) <<- ftmp$method.modFit
+ svalue(f.gg.opts.maxit) <<- ftmp$maxit
show_fit_option_widgets(TRUE)
update_plot_obssel()
f.gg.parms[,] <- get_Parameters(stmp, ftmp$optimised)
@@ -321,7 +318,7 @@ update_f_results <- function() { # {{{3 svalue(r.name) <- ftmp$name
r.parameters[] <- cbind(Parameter = rownames(stmp$bpar), stmp$bpar[, c(1, 4, 5, 6)])
err.min <- 100 * stmp$errmin$err.min
- r.frames.chi2.gt[] <- cbind(Variable = rownames(stmp$errmin),
+ r.frames.chi2.gt[] <- cbind(Variable = rownames(stmp$errmin),
Error = signif(err.min, 3),
n.opt = stmp$errmin$n.optim,
df = stmp$errmin$df)
@@ -350,7 +347,7 @@ update_f_results <- function() { # {{{3 }
update_plot_obssel <- function() {
delete(f.gg.plotopts, f.gg.po.obssel)
- f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec),
+ f.gg.po.obssel <<- gcheckboxgroup(names(ftmp$mkinmod$spec),
cont = f.gg.plotopts, checked = TRUE)
}
configure_fit_handler <- function(h, ...) { # Configure fit button {{{3
@@ -362,9 +359,8 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3 }
ftmp <<- suppressWarnings(mkinfit(m.cur,
override(ds.cur$data),
- method.modFit = "Marq",
- err = "err", quiet = TRUE,
- control.modFit = list(maxiter = 0)))
+ quiet = TRUE,
+ control = list(iter.max = 0)))
ftmp$optimised <<- FALSE
ftmp$ds <<- ds.cur
ws$ftmp <<- ftmp
@@ -372,8 +368,8 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3 update_f.df()
update_f_conf()
- svalue(f.gg.opts.method.modFit) <<- "Port"
f.run$call_Ext("enable")
+ print("test")
svalue(f.running.label) <- "Fit configured and ready to run"
} else {
svalue(f.running.label) <- paste("No fit configured:",
@@ -387,16 +383,16 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3 }
svalue(center) <- 4
}
-f.conf.line <- ggroup(cont = c.gf,
+f.conf.line <- ggroup(cont = c.gf,
ext.args = list(layout = list(type = "vbox", align = "center")))
-f.conf <- gbutton("<b>Configure fit</b>",
+f.conf <- gbutton("<b>Configure fit</b>",
width = 100,
cont = f.conf.line,
handler = configure_fit_handler,
ext.args = list(disabled = TRUE))
# center: Project editor {{{1
-p.editor <- gframe("", horizontal = FALSE, cont = center,
+p.editor <- gframe("", horizontal = FALSE, cont = center,
label = "Project")
# Line with buttons {{{2
p.line.buttons <- ggroup(cont = p.editor, horizontal = TRUE)
@@ -461,7 +457,7 @@ p.save.action <- gaction("Save project to project file", parent = w, }
if (file.exists(filename)) {
gconfirm(paste("File", filename, "exists. Overwrite?"),
- parent = w,
+ parent = w,
handler = function(h, ...) {
try_to_save(filename)
})
@@ -471,7 +467,7 @@ p.save.action <- gaction("Save project to project file", parent = w, }
})
p.save.action$add_keybinding(save_keybinding)
-p.save <- gbutton(action = p.save.action,
+p.save <- gbutton(action = p.save.action,
cont = p.line.buttons)
tooltip(p.save) <- paste("Press", save_keybinding, "to save")
@@ -542,7 +538,7 @@ p.line.import.p <- gcombobox(c("", p.df$Name), label = "Import from", cont = p.l })
p.line.import.frames <- ggroup(cont = p.editor, horizontal = TRUE)
-p.line.import.dsf <- gframe("Datasets for import", cont = p.line.import.frames,
+p.line.import.dsf <- gframe("Datasets for import", cont = p.line.import.frames,
horizontal = FALSE, spacing = 0)
p.line.import.dst <- gtable(ds.df.empty, cont = p.line.import.dsf, multiple = TRUE,
width = left_width - 10, height = 160,
@@ -558,7 +554,7 @@ p.line.import.dsb <- gbutton("Import selected", cont = p.line.import.dsf, }
)
-p.line.import.mf <- gframe("Models for import", cont = p.line.import.frames,
+p.line.import.mf <- gframe("Models for import", cont = p.line.import.frames,
horizontal = FALSE, spacing = 0)
p.line.import.mt <- gtable(m.df.empty, cont = p.line.import.mf, multiple = TRUE,
width = left_width - 10, height = 160,
@@ -597,7 +593,7 @@ copy_dataset_handler <- function(h, ...) { ds.new$title <- paste("Copy of ", ds.cur$title)
stage_dataset(ds.new)
}
-
+
delete_dataset_handler <- function(h, ...) {
ds.i <- svalue(ds.gtable, index = TRUE)
ws$delete_ds(ds.i)
@@ -611,7 +607,7 @@ keep_ds_changes_handler <- function(h, ...) { editor_title <- svalue(ds.title.ge)
editor_ds <- mkinds$new(
title = editor_title,
- data = ds.e.gdf[,],
+ data = ds.e.gdf[,],
time_unit = svalue(ds.e.stu),
unit = svalue(ds.e.obu))
@@ -665,7 +661,7 @@ load_text_file_with_data <- function(h, ...) { }
svalue(ds.e.up.skip) <- tmptextskip
if (svalue(ds.e.up.header)) {
- tmptextheader <<- strsplit(tmptext[tmptextskip + 1],
+ tmptextheader <<- strsplit(tmptext[tmptextskip + 1],
" |\t|;|,")[[1]]
}
svalue(ds.e.up.wide.time) <- tmptextheader[[1]]
@@ -673,13 +669,13 @@ load_text_file_with_data <- function(h, ...) { svalue(ds.e.up.text) <- c("<pre>", c(tmptext[1:5], "\n...\n"), "</pre>")
visible(ds.e.import) <- TRUE
}
-
+
new_ds_from_csv_handler <- function(h, ...) {
tmpd <- try(read.table(tmptextfile,
- skip = as.numeric(svalue(ds.e.up.skip)),
+ skip = as.numeric(svalue(ds.e.up.skip)),
dec = svalue(ds.e.up.dec),
- sep = switch(svalue(ds.e.up.sep),
- whitespace = "",
+ sep = switch(svalue(ds.e.up.sep),
+ whitespace = "",
";" = ";",
"," = ","),
header = svalue(ds.e.up.header),
@@ -731,7 +727,7 @@ ds.e.buttons <- ggroup(cont = ds.editor, horizontal = TRUE) ds.e.new <- gbutton("New dataset", cont = ds.e.buttons, handler = new_dataset_handler)
ds.copy <- gbutton("Copy dataset", cont = ds.e.buttons,
handler = copy_dataset_handler, ext.args = list(disabled = TRUE))
-ds.delete <- gbutton("Delete dataset", cont = ds.e.buttons,
+ds.delete <- gbutton("Delete dataset", cont = ds.e.buttons,
handler = delete_dataset_handler, ext.args = list(disabled = TRUE))
ds.keep <- gbutton("Keep changes", cont = ds.e.buttons, handler = keep_ds_changes_handler)
ds.keep$call_Ext("disable")
@@ -761,7 +757,7 @@ upload_dataset.gf <- gfile(text = "Upload text file", cont = ds.editor, # Import options {{{3
ds.e.import <- ggroup(cont = ds.editor, horizontal = FALSE)
visible(ds.e.import) <- FALSE
-ds.e.preview <- ggroup(cont = ds.e.import,
+ds.e.preview <- ggroup(cont = ds.e.import,
# width = 540, height = 150,
ext.args = list(layout = list(type="vbox", align = "center")))
ds.e.up.text <- ghtml("<pre></pre>", cont = ds.e.preview, width = 530, height = 150)
@@ -816,7 +812,7 @@ copy_model_handler <- function(h, ...) { m.new$name <- paste("Copy of ", m.cur$name)
stage_model(m.new)
}
-
+
delete_model_handler <- function(h, ...) {
m.i <- svalue(m.gtable, index = TRUE)
ws$delete_m(m.i)
@@ -837,9 +833,9 @@ keep_m_changes_handler <- function(h, ...) { names(spec)[[obs.i]] <- svalue(m.e.obs[[obs.i]])
}
- m.cur <<- mkinmod(use_of_ff = svalue(m.ff.gc),
+ m.cur <<- mkinmod(use_of_ff = svalue(m.ff.gc),
speclist = spec)
- m.cur$name <<- svalue(m.name.ge)
+ m.cur$name <<- svalue(m.name.ge)
m.i <- svalue(m.gtable, index = TRUE)
if (!is.null(m.i) && !is.na(m.i) && ws$m[[m.i]]$name == m.cur$name) {
@@ -863,24 +859,24 @@ add_observed <- function(obs.i) { m.add_observed$call_Ext("disable")
}
m.e.rows[[obs.i]] <<- ggroup(cont = m.editor, horizontal = TRUE)
- m.e.obs[[obs.i]] <<- gcombobox(ws$observed,
- selected = obs.i,
+ m.e.obs[[obs.i]] <<- gcombobox(ws$observed,
+ selected = obs.i,
width = gcb_observed_width,
cont = m.e.rows[[obs.i]])
obs.types <- if (obs.i == 1) c("SFO", "FOMC", "DFOP", "HS", "SFORB")
else c("SFO", "SFORB")
m.e.type[[obs.i]] <<- gcombobox(obs.types, width = gcb_type_width,
selected = 1L, cont = m.e.rows[[obs.i]])
- glabel("to", cont = m.e.rows[[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,
- checked = TRUE, cont = m.e.rows[[obs.i]])
+ checked = TRUE, cont = m.e.rows[[obs.i]])
if (obs.i > 1) {
- gbutton("Remove observed variable", handler = remove_observed_handler,
+ gbutton("Remove observed variable", handler = remove_observed_handler,
action = obs.i, cont = m.e.rows[[obs.i]])
}
}
@@ -916,7 +912,7 @@ m.e.buttons <- ggroup(cont = m.editor, horizontal = TRUE) m.e.new <- gbutton("New model", cont = m.e.buttons, handler = new_model_handler)
m.copy <- gbutton("Copy model", cont = m.e.buttons,
handler = copy_model_handler, ext.args = list(disabled = TRUE))
-m.delete <- gbutton("Delete model", cont = m.e.buttons,
+m.delete <- gbutton("Delete model", cont = m.e.buttons,
handler = delete_model_handler, ext.args = list(disabled = TRUE))
m.keep <- gbutton("Keep changes", cont = m.e.buttons, handler = keep_m_changes_handler)
m.keep$call_Ext("disable")
@@ -924,11 +920,11 @@ m.keep$call_Ext("disable") # Formlayout for meta data {{{3
m.e.gfl <- gformlayout(cont = m.editor)
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",
+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.line <- ggroup(cont = m.editor)
-m.add_observed <- gbutton("Add observed variable",
+m.add_observed <- gbutton("Add observed variable",
width = 150,
cont = m.add_observed.line,
handler = add_observed_handler)
@@ -960,7 +956,7 @@ show_m_spec() # center: Fit configuration {{{1
-f.config <- gframe("", horizontal = FALSE, cont = center,
+f.config <- gframe("", horizontal = FALSE, cont = center,
label = "Configuration")
# Handler functions {{{2
run_confirm_message <- paste("The progress of the fit is shown in the R console. ",
@@ -970,7 +966,7 @@ run_confirm_message <- paste("The progress of the fit is shown in the R console. "the Windows R GUI). " ) } else "",
"Proceed to start the fit?", sep = "")
run_fit_handler <- function(h, ...) { #{{{3
- gconfirm(run_confirm_message, handler = function(h, ...)
+ gconfirm(run_confirm_message, handler = function(h, ...)
{
Parameters <- f.gg.parms[,]
Parameters.de <- subset(Parameters, Type == "deparm")
@@ -999,7 +995,7 @@ run_fit_handler <- function(h, ...) { #{{{3 ftmp <<- mkinfit(m.cur, override(ds.cur$data),
state.ini = iniparms,
fixed_initials = inifixed,
- parms.ini = deparms,
+ parms.ini = deparms,
fixed_parms = defixed,
plot = svalue(f.gg.opts.plot),
solution_type = svalue(f.gg.opts.st),
@@ -1007,13 +1003,10 @@ run_fit_handler <- function(h, ...) { #{{{3 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)
+ error_model = svalue(f.gg.opts.error_model),
+ error_model_algorithm = svalue(f.gg.opts.error_model_algorithm)
)
ftmp$optimised <<- TRUE
ftmp$ds <<- ds.cur
@@ -1077,7 +1070,7 @@ export_csv_handler <- function(h, ...) { # {{{3 rownames(subset(ftmp$fixed, type == "deparm")))
odeparms <- parms.all[odenames]
- out <- mkinpredict(ftmp$mkinmod, odeparms, odeini, outtimes,
+ out <- mkinpredict(ftmp$mkinmod, odeparms, odeini, outtimes,
solution_type = solution_type, atol = ftmp$atol, rtol = ftmp$rtol)
write.csv(out, csv_file)
@@ -1110,17 +1103,17 @@ show_plot <- function(type) { deparms <- as.numeric(Parameters.de[[type]])
names(deparms) <- rownames(Parameters.de)
if (type == "Initial") {
- ftmp <<- suppressWarnings(mkinfit(m.cur,
+ ftmp <<- suppressWarnings(mkinfit(m.cur,
override(ds.cur$data),
parms.ini = deparms,
- state.ini = stateparms,
+ state.ini = stateparms,
fixed_parms = names(deparms),
fixed_initials = names(stateparms),
err = "err", quiet = TRUE,
method.modFit = "Marq",
control.modFit = list(maxiter = 0)))
ftmp$ds <<- ds.cur
- }
+ }
svalue(plot.ftmp.gi) <<- plot_ftmp_png()
svalue(plot.ftmp.savefile) <- paste0(ftmp$mkinmod$name, " - ", ftmp$ds$title, ".", plot_format)
svalue(plot.confint.gi) <<- if (type == "Initial") NA
@@ -1132,12 +1125,12 @@ show_plot <- function(type) { f.run.line <- ggroup(cont = f.config)
f.run <- gbutton("<b>Run fit</b>",
width = 100,
- cont = f.run.line,
+ cont = f.run.line,
handler = run_fit_handler,
ext.args = list(disabled = TRUE))
f.running.line <- ggroup(cont = f.config)
-f.running_noconf <- paste("No fit configured. Please select a dataset and a model and",
+f.running_noconf <- paste("No fit configured. Please select a dataset and a model and",
"press the button 'Configure fit' on the left.")
f.running.label <- glabel(f.running_noconf, cont = f.running.line)
@@ -1147,7 +1140,7 @@ f.gg.opts.g <- ggroup(cont = f.config) # First group {{{4
f.gg.opts.1 <- gformlayout(cont = f.gg.opts.g)
solution_types <- c("auto", "analytical", "eigen", "deSolve")
-f.gg.opts.plot <- gcheckbox("Plot during the fit",
+f.gg.opts.plot <- gcheckbox("Plot during the fit",
cont = f.gg.opts.1, checked = FALSE)
f.gg.opts.st <- gcombobox(solution_types, selected = 1,
label = "solution_type", width = 160,
@@ -1156,12 +1149,17 @@ f.gg.opts.atol <- gedit(1e-8, label = "atol", width = 20, cont = f.gg.opts.1)
f.gg.opts.rtol <- gedit(1e-10, label = "rtol", width = 20,
cont = f.gg.opts.1)
-optimisation_methods <- c("Port", "Marq", "SANN")
-f.gg.opts.method.modFit <- gcombobox(optimisation_methods, selected = 1,
- label = "method.modFit",
- width = 160,
- cont = f.gg.opts.1)
-f.gg.opts.maxit.modFit <- gedit("auto", label = "maxit.modFit",
+error_models <- c("const", "obs", "tc")
+f.gg.opts.error_model <- gcombobox(error_models, selected = 1,
+ label = "error_model",
+ width = 160,
+ cont = f.gg.opts.1)
+error_model_algorithms <- c("d_3", "direct", "threestep", "IRLS")
+f.gg.opts.error_model_algorithm <- gcombobox(error_model_algorithms, selected = 1,
+ label = "error_model_algorithm",
+ width = 160,
+ cont = f.gg.opts.1)
+f.gg.opts.maxit <- gedit("auto", label = "maxit",
width = 20, cont = f.gg.opts.1)
# Second group {{{4
@@ -1184,7 +1182,7 @@ f.gg.opts.reweight.max.iter <- gedit(10, label = "reweight.max.iter", f.gg.plotopts <- ggroup(cont = f.gg.opts.g, horizontal = FALSE, width = 80)
-f.gg.po.format <- gcombobox(plot_formats, selected = 1,
+f.gg.po.format <- gcombobox(plot_formats, selected = 1,
cont = f.gg.plotopts, width = 50,
handler = function(h, ...) {
plot_format <<- svalue(h$obj)
@@ -1193,7 +1191,7 @@ f.gg.po.format <- gcombobox(plot_formats, selected = 1, })
plot_format <- svalue(f.gg.po.format)
f.gg.po.legend <- gcheckbox("legend", cont = f.gg.plotopts, checked = TRUE)
-f.gg.po.obssel <- gcheckboxgroup("", cont = f.gg.plotopts,
+f.gg.po.obssel <- gcheckboxgroup("", cont = f.gg.plotopts,
checked = TRUE)
visible(f.gg.po.obssel) <- FALSE
# Parameter table {{{3
@@ -1212,7 +1210,7 @@ get_initials_handler <- function(h, ...) get.initials.gb <- gbutton("Get starting parameters from", cont = f.parameters.line,
handler = get_initials_handler)
get.initials.gc <- gcombobox(paste("Result", f.df$Name), width = 200, cont = f.parameters.line)
-show.initial.gb.u <- gbutton("Plot unoptimised",
+show.initial.gb.u <- gbutton("Plot unoptimised",
handler = function(h, ...) show_plot("Initial"),
cont = f.parameters.line)
tooltip(show.initial.gb.u) <- "Show model with inital parameters shown below"
@@ -1229,13 +1227,13 @@ Parameters <- Parameters.empty <- data.frame( Fixed = logical(1),
Optimised = numeric(1))
# Dataframe with initial and optimised parameters {{{4
-f.gg.parms <- gdf(Parameters, cont = f.config, height = 500,
+f.gg.parms <- gdf(Parameters, cont = f.config, height = 500,
name = "Starting parameters",
do_add_remove_buttons = FALSE)
size(f.gg.parms) <- list(columnWidths = c(220, 50, 65, 50, 65))
# Do not show fit option widgets when no fit is configured
-show_fit_option_widgets <- function(show)
+show_fit_option_widgets <- function(show)
{
visible(f.gg.opts.g) <- show
visible(f.parameters.line) <- show
@@ -1244,11 +1242,11 @@ show_fit_option_widgets <- function(show) show_fit_option_widgets(FALSE)
# center: Results viewer {{{1
-r.viewer <- gframe("", horizontal = FALSE, cont = center,
+r.viewer <- gframe("", horizontal = FALSE, cont = center,
label = "Result")
# Row with buttons {{{2
r.buttons <- ggroup(cont = r.viewer, horizontal = TRUE)
-f.delete <- gbutton("Delete fit", cont = r.buttons,
+f.delete <- gbutton("Delete fit", cont = r.buttons,
handler = delete_fit_handler, ext.args = list(disabled = TRUE))
f.keep <- gbutton("Keep fit", cont = r.buttons, handler = keep_fit_handler)
tooltip(f.keep) <- "Store the optimised model with all settings and the current dataset in the fit list"
@@ -1265,7 +1263,7 @@ par.df.empty <- data.frame( Parameter = character(1),
Estimate = numeric(1), "Pr(>t)" = numeric(1),
Lower = numeric(1), Upper = numeric(1), check.names = FALSE)
-r.par.gf <- gframe("Optimised parameters", cont = r.viewer,
+r.par.gf <- gframe("Optimised parameters", cont = r.viewer,
horizontal = FALSE, spacing = 0)
r.parameters <- gtable(par.df.empty, cont = r.par.gf, height = 200,
ext.args = list(resizable = TRUE, resizeHandles = 's'))
@@ -1273,16 +1271,16 @@ r.parameters <- gtable(par.df.empty, cont = r.par.gf, height = 200, # Tables with chi2, ff, DT50 {{{2
r.frames <- ggroup(cont = r.viewer, horizontal = TRUE, spacing = 0)
-r.frames.chi2 <- gframe("Chi2 errors [%]", cont = r.frames,
+r.frames.chi2 <- gframe("Chi2 errors [%]", cont = r.frames,
horizontal = TRUE, spacing = 0)
chi2.df.empty = data.frame(Variable = character(1), Error = character(1),
- n.opt = character(1), df = character(1),
+ n.opt = character(1), df = character(1),
stringsAsFactors = FALSE)
r.frames.chi2.gt <- gtable(chi2.df.empty, cont = r.frames.chi2,
width = 180, height = 150)
size(r.frames.chi2.gt) <- list(columnWidths = c(60, 35, 35, 15))
-r.frames.ff <- gframe("Formation fractions", cont = r.frames,
+r.frames.ff <- gframe("Formation fractions", cont = r.frames,
horizontal = TRUE, spacing = 0)
ff.df.empty = data.frame(Path = character(1), ff = character(1),
stringsAsFactors = FALSE)
@@ -1290,7 +1288,7 @@ r.frames.ff.gt <- gtable(ff.df.empty, cont = r.frames.ff, width = 150, height = 150)
size(r.frames.ff.gt) <- list(columnWidths = c(80, 15))
-r.frames.distimes <- gframe("Disappearance times", cont = r.frames,
+r.frames.distimes <- gframe("Disappearance times", cont = r.frames,
horizontal = TRUE, spacing = 0)
distimes.df.empty = data.frame(Variable = character(1), DT50 = character(1),
stringsAsFactors = FALSE)
@@ -1298,7 +1296,7 @@ r.frames.distimes.gt <- gtable(distimes.df.empty, cont = r.frames.distimes, width = 150, height = 150)
# Summary {{{2
-f.gg.summary <- gframe("Summary", height = 400, use.scrollwindow = TRUE,
+f.gg.summary <- gframe("Summary", height = 400, use.scrollwindow = TRUE,
cont = r.viewer, horizontal = FALSE)
f.gg.summary.topline <- ggroup(cont = f.gg.summary, horizontal = TRUE)
f.gg.summary.filename <- gedit("", width = 40, cont = f.gg.summary.topline)
@@ -1328,7 +1326,7 @@ workflow_url <- "/custom/gmkin_png/workflow/gmkin_workflow_434x569.png" workflow.gi <- gimage(workflow_url, size = c(434, 569), label = "Workflow", cont = workflow.gg)
# Data editor {{{2
-ds.e.gdf <- gdf(ds.cur$data, label = "Data", name = "Kinetic data",
+ds.e.gdf <- gdf(ds.cur$data, label = "Data", name = "Kinetic data",
do_add_remove_buttons = FALSE,
width = 488, height = 577, cont = right)
@@ -1346,10 +1344,10 @@ add_gallery_model_handler <- function(h, ...) { update_m.df()
m.i <- nrow(m.df)
svalue(c.m) <- m.df[m.i, "Name"]
- m.cur <<- ws$m[[m.i]]
+ m.cur <<- ws$m[[m.i]]
update_m_editor()
- m.delete$call_Ext("enable")
- m.copy$call_Ext("enable")
+ m.delete$call_Ext("enable")
+ m.copy$call_Ext("enable")
if (!is.null(svalue(ds.gtable, index = TRUE))) {
if (length(svalue(ds.gtable)) > 0) {
if (!is.na(svalue(ds.gtable))) f.conf$call_Ext("enable")
@@ -1370,10 +1368,10 @@ create_model_gallery <- function() { for (j in 1:4) {
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,
+ m.g.fields[[i]][[j]] <<- gimage(m.url, width = 110,
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,
+ m.g.buttons[[i]][[j]] <<- gbutton(model$name, width = 110,
cont = m.g.buttonrows[[i]],
handler = add_gallery_model_handler,
action = c(i, j))
@@ -1400,11 +1398,11 @@ plot_ftmp <- function() { } else {
plot_legend = TRUE
}
- plot(ftmp, main = paste(ftmp$mkinmod$name, "-", ftmp$ds$title),
+ plot(ftmp, main = paste(ftmp$mkinmod$name, "-", ftmp$ds$title),
obs_vars = obs_vars_plot,
- xlab = ifelse(ftmp$ds$time_unit == "", "Time",
+ xlab = ifelse(ftmp$ds$time_unit == "", "Time",
paste("Time in", ftmp$ds$time_unit)),
- ylab = ifelse(ftmp$ds$unit == "", "Observed",
+ ylab = ifelse(ftmp$ds$unit == "", "Observed",
paste("Observed in", ftmp$ds$unit)),
legend = plot_legend,
show_residuals = TRUE)
@@ -1432,7 +1430,7 @@ plot_ftmp_save <- function(filename) { plot_confint_png <- function() {
tf <- get_tempfile(ext=".png")
png(tf, width = 400, height = 400)
- mkinparplot(ftmp)
+ mkinparplot(ftmp)
dev.off()
return(tf)
}
@@ -1446,7 +1444,7 @@ plot.ftmp.savebutton <- gbutton("Save plot", cont = plot.ftmp.saveline, filename <- svalue(plot.ftmp.savefile)
if (file.exists(filename))
{
- gconfirm(paste("File", filename,
+ gconfirm(paste("File", filename,
"exists. Overwrite?"),
parent = w,
handler = function(h, ...) {
@@ -1474,7 +1472,7 @@ manual.gh <- ghtml(label = "Manuals", paste0("<div class = 'manual' style = 'mar </div>"), width = 460, cont = right)
# Changes {{{2
-gmkin_news <- markdown::markdownToHTML(system.file("NEWS.md",
+gmkin_news <- markdown::markdownToHTML(system.file("NEWS.md",
package = "gmkin"),
fragment.only = TRUE)
|