From 8b3380438908cb55416afccd90c4e173dff719df Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Sat, 24 Oct 2015 19:05:35 +0200 Subject: Overhauled model editor with simplified target specification Enabling multiple selections in a combobox required some hacking, as this is not currently supported by gWidgetsWWW2 --- inst/GUI/gmkin.R | 124 +++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 115 insertions(+), 9 deletions(-) diff --git a/inst/GUI/gmkin.R b/inst/GUI/gmkin.R index 9faf370..5cdf22c 100644 --- a/inst/GUI/gmkin.R +++ b/inst/GUI/gmkin.R @@ -19,11 +19,16 @@ # You should have received a copy of the GNU General Public License along with # this program. If not, see -# Set the GUI title and create the basic widget layout {{{1 -# Configuration {{{2 +# Configuration {{{1 left_width = 250 right_width = 500 save_keybinding = "Ctrl-X" +gcb_observed_width = 100 +gcb_type_width = 70 +gcb_to_width = 160 +gcb_sink_width = 70 + +# Set the GUI title and create the basic widget layout {{{1 # Three panel layout {{{2 window_title <- paste0("gmkin ", packageVersion("gmkin"), "- Browser based GUI for kinetic evaluations using mkin") @@ -84,6 +89,10 @@ update_ds.df <- function() { update_m.df <- function() { if (is.na(ws$m[1])) m.df <<- m.df.empty else m.df <<- data.frame(Name = sapply(ws$m, function(x) x$name)) + m.gtable[,] <- m.df + update_m_editor() + m.delete$call_Ext("disable") + m.copy$call_Ext("disable") } # Update dataframe with fits {{{2 update_f.df <- function() { @@ -119,7 +128,10 @@ ds.empty <- mkinds$new( ds.cur <- ds.empty$clone() ds.df <- ds.df.empty <- data.frame(Title = "", stringsAsFactors = FALSE) # Models {{{2 -m.cur <- m.empty <- mkinmod(parent = mkinsub("SFO")) +m.empty <- mkinmod(parent = mkinsub("SFO")) +m.empty$name <- "" +m.empty$spec <- list() +m.cur <- m.empty m.df <- m.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) # Fits {{{2 f.df <- f.df.empty <- data.frame(Name = "", stringsAsFactors = FALSE) @@ -202,7 +214,10 @@ addHandlerClicked(ds.gtable, ds.switcher) m.switcher <- function(h, ...) { m.i <- h$row_index svalue(c.m) <- m.df[m.i, "Name"] - #update_m_editor() + m.cur <<- ws$m[[m.i]] + update_m_editor() + m.delete$call_Ext("enable") + m.copy$call_Ext("enable") svalue(center) <- 3 svalue(right) <- 3 } @@ -519,6 +534,7 @@ update_ds_editor <- function() { svalue(ds.e.obu) <- ds.cur$unit svalue(ds.e.rep) <- ds.cur$replicates ds.e.gdf[,] <- ds.cur$data + ds.keep$call_Ext("enable") visible(ds.e.import) <- FALSE svalue(ds.e.up.text) <- "
"
 }
@@ -531,6 +547,7 @@ ds.copy <- gbutton("Copy 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")
 
 # Formlayout for meta data {{{3
 ds.e.gfl <- gformlayout(cont = ds.editor)
@@ -622,13 +639,74 @@ delete_model_handler <- function(h, ...) {
 }
 
 keep_m_changes_handler <- function(h, ...) {
-  add_model(
-            )
-  update_m.df()
-  m.gtable$set_index(length(ws$m))
-  update_m_editor()
+  spec <- list()
+  for (obs.i in 1:length(m.e.rows)) {
+    to_string <- svalue(m.e.to[[obs.i]])
+    if (length(to_string) == 0) to_vector = NULL
+    else to_vector = strsplit(svalue(m.e.to[[obs.i]]), ", ")[[1]]
+    spec[[obs.i]] <- mkinsub(svalue(m.e.type[[obs.i]]),
+                          to = to_vector,
+                          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 = ", ")
 }
+# Add and remove observed variables {{{3
+add_observed <- function(obs.i) {
+  if (obs.i == length(ws$observed)) {
+    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, 
+                                 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 = 0L, 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,
+                                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]]) 
+  if (obs.i > 1) {
+    gbutton("Remove observed variable", handler = remove_observed_handler, 
+            action = obs.i, cont = m.e.rows[[obs.i]])
+  }
+}
+
+add_observed_handler <- function(h, ...) {
+  obs.i <- length(m.e.rows) + 1
+  add_observed(obs.i)
+}
+
+remove_observed_handler <- function(h, ...) {
+  m.cur$spec[[h$action]] <<- NULL
+  update_m_editor()
+}
+# Update the model editor {{{3
+update_m_editor <- function() {
+  svalue(m.name.ge) <- m.cur$name
+  svalue(m.ff.gc) <- m.cur$use_of_ff
+  for (oldrow.i in seq_along(m.e.rows)) {
+    delete(m.editor, m.e.rows[[oldrow.i]])
+  }
+  m.keep$call_Ext("enable")
+  m.e.rows <<- m.e.obs <<- m.e.type <<- m.e.to <<- m.e.sink <<- list()
+  if (length(m.cur$spec) == length(ws$observed)) {
+    m.add_observed$call_Ext("disable")
+  } else {
+    m.add_observed$call_Ext("enable")
+  }
+  show_m_spec()
+}
 # Widget setup {{{2
 # Line 1 with buttons {{{3
 m.e.buttons <- ggroup(cont = m.editor, horizontal = TRUE)
@@ -638,6 +716,7 @@ m.copy <- gbutton("Copy 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")
 
 # Formlayout for meta data {{{3
 m.e.gfl <- gformlayout(cont = m.editor)
@@ -645,6 +724,33 @@ m.name.ge <- gedit(label = "Model name", 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,
+  handler = add_observed_handler)
+m.add_observed$call_Ext("disable")
+
+
+# Model specification {{{3
+m.e.rows <- m.e.obs <- m.e.type <- m.e.to <- m.e.sink <- list()
+
+# Show the model specification {{{4
+show_m_spec <- function() {
+  for (obs.i in seq_along(m.cur$spec)) {
+    obs.name <- names(m.cur$spec)[[obs.i]]
+
+    add_observed(obs.i)
+
+    svalue(m.e.obs[[obs.i]]) <<- obs.name
+    svalue(m.e.type[[obs.i]]) <<- m.cur$spec[[obs.i]]$type
+    obs.to = m.cur$spec[[obs.i]]$to
+    obs.to_string_R = paste(obs.to, collapse = ", ")
+    obs.to_string_JS = paste0("['", paste(obs.to, collapse = "', '"), "']")
+    # Set R and Ext values separately, as multiple selections are not supported
+    svalue(m.e.to[[obs.i]]) <<- obs.to_string_R
+    m.e.to[[obs.i]]$call_Ext("select", String(obs.to_string_JS))
+  }
+}
+show_m_spec()
+
 
 # center: Fit configuration {{{1
 f.config  <- gframe("", horizontal = FALSE, cont = center, 
-- 
cgit v1.2.1