Skip to content

Commit

Permalink
175 add prompt to save table when switching tabs (#189)
Browse files Browse the repository at this point in the history 
* fix indentation in run policy server script

* added alert when switching tabs, but need to add functions to the Yes button when selected

* updated alert to save data and added an observeEvent to save or not save based on user input

* integrated the save table observe events but need to figure out how to handle each trigger separately

* logic for saving from btn vs changing tabs should be correct but need a bit more testing

* logic for saving data to fishset database looks good, still need to check when changes are automatically saved when certain functions are called

* remove test output code and update notification when data not saved

* don't use regular save prompt for define alternatives tab

* complete the save table prompt

* fix code formatting

* don't show save popup for exp catch, model, and policy tabs because nothing in there changes the primary data table
  • Loading branch information
@Paul-Carvalho
Paul-Carvalho authored Jan 8, 2025
1 parent acf2661 commit f5d2d8e
Show file tree
Hide file tree
Showing 2 changed files with 182 additions and 156 deletions.
268 changes: 134 additions & 134 deletions inst/ShinyFiles/MainApp/run_policy_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,12 @@ pred_plotsServer <- function(id, project, spatdat, values){
req(project)

checkboxGroupInput(
inputId = ns("run_pol_chk_scen"),
label = "Select closure scenario(s):",
choices = c(close_names(project)),
inline = TRUE
)
inputId = ns("run_pol_chk_scen"),
label = "Select closure scenario(s):",
choices = c(close_names(project)),
inline = TRUE
)

})

output$pol_prim_cat <- renderUI({
Expand All @@ -54,36 +54,36 @@ pred_plotsServer <- function(id, project, spatdat, values){
if((model_design_list(project)[[which(lapply(model_design_list(project=project), "[[", "mod.name")
== input$select_pol_mod)]]$likelihood %in% c("logit_c", "logit_zonal"))){
tagList(
selectInput(ns("select_marg_inc"),'Marginal utility of income coefficient',
choices = row.names(model_out_view(project)[[which(lapply(model_out_view(project), "[[", "name")
== input$select_pol_mod)]]$OutLogit)),

add_prompter(
selectInput(ns("income_cost_pol"), "Income Cost",
choices = c("TRUE", "FALSE")),
position = "bottom", type='info', size='medium',
message = "For conditional and zonal logit models. Logical indicating whether the coefficient
selectInput(ns("select_marg_inc"),'Marginal utility of income coefficient',
choices = row.names(model_out_view(project)[[which(lapply(model_out_view(project), "[[", "name")
== input$select_pol_mod)]]$OutLogit)),
add_prompter(
selectInput(ns("income_cost_pol"), "Income Cost",
choices = c("TRUE", "FALSE")),
position = "bottom", type='info', size='medium',
message = "For conditional and zonal logit models. Logical indicating whether the coefficient
for the marginal utility of income relates to cost (TRUE) or revenue (FALSE).")
)

} else{
return()
}

})

pol <- reactiveValues(outputs_welf = NULL)


observeEvent(input$run_policy_button,{
pol <- reactiveValues(outputs_welf = NULL)
observeEvent(input$run_policy_button,{
req(project)
req(input$select_pol_mod)
req(input$run_pol_chk_scen)
req(input$pol_betadraws)
req(input$select_marg_inc)
req(input$income_cost_pol)
req(input$pol_prim_sel_cat)

pol$outputs_welf <- run_policy(project,
mod.name = isolate(input$select_pol_mod),
policy.name = c(input$run_pol_chk_scen),
Expand All @@ -98,117 +98,117 @@ pred_plotsServer <- function(id, project, spatdat, values){
scaler.func = NULL)


if(pol$outputs_welf[[2]] <0)
shinyWidgets::show_alert(
title = NULL,
text = paste0("Marginal utility of income is negative. Check model coefficient (estimate and standard error) and select appropriate marginal utility of income."),
type = "error",
btn_colors = "#2A90A1",
closeOnClickOutside = TRUE,
width = "50%"
)
})
if(pol$outputs_welf[[2]] < 0)
shinyWidgets::show_alert(
title = NULL,
text = paste0("Marginal utility of income is negative. Check model coefficient (estimate and standard error) and select appropriate marginal utility of income."),
type = "error",
btn_colors = "#2A90A1",
closeOnClickOutside = TRUE,
width = "50%"
)
})

output$welfare_plot_dol <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[1]]

})

output$welfare_plot_prc <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[2]]

})

