diff --git a/h2/app.r b/h2/app.r index 3d73a49..8323bee 100644 --- a/h2/app.r +++ b/h2/app.r @@ -8,26 +8,20 @@ ui <- fluidPage( collapsible = TRUE, tabPanel(title = "Home", includeHTML("./components/layout/homepage.html")), - tabPanel(title = "Guides",), + tabPanel(title = "Guides"), tabPanel(title = "Explore Hector", fluidRow( - column(3, - wellPanel( - run_ui("run_1"), - download_ui("download_1") - )), - column(4, - summary_ui("summary_1")), - column(4, - graph_ui("graph_1")) - )), + run_ui("run_1"), + #download_ui("download_1"), + ) + ), tabPanel(title = "About") ), ) server <- function(input, output, session) { r6 <- HectorInputs$new() # r6 class - + run_server("run_1", r6 = r6) summary_server("summary_1", r6 = r6) graph_server("graph_1", r6 = r6) @@ -35,4 +29,4 @@ server <- function(input, output, session) { } # Run the application -shinyApp(ui = ui, server = server) \ No newline at end of file +shinyApp(ui = ui, server = server) diff --git a/h2/components/functions/func_graph_plots.R b/h2/components/functions/func_graph_plots.R new file mode 100644 index 0000000..4a5c104 --- /dev/null +++ b/h2/components/functions/func_graph_plots.R @@ -0,0 +1,30 @@ + + +graph_plots <- function(r6) { + + if (r6$save == TRUE) { + #browser() + + {ggplot(r6$no_save_output) + + geom_line(aes(x = year, y = value, color = ssp)) + + labs(x = "Year", y = last(r6$output)$variable[1], + title = paste0("Run Name: ", last(r6$output)$run[1], "\n", "Variable: ", last(r6$output)$variable[1])) + + theme(legend.position = "bottom")} %>% + plotly::ggplotly() + + } else if(r6$save == FALSE) { + + {ggplot(r6$no_save_output) + + geom_line(aes(x = year, y = value, color = ssp)) + + labs(x = "Year", y = r6$no_save_output$variable[1], + title = paste0("Run Name: Unsaved Run\n", "Variable: ", r6$no_save_output$variable[1]))} %>% + plotly::ggplotly() %>% + layout( + legend = list( + orientation = 'h', x = 0 + ) + ) + + } +} + diff --git a/h2/components/layout/style copy.css b/h2/components/layout/style copy.css index 0a99d04..fd14914 100644 --- a/h2/components/layout/style copy.css +++ b/h2/components/layout/style copy.css @@ -1,10 +1,8 @@ .test { font-family:"Barlow Regular", Sans-Serif !important; - font-size: 20px; } h5 { - font-size: 20px; font-weight: bold; -} \ No newline at end of file +} diff --git a/h2/components/modules/mod_graph.R b/h2/components/modules/mod_graph.R index 842ab03..f4dd39d 100644 --- a/h2/components/modules/mod_graph.R +++ b/h2/components/modules/mod_graph.R @@ -5,6 +5,7 @@ graph_ui <- function(id) { ns <- NS(id) + fluidRow(selectInput(ns("variable"), "Select a variable to plot:", list("Carbon Cycle" = list("Atmospheric CO2" = CONCENTRATIONS_CO2(), "Atmospheric Carbon Pool" = ATMOSPHERIC_CO2(), # i think this is the right var? @@ -54,13 +55,17 @@ graph_ui <- function(id) { "Heat Flux - Interior Layer Ocean" = FLUX_INTERIOR(), "Total Heat Flux - Ocean" = HEAT_FLUX()))), # other variables can be found from the fetchvars help page + column(3, actionButton(ns("plot"), "Plot"), - plotlyOutput(ns("graph"))) + plotlyOutput(ns("graph")) + ) + #) } graph_server <- function(id, r6) { moduleServer(id, function(input, output, session) { observe({ + if (r6$save == TRUE) { # Get labels given input @@ -70,8 +75,8 @@ graph_server <- function(id, r6) { # Filter data for selected variable filtered_output <- - filter(r6$output[[r6$i()]], variable == input$variable) - + filter(r6$output[[r6$run_name()]], variable == r6$selected_var()) + output$graph <- renderPlotly({ plot_ly( filtered_output, @@ -107,7 +112,7 @@ graph_server <- function(id, r6) { output$graph <- renderPlotly({ plot_ly( - filtered_output, + r6$output, x = ~ year, y = ~ value, type = 'scatter', @@ -126,8 +131,8 @@ graph_server <- function(id, r6) { }) } }) %>% - bindEvent(input$plot, ignoreNULL = TRUE, ignoreInit = FALSE) + bindEvent(input$run, ignoreNULL = TRUE, ignoreInit = TRUE) }) } -# add reset variables button \ No newline at end of file +# add reset variables button diff --git a/h2/components/modules/mod_run.R b/h2/components/modules/mod_run.R index 69dca7e..6c768b9 100644 --- a/h2/components/modules/mod_run.R +++ b/h2/components/modules/mod_run.R @@ -1,193 +1,160 @@ # Run Hector using R6 module run_ui <- function(id) { - ns <- NS(id) - - tagList( - chooseSliderSkin(skin = "Flat", color = "#375a7f"), - textInput(ns("core_name"), "Input name for core:", placeholder="Unnamed Hector core"), - prettyRadioButtons(ns("ssp_path"), label="Select SSP:", - choices = list("SSP 1-1.9"="input/hector_ssp119.ini", - "SSP 1-2.6"="input/hector_ssp126.ini", - "SSP 2-4.5"="input/hector_ssp245.ini", - "SSP 3-7.0"="input/hector_ssp370.ini", - "SSP 4-3.4"="input/hector_ssp434.ini", - "SSP 4-6.0"="input/hector_ssp460.ini", - "SSP 5-3.4OS"="input/hector_ssp534-over.ini", - "SSP 5-8.5"="input/hector_ssp585.ini"), - selected = "input/hector_ssp245.ini", inline=TRUE, - shape = "square", width = "80%"), - sliderInput(ns("start"), label="Select dates:", - min = 1750, max = 2300, value = c(1900,2100), sep="", width = "90%", step=5), - br(), - h5("Model Parameters"), - sliderInput(ns("alpha"), label="Aerosol forcing scaling factor", # AERO_SCALE() - min = 0.01, max = 1, value = 1, width = "90%"), - sliderInput(ns("beta"), label="CO2 fertilization factor", # BETA() - min = 0.01, max = 4, value = 0.36, step=0.01, width = "90%"), - sliderInput(ns("diff"), label="Ocean heat diffusivity", # DIFFUSIVITY() - min = 0, max = 5, value = 2.3, step=0.1, post = " cm2/s", width = "90%"), - sliderInput(ns("S"), label="Equilibrium climate sensitivity", # ECS() - min = 1, max = 6, value = 3, step=0.1, post = " °C", width = "90%"), - sliderInput(ns("q10_rh"), label="Heterotrophic temperature sensitivity", # Q10_RH() - min = 1, max = 5, value = 2, step=0.1, width = "90%"), - sliderInput(ns("volscl"), label="Volcanic forcing scaling factor", # VOLCANIC_SCALE() - min = 0, max = 1, value = 1, width = "90%"), - materialSwitch(ns("savetoggle"),"Save Run", value = FALSE), - actionButton(ns("run"),"Run") - ) + ns <- NS(id) + fluidRow( + sidebarPanel( + tabsetPanel( + tabPanel(class = "params", "Standard Scenarios", + chooseSliderSkin(skin = "Flat", color = "#375a7f"), + prettyRadioButtons(ns("ssp_path"), label="Select SSP:", + choices = list("SSP 1-1.9"="input/hector_ssp119.ini", + "SSP 1-2.6"="input/hector_ssp126.ini", + "SSP 2-4.5"="input/hector_ssp245.ini", + "SSP 3-7.0"="input/hector_ssp370.ini", + "SSP 4-3.4"="input/hector_ssp434.ini", + "SSP 4-6.0"="input/hector_ssp460.ini", + "SSP 5-3.4OS"="input/hector_ssp534-over.ini", + "SSP 5-8.5"="input/hector_ssp585.ini"), + selected = "input/hector_ssp245.ini", inline=TRUE, + shape = "square", width = "80%"), + sliderInput(ns("time"), label="Select dates:", + min = 1750, max = 2300, value = c(1900,2100), sep="", width = "90%", step=5), + h5("Model Parameters"), + sliderInput(ns("alpha"), label="Aerosol forcing scaling factor", # AERO_SCALE() + min = 0.01, max = 1, value = 1, width = "90%"), + sliderInput(ns("beta"), label="CO2 fertilization factor", # BETA() + min = 0.01, max = 4, value = 0.36, step=0.01, width = "90%"), + sliderInput(ns("diff"), label="Ocean heat diffusivity", # DIFFUSIVITY() + min = 0, max = 5, value = 2.3, step=0.1, post = " cm2/s", width = "90%"), + sliderInput(ns("S"), label="Equilibrium climate sensitivity", # ECS() + min = 1, max = 6, value = 3, step=0.1, post = " °C", width = "90%"), + sliderInput(ns("q10_rh"), label="Heterotrophic temperature sensitivity", # Q10_RH() + min = 1, max = 5, value = 2, step=0.1, width = "90%"), + sliderInput(ns("volscl"), label="Volcanic forcing scaling factor", # VOLCANIC_SCALE() + min = 0, max = 1, value = 1, width = "90%"), + materialSwitch(ns("savetoggle"),"Save Run", value = FALSE), + textInput(ns("run_name"), label = "Run Name", placeholder = "Run 1"), + dropdownButton(inputId = ns("dropdown"), + icon = icon("gear"), + circle = TRUE, + status = "primary", + dataTableOutput(ns("savetable")), + actionButton(ns("deleteRuns"), "Delete Selected") + ) + ) + ) + + ), + mainPanel(width = 8, + tabsetPanel( + tabPanel(p(icon("chart-line","fa-2x"), "Scenario Output", value="outputTab"), + br(), + fluidRow( + column(4, + selectInput(ns("variable"), "Select variable:", + list("Carbon Cycle" = list("Atmospheric CO2" = CONCENTRATIONS_CO2(), + "FFI Emissions" = FFI_EMISSIONS(), + "LUC Emissions" = LUC_EMISSIONS()), + "Concentrations" = list("N2O Concentration" = CONCENTRATIONS_N2O()), + "Emissions" = list("Black Carbon Emissions" = EMISSIONS_BC(), + "Organic Carbon Emissions" = EMISSIONS_OC()), + "Forcings" = list("RF - Total" = RF_TOTAL(), + "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 - CH4" = RF_CH4())), + selected = "Atmospheric CO2", multiple = FALSE), + ), + column(3, + actionBttn(ns("run"),"Run", color = "primary"), + + ) + ), + fluidRow( + withSpinner(plotlyOutput(ns("graph"))) + ) + ), + tabPanel(p(icon("globe-americas","fa-2x"), "World Maps", value="outputTab") + ), + tabPanel(p(icon("chart-pie","fa-2x"), "Carbon Tracking", value="outputTab") + ) + + ) + ) + ) + } run_server <- function(id, r6) { - moduleServer(id, function(input, output, session) { - ns <- NS(id) - - observe({ - - toggle <- reactive({input$savetoggle}) - - if (toggle() == TRUE) { - # shinyalert( - # text = tagList( - # textInput("run_name,","Input run name:",placeholder="run name"), - # actionButton("OK","OK") - # ), - # html = TRUE, - # #type = "input", - # #inputType = "text", - # #inputPlaceholder = "run name", - # showConfirmButton = TRUE, - # confirmButtonText = "OK", - # showCancelButton = TRUE, - # cancelButtonText = "Cancel", - # closeOnClickOutside = FALSE - # ) - - observe({ - showModal(modalDialog( - textInput(ns("run_name"),"Enter run name:",value="run name"), - easyClose=TRUE, - footer=tagList( - actionButton(ns("ok"), "OK"), - modalButton("Cancel") - ) - )) - }) %>% - bindEvent(input$run, ignoreNULL = TRUE, ignoreInit = TRUE) - + moduleServer(id, function(input, output, session) { + observe({ - # Close input modal - removeModal() - - #browser() - - r6$i <- reactive({input$run_name}) - - r6$ini_file <- reactive({system.file(input$ssp_path,package="hector")}) - r6$start <- reactive({input$start[1]}) - r6$end <- reactive({input$start[2]}) - - print("Running...") # in command line - - # Create core - core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) - - # Set parameters using inputs (function to only call setvar once in final version) - setvar(core(),NA,AERO_SCALE(),input$alpha,"(unitless)") - setvar(core(),NA,BETA(),input$beta,"(unitless)") - setvar(core(),NA,DIFFUSIVITY(),input$diff,"cm2/s") - setvar(core(),NA,ECS(),input$S,"degC") - setvar(core(),NA,Q10_RH(),input$q10_rh,"(unitless)") - setvar(core(),NA,VOLCANIC_SCALE(),input$volscl,"(unitless)") - - # Run core - reset(core()) - run(core()) - - r6$output[[r6$i()]] <- fetchvars(core(),r6$start():r6$end(),vars= - list(CONCENTRATIONS_CO2(),FFI_EMISSIONS(), - LUC_EMISSIONS(),CONCENTRATIONS_N2O(), - EMISSIONS_BC(),EMISSIONS_OC(),RF_TOTAL(), - RF_ALBEDO(),RF_N2O(),RF_CO2(),RF_BC(), - RF_OC(),RF_SO2(),RF_CH4(),RF_VOL(), - RF_CF4(),RF_C2F6(),RF_HFC23(), - RF_HFC4310(),RF_HFC125(),RF_HFC143A(), - RF_HFC245FA(),RF_SF6(),RF_CFC11(), - RF_CFC12(),RF_CFC113(),RF_CFC114(), - RF_CFC115(),RF_CCL4(),RF_CH3CCL3(), - RF_HALON1211(),RF_HALON1301(), - RF_HALON2402(),RF_CH3CL(),RF_CH3BR(), - CONCENTRATIONS_CH4(),EMISSIONS_CH4(), - EMISSIONS_SO2(),VOLCANIC_SO2(), - GLOBAL_TAS(),SST(),OCEAN_TAS(), - FLUX_MIXED(),FLUX_INTERIOR(),HEAT_FLUX(), - ATMOSPHERIC_CO2(),GMST() - )) %>% - mutate(run=r6$i()) - - #output$done <- renderPrint({r6$i()}) - r6$save <- TRUE - - print("Done") # in console - + + if (input$savetoggle == TRUE) { + + r6$save <- TRUE + + } else { + + r6$save <- FALSE + + } + + r6$selected_var <- reactive({input$variable}) + r6$run_name <- reactive({input$run_name}) + r6$ini_file <- reactive({system.file(input$ssp_path,package="hector")}) + r6$time <- reactive({input$time}) + + print("Running...") # in command line + core <- reactive({newcore(r6$ini_file())}) # create core + + # Set parameters using inputs (function to only call setvar once in final version) + setvar(core(),NA,AERO_SCALE(),input$alpha,"(unitless)") + setvar(core(),NA,BETA(),input$beta,"(unitless)") + setvar(core(),NA,DIFFUSIVITY(),input$diff,"cm2/s") + setvar(core(),NA,ECS(),input$S,"degC") + setvar(core(),NA,Q10_RH(),input$q10_rh,"(unitless)") + setvar(core(),NA,VOLCANIC_SCALE(),input$volscl,"(unitless)") + + reset(core()) + run(core()) + + #browser() + if (r6$save == TRUE) { + + r6$output[[r6$run_name()]] <- fetchvars(core(), r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% + mutate(run = r6$run_name(), Scenario = input$ssp_path) + + } else if (r6$save == FALSE) { + + r6$no_save_output <- fetchvars(core(), r6$time()[1]:r6$time()[2], vars = list(r6$selected_var())) %>% + mutate(ssp = input$ssp_path) + + } + + print("Done") + }) %>% - bindEvent(input$ok) - - } else if (toggle() == FALSE) { - + bindEvent(input$run, ignoreNULL = FALSE, ignoreInit = FALSE) + observe({ - browser() - r6$i <- reactive({input$run_name}) - - r6$ini_file <- reactive({system.file(input$ssp_path,package="hector")}) - r6$start <- reactive({input$start[1]}) - r6$end <- reactive({input$start[2]}) - - print("Running...") # in console - - # Create core - core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) - - # Set parameters using inputs (function to only call setvar once in final version) - setvar(core(),NA,AERO_SCALE(),input$alpha,"(unitless)") - setvar(core(),NA,BETA(),input$beta,"(unitless)") - setvar(core(),NA,DIFFUSIVITY(),input$diff,"cm2/s") - setvar(core(),NA,ECS(),input$S,"degC") - setvar(core(),NA,Q10_RH(),input$q10_rh,"(unitless)") - setvar(core(),NA,VOLCANIC_SCALE(),input$volscl,"(unitless)") - - # Run core - reset(core()) - run(core()) - - # Output results - r6$no_save <- fetchvars(core(),r6$start():r6$end(),vars= - list(CONCENTRATIONS_CO2(),FFI_EMISSIONS(), - LUC_EMISSIONS(),CONCENTRATIONS_N2O(), - EMISSIONS_BC(),EMISSIONS_OC(),RF_TOTAL(), - RF_ALBEDO(),RF_N2O(),RF_CO2(),RF_BC(), - RF_OC(),RF_SO2(),RF_CH4(),RF_VOL(), - RF_CF4(),RF_C2F6(),RF_HFC23(), - RF_HFC4310(),RF_HFC125(),RF_HFC143A(), - RF_HFC245FA(),RF_SF6(),RF_CFC11(), - RF_CFC12(),RF_CFC113(),RF_CFC114(), - RF_CFC115(),RF_CCL4(),RF_CH3CCL3(), - RF_HALON1211(),RF_HALON1301(), - RF_HALON2402(),RF_CH3CL(),RF_CH3BR(), - CONCENTRATIONS_CH4(),EMISSIONS_CH4(), - EMISSIONS_SO2(),VOLCANIC_SO2(), - GLOBAL_TAS(),SST(),OCEAN_TAS(), - FLUX_MIXED(),FLUX_INTERIOR(),HEAT_FLUX(), - ATMOSPHERIC_CO2(),GMST() - )) - r6$save <- FALSE - - print("Done") # in console - }) %>% - bindEvent(input$run, ignoreNULL = TRUE, ignoreInit = FALSE) - - } - + + output$graph <- renderPlotly({ + graph_plots(r6 = r6) + }) + }) %>% + bindEvent(input$run, ignoreNULL = TRUE, ignoreInit = FALSE) + }) - }) -} \ No newline at end of file +} + +# might be worth it to just run the core with all selectable variables. how much time would that add? +# issue seems to be that mod_run goes first, so input$variable just doesn't exist yet... maybe having +# that module containing all choices is a good idea + +# fetchvars(core,1745:2300,vars=list(CONCENTRATIONS_CO2(),FFI_EMISSIONS(),LUC_EMISSIONS(),CONCENTRATIONS_N2O,EMISSIONS_BC(),EMISSIONS_OC(),RF_TOTAL(),RF_ALBEDO(),RF_N2O(),RF_CO2(),RF_BC(),RF_OC(),RF_SO2(),RF_CH4(),RF_VOL())) diff --git a/h2/components/modules/mod_summary.r b/h2/components/modules/mod_summary.r index 6c477c5..7ed08b9 100644 --- a/h2/components/modules/mod_summary.r +++ b/h2/components/modules/mod_summary.r @@ -12,19 +12,17 @@ summary_ui <- function(id) { summary_server <- function(id, r6) { moduleServer(id, function(input, output, session) { observe({ + browser() if (r6$save == TRUE) { - hectoroutput <- r6$output[[r6$i()]] + hectoroutput <- r6$output[[r6$run_name()]] output$summary <- renderDT({datatable(hectoroutput)}) } if (r6$save == FALSE) { - hectoroutput <- r6$no_save - #filtered_output <- - # filter(r6$no_save, variable == r6$selected_var()) - + hectoroutput <- r6$output output$summary <- renderDT({datatable(hectoroutput)}) } }) %>% bindEvent(input$print, ignoreNULL = TRUE, ignoreInit = FALSE) # run when Print button is clicked - + }) -} \ No newline at end of file +} diff --git a/h2/global.r b/h2/global.r index 4315b2b..4b70015 100644 --- a/h2/global.r +++ b/h2/global.r @@ -9,81 +9,44 @@ library(shinyalert) # don't need if we have shinyWidgets? library(DT) library(shinyWidgets) -setwd("~/GitHub/hectorui/h2") +#setwd("~/GitHub/hectorui/h2") source("./components/modules/mod_graph.r") source("./components/modules/mod_run.r") source("./components/modules/mod_summary.r") source("./components/modules/mod_download.r") +source("./components/functions/func_graph_plots.R") + +theme_set(theme_minimal()) # Define R6 class HectorInputs <- R6Class( classname = "HectorInputs", public = list( ini_file = NULL, - start = NA, - end = NA, + time = NA, output = NULL, + no_save_output = NULL, no_save = NULL, - i = NA, + run_name = NA, save = NULL, inputs = NULL, selected_var = NULL, initialize = function(ini_file = system.file("input/hector_ssp245.ini", - package = "hector"), - start = 2000, - end = 2300, - selected_var = "global_tas") { + package = "hector")) { self$ini_file <- ini_file - self$start <- start - self$end <- end + self$time <- time + # self$time[2] <- time self$output <- list() - #self$no_save <- NULL - self$i <- 1 + self$no_save <- NULL + self$run_name <- 1 self$inputs <- list() - self$selected_var <- selected_var - stopifnot(end > start) #gotta have the start year before the end year + self$selected_var <- "CO2_concentration" + #stopifnot(time[2] > time[1]) #gotta have the start year before the end year } ) ) -# labels dictionary -# title <- list("Atmospheric CO2" = CONCENTRATIONS_CO2(), -# "FFI Emissions" = FFI_EMISSIONS(), -# "LUC Emissions" = LUC_EMISSIONS(), -# "N2O Concentration" = CONCENTRATIONS_N2O(), -# "Black Carbon Emissions" = EMISSIONS_BC(), -# "Organic Carbon Emissions" = EMISSIONS_OC(), -# "RF - Total" = RF_TOTAL(), -# "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 - CH4" = RF_CH4(), -# "CF4 Forcing"="RF_CF4", #function doesn't give the correct output? -# "C2F6 Forcing"="RF_C2F6", -# "HFC-23 Forcing"="RF_HFC23", -# "HFC-4310 Forcing"="RF_HFC4310", -# "HFC-125 Forcing"="RF_HFC125", -# "HFC-143a Forcing"="RF_HFC143A", -# "HFC-245fa Forcing"="RF_HFC245FA", -# "SF6 Forcing"="RF_SF6", -# "CFC-11 Forcing"="RF_CFC11", -# "CFC-12 Forcing"="RF_CFC12", -# "CFC-113 Forcing"="RF_CFC113", -# "CFC-114 Forcing"="RF_CFC114", -# "CFC-115 Forcing"="RF_CFC115", -# "CCl4 Forcing"="RF_CCl4", -# "CH3CCl3 Forcing"="RF_CH3CCl3", -# "Halon-1211 Forcing"="RF_halon1211", -# "Halon-1301 Forcing"="RF_halon1301", -# "Halon-2402 Forcing"="RF_halon2402", -# "CH3Cl Forcing"="RF_CH3Cl", -# "CH3Br Forcing"="RF_CH3Br") - title <- list("CO2_concentration" = "Atmospheric CO2", "atmos_co2" = "Atmospheric Carbon Pool", "ffi_emissions" = "FFI Emissions", @@ -180,4 +143,4 @@ units <- list("CO2_concentration" = "DegC", "heatflux_mixed" = "W/m2", "heatflux_interior" = "W/m2", "heatflux" = "W/m2" -) \ No newline at end of file +)