Merge pull request #78 from jhmigueles/issue54_app_status

Issue54 app status

.Rbuildignore

@@ -6,3 +6,4 @@ Docker_windows_printscreen.png
 CONTRIBUTING.md
 INSTRUCTIONS_TOOL_MAINTAINERS.md
 UCloud_files
+HabitusGUIbookmark.RData

.gitignore

@@ -43,3 +43,7 @@ vignettes/*.pdf
 # template files
 inst/testfiles_palmspy/palmspy-params.json
 inst/testfiles_ggir/config.csv
+
+# server state files
+/previous_config/
+HabitusGUIbookmark.RData

NAMESPACE

@@ -6,6 +6,7 @@ export(PALMSpyshiny)
 export(checkFile)
 export(check_and_clean_palms_data)
 export(check_params)
+export(cleanPath)
 export(create_test_GGIRconfig)
 export(create_test_files)
 export(hbt_build_days)

R/check_params.R

@@ -75,9 +75,13 @@ check_params = function(params = c(), tool = c()) {
   seti = which(params$class == "timezone")
   if (length(seti) > 0) {
     for (i in seti) {
-      if (params$value[i] %in% OlsonNames() ==  FALSE) {
+      if (params$value[i] %in% c(OlsonNames(), "") ==  FALSE) {
         blocked_params$name[cnt] = rowNames[i]
-        blocked_params$error[cnt] = "is not an expected (Olson) timezone name. You may want to check spelling."
+        blocked_params$error[cnt] = paste0("is not an expected (Olson) timezone name.",
+                                           " You may want to check spelling. If you want",
+                                           " to use the timezone of the computer where",
+                                           " this app is run then you can leave the",
+                                           " value empty.")
         cnt = cnt + 1
       }
     }

R/cleanPath.R

@@ -0,0 +1,27 @@
+#' Cleans multiple consecutive file separator from file path
+#'
+#' @param path Character with file path to be cleaned
+#'
+#' @return Character with cleaned file path
+#' @export
+#'
+#' @examples cleanPath("C:/myfolder///myfile.csv")
+cleanPath = function(path) {
+  if (!is.character(path)) return(path)
+  split_tmp = unlist(strsplit(path, .Platform$file.sep))
+  empty = which(split_tmp == "")
+  if (length(empty) > 0) split_tmp = split_tmp[-empty]
+  newPath = paste(split_tmp, collapse = .Platform$file.sep)
+  # In Linux the first character of the path can be a forward
+  # slash, which needs to be kept
+  firstChar = substring(path, 1, 1)
+  if (firstChar == "/") {
+    newPath = paste0("/", newPath)
+  }
+  # In both Linux and Windows ~ signs may be used as shortcut to the users home
+  # directory. To avoid inconsistencies we replace them by the full path.
+  # If we do not do this myApp may copy ~/config.csv to /home/user/config.csv which
+  # essentially is the same file and would then result in an empty file.
+  newPath = normalizePath(newPath)
+  return(newPath)
+}

R/identify_tools.R

@@ -23,13 +23,13 @@ identify_tools = function(datatypes = c("AccRaw", "ACount", "GPS", "GIS", "PALMS
                                output = c("PALMSpy_out"),
                                usecases = c("Trips", "QC", "Environment")),
                  palmsplusr = new("toolio",
-                                 input = c("PALMSpy_out", "GIS"),
-                                 output = c("palmsplusr_out"),
-                                 usecases = c("Environment", "QC")),
+                                  input = c("PALMSpy_out", "GIS"),
+                                  output = c("palmsplusr_out"),
+                                  usecases = c("Environment", "QC")),
                  Counts = new("toolio",
-                                   input = "AccRaw",
-                                   output = c("Counts_out"),
-                                   usecases = c("PA", "Trips", "QC", "Environment")))
+                              input = "AccRaw",
+                              output = c("Counts_out"),
+                              usecases = c("PA", "Trips", "QC", "Environment")))
   iotools = iotools[which(names(iotools) %in% available_tools)] # only look at available tools
   allgoals = tools_needed = outputs = c()
   # loop over tools and select the ones that generate the output users needs and is able to generate

R/modConfigServer.R

@@ -2,13 +2,15 @@
 #'
 #' @param id ...
 #' @param tool ...
+#' @param prevConfig character to specify path to config file selected in previous run 
 #' @param homedir character to specify home directory
+#'
 #' @return No object returned, this is a shiny module
 #' @import shinyFiles
 #' @importFrom magrittr %>%
 #' @export
 
-modConfigServer = function(id, tool, homedir = getwd()) {
+modConfigServer = function(id, tool, homedir = getwd(), prevConfig = c()) {
 
   moduleServer(id, function(input, output, session) {
     observeEvent(tool(), {
@@ -38,22 +40,134 @@ modConfigServer = function(id, tool, homedir = getwd()) {
           },
           contentType = "text/csv")
       }
+
+      # Previously selected config file
+      if (!is.null(prevConfig)) {
+        current_config = prevConfig
+        configfile <- reactive(current_config)
+
+        if (tool() == "PALMSpy") {
+          params = load_params(file = current_config, format = "json_palmspy") #$datapath
+        } else if (tool() == "GGIR") {
+          params = load_params(file = current_config, format = "csv_ggir") #$datapath
+        } else if (tool() == "palmsplusr") {
+          params = load_params(file = current_config, format = "csv_palmsplusr") #$datapath
+        }
+        # if config file is loaded, then check params
+        params_errors = check_params(params, tool = tool())
+        output$config_issues <- renderUI({
+          HTML(params_errors$error_message)
+        })
+        output$config_green <- renderUI({
+          HTML(params_errors$green_message)
+        })
+
+        v <- reactiveValues(params = params)
+        proxy = DT::dataTableProxy("mod_table", session)
+        observeEvent(input$mod_table_cell_edit, {
+          info = input$mod_table_cell_edit
+          i = info$row
+          j = info$col
+          k = info$value
+          modifiable_column = "value" # modifiable columns
+          isolate(
+            if (j %in% match(modifiable_column, colnames(v$params))) {
+              do.replace = TRUE
+              v$params[which(v$params$display == TRUE)[i], j] <<- DT::coerceValue(k, v$params[i, j])
+            } else {
+              do.replace = FALSE
+              warning("You are not supposed to change this column.") # check to stop the user from editing only few columns
+            }
+          )
+          if (do.replace == TRUE) {
+            DT::replaceData(proxy, v$params, resetPaging = FALSE)  # replaces data displayed by the updated table
+            params_errors = check_params(v$params, tool = tool())
+            output$config_issues <- renderUI({
+              HTML(params_errors$error_message)
+            })
+            output$config_green <- renderUI({
+              HTML(params_errors$green_message)
+            })
+            if (nrow(params_errors$blocked_params) != 0) {
+              v$params$display[which(rownames(v$params) %in% params_errors$blocked_params$name == TRUE)] = TRUE
+            }
+            # Auto-save after every change
+            if (tool() == "PALMSpy") {
+              update_params(new_params = v$params, file = current_config, format = "json_palmspy") #$datapath
+            } else if (tool() == "GGIR") {
+              update_params(new_params = v$params, file = current_config, format = "csv_ggir") #$datapath
+            } else if (tool() == "palmsplusr") {
+              update_params(new_params = v$params, file = current_config, format = "csv_palmsplusr") #$datapath
+            }
+          }
+        })
+
+        ### Reset Table
+        observeEvent(input$reset, {
+          showNotification("Resetting values", type = "message")
+          v$params <- params # your default data
+          current_config = as.character(parseFilePaths(c(home = homedir), configfile())$datapath)
+          # also saving to file
+          if (tool() == "PALMSpy") {
+            update_params(new_params = v$params, file = current_config, format = "json_palmspy") #$datapath
+          } else if (tool() == "GGIR") {
+            update_params(new_params = v$params, file = current_config, format = "csv_ggir") #$datapath
+          } else if (tool() == "palmsplusr") {
+            update_params(new_params = v$params, file = current_config, format = "csv_palmsplusr") #$datapath
+          }
+          # update list with errors
+          params_errors = check_params(params, tool = tool())
+          output$config_issues <- renderUI({
+            HTML(params_errors$error_message)
+          })
+          output$config_green <- renderUI({
+            HTML(params_errors$green_message)
+          })
+        })
+        # Prepare data to be visualised:
+        rows2show = which(v$params$display == TRUE)
+        v$params = v$params[order(v$params$priority, decreasing = TRUE),]
+        cols2show = which(colnames(v$params) %in% c("class", "minimum", "maximum",	"set", "display") == FALSE)
+        data2vis = reactive(v$params[rows2show, cols2show])
+
+        # Render table for use in UI
+        output$mod_table <- DT::renderDT({
+          DT::datatable(data2vis(), editable = TRUE,
+                        options = list(lengthMenu = list(c(5, 10, -1), c('5', '10', 'All')),
+                                       pageLength = 5
+                                       # , columnDefs = list(list(targets = 'priority', visible = FALSE))
+                        )) %>% DT::formatStyle(
+                          'value', 'priority',
+                          backgroundColor = DT::styleEqual(c("0", "1"), c('gray91', 'lightyellow'))
+                        )
+          # editable = list(target = "column", disable = list(columns = c(2,3,4))), #< would be nice, but seems to disable reset option
+        })
+
+        output$config_instruction <- renderText({
+          "Review the parameter values, especially the ones in yellow, and edit where needed by double clicking:"
+        })
+      }
     })
 
+
+    # Selected config file
     shinyFileChoose(input, "configfile",  roots = c(home = homedir))
     configfile <- reactive(input$configfile)
 
+
+
     # This line has no function locally, but seems critical for the app to work on UCloud
     # output$test_shinytable1 <- renderDataTable(data.frame(a = 1:3, b = rep("shinytable", 3), c = 3:1))
 
     observeEvent(input$configfile, {
+
       # inspired on https://community.rstudio.com/t/saving-editable-dt-table-values-to-reactivevalue-in-shiny/48825
       current_config = as.character(parseFilePaths(c(home = homedir), configfile())$datapath)
-
+      
       if (length(current_config) > 0) {
         # check config file
         check = checkFile(file = current_config, tool = tool())
-
+        
         if (check != "ok") {
           # Show notification and keep waiting for correct config file
           showNotification(check, type = "error")