First partial rough pass of modules (LandSciTech#193)

R/app_utils_server.R

@@ -271,40 +271,53 @@ combine_outdata <- function(out_data_lst){
 # read.csv("../../../Downloads/CCVI_data-2022-11-18 (1).csv") %>% colnames() %>% paste0(collapse = "', '")
 
 # Update UI based on values loaded from csv
-update_restored <- function(df, session){
+update_restored <- function(df, section = NULL, session){
   # match column names to inputs and/or maybe reactive values?
   # will need some sort of lookup for what type of input needs to be updated
-  df_coms <- df %>% select(matches("^com_")) %>%
+
+  df_coms <- df %>%
+    select(matches("^com_")) %>%
     tidyr::pivot_longer(everything(), names_to = "input",
                         names_prefix = "com_",
                         values_to = "comment",
                         values_transform = as.character) %>%
     mutate(comment = ifelse(is.na(comment), "", comment)) %>%
     distinct()
 
-  df2 <- df %>% select(-matches("^com_")) %>%
+  df2 <- df %>%
+    select(-matches("^com_")) %>%
     tidyr::pivot_longer(everything(), names_to = "input",
                              values_to = "value",
                              values_transform = as.character) %>%
     distinct() %>%
-    mutate(input2 = ifelse(stringr::str_detect(.data$input, "rng_chg_pth"), "rng_chg_pth", .data$input)) %>%
+    mutate(input2 = ifelse(stringr::str_detect(.data$input, "rng_chg_pth"),
+                           "rng_chg_pth", .data$input)) %>%
     left_join(df_coms, by = "input") %>%
-    left_join( ui_build_table %>% select(id, .data$update_fun), by = c("input2" = "id")) %>%
+    left_join(select(ui_build_table, "id", "section", "update_fun"),
+              by = c("input2" = "id")) %>%
     select(-"input2") %>%
     filter(!is.na(.data$update_fun)) %>%
-    mutate(comment = ifelse(is.na(.data$comment) & stringr::str_detect(.data$input, "^[B,C,D]\\d.*"),
-                            "", .data$comment),
-           value = ifelse(is.na(.data$value) & stringr::str_detect(.data$input, "pth"),
-                          "", .data$value)) %>%
+    mutate(
+      comment = ifelse(
+        is.na(.data$comment) & stringr::str_detect(.data$input, "^[B,C,D]\\d.*"),
+        "", .data$comment),
+      value = ifelse(is.na(.data$value) & stringr::str_detect(.data$input, "pth"),
+                     "", .data$value)) %>%
     rowwise() %>%
     mutate(arg_name = intersect( c("selected", "value"), formalArgs(.data$update_fun)))
 
   # this is used as a trigger to skip running spatial until after returning to
   # UI so that input is updated with values from csv
   updateTextInput(inputId = "hidden", value = "yes")
 
+  if(!is.null(section)) {
+    df2 <- filter(df2, .data$section %in% .env$section) %>%
+      select(-"section")
+  }
+
   # run the appropriate update function for each input
   # tricky part is supplying the right argument name for the update fun
+
   purrr::pwalk(df2, update_call, session = session)
 }
 
@@ -420,3 +433,8 @@ recreate_index_res <- function(df){
   return(index_res)
 
 }
+
+switch_tab <- function(tab, parent_session) {
+  updateTabsetPanel(session = parent_session, input = "tabset", selected = tab)
+  shinyjs::runjs("window.scrollTo(0, 0)")
+}

R/ccvi_app.R

@@ -667,7 +667,7 @@ ccvi_app <- function(testmode_in, ...){
 
           } else {
 
-            update_restored(df_in, session)
+            update_restored(df_in, session = session)
             return(df_in)
           }
         }

R/ccvi_app2.R

@@ -0,0 +1,116 @@
+# based on example app: https://github.com/daattali/shiny-server/blob/master/mimic-google-form/app.R
+# and blog post explaining it: https://deanattali.com/2015/06/14/mimicking-google-form-shiny/
+
+#' Create the ccviR Shiny application
+#'
+#' @noRd
+#' @examples
+#'
+#' ccvi_app2()
+
+ccvi_app2 <- function(testmode_in, ...){
+
+  # Input options
+  valueNms <- c("Greatly increase", "Increase", "Somewhat increase", "Neutral")
+  valueOpts <- c(3, 2, 1, 0)
+
+  # set theme
+  my_theme <- ggplot2::theme_classic() +
+    ggplot2::theme(text = ggplot2::element_text(size = 12),
+          strip.background = ggplot2::element_blank())
+
+  ggplot2::theme_set(my_theme)
+
+  ui <- ui_setup(
+    mod_home_ui(id = "home"),
+    mod_species_ui(id = "species")
+    #mod_A_ui(id = "section_a"),
+    #mod_B_ui(id = "section_b"),
+    #mod_C_ui(id = "section_c")
+  )
+
+  server <- function(input, output, session) {
+    volumes <- server_setup()
+    x <- mod_home_server(id = "home", volumes = volumes, parent_session = session)
+    mod_species_server(id = "species", df_loaded = x$df_loaded)
+    #mod_A_server(id = "section_a")
+  }
+
+
+  onStop(function(){options(testmode_in)})
+
+  shinyApp(ui, server, enableBookmarking = "server",
+           options = list(...))
+}
+
+ui_setup <- function(...) {
+  # CSS to use in the app
+  appCSS <-
+    ".mandatory_star { color: red; }
+   .shiny-input-container { margin-top: 25px; }
+   #submit_msg { margin-left: 15px; }
+   #error { color: red; }
+   body { background: #fcfcfc; }
+   #header { background: #fff; border-bottom: 1px solid #ddd; margin: -20px -15px 0; padding: 15px 15px 10px; }
+  "
+
+  fluidPage(
+    shinyjs::useShinyjs(),
+    shinyjs::inlineCSS(appCSS),
+    title = "ccviR app",
+    tags$head(tags$style(type = "text/css",
+                         ".container-fluid {  max-width: 1050px; /* or 1050px */}")),
+    div(id = "header",
+        h1("ccviR: An app to calculate the NatureServe Climate Change Vulnerability Index"),
+        strong(
+          span("ccviR is a product developed and maintained by ECCC STB. This project is lead by Ilona Naujokaitis-Lewis and Sarah Endicott"),
+          br(),
+          span("Code"),
+          a("on GitHub", href = "https://github.com/see24/ccviR", target="_blank"),
+          HTML("&bull;"),
+          a("ccviR website", href = "https://landscitech.github.io/ccviR/articles/app_vignette.html", target="_blank"),
+          HTML("&bull;"),
+          a("NatureServe website", href = "https://www.natureserve.org/conservation-tools/climate-change-vulnerability-index", target="_blank"))
+    ),
+    navlistPanel(
+      id = "tabset",
+      well = FALSE,
+      widths = c(3, 9),
+      ...
+    ),
+    div(
+      id = "footer",
+      style = "float:right",
+      br(), br(), br(), br(),
+      shinySaveButton("downloadData", "Save progress", "Save app data as a csv file",
+                      class = "btn-primary", icon = shiny::icon("save")),
+      br(),
+      br(),
+      br()
+    )
+  )
+}
+
+
+server_setup <- function() {
+  file_pths <- NULL
+
+  # start up Note this time out is because when I disconnected from VPN it
+  # made the getVolumes function hang forever because it was looking for
+  # drives that were no longer connected. Now it will give an error
+  timeout <- R.utils::withTimeout({
+    volumes <- c(wd = getShinyOption("file_dir"),
+                 Home = fs::path_home(),
+                 getVolumes()())
+  }, timeout = 200, onTimeout = "silent")
+
+  if(is.null(timeout)){
+    stop("The app is unable to access your files because you were connected",
+         " to the VPN and then disconnected. To fix this either reconnect to",
+         " the VPN or restart your computer and use the app with out connecting",
+         " to VPN. See issue https://github.com/see24/ccviR/issues/36 for more ",
+         "information", call. = FALSE)
+  }
+
+  volumes
+}