Several 🐛 fixes and updates plus examples

R/app_ui.R

@@ -186,13 +186,15 @@ app_ui <- function(request) {
 #' @importFrom golem add_resource_path activate_js favicon bundle_resources
 #' @noRd
 golem_add_external_resources <- function() {
+
+  # Add resource path
   add_resource_path(
     "www",
     app_sys("app/www")
   )
 
   tags$head(
-    favicon(),
+    golem::favicon(),
     bundle_resources(
       path = app_sys("app/www"),
       app_title = "ODPSCP"

R/misc.R

@@ -54,3 +54,28 @@ spatial_to_sf <- function(file, make_valid = FALSE){
 
   return(out)
 }
+
+#' Small helper for spatial conversion to wkt
+#' @param val A [`list`] with the datapath for the spatial file
+#' @return A [`character`] with a WKT.
+#' @noRd
+format_studyregion_to_text <- function(val){
+  assertthat::assert_that(utils::hasName(val, "datapath"))
+  # Check that if file exists
+  if(!file.exists(val$datapath)) return("Studyregion could not be loaded?")
+  # Load from data path
+  val <- try({
+    spatial_to_sf(val$datapath, make_valid = FALSE)
+  }, silent = TRUE)
+  if(inherits(val,"try-error")){
+    val <- "Studyregion could not be loaded?"
+  } else {
+    # Convert to sfc
+    val <- val |> sf::st_as_sfc()
+    val <- paste0(
+      # Also append SRID in front
+      sf::st_crs(val) |> sf::st_as_text(),";", sf::st_as_text(val)
+    )
+  }
+  return(val)
+}

R/mod_Export.R

@@ -43,7 +43,7 @@ mod_Export_ui <- function(id){
               justified = TRUE,
               size = "lg",
               status = "info",
-              choices = c('docx', 'pdf', 'csv', 'yaml'),
+              choices = c('docx', 'csv', 'yaml'),
               selected = 'csv',
               checkIcon = list(
                 yes = shiny::icon("circle-down"),
@@ -182,7 +182,7 @@ mod_Export_server <- function(id, results){
         } else if(oftype() == "docx"){
           # Create document from results, everything handled by function
           protocol <- format_protocol(results, format = "list")
-          # saveRDS(results, "test.rds")
+          # saveRDS(rvtl(results), "test.rds")
           protocol_to_document(protocol, file = file, format = "docx")
         } else if(oftype() == "pdf"){
           # Create document from results
@@ -217,11 +217,10 @@ mod_Export_server <- function(id, results){
         protocol_to_document(protocol, file = ofname2,
                              format = "docx")
 
-        # Create PDF document from results
+        # Create yaml from results
         protocol <- format_protocol(results, format = "list")
-        ofname3 <- file.path(tempdir(), "ODPSCP_protocol.pdf")
-        protocol_to_document(protocol, file = ofname3,
-                             format = "pdf")
+        ofname3 <- file.path(tempdir(), "ODPSCP_protocol.yaml")
+        yaml::write_yaml(protocol, file = ofname3)
 
         # Zip everything together
         zip::zip(file,

R/mod_Prioritization.R

@@ -186,7 +186,7 @@ mod_Prioritization_ui <- function(id){
                        shiny::conditionalPanel(
                          condition = "input.checkperformance == 'Yes'",
                          ns = ns,
-                         DT::DTOutput(outputId = ns("evalperformance")),
+                         DT::DTOutput(outputId = ns("evalidentification")),
                          shiny::actionButton(inputId = ns("add_indicator"), label = "Add a new indicator",
                                              icon = shiny::icon("plus")),
                          shiny::actionButton(inputId = ns("remove_indicator"), label = "Remove last indicator",
@@ -257,7 +257,7 @@ mod_Prioritization_server <- function(id, results, parentsession){
     ids <- get_protocol_ids(group = "prioritization")
     shiny::observe({
       for(id in ids){
-        if(id == "evalperformance"){
+        if(id == "evalidentification"){
           results[[id]] <- data.frame(indicators()) |> asplit(MARGIN = 1)
         } else {
           results[[id]] <- input[[id]]
@@ -310,16 +310,17 @@ mod_Prioritization_server <- function(id, results, parentsession){
       indicators(new_data)
     })
 
-    #output the datatable based on the dataframe (and make it editable)
-    output$evalperformance <- DT::renderDT({
+    # --- #
+    # Output the datatable based on the dataframe (and make it editable)
+    output$evalidentification <- DT::renderDT({
       DT::datatable(indicators(),rownames = FALSE,
                     filter = "none", selection = "none",
                     style = "auto",
                     editable = TRUE)
     })
 
-    shiny::observeEvent(input$evalperformance_cell_edit, {
-      info <- input$evalperformance_cell_edit
+    shiny::observeEvent(input$evalidentification_cell_edit, {
+      info <- input$evalidentification_cell_edit
       modified_data <- indicators()
       modified_data[info$row, info$col+1] <- info$value
       indicators(modified_data)

R/mod_Specification.R

@@ -523,10 +523,10 @@ mod_Specification_server <- function(id, results, parentsession){
     ids <- get_protocol_ids(group = "specification")
     shiny::observe({
       for(id in ids){
-        if(id == "feature_table"){
-          results[[id]] <- data.frame(feature_table$df) |> asplit(MARGIN = 1)
-        } else if(id == "zones_table") {
-          results[[id]] <- data.frame(zones_table$df) |> asplit(MARGIN = 1)
+        if(id == "featurelist"){
+          results[[id]] <- data.frame(feature_table()) |> asplit(MARGIN = 1)
+        } else if(id == "specificzones") {
+          results[[id]] <- data.frame(zones_table()) |> asplit(MARGIN = 1)
         } else {
           results[[id]] <- input[[id]]
         }
@@ -535,8 +535,8 @@ mod_Specification_server <- function(id, results, parentsession){
 
     # --- #
     # Define the features list
-    feature_table <- shiny::reactiveValues(
-      df = data.frame(name = character(0),
+    feature_table <- shiny::reactiveVal(
+      data.frame(name = character(0),
                  group = character(0),
                  number = numeric(0L))
     )
@@ -561,40 +561,42 @@ mod_Specification_server <- function(id, results, parentsession){
       } else {
         new_feature = data.frame("name" = input$name, "group" = input$group, "number" = input$number,
                                  stringsAsFactors = F)
-        new_data <- feature_table$df |> dplyr::add_row(new_feature)
-        feature_table$df <- new_data
+        # Check for zero number
+        if(input$number==0){
+          shiny::showNotification("Features with number zero?", duration = 4, type = "error")
+        }
+        new_data <- feature_table() |> dplyr::add_row(new_feature)
+        feature_table(new_data)
         shiny::removeModal()
       }
     })
 
     shiny::observeEvent(input$remove_feature, {
-      new_data <- feature_table$df
+      new_data <- feature_table()
       if(nrow(new_data)==0){
         shiny::showNotification("No features added yet!",
                                 duration = 2, type = "warning")
       } else {
         new_data <- new_data |> dplyr::slice(-dplyr::n())
-        feature_table$df <- new_data
+        feature_table(new_data)
       }
     })
 
     #output the datatable based on the dataframe (and make it editable)
     output$featurelist <- DT::renderDataTable({
-      features = feature_table$df
-      features_dt <- DT::datatable(features, rownames = FALSE,
+        DT::datatable(feature_table(), rownames = FALSE,
                     colnames = c("Feature name", "Feature group", "Total number"),
                     filter = "none", selection = "none",
                     style = "auto",
                     editable = TRUE)
-      return(features_dt)
     })
 
     # Manual edit
     shiny::observeEvent(input$featurelist_cell_edit, {
       info <- input$featurelist_cell_edit
-      modified_data <- feature_table$df
+      modified_data <- feature_table()
       modified_data[info$row, info$col+1] <- info$value
-      feature_table$df <- modified_data
+      feature_table(modified_data)
     })
 
     # Load an external file
@@ -624,38 +626,38 @@ mod_Specification_server <- function(id, results, parentsession){
 
     # --- #
     # Define the features list
-    zones_table <- shiny::reactiveValues(
-      df = data.frame(name = character(0),
+    zones_table <- shiny::reactiveVal(
+      data.frame(name = character(0),
                  aim = character(0),
                  costs = character(0),
                  contributions = character(0)
-                 )
+      )
     )
 
     # Events for author table
     shiny::observeEvent(input$add_zone, {
-      new_data <- zones_table$df |> dplyr::add_row(
+      new_data <- zones_table() |> dplyr::add_row(
         data.frame(name = "My zone", aim = "Zone purpose",
                    costs = "Differing costs",
                    contributions = "Who benefits")
       )
-      zones_table$df <- new_data
+      zones_table(new_data)
     })
 
     shiny::observeEvent(input$remove_zone, {
-      new_data <- zones_table$df
+      new_data <- zones_table()
       if(nrow(new_data)==0){
         shiny::showNotification("No zones added yet!",
                                 duration = 2, type = "warning")
       } else {
         new_data <- new_data |> dplyr::slice(-dplyr::n())
-        zones_table$df <- new_data
+        zones_table(new_data)
       }
     })
 
     #output the datatable based on the dataframe (and make it editable)
     output$specificzones <- DT::renderDT({
-      DT::datatable(zones_table$df,rownames = FALSE,
+      DT::datatable(zones_table(), rownames = FALSE,
                     colnames = c("Zone name", "Purpose", "Costs", "Who benefits"),
                     filter = "none", selection = "none",
                     style = "auto",
@@ -665,9 +667,9 @@ mod_Specification_server <- function(id, results, parentsession){
     # Manual edit
     shiny::observeEvent(input$specificzones_cell_edit, {
       info <- input$specificzones_cell_edit
-      modified_data <- zones_table$df
+      modified_data <- zones_table()
       modified_data[info$row, info$col+1] <- info$value
-      zones_table$df <- modified_data
+      zones_table(modified_data)
     })
 
     # Load an external file