output$welfare_tbl_dol <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[3]]

})

output$welfare_tbl_prc <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[4]]
})

output$welfare_tbl_details <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[5]]
})


output$pred_prob_tbl <- DT::renderDataTable({
req(project)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))
output$welfare_plot_dol <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[1]]

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod), output_option = "table")
})
})

output$welfare_plot_prc <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)

output$pred_prod_mod_fig <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[2]]

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod), output_option = "model_fig")

})
})

output$welfare_tbl_dol <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

output$pred_prod_pol_fig <- plotly::renderPlotly({
req(project)
req(input$pol_prim_sel_cat)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[3]]

})

output$welfare_tbl_prc <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[4]]
})

output$welfare_tbl_details <- DT::renderDataTable({
req(project)
req(input$run_policy_button)

if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pol$outputs_welf[[1]][[5]]
})


output$pred_prob_tbl <- DT::renderDataTable({
req(project)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))


if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod), output_option = "table")
})

output$pred_prod_mod_fig <- plotly::renderPlotly({
req(project)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))


if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod), output_option = "model_fig")

})

output$pred_prod_pol_fig <- plotly::renderPlotly({
req(project)
req(input$pol_prim_sel_cat)
req(input$run_policy_button)
req(isTruthy(pol$outputs_welf))


if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod),
policy.name = c(input$run_pol_chk_scen),
output_option = "policy_fig")

})

output$pol_mod_diff_tbl <- function() {
req(project)
req(input$run_policy_button)
req(input$pol_prim_sel_cat)
req(input$run_pol_chk_scen)
req(isTruthy(pol$outputs_welf))



if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod),
zone.dat = input$pol_prim_sel_cat,
policy.name = c(input$run_pol_chk_scen),
output_option = "diff_table")


}
if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod),
policy.name = c(input$run_pol_chk_scen),
output_option = "policy_fig")

})

output$pol_mod_diff_tbl <- function() {
req(project)
req(input$run_policy_button)
req(input$pol_prim_sel_cat)
req(input$run_pol_chk_scen)
req(isTruthy(pol$outputs_welf))



if(is.null(pol$outputs_welf) | pol$outputs_welf[[2]] <0) return()
pred_prob_outputs(project, mod.name = isolate(input$select_pol_mod),
zone.dat = input$pol_prim_sel_cat,
policy.name = c(input$run_pol_chk_scen),
output_option = "diff_table")


}
)
}
}
)
}



Expand Down Expand Up @@ -246,17 +246,17 @@ pred_mapServer <- function(id, project, spatdat){
req(input$pred_map_sel_cat)

if(input$pred_pol_name == "no closure"){
v$plot <- predict_map(project, mod.name = isolate(input$select_pol_mod),
policy.name = isolate(input$select_pol_mod),
spat = spatdat, zone.spat = input$pred_map_sel_cat)

} else {

v$plot <- predict_map(project, mod.name = isolate(input$select_pol_mod),
policy.name = paste0(isolate(input$select_pol_mod), " ",input$pred_pol_name),
spat = spatdat, zone.spat = input$pred_map_sel_cat)
}
})
v$plot <- predict_map(project, mod.name = isolate(input$select_pol_mod),
policy.name = isolate(input$select_pol_mod),
spat = spatdat, zone.spat = input$pred_map_sel_cat)
} else {
v$plot <- predict_map(project, mod.name = isolate(input$select_pol_mod),
policy.name = paste0(isolate(input$select_pol_mod), " ",input$pred_pol_name),
spat = spatdat, zone.spat = input$pred_map_sel_cat)
}
})

output$predict_map <- leaflet::renderLeaflet({
req(input$run_pred_map)
Expand Down
Loading

0 comments on commit f5d2d8e

Please sign in to comment.