From 81dd0772995db1877220ea13a139e4c2b5c5d5c9 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Mon, 9 Nov 2015 21:03:21 +0100
Subject: Fixed a couple of bugs and added some error handling

---
 R/gmkinws.R      |  6 +++---
 inst/GUI/gmkin.R | 66 +++++++++++++++++++++++++++++++++++---------------------
 2 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/R/gmkinws.R b/R/gmkinws.R
index 87eaf8a..071e3b1 100644
--- a/R/gmkinws.R
+++ b/R/gmkinws.R
@@ -34,10 +34,10 @@
 gmkinws <- R6Class("gmkinws", 
   public = list(
     observed = NULL,
-    ds = NA,
-    m = NA,
+    ds = list(),
+    m = list(),
     ftmp = list(Name = ""),
-    f = NA,
+    f = list(),
 
     initialize = function(ds, m, f) {
 
diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R
index 0054a72..183903a 100644
--- a/inst/GUI/gmkin.R
+++ b/inst/GUI/gmkin.R
@@ -105,7 +105,10 @@ update_ds.df <- function() {
 }
 # Update dataframe with models {{{2
 update_m.df <- function() {
-  if (is.na(ws$m[1])) m.df <<- m.df.empty
+  if (length(ws$m) == 0) {
+    m.df <<- m.df.empty
+    m.cur <<- m.empty
+  }
   else m.df <<- data.frame(Name = sapply(ws$m, function(x) x$name), stringsAsFactors = FALSE)
   m.gtable[,] <- m.df
   update_m_editor()
@@ -115,7 +118,7 @@ update_m.df <- function() {
 # Update dataframe with fits {{{2
 update_f.df <- function() {
   f.df <- data.frame(Name = ws$ftmp$Name, stringsAsFactors = FALSE)
-  if (!is.na(ws$f[1])) {
+  if (length(ws$f) > 0) {
     f.df.ws <- data.frame(Name = sapply(ws$f, function(x) x$name),
                           stringsAsFactors = FALSE)
     f.df <- rbind(f.df, f.df.ws)
@@ -337,26 +340,36 @@ update_plot_obssel <- function() {
                                      cont = f.gg.plotopts, checked = TRUE)
 }
 configure_fit_handler <- function(h, ...) { # Configure fit button {{{3
-  if (is.null(m.cur$cf) && Sys.which("gcc") != "") {
-    mtmp <- mkinmod(speclist = m.cur$spec)
-    mtmp$name <- m.cur$name
-    m.cur <<- mtmp
-  }
-  ftmp <<- suppressWarnings(mkinfit(m.cur,
-                            override(ds.cur$data),
-                            method.modFit = "Marq",
-                            err = "err", quiet = TRUE,
-                            control.modFit = list(maxiter = 0)))
-  ftmp$optimised <<- FALSE
-  ftmp$ds <<- ds.cur
-  ws$ftmp <<- ftmp
-  ws$ftmp$Name <<- "Temporary (not fitted)"
-  update_f.df()
-  update_f_conf()
+  if (length(intersect(names(m.cur$spec), ds.cur$observed)) > 0) {
+    if (is.null(m.cur$cf) && Sys.which("gcc") != "") {
+      mtmp <- mkinmod(speclist = m.cur$spec)
+      mtmp$name <- m.cur$name
+      m.cur <<- mtmp
+    }
+    ftmp <<- suppressWarnings(mkinfit(m.cur,
+                              override(ds.cur$data),
+                              method.modFit = "Marq",
+                              err = "err", quiet = TRUE,
+                              control.modFit = list(maxiter = 0)))
+    ftmp$optimised <<- FALSE
+    ftmp$ds <<- ds.cur
+    ws$ftmp <<- ftmp
+    ws$ftmp$Name <<- "Temporary (not fitted)"
+    update_f.df()
+    update_f_conf()
 
-  svalue(f.gg.opts.method.modFit) <<- "Port"
-  f.run$call_Ext("enable")
-  svalue(f.running.label) <- "Fit configured and ready to run"
+    svalue(f.gg.opts.method.modFit) <<- "Port"
+    f.run$call_Ext("enable")
+    svalue(f.running.label) <- "Fit configured and ready to run"
+  } else {
+    svalue(f.running.label) <- paste("No fit configured:",
+                                     "The model and the dataset you selected do",
+                                     "not share names for observed variables!")
+    f.run$call_Ext("disable")
+    show.initial.gb.u$call_Ext("disable")
+    show.initial.gb.o$call_Ext("disable")
+    f.gg.parms[,] <- Parameters.empty
+  }
   svalue(center) <- 4
 }
 f.conf <- gbutton("Configure fit", 
@@ -369,8 +382,7 @@ p.editor  <- gframe("", horizontal = FALSE, cont = center,
                      label = "Project")
 # Line with buttons {{{2
 p.line.buttons <- ggroup(cont = p.editor, horizontal = TRUE)
-p.new <- gbutton("New project", cont = p.line.buttons,
-  handler = function(h, ...) {
+p.new.handler <- function(h, ...) {
     project_name <- "New project"
     svalue(p.name) <- project_name
     svalue(p.filename) <- file.path(getwd(), paste0(project_name, ".gmkinws"))
@@ -380,7 +392,8 @@ p.new <- gbutton("New project", cont = p.line.buttons,
     update_ds.df()
     update_m.df()
     update_f.df()
-  })
+}
+p.new <- gbutton("New project", cont = p.line.buttons, handler = p.new.handler)
 p.delete.handler = function(h, ...) {
   filename <- file.path(getwd(), paste0(svalue(p.name), ".gmkinws"))
   gconfirm(paste0("Are you sure you want to delete ", filename, "?"),
@@ -957,6 +970,7 @@ keep_fit_handler <- function(h, ...) { # {{{3
   ws$ftmp <<- list(Name = "")
   update_f.df()
   update_plot_obssel()
+  p.modified <<- TRUE
 }
 get_Parameters <- function(stmp, optimised) # {{{3
 {
@@ -1211,7 +1225,9 @@ add_gallery_model_handler <- function(h, ...) {
   m.delete$call_Ext("enable")  
   m.copy$call_Ext("enable")  
   if (!is.null(svalue(ds.gtable, index = TRUE))) {
-    if (!is.na(svalue(ds.gtable))) f.conf$call_Ext("enable")
+    if (length(svalue(ds.gtable)) > 0) {
+      if (!is.na(svalue(ds.gtable))) f.conf$call_Ext("enable")
+    }
   }
   svalue(center) <- 3
 }
-- 
cgit v1.2.1