Skip to content

Commit

Permalink
Merge pull request #85 from JGCRI/dev
Browse files Browse the repository at this point in the history 
HectorUI v3.1
  • Loading branch information
@stephpenn1
stephpenn1 authored Oct 1, 2024
2 parents 1d11114 + 415c83e commit dc46bb1
Show file tree
Hide file tree
Showing 2 changed files with 120 additions and 13 deletions.
129 changes: 116 additions & 13 deletions inst/shinyApp/components/modules/mod_run.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")),
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"),
Expand Down Expand Up @@ -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)
),
Expand All @@ -92,19 +92,19 @@ run_server <- function(id, r6) {
observe({

r6$run_mode <- "regular"
runs <- list()
cores <- list()
runs <- 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(input$ssp_path[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 == 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
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) {
Expand Down Expand Up @@ -132,15 +132,67 @@ 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)))

}

}

}

r6$output <- bind_rows(runs)
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 <- runs_df
print("Done")

# Save scenarios used in run
r6$ini_list <- unique(r6$output$Scenario)

output$graph <- renderPlotly({
graph_plots(r6 = r6)
})
Expand All @@ -151,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)) {

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)))
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)
Expand Down
4 changes: 4 additions & 0 deletions inst/shinyApp/global.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -45,6 +46,7 @@ HectorInputs <- R6Class(
self$run_name <- 1
self$inputs <- list()
self$selected_var <- "CO2_concentration"
self$ini_list <- list()
}
)
)
Expand Down Expand Up @@ -72,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",
Expand Down

0 comments on commit dc46bb1

Please sign in to comment.