Found a way to show that a fit is going on.

1 files changed, 67 insertions, 64 deletions

diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 671283a..55d5d95 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -333,6 +333,7 @@ configure_fit_handler <- function(h, ...) { # Configure fit button {{{3
 

   svalue(f.gg.opts.method.modFit) <<- "Port"

   f.run$call_Ext("enable")

+  svalue(f.running.label) <- "Fit configured and ready to run"

   svalue(center) <- 4

 }

 f.conf <- gbutton("Configure fit", 

@@ -852,66 +853,68 @@ show_m_spec()
 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.",

+                            "To cancel, switch to the window of the R console and press Esc (on Windows)",

+                            "or Ctrl-C (on Linux/Unix). Proceed to start the fit?")

 run_fit_handler <- function(h, ...) { #{{{3

-  Parameters <- f.gg.parms[,]

-  Parameters.de <- subset(Parameters, Type == "deparm")

-  deparms <- Parameters.de$Initial

-  names(deparms) <- Parameters.de$Name

-  defixed <- names(deparms[Parameters.de$Fixed])

-  Parameters.ini <- subset(Parameters, Type == "state")

-  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 (reweight.method == "none") reweight.method = NULL

-#  fit_progress_handler = function(x, y) {

-    #  svalue(sb) <- x

-    #  f.progress.evaluations$call_Ext("setText", x, FALSE)

-    #  f.progress.evaluations$parent$do_layout()

-#  }

-  ftmp <<- mkinfit(m.cur, override(ds.cur$data),

-                   state.ini = iniparms,

-                   fixed_initials = inifixed,

-                   parms.ini = deparms, 

-                   fixed_parms = defixed,

-                   plot = svalue(f.gg.opts.plot),

-                   solution_type = svalue(f.gg.opts.st),

-                   atol = as.numeric(svalue(f.gg.opts.atol)),

-                   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)

-#                   progress_handler = fit_progress_handler

-                   )

-  ftmp$optimised <<- TRUE

-  ftmp$ds <<- ds.cur

-  ws$ftmp <<- ftmp

-  ws$ftmp$Name <<- "Temporary (fitted)"

-  ftmp$name <<- paste(m.cur$name, "-", ds.cur$title)

-  update_f.df()

-  stmp <<- summary(ftmp)

-  f.gg.parms[,] <- get_Parameters(stmp, TRUE)

-

-  show_plot("Optimised")

-

-  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

-

-  update_f_results()

+  gconfirm(run_confirm_message, handler = function(h, ...) 

+    {

+      Parameters <- f.gg.parms[,]

+      Parameters.de <- subset(Parameters, Type == "deparm")

+      deparms <- Parameters.de$Initial

+      names(deparms) <- Parameters.de$Name

+      defixed <- names(deparms[Parameters.de$Fixed])

+      Parameters.ini <- subset(Parameters, Type == "state")

+      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 (reweight.method == "none") reweight.method = NULL

+      ftmp <<- mkinfit(m.cur, override(ds.cur$data),

+                       state.ini = iniparms,

+                       fixed_initials = inifixed,

+                       parms.ini = deparms, 

+                       fixed_parms = defixed,

+                       plot = svalue(f.gg.opts.plot),

+                       solution_type = svalue(f.gg.opts.st),

+                       atol = as.numeric(svalue(f.gg.opts.atol)),

+                       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)

+                       )

+      ftmp$optimised <<- TRUE

+      ftmp$ds <<- ds.cur

+      ws$ftmp <<- ftmp

+      ws$ftmp$Name <<- "Temporary (fitted)"

+      ftmp$name <<- paste(m.cur$name, "-", ds.cur$title)

+      update_f.df()

+      stmp <<- summary(ftmp)

+      f.gg.parms[,] <- get_Parameters(stmp, TRUE)

+

+      show_plot("Optimised")

+

+      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()

+    })

+  svalue(f.running.label) <- "Running..."

 }

 delete_fit_handler <- function(h, ...) { # {{{3

   f.i <- svalue(f.gtable, index = TRUE)

@@ -976,13 +979,13 @@ show_plot <- function(type) {
 }

 # Widget setup {{{2

 # Line 1 with buttons {{{3

-f.run <- gbutton("Run fit", cont = f.config, handler = run_fit_handler,

+f.run <- gbutton("Run fit", 

+                 cont = f.config, 

+                 handler = run_fit_handler,

                  ext.args = list(disabled = TRUE))

-f.progress.line <- ggroup(cont = f.config)

-f.progress.label <- glabel("Number of model evaluations:", 

-                           cont = f.progress.line)

-f.progress.evaluations <- glabel("0", cont = f.progress.line)

 

+f.running.line <- ggroup(cont = f.config)

+f.running.label <- glabel("No fit configured", cont = f.running.line)

 

 # Fit options forms {{{3

 f.gg.opts.g <- ggroup(cont = f.config)