From c8e42affb7bd2838014cc1f529ed1c60f1230abc Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Wed, 4 Oct 2023 11:40:34 -0400 Subject: [PATCH] Added toggle switch Added toggle to run without saving or save to one of 8 slots. Saving currently doesn't work (issue with popup) --- h2/components/modules/mod_graph.R | 71 ++++++++----- h2/components/modules/mod_run.R | 150 ++++++++++++++++++---------- h2/components/modules/mod_summary.r | 11 +- h2/global.r | 6 +- 4 files changed, 161 insertions(+), 77 deletions(-) diff --git a/h2/components/modules/mod_graph.R b/h2/components/modules/mod_graph.R index edcd2ca..2dafd88 100644 --- a/h2/components/modules/mod_graph.R +++ b/h2/components/modules/mod_graph.R @@ -12,29 +12,54 @@ graph_ui <- function(id) { graph_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { observe({ - filtered_output <- - filter(r6$output[[r6$i()]], variable == "global_tas") - #filter(bind_rows(r6$output), variable == "global_tas") - output$graph <- renderPlotly({ - plot_ly( - filtered_output, - x = ~ year, - y = ~ value, - type = 'scatter', - mode = 'lines', - hovertemplate = paste( - "Year: %{x}
", - "Value: %{y:.2f}", - "" - ) - ) %>% - layout( - xaxis = list(title = "Year"), - yaxis = list(title = "Global Temperature (C)"), - title = "Global Temperature at Surface" - ) - #ggplot(filtered_output, aes(x=year,y=value)) - }) + if (r6$save == TRUE) { + filtered_output <- + filter(r6$output[[r6$i()]], variable == "global_tas") + + output$graph <- renderPlotly({ + plot_ly( + filtered_output, + x = ~ year, + y = ~ value, + type = 'scatter', + mode = 'lines', + hovertemplate = paste( + "Year: %{x}
", + "Value: %{y:.2f}", + "" + ) + ) %>% + layout( + xaxis = list(title = "Year"), + yaxis = list(title = "Global Temperature (C)"), + title = "Global Temperature at Surface" + ) + }) + } + if (r6$save == FALSE) { + filtered_output <- + filter(r6$no_save, variable == "global_tas") + + output$graph <- renderPlotly({ + plot_ly( + filtered_output, + x = ~ year, + y = ~ value, + type = 'scatter', + mode = 'lines', + hovertemplate = paste( + "Year: %{x}
", + "Value: %{y:.2f}", + "" + ) + ) %>% + layout( + xaxis = list(title = "Year"), + yaxis = list(title = "Global Temperature (C)"), + title = "Global Temperature at Surface" + ) + }) + } }) %>% bindEvent(input$plot) }) diff --git a/h2/components/modules/mod_run.R b/h2/components/modules/mod_run.R index b18c0e0..483ce8e 100644 --- a/h2/components/modules/mod_run.R +++ b/h2/components/modules/mod_run.R @@ -19,17 +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=""), - 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") + # 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("runsave"),"Run and Save"), + materialSwitch(ns("savetoggle"),"Save Run"), + actionButton(ns("run"),"Run") #not actually hooked up to anything yet lol #verbatimTextOutput(ns("done")), #actionButton(ns("stop"),"show warning") ) @@ -38,47 +40,95 @@ run_ui <- function(id) { run_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { - observe({ - # store inputs in r6 class - 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 <- 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 - 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") + # # store inputs in r6 class + # 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)}) + # + # # sendSweetAlert(session = session, + # # html = TRUE, + # # text = tagList( + # # numericInput("num","Select save slot:", 1) + # # )) + # #browser() + # r6$i <- reactive({as.integer(input$run_number)}) + # + # # run hector using inputs + # print("Running...") # in command line + # core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) + # run(core()) + # #browser() + # 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 + # 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$stop) + # bindEvent(input$run) # triggers when "Run Model" is clicked - # 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? + observe({ + if (input$savetoggle == TRUE) { + # store inputs in r6 class + 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)}) + + sendSweetAlert(session = session, + html = TRUE, + text = tagList( + radioButtons("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), + )) + + # run hector using inputs + browser() + r6$i <- reactive({input$run_number}) + print("Running...") # in command line + core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) + run(core()) + #browser() + 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 + r6$save <- TRUE + } + if (input$savetoggle == FALSE) { + r6$ini_file <- reactive({system.file(input$ssp_path,package="hector")}) + r6$start <- reactive({input$start}) + r6$end <- reactive({input$end}) + + print("Running...") # in command line + core <- reactive({newcore(r6$ini_file(),name=input$core_name)}) + run(core()) + + r6$no_save <- fetchvars(core(),r6$start():r6$end()) + print("Done") + r6$save <- FALSE + } + }) %>% + bindEvent(input$run) }) } \ No newline at end of file diff --git a/h2/components/modules/mod_summary.r b/h2/components/modules/mod_summary.r index 7f663ff..efd5ac6 100644 --- a/h2/components/modules/mod_summary.r +++ b/h2/components/modules/mod_summary.r @@ -12,9 +12,14 @@ summary_ui <- function(id) { summary_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { observe({ - #browser() - hectoroutput <- r6$output[[r6$i()]] - output$summary <- renderDT({datatable(hectoroutput,editable=TRUE)}) + if (r6$save == TRUE) { + hectoroutput <- r6$output[[r6$i()]] + output$summary <- renderDT({datatable(hectoroutput)}) + } + if (r6$save == FALSE) { + hectoroutput <- r6$no_save + output$summary <- renderDT({datatable(hectoroutput)}) + } }) %>% bindEvent(input$print) # run when Print button is clicked diff --git a/h2/global.r b/h2/global.r index 1a0a5a6..bb5067b 100644 --- a/h2/global.r +++ b/h2/global.r @@ -5,7 +5,7 @@ library(dplyr) library(ggplot2) library(shinycssloaders) library(plotly) -library(shinyalert) # don't need if we have shinyWidgets? +#library(shinyalert) # don't need if we have shinyWidgets? library(DT) library(shinyWidgets) @@ -22,7 +22,9 @@ HectorInputs <- R6Class( start = NA, end = NA, output = NULL, + no_save = NULL, i = NA, + save = NULL, initialize = function(ini_file = system.file("input/hector_ssp245.ini", package = "hector"), start = 2000, @@ -31,7 +33,9 @@ HectorInputs <- R6Class( self$start <- start self$end <- end self$output <- list() + #self$no_save <- NULL self$i <- 1 + #self$savetoggle <- FALSE stopifnot(end > start) #gotta have the start year before the end year } )