From eaa89fbe57cf7aa1b9c638c8cdffb4843a706a3d Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Tue, 26 Sep 2023 11:47:38 -0400 Subject: [PATCH] Add scenario name, select "save slot" Added text input to give runs names, and "save slots" for runs --- h2/app.r | 3 +- h2/components/modules/mod_download.R | 1 - h2/components/modules/mod_graph.R | 9 ++--- h2/components/modules/mod_run.R | 49 ++++++++++++++++++++++++---- h2/components/modules/mod_summary.r | 6 ++-- h2/global.r | 6 +++- 6 files changed, 56 insertions(+), 18 deletions(-) diff --git a/h2/app.r b/h2/app.r index abe6f90..47d85f9 100644 --- a/h2/app.r +++ b/h2/app.r @@ -11,7 +11,7 @@ ui <- fluidPage( tabPanel(title = "Guides",), tabPanel(title = "Explore Hector", fluidRow( - column(2, + column(3, wellPanel( run_ui("run_1"), download_ui("download_1") @@ -27,7 +27,6 @@ ui <- fluidPage( server <- function(input, output, session) { r6 <- HectorInputs$new() # r6 class - i <- reactiveVal(1) # set up pseudo loop run_server("run_1", r6 = r6, i = i) summary_server("summary_1", r6 = r6, i = i) diff --git a/h2/components/modules/mod_download.R b/h2/components/modules/mod_download.R index a59bf56..caeaed8 100644 --- a/h2/components/modules/mod_download.R +++ b/h2/components/modules/mod_download.R @@ -13,7 +13,6 @@ download_server <- function(id, r6) { content = function(file) { write.csv(bind_rows(r6$output), file) } - ) }) } \ No newline at end of file diff --git a/h2/components/modules/mod_graph.R b/h2/components/modules/mod_graph.R index 0362f3e..edcd2ca 100644 --- a/h2/components/modules/mod_graph.R +++ b/h2/components/modules/mod_graph.R @@ -13,8 +13,8 @@ graph_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { observe({ filtered_output <- - filter(r6$output[[i() - 1]], variable == "CO2_concentration") #i increases at end of mod_run so output is i-1 - #filter(bind_rows(r6$output), variable == "CO2_concentration") + filter(r6$output[[r6$i()]], variable == "global_tas") + #filter(bind_rows(r6$output), variable == "global_tas") output$graph <- renderPlotly({ plot_ly( filtered_output, @@ -30,9 +30,10 @@ graph_server <- function(id, r6, i) { ) %>% layout( xaxis = list(title = "Year"), - yaxis = list(title = "CO2 Concentration (ppmv)"), - title = "CO2 Concentration" + yaxis = list(title = "Global Temperature (C)"), + title = "Global Temperature at Surface" ) + #ggplot(filtered_output, aes(x=year,y=value)) }) }) %>% bindEvent(input$plot) diff --git a/h2/components/modules/mod_run.R b/h2/components/modules/mod_run.R index ade1217..b18c0e0 100644 --- a/h2/components/modules/mod_run.R +++ b/h2/components/modules/mod_run.R @@ -4,6 +4,7 @@ run_ui <- function(id) { ns <- NS(id) tagList( + textInput(ns("core_name"), "Input name for core:", placeholder="Unnamed Hector core"), selectInput(ns("ssp_path"), label="Select SSP:", choices = list("SSP 1-1.9"="input/hector_ssp119.ini", "SSP 1-2.6"="input/hector_ssp126.ini", @@ -18,8 +19,19 @@ run_ui <- function(id) { min = 1750, max = 2300, value = 2000, sep=""), sliderInput(ns("end"), "Select end date:", min = 1750, max = 2300, value = 2300, sep=""), - actionButton(ns("run"),"Run Model"), - verbatimTextOutput(ns("done")) + radioButtons(ns("run_number"), label="Select run number:", + choices = list("1" = 1, + "2" = 2, + "3" = 3, + "4" = 4, + "5" = 5, + "6" = 6, + "7" = 7, + "8" = 8), + selected = "1", inline=TRUE), + actionButton(ns("run"),"Run Model") + #verbatimTextOutput(ns("done")), + #actionButton(ns("stop"),"show warning") ) } @@ -31,19 +43,42 @@ run_server <- function(id, r6, i) { r6$ini_file <- reactive({system.file(input$ssp_path,package="hector")}) r6$start <- reactive({input$start}) r6$end <- reactive({input$end}) + r6$i <- reactive({as.integer(input$run_number)}) # run hector using inputs print("Running...") # in command line - core <- newcore(r6$ini_file()) - run(core) - r6$output[[i()]] <- fetchvars(core,r6$start():r6$end()) %>% mutate(run=i()) - output$done <- renderPrint({as.character(i()-1)}) #print run number + core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) + run(core()) + r6$output[[r6$i()]] <- fetchvars(core(),r6$start():r6$end()) %>% mutate(run=r6$i()) + output$done <- renderPrint({r6$i()}) #print run number print("Done") # in command line - i(i() + 1) # add 1 to i. like a pseudo loop for storing output + #i(i() + 1) # add 1 to i. like a pseudo loop for storing output print(r6$output) #print(i()) + + if (length(r6$output) == 8 && + identical( + lapply(r6$output, is.null), + list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE) + )) + shinyalert(title = "Run Limit Reached", + text = "You have completed eight runs. Select a run to replace.", + type = "input", + inputType = "number") }) %>% bindEvent(input$run) # triggers when "Run Model" is clicked + + # observe({ + # shinyalert(title = "Run Limit Reached", + # text = "You have completed five runs. Select a run to replace.", + # type = "warning") + # }) %>% + # bindEvent(input$stop) + + # showModal(modalDialog( + # title="Run Limit Reached", + # "You have reached the limit of 5 runs. Select a run to replace." + # )) # how to make it appear after 5 runs? }) } \ No newline at end of file diff --git a/h2/components/modules/mod_summary.r b/h2/components/modules/mod_summary.r index 698a823..7f663ff 100644 --- a/h2/components/modules/mod_summary.r +++ b/h2/components/modules/mod_summary.r @@ -6,15 +6,15 @@ summary_ui <- function(id) { ns <- NS(id) fluidRow(actionButton(ns("print"), "Print"), - dataTableOutput(ns("summary"))) + DTOutput(ns("summary"))) } summary_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { observe({ #browser() - hectoroutput <- r6$output[[i()-1]] - output$summary <- renderDataTable({hectoroutput}) + hectoroutput <- r6$output[[r6$i()]] + output$summary <- renderDT({datatable(hectoroutput,editable=TRUE)}) }) %>% bindEvent(input$print) # run when Print button is clicked diff --git a/h2/global.r b/h2/global.r index 85500c4..1a0a5a6 100644 --- a/h2/global.r +++ b/h2/global.r @@ -5,7 +5,9 @@ library(dplyr) library(ggplot2) library(shinycssloaders) library(plotly) -library(shinyalert) +library(shinyalert) # don't need if we have shinyWidgets? +library(DT) +library(shinyWidgets) source("./components/modules/mod_graph.r") source("./components/modules/mod_run.r") @@ -20,6 +22,7 @@ HectorInputs <- R6Class( start = NA, end = NA, output = NULL, + i = NA, initialize = function(ini_file = system.file("input/hector_ssp245.ini", package = "hector"), start = 2000, @@ -28,6 +31,7 @@ HectorInputs <- R6Class( self$start <- start self$end <- end self$output <- list() + self$i <- 1 stopifnot(end > start) #gotta have the start year before the end year } )