Skip to content

Commit

Permalink
Added toggle switch
Browse files Browse the repository at this point in the history 
Added toggle to run without saving or save to one of 8 slots. Saving currently doesn't work (issue with popup)
  • Loading branch information
@ciara-donegan
ciara-donegan committed Oct 4, 2023
1 parent eaa89fb commit c8e42af
Show file tree
Hide file tree
Showing 4 changed files with 161 additions and 77 deletions.
71 changes: 48 additions & 23 deletions h2/components/modules/mod_graph.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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(
"<b>Year:</b> %{x}<br>",
"<b>Value:</b> %{y:.2f}",
"<extra></extra>"
)
) %>%
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(
"<b>Year:</b> %{x}<br>",
"<b>Value:</b> %{y:.2f}",
"<extra></extra>"
)
) %>%
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(
"<b>Year:</b> %{x}<br>",
"<b>Value:</b> %{y:.2f}",
"<extra></extra>"
)
) %>%
layout(
xaxis = list(title = "Year"),
yaxis = list(title = "Global Temperature (C)"),
title = "Global Temperature at Surface"
)
})
}
}) %>%
bindEvent(input$plot)
})
Expand Down
150 changes: 100 additions & 50 deletions h2/components/modules/mod_run.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")
)
Expand All @@ -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)
})
}
11 changes: 8 additions & 3 deletions h2/components/modules/mod_summary.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
6 changes: 5 additions & 1 deletion h2/global.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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,
Expand All @@ -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
}
)
Expand Down

0 comments on commit c8e42af

Please sign in to comment.