From cf4de2090c88d0f4e04f832a428d913f78332b30 Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Thu, 22 Aug 2024 16:03:15 -0400 Subject: [PATCH 1/8] No longer crashes when selecting variable before clicking "Load Graphs" New variables can be selected without having to click "Load Graphs" first, by carrying over the "runs" var as r6$output instead of creating a new blank variable. This does cause the app to crash if a new SSP is selected after selecting new variables, though, so it's not a complete fix --- inst/shinyApp/components/modules/mod_run.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index 12fee0f..bdde66c 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -133,6 +133,7 @@ run_server <- function(id, r6) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) } + #browser() r6$output <- bind_rows(runs) print("Done") @@ -146,7 +147,7 @@ run_server <- function(id, r6) { observe({ r6$selected_var <- reactive({input$variable}) - runs <- list() + runs <- list(r6$output) for(i in 1:length(input$ssp_path)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% From 193fc4495b0c8ee24fd386596a8da8c7ff865f3f Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Thu, 22 Aug 2024 16:32:31 -0400 Subject: [PATCH 2/8] Revert "No longer crashes when selecting variable before clicking "Load Graphs"" This reverts commit cf4de2090c88d0f4e04f832a428d913f78332b30. --- inst/shinyApp/components/modules/mod_run.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index bdde66c..12fee0f 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -133,7 +133,6 @@ run_server <- function(id, r6) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) } - #browser() r6$output <- bind_rows(runs) print("Done") @@ -147,7 +146,7 @@ run_server <- function(id, r6) { observe({ r6$selected_var <- reactive({input$variable}) - runs <- list(r6$output) + runs <- list() for(i in 1:length(input$ssp_path)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% From 70f565fe179d43a98edaa1520bc85c12acd833ad Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Fri, 23 Aug 2024 09:20:15 -0400 Subject: [PATCH 3/8] Fixed disconnect when selecting new SSPs and output variables Selecting a new output variable now draws the chosen SSP from the R6 class rather than the shiny input, ensuring that it uses the SSPs that were selected at the time "Load Graph" was last clicked (or when app was opened). This does impact plotting (and downloading data) -- when you change output variables, it will only plot one SSP and you have to click Load Graph to show both again. --- inst/shinyApp/components/modules/mod_run.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index 12fee0f..197ebfe 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -148,7 +148,7 @@ run_server <- function(id, r6) { r6$selected_var <- reactive({input$variable}) runs <- list() - for(i in 1:length(input$ssp_path)) { + for(i in 1:length(r6$ini_file)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) } From 80982e6f0bb240089c9bbeb2cc21978b27ed422a Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Mon, 26 Aug 2024 11:24:24 -0400 Subject: [PATCH 4/8] Changing SSPs and parameters won't crash app Another update to the flow of selecting SSPs and parameters -- the app will no longer crash, but users will need to select Load Graphs when selecting new parameters or else only the first selected SSP will plot. Gets rid of disconnect issue (seemingly completely?) but does cause issue with plotting. --- inst/shinyApp/components/modules/mod_run.R | 16 ++++++++++------ inst/shinyApp/global.r | 2 ++ 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index 197ebfe..20c6b8b 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -10,7 +10,7 @@ run_ui <- function(id) { label = "Select SSPs:", choices = scenarios, multiple = TRUE, - selected = "input/hector_ssp245.ini"), + selected = list("input/hector_ssp245.ini","input/hector_ssp460.ini")), sliderInput(ns("time"), label="Select dates:", min = 1750, max = 2300, value = c(1900,2100), sep="", width = "90%", step=5), h5("Include permafrost thaw:", id = "perm-lab"), @@ -90,15 +90,17 @@ run_server <- function(id, r6) { r6$run_mode <- "regular" runs <- list() cores <- list() + r6$ini_list <- reactive({input$ssp_path}) + #browser() - for(i in 1:length(input$ssp_path)) { + for(i in 1:length(r6$ini_list())) { r6$selected_var <- reactive({input$variable}) r6$run_name <- reactive({input$run_name}) - r6$ini_file <- reactive({system.file(input$ssp_path[i],package="hector")}) + r6$ini_file <- reactive({system.file(r6$ini_list()[i],package="hector")}) r6$time <- reactive({input$time}) - withProgress(message = paste("Running Hector", names(which(scenarios == input$ssp_path[i], arr.ind = FALSE)), "...\n"), value = 1/2, { + withProgress(message = paste("Running Hector", names(which(scenarios == r6$ini_file(), arr.ind = FALSE)), "...\n"), value = 1/2, { print("Running...") # in command line core <- reactive({newcore(r6$ini_file())}) # create core @@ -129,13 +131,14 @@ run_server <- function(id, r6) { r6$core <- cores - for(i in 1:length(input$ssp_path)) { + for(i in 1:length(r6$ini_list())) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% - mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) + mutate(Scenario = names(which(scenarios == r6$ini_list()[i], arr.ind = FALSE))) } r6$output <- bind_rows(runs) print("Done") + #browser() output$graph <- renderPlotly({ graph_plots(r6 = r6) @@ -147,6 +150,7 @@ run_server <- function(id, r6) { observe({ r6$selected_var <- reactive({input$variable}) runs <- list() + #browser() for(i in 1:length(r6$ini_file)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% diff --git a/inst/shinyApp/global.r b/inst/shinyApp/global.r index 04a2d20..adc1d9e 100644 --- a/inst/shinyApp/global.r +++ b/inst/shinyApp/global.r @@ -37,6 +37,7 @@ HectorInputs <- R6Class( inputs = NULL, core = NULL, selected_var = NULL, + ini_list = NULL, initialize = function(ini_file = system.file("input/hector_ssp245.ini", package = "hector")) { self$ini_file <- ini_file @@ -45,6 +46,7 @@ HectorInputs <- R6Class( self$run_name <- 1 self$inputs <- list() self$selected_var <- "CO2_concentration" + self$ini_list <- list() } ) ) From 1f228812ea334db60b47d7422235741645384fa5 Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Thu, 12 Sep 2024 11:19:10 -0400 Subject: [PATCH 5/8] Graphs update as intended when output variable is changed When a new output variable is selected, the SSPs/parameters selected the last time Load Graphs was clicked (or when the app loaded) will remain the same, until Load Graphs is clicked again. --- inst/shinyApp/components/modules/mod_run.R | 25 +++++++++++----------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index fb30d75..38b936d 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -10,7 +10,7 @@ run_ui <- function(id) { label = "Select SSPs:", choices = scenarios, multiple = TRUE, - selected = list("input/hector_ssp245.ini","input/hector_ssp460.ini")), + selected = list("input/hector_ssp245.ini")), sliderInput(ns("time"), label="Select dates:", min = 1750, max = 2300, value = c(1900,2100), sep="", width = "90%", step=5), h5("Include permafrost thaw:", id = "perm-lab"), @@ -94,19 +94,17 @@ run_server <- function(id, r6) { r6$run_mode <- "regular" runs <- list() cores <- list() - r6$ini_list <- reactive({input$ssp_path}) - #browser() - for(i in 1:length(r6$ini_list())) { + for(i in 1:length(input$ssp_path)) { r6$selected_var <- reactive({input$variable}) r6$run_name <- reactive({input$run_name}) - r6$ini_file <- reactive({system.file(r6$ini_list()[i],package="hector")}) + r6$ini_file <- system.file(input$ssp_path[i],package="hector") r6$time <- reactive({input$time}) - withProgress(message = paste("Running Hector", names(which(scenarios == r6$ini_file(), arr.ind = FALSE)), "...\n"), value = 1/2, { + withProgress(message = paste("Running Hector", names(which(scenarios == r6$ini_file, arr.ind = FALSE)), "...\n"), value = 1/2, { print("Running...") # in command line - core <- reactive({newcore(r6$ini_file())}) # create core + core <- reactive({newcore(r6$ini_file)}) # create core # Set parameters using inputs (function to only call setvar once in final version) if (input$permafrost == TRUE) { @@ -135,14 +133,15 @@ run_server <- function(id, r6) { r6$core <- cores - for(i in 1:length(r6$ini_list())) { + for(i in 1:length(input$ssp_path)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% - mutate(Scenario = names(which(scenarios == r6$ini_list()[i], arr.ind = FALSE))) + mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) } r6$output <- bind_rows(runs) print("Done") - #browser() + + r6$ini_list <- unique(r6$output$Scenario) output$graph <- renderPlotly({ graph_plots(r6 = r6) @@ -156,12 +155,14 @@ run_server <- function(id, r6) { runs <- list() #browser() - for(i in 1:length(r6$ini_file)) { + for(i in 1:length(r6$ini_list)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% - mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) + mutate(Scenario = names(which(scenarios == scenarios[[r6$ini_list[i]]], arr.ind = FALSE))) } + #browser() r6$output <- bind_rows(runs) + #browser() output$graph <- renderPlotly({ graph_plots(r6 = r6) From f1103f3e45cbb8823a41cf615bbe73efe1ca3394 Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Thu, 12 Sep 2024 11:59:47 -0400 Subject: [PATCH 6/8] Condensed code Condensed line of code where vars are fetched when output variable is changed --- inst/shinyApp/components/modules/mod_run.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index 38b936d..c7079d3 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -141,6 +141,7 @@ run_server <- function(id, r6) { r6$output <- bind_rows(runs) print("Done") + # Save scenarios used in run r6$ini_list <- unique(r6$output$Scenario) output$graph <- renderPlotly({ @@ -153,16 +154,13 @@ run_server <- function(id, r6) { observe({ r6$selected_var <- reactive({input$variable}) runs <- list() - #browser() for(i in 1:length(r6$ini_list)) { runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% - mutate(Scenario = names(which(scenarios == scenarios[[r6$ini_list[i]]], arr.ind = FALSE))) + mutate(Scenario = r6$ini_list[i]) } - #browser() r6$output <- bind_rows(runs) - #browser() output$graph <- renderPlotly({ graph_plots(r6 = r6) From 796a7becd4ac5cc704ceb57c919945245b9c49f4 Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Fri, 13 Sep 2024 10:18:01 -0400 Subject: [PATCH 7/8] Volcanic/aerosol forcing variables temporarily removed Variables temporarily removed from app, as there is an issue with Hector that causes values to not be affected by parameter changes correctly. Will be added back to the app when the issue is fixed. --- inst/shinyApp/components/modules/mod_run.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index da6cb83..437e726 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -70,10 +70,10 @@ run_ui <- function(id) { "RF - Albedo" = RF_ALBEDO(), "RF - CO2" = RF_CO2(), "RF - N2O" = RF_N2O(), - "RF - Black Carbon" = RF_BC(), - "RF - Organic Carbon" = RF_OC(), - "RF - Total SO2" = RF_SO2(), - "RF - Volcanic Activity" = RF_VOL(), + #"RF - Black Carbon" = RF_BC(), + #"RF - Organic Carbon" = RF_OC(), + #"RF - Total SO2" = RF_SO2(), + #"RF - Volcanic Activity" = RF_VOL(), "RF - CH4" = RF_CH4())), selected = "Atmospheric CO2", multiple = FALSE) ), From c43a4168915d87d2879bb76f8f7ff8a6f29aaf33 Mon Sep 17 00:00:00 2001 From: Stephanie Pennington Date: Mon, 30 Sep 2024 20:54:47 -0400 Subject: [PATCH 8/8] ffi and luc emissions go neg --- inst/shinyApp/components/modules/mod_run.R | 108 ++++++++++++++++++++- inst/shinyApp/global.r | 2 + 2 files changed, 106 insertions(+), 4 deletions(-) diff --git a/inst/shinyApp/components/modules/mod_run.R b/inst/shinyApp/components/modules/mod_run.R index c7079d3..f16554a 100644 --- a/inst/shinyApp/components/modules/mod_run.R +++ b/inst/shinyApp/components/modules/mod_run.R @@ -92,8 +92,8 @@ run_server <- function(id, r6) { observe({ r6$run_mode <- "regular" - runs <- list() cores <- list() + runs <- list() for(i in 1:length(input$ssp_path)) { @@ -132,15 +132,64 @@ run_server <- function(id, r6) { } r6$core <- cores + runs2_list <- list() for(i in 1:length(input$ssp_path)) { + runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) + + if(r6$selected_var() == "ffi_emissions" | r6$selected_var() == "luc_emissions") { + + if(r6$selected_var() == "ffi_emissions") { + + runs2_list[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = "daccs_uptake") %>% + mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) + + } else if(r6$selected_var() == "luc_emissions") { + + runs2_list[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = "luc_uptake") %>% + mutate(Scenario = names(which(scenarios == input$ssp_path[i], arr.ind = FALSE))) + + } + + } + + } + + if(r6$selected_var() == "ffi_emissions" | r6$selected_var() == "luc_emissions") { + if(r6$selected_var() == "ffi_emissions") { + + runs2 <- bind_rows(runs2_list) %>% pivot_wider(names_from = variable, values_from = value) + + bind_rows(runs) %>% + pivot_wider(names_from = variable, values_from = value) %>% + left_join(runs2) %>% + mutate(ffi_emissions = ffi_emissions - daccs_uptake) %>% + select(-daccs_uptake) %>% pivot_longer(cols = ffi_emissions, names_to = "variable", values_to = "value") %>% + select(scenario, year, variable, value, units, Scenario) -> runs_w_uptake + + } else if(r6$selected_var() == "luc_emissions") { + + runs2 <- bind_rows(runs2_list) %>% pivot_wider(names_from = variable, values_from = value) + + bind_rows(runs) %>% + pivot_wider(names_from = variable, values_from = value) %>% + left_join(runs2) %>% + mutate(luc_emissions = luc_emissions - luc_uptake) %>% + select(-luc_uptake) %>% pivot_longer(cols = luc_emissions, names_to = "variable", values_to = "value") %>% + select(scenario, year, variable, value, units, Scenario) -> runs_w_uptake + + } + runs_df <- as.data.frame(runs_w_uptake) + + } else{ + runs_df <- bind_rows(runs) } - r6$output <- bind_rows(runs) + r6$output <- runs_df print("Done") - + # Save scenarios used in run r6$ini_list <- unique(r6$output$Scenario) @@ -154,13 +203,64 @@ run_server <- function(id, r6) { observe({ r6$selected_var <- reactive({input$variable}) runs <- list() + runs2_list <- list() for(i in 1:length(r6$ini_list)) { + runs[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% mutate(Scenario = r6$ini_list[i]) + + if(r6$selected_var() == "ffi_emissions" | r6$selected_var() == "luc_emissions") { + + if(r6$selected_var() == "ffi_emissions") { + + runs2_list[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = "daccs_uptake") %>% + mutate(Scenario = r6$ini_list[i]) + + } else if(r6$selected_var() == "luc_emissions") { + + runs2_list[[i]] <- fetchvars(r6$core[[i]], r6$time()[1]:r6$time()[2], vars = "luc_uptake") %>% + mutate(Scenario = r6$ini_list[i]) + + } + + } + + } + + if(r6$selected_var() == "ffi_emissions" | r6$selected_var() == "luc_emissions") { + + if(r6$selected_var() == "ffi_emissions") { + runs2 <- bind_rows(runs2_list) %>% pivot_wider(names_from = variable, values_from = value) + + bind_rows(runs) %>% + pivot_wider(names_from = variable, values_from = value) %>% + left_join(runs2) %>% + mutate(ffi_emissions = ffi_emissions - daccs_uptake) %>% + select(-daccs_uptake) %>% pivot_longer(cols = ffi_emissions, names_to = "variable", values_to = "value") %>% + select(scenario, year, variable, value, units, Scenario) -> runs_w_uptake + + } else if(r6$selected_var() == "luc_emissions") { + runs2 <- bind_rows(runs2_list) %>% pivot_wider(names_from = variable, values_from = value) + + bind_rows(runs) %>% + pivot_wider(names_from = variable, values_from = value) %>% + left_join(runs2) %>% + mutate(luc_emissions = luc_emissions - luc_uptake) %>% + select(-luc_uptake) %>% pivot_longer(cols = luc_emissions, names_to = "variable", values_to = "value") %>% + select(scenario, year, variable, value, units, Scenario) -> runs_w_uptake + + } + + runs_df <- as.data.frame(runs_w_uptake) + + } else{ + + runs_df <- bind_rows(runs) + } - r6$output <- bind_rows(runs) + r6$output <- runs_df output$graph <- renderPlotly({ graph_plots(r6 = r6) diff --git a/inst/shinyApp/global.r b/inst/shinyApp/global.r index adc1d9e..4c8bad8 100644 --- a/inst/shinyApp/global.r +++ b/inst/shinyApp/global.r @@ -74,7 +74,9 @@ get_titles <- function() { title <- list("CO2_concentration" = "Atmospheric CO2", "atmos_co2" = "Atmospheric Carbon Pool", "ffi_emissions" = "FFI Emissions", + "daccs_uptake" = "FFI Emission Uptake", "luc_emissions" = "LUC Emissions", + "luc_uptake" = "LuC Emission Uptake", "N2O_concentration" = "N2O Concentration", "BC_emissions" = "Black Carbon Emissions", "OC_emissions" = "Organic Carbon Emissions",