From bbcf0015825538fd6b5365c0115418f7c10873d6 Mon Sep 17 00:00:00 2001
From: Ciara Donegan <82416895+ciara-donegan@users.noreply.github.com>
Date: Thu, 7 Sep 2023 11:05:53 -0400
Subject: [PATCH] Added download button
Can download csv with output from multiple runs. Currently only works if dataframes are same length (so year range isn't changed)
---
h2/app.r | 24 ++++++++++--------------
h2/components/modules/mod_download.R | 21 +++++++++++++++++++++
h2/components/modules/mod_graph.R | 26 +++++++++++++++-----------
h2/components/modules/mod_run.R | 12 ++++++++----
h2/components/modules/mod_summary.r | 4 ++--
h2/global.r | 5 ++++-
6 files changed, 60 insertions(+), 32 deletions(-)
create mode 100644 h2/components/modules/mod_download.R
diff --git a/h2/app.r b/h2/app.r
index d0678cb..e01ff18 100644
--- a/h2/app.r
+++ b/h2/app.r
@@ -9,17 +9,11 @@ ui <- fluidPage(
tabPanel(title = "Guides",
),
tabPanel(title = "Explore Hector",
- # sidebarPanel(
- # run_ui("run_1"), # buttons and sliders
- # width = 4
- # ),
- # h4("Summary"),
- # summary_ui("summary_1"), # print summary
- # graph_ui("graph_1") # plot
fluidRow(
- column(4,
+ column(2,
wellPanel(
- run_ui("run_1")
+ run_ui("run_1"),
+ download_ui("download_1")
)
),
column(4,
@@ -37,12 +31,14 @@ ui <- fluidPage(
server <- function(input, output, session) {
- r6 <- HectorInputs$new()
+ r6 <- HectorInputs$new() # r6 class
+ i <- reactiveVal(1) # set up pseudo loop
- run_server("run_1", r6=r6)
- summary_server("summary_1", r6=r6)
- graph_server("graph_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
-shinyApp(ui = ui, server = server)
+shinyApp(ui = ui, server = server)
\ No newline at end of file
diff --git a/h2/components/modules/mod_download.R b/h2/components/modules/mod_download.R
new file mode 100644
index 0000000..4363ced
--- /dev/null
+++ b/h2/components/modules/mod_download.R
@@ -0,0 +1,21 @@
+# Download outputs as a csv file
+
+download_ui <- function(id) {
+ ns <- NS(id)
+
+ tagList(
+ downloadButton(ns("download"), "Download Outputs")
+ )
+}
+
+download_server <- function(id, r6) {
+ moduleServer(id, function(input, output, session) {
+ output$download <- downloadHandler(
+ filename = "hectorUI_output.csv",
+ content = function(file) {
+ write.csv(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 d6a3972..f5b9705 100644
--- a/h2/components/modules/mod_graph.R
+++ b/h2/components/modules/mod_graph.R
@@ -7,23 +7,27 @@ graph_ui <- function(id) {
ns <- NS(id)
fluidRow(
actionButton(ns("plot"),"Plot"),
- plotOutput(ns("graph"))
+ plotlyOutput(ns("graph"))
)
}
-graph_server <- function(id,r6) {
+graph_server <- function(id, r6, i) {
moduleServer(id, function(input, output, session) {
observe({
- #filtered_output <- filter(r6$output,variable=="RF_tot")
- output$graph <- renderPlot({
- ggplot(r6$output) +
- aes(x = year, y = value) +
- geom_line() +
- facet_wrap(~variable, scales = "free_y")
+ 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")
})
}) %>%
bindEvent(input$plot)
})
-}
-
-
+}
\ No newline at end of file
diff --git a/h2/components/modules/mod_run.R b/h2/components/modules/mod_run.R
index 6e6ff11..4fe0371 100644
--- a/h2/components/modules/mod_run.R
+++ b/h2/components/modules/mod_run.R
@@ -23,8 +23,9 @@ run_ui <- function(id) {
)
}
-run_server <- function(id, r6) {
+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")})
@@ -32,13 +33,16 @@ run_server <- function(id, r6) {
r6$end <- reactive({input$end})
# run hector using inputs
- #output$done <- renderPrint({"Running..."}) # how to show this, then be replaced by "Done" ?
print("Running...") # in command line
core <- newcore(r6$ini_file())
run(core)
- r6$output <- fetchvars(core,r6$start():r6$end())
- output$done <- renderPrint({"Done"})
+ r6$output[[i()]] <- fetchvars(core,r6$start():r6$end())
+ 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(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 cb64216..ccde439 100644
--- a/h2/components/modules/mod_summary.r
+++ b/h2/components/modules/mod_summary.r
@@ -11,10 +11,10 @@ summary_ui <- function(id) {
)
}
-summary_server <- function(id,r6) {
+summary_server <- function(id, r6, i) {
moduleServer(id, function(input, output, session) {
observe({
- output$summary <- renderTable({r6$output})
+ output$summary <- renderTable({r6$output[[i()-1]]}) #i increases at end of mod_run so output is i-1
}) %>%
bindEvent(input$print) # run when Print button is clicked
diff --git a/h2/global.r b/h2/global.r
index a113ad1..2a4f143 100644
--- a/h2/global.r
+++ b/h2/global.r
@@ -4,10 +4,12 @@ library(hector)
library(dplyr)
library(ggplot2)
library(shinycssloaders)
+library(plotly)
source("./components/modules/mod_graph.r")
source("./components/modules/mod_run.r")
source("./components/modules/mod_summary.r")
+source("./components/modules/mod_download.r")
# Define R6 class
HectorInputs <- R6Class(
@@ -23,7 +25,8 @@ HectorInputs <- R6Class(
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
}
)
-)
+)
\ No newline at end of file