From 55790c2de86a3315f11c5bd3f8db1c35fc27cf3d Mon Sep 17 00:00:00 2001 From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com> Date: Wed, 13 Sep 2023 16:52:31 -0400 Subject: [PATCH] Download button update Now lets you download runs of different sizes. Fixed summary updating automatically without "Print" button being clicked --- h2/app.r | 61 +++++++++++------------- h2/components/modules/mod_download.R | 6 +-- h2/components/modules/mod_graph.R | 36 ++++++++------ h2/components/modules/mod_run.R | 71 +++++++++++++++++++--------- h2/components/modules/mod_summary.r | 12 +++-- h2/global.r | 9 ++-- 6 files changed, 112 insertions(+), 83 deletions(-) diff --git a/h2/app.r b/h2/app.r index e01ff18..abe6f90 100644 --- a/h2/app.r +++ b/h2/app.r @@ -1,43 +1,38 @@ source("./global.r") ui <- fluidPage( - includeCSS("./components/layout/style copy.css"), - navbarPage(id = "nav", title = "", collapsible = TRUE, - tabPanel(title = "Home", - includeHTML("./components/layout/homepage.html") - ), - tabPanel(title = "Guides", - ), - tabPanel(title = "Explore Hector", - fluidRow( - column(2, - wellPanel( - run_ui("run_1"), - download_ui("download_1") - ) - ), - column(4, - summary_ui("summary_1") - ), - column(4, - graph_ui("graph_1") - ) - ) - ), - tabPanel(title = "About" - ) - ), + includeCSS("./components/layout/style copy.css"), + navbarPage( + id = "nav", + title = "", + collapsible = TRUE, + tabPanel(title = "Home", + includeHTML("./components/layout/homepage.html")), + tabPanel(title = "Guides",), + tabPanel(title = "Explore Hector", + fluidRow( + column(2, + wellPanel( + run_ui("run_1"), + download_ui("download_1") + )), + column(4, + summary_ui("summary_1")), + column(4, + graph_ui("graph_1")) + )), + tabPanel(title = "About") + ), ) server <- function(input, output, session) { + r6 <- HectorInputs$new() # r6 class + i <- reactiveVal(1) # set up pseudo loop - 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) - graph_server("graph_1", r6=r6, i=i) - download_server("download_1", r6=r6) + run_server("run_1", r6 = r6, i = i) + summary_server("summary_1", r6 = r6, i = i) + graph_server("graph_1", r6 = r6, i = i) + download_server("download_1", r6 = r6) } # Run the application diff --git a/h2/components/modules/mod_download.R b/h2/components/modules/mod_download.R index 4363ced..a59bf56 100644 --- a/h2/components/modules/mod_download.R +++ b/h2/components/modules/mod_download.R @@ -3,9 +3,7 @@ download_ui <- function(id) { ns <- NS(id) - tagList( - downloadButton(ns("download"), "Download Outputs") - ) + tagList(downloadButton(ns("download"), "Download Outputs")) } download_server <- function(id, r6) { @@ -13,7 +11,7 @@ download_server <- function(id, r6) { output$download <- downloadHandler( filename = "hectorUI_output.csv", content = function(file) { - write.csv(r6$output,file) + write.csv(bind_rows(r6$output), file) } ) diff --git a/h2/components/modules/mod_graph.R b/h2/components/modules/mod_graph.R index f5b9705..235d0b7 100644 --- a/h2/components/modules/mod_graph.R +++ b/h2/components/modules/mod_graph.R @@ -5,27 +5,33 @@ graph_ui <- function(id) { ns <- NS(id) - fluidRow( - actionButton(ns("plot"),"Plot"), - plotlyOutput(ns("graph")) - ) + fluidRow(actionButton(ns("plot"), "Plot"), + plotlyOutput(ns("graph"))) } 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 + filtered_output <- + filter(r6$output[[i() - 1]], variable == "CO2_concentration") #i increases at end of mod_run so output is i-1 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="CO2 Concentration (ppmv)"), - title = "CO2 Concentration") + 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 = "CO2 Concentration (ppmv)"), + title = "CO2 Concentration" + ) }) }) %>% bindEvent(input$plot) diff --git a/h2/components/modules/mod_run.R b/h2/components/modules/mod_run.R index 4fe0371..60a2e7c 100644 --- a/h2/components/modules/mod_run.R +++ b/h2/components/modules/mod_run.R @@ -4,44 +4,71 @@ run_ui <- function(id) { ns <- NS(id) tagList( - 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", - "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_ssp119.ini"), - sliderInput(ns("start"), label="Select start date:", - 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"), + 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", + "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_ssp119.ini" + ), + sliderInput( + ns("start"), + label = "Select start date:", + 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")) ) } 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$ini_file <- + reactive({ + system.file(input$ssp_path, package = "hector") + }) + r6$start <- reactive({ + input$start + }) + r6$end <- reactive({ + input$end + }) # 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()) - output$done <- renderPrint({as.character(i()-1)}) #print run number + r6$output[[i()]] <- + fetchvars(core, r6$start():r6$end()) %>% mutate(run = i()) + output$done <- + renderPrint({ + as.character(i() - 1) + }) #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(r6$output) #print(i()) }) %>% bindEvent(input$run) # triggers when "Run Model" is clicked diff --git a/h2/components/modules/mod_summary.r b/h2/components/modules/mod_summary.r index ccde439..eb7c35a 100644 --- a/h2/components/modules/mod_summary.r +++ b/h2/components/modules/mod_summary.r @@ -5,16 +5,18 @@ summary_ui <- function(id) { ns <- NS(id) - fluidRow( - actionButton(ns("print"),"Print"), - tableOutput(ns("summary")) - ) + fluidRow(actionButton(ns("print"), "Print"), + tableOutput(ns("summary"))) } summary_server <- function(id, r6, i) { moduleServer(id, function(input, output, session) { observe({ - output$summary <- renderTable({r6$output[[i()-1]]}) #i increases at end of mod_run so output is i-1 + hectoroutput <- + r6$output[[i() - 1]] #i increases at end of mod_run so output is i-1 + output$summary <- renderTable({ + hectoroutput + }) }) %>% bindEvent(input$print) # run when Print button is clicked diff --git a/h2/global.r b/h2/global.r index 2a4f143..48d0968 100644 --- a/h2/global.r +++ b/h2/global.r @@ -19,14 +19,15 @@ HectorInputs <- R6Class( start = NA, end = NA, output = NULL, - initialize = function(ini_file=system.file("input/hector_ssp245.ini", - package="hector"), - start=2000,end=2300) { + initialize = function(ini_file = system.file("input/hector_ssp245.ini", + package = "hector"), + start = 2000, + end = 2300) { self$ini_file <- ini_file self$start <- start self$end <- end self$output <- list() - stopifnot(end>start) #gotta have the start year before the end year + stopifnot(end > start) #gotta have the start year before the end year } ) ) \ No newline at end of file