From 15ced413958fe8f7a1f9bac6f9224a978f29aa03 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Mon, 8 Jul 2019 18:11:26 +0200 Subject: Now working with mkin >= 0.9.49.6 --- DESCRIPTION | 7 +++---- NEWS.md | 6 ++++-- README.md | 6 ++++-- inst/GUI/gmkin.R | 45 +++++++++++++++++++-------------------------- test.R | 21 +++++++++++++++++++++ 5 files changed, 51 insertions(+), 34 deletions(-) create mode 100644 test.R diff --git a/DESCRIPTION b/DESCRIPTION index f8765e0..9316135 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.10 -Date: 2019-07-05 +Date: 2019-07-08 Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre", "cph"), email = "jranke@uni-bremen.de"), person("Stefan", "Meinecke", role = "ctb"), @@ -10,7 +10,7 @@ Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre", "cph"), 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.47.3), gWidgetsWWW2 (>= 0.4-7) +Depends: mkin (>= 0.9.49.6), gWidgetsWWW2 (>= 0.4-7) Imports: R6, markdown, plyr, devEMF Suggests: knitr, rmarkdown License: GPL @@ -19,6 +19,5 @@ LazyData: yes Encoding: UTF-8 VignetteBuilder: knitr BugReports: http://github.com/jranke/gmkin/issues -URL: http://kinfit.r-forge.r-project.org/gmkin_static, - http://pkgdown.jrwb.de/gmkin +URL: http://pkgdown.jrwb.de/gmkin RoxygenNote: 6.1.1 diff --git a/NEWS.md b/NEWS.md index f9c771f..a6aea8d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,13 @@ # NEWS for package 'gmkin' -## gmkin 0.6-10 (2019-07-06) +## gmkin 0.6-10 (2019-07-08) -- Adapt to mkin 0.9.49.1 +- Adapt to mkin 0.9.49.6 - Use devEMF for better vector graphics export for Windows +- Manual weighting is not possible as this functionality is currently not present in mkin versions > 0.9.48.1 + ## gmkin 0.6-9 (2018-09-13) - Enable fits with the two-component error model during iterative reweighting (IRLS) diff --git a/README.md b/README.md index 7c0f7ea..19f3980 100644 --- a/README.md +++ b/README.md @@ -15,8 +15,7 @@ For running gmkin you need a system running a recent version of R (version (Firefox/Iceweasel and Chrome work for me) with JavaScript enabled. It should be possible to run gmkin on most laptop or desktop computers running -Linux, Mac OS X, Windows XP or Windows 7. It is frequently checked under Linux and -Windows 7. +Linux, Mac OS X, Windows 7 or Windows 10. To view the complete set of widgets in the browser window without resizing anything, it needs a screen space of 1366x740 pixels. @@ -168,3 +167,6 @@ Agency ([Umweltbundesamt](http://www.umweltbundesamt.de)) in two projects in gratefully acknowledged. In particular, Stefan Meinecke contributed with a lot of user feedback and suggestions for improvement in that time. +The adaptation to mkin versions > 0.9.49.6 that can do fits using a two-component +error model was supported by another project by the Umweltbundesamt in 2018/2019. + diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index b7ddc13..1320da0 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -299,17 +299,25 @@ c.ds <- glabel(empty_conf_labels[1], cont = c.gf, ext.args = list(margin = "0 0 c.m <- glabel(empty_conf_labels[2], cont = c.gf, ext.args = list(margin = "0 0 0 5")) update_f_conf <- function() { # {{{3 - stmp <<- summary(ftmp) + stmp <<- suppressWarnings(summary(ftmp)) svalue(f.gg.opts.st) <<- ftmp$solution_type 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.error_model) <<- ftmp$error_model - svalue(f.gg.opts.error_model_algorithm) <<- ftmp$error_model_algorithm + if (!is.null(ftmp$error_model_algorithm)) { + svalue(f.gg.opts.error_model_algorithm) <<- ftmp$error_model_algorithm + if (ftmp$error_model_algorithm == "OLS") { + svalue(f.gg.opts.error_model) <<- "const" + } else { + svalue(f.gg.opts.error_model) <<- ftmp$error_model + } + } 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) <<- ftmp$maxit + if (!is.null(ftmp$maxit)) { + svalue(f.gg.opts.maxit) <<- ftmp$maxit + } show_fit_option_widgets(TRUE) update_plot_obssel() f.gg.parms[,] <- get_Parameters(stmp, ftmp$optimised) @@ -369,7 +377,6 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3 update_f_conf() 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:", @@ -977,13 +984,6 @@ run_fit_handler <- function(h, ...) { #{{{3 iniparms <- Parameters.ini$Initial names(iniparms) <- sub("_0", "", Parameters.ini$Name) inifixed <- names(iniparms[Parameters.ini$Fixed]) - weight <- svalue(f.gg.opts.weight) - if (weight == "manual") { - err = "err" - } else { - err = NULL - } - reweight.method <- svalue(f.gg.opts.reweight.method) if (svalue(f.gg.opts.plot)) { if (.Platform$OS.type == "windows") { # When on windows, check for an active windows device. If not present, @@ -991,7 +991,6 @@ run_fit_handler <- function(h, ...) { #{{{3 if (attr(dev.cur(), "names") != "windows") windows() } } - if (reweight.method == "none") reweight.method = NULL ftmp <<- mkinfit(m.cur, override(ds.cur$data), state.ini = iniparms, fixed_initials = inifixed, @@ -1022,7 +1021,6 @@ run_fit_handler <- function(h, ...) { #{{{3 f.keep$call_Ext("enable") show.initial.gb.o$call_Ext("enable") svalue(f.gg.opts.st) <- ftmp$solution_type - svalue(f.gg.opts.weight) <- ftmp$weight.ini svalue(f.running.label) <- "Terminated" update_f_results() @@ -1089,7 +1087,8 @@ get_Parameters <- function(stmp, optimised) # {{{3 Fixed = pars$fixed, Optimised = as.numeric(NA)) Parameters <- rbind(subset(Parameters, Type == "state"), - subset(Parameters, Type == "deparm")) + subset(Parameters, Type == "deparm"), + subset(Parameters, Type == "error")) rownames(Parameters) <- Parameters$Name if (optimised) { Parameters[rownames(stmp$bpar), "Optimised"] <- stmp$bpar[, "Estimate"] @@ -1154,13 +1153,13 @@ 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, +error_model_algorithms <- c("d_3", "direct", "threestep", "IRLS", "OLS") +f.gg.opts.error_model_algorithm <- gcombobox(error_model_algorithms, selected = 5, 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) +f.gg.opts.maxit <- gedit(200, label = "maxit", + width = 20, cont = f.gg.opts.1) # Second group {{{4 f.gg.opts.2 <- gformlayout(cont = f.gg.opts.g) @@ -1169,12 +1168,6 @@ f.gg.opts.transform_rates <- gcheckbox("transform_rates", f.gg.opts.transform_fractions <- gcheckbox("transform_fractions", cont = f.gg.opts.2, checked = TRUE) weights <- c("manual", "none", "std", "mean") -f.gg.opts.weight <- gcombobox(weights, selected = 1, label = "weight", - width = 180, cont = f.gg.opts.2) -f.gg.opts.reweight.method <- gcombobox(c("none", "obs", "tc"), selected = 1, - label = "IRLS", - width = 180, - cont = f.gg.opts.2) f.gg.opts.reweight.tol <- gedit(1e-8, label = "reweight.tol", width = 20, cont = f.gg.opts.2) f.gg.opts.reweight.max.iter <- gedit(10, label = "reweight.max.iter", @@ -1421,7 +1414,7 @@ plot_ftmp_save <- function(filename) { switch(plot_format, png = png(filename, width = 400, height = 400), pdf = pdf(filename), - wmf = win.metafile(filename)) + emf = devEMF::emf(filename)) plot_ftmp() dev.off() svalue(sb) <- paste("Saved plot to", filename, "in working directory", getwd()) diff --git a/test.R b/test.R new file mode 100644 index 0000000..eb61a1a --- /dev/null +++ b/test.R @@ -0,0 +1,21 @@ +library(gmkin) + +app <- gmkin(script = "~/git/gmkin/inst/GUI/gmkin.R") +s <- gmkin:::get_current_session(app) + +s$show_fit_option_widgets(TRUE) +s$f.run$call_Ext("enable") + +names(s) +s$ftmp$reweight.max.iter +s$ftmp$maxit +names(s$ftmp) + +s$ws$ftmp$maxit +s$f.run$call_Ext("enable") +s$f.gg.parms[,] +s$show_fit_option_widgets +svalue(s$f.gg.opts.reweight.tol) <- +svalue(s$f.gg.opts.error_model) +svalue(s$f.gg.opts.error_model_algorithm) +visible(s$f.gg.opts.g) <- TRUE -- cgit v1.2.1