From f5d2d8ebaaf724e9f52e0bbc4e6b29a8a51f9744 Mon Sep 17 00:00:00 2001 From: Paul Carvalho <143020124+Paul-Carvalho@users.noreply.github.com> Date: Wed, 8 Jan 2025 08:49:03 -0800 Subject: [PATCH] 175 add prompt to save table when switching tabs (#189) * 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 --- inst/ShinyFiles/MainApp/run_policy_server.R | 268 ++++++++++---------- inst/ShinyFiles/MainApp/server.R | 70 +++-- 2 files changed, 182 insertions(+), 156 deletions(-) diff --git a/inst/ShinyFiles/MainApp/run_policy_server.R b/inst/ShinyFiles/MainApp/run_policy_server.R index c77737a2..b4918703 100644 --- a/inst/ShinyFiles/MainApp/run_policy_server.R +++ b/inst/ShinyFiles/MainApp/run_policy_server.R @@ -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({ @@ -54,28 +54,28 @@ 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) @@ -83,7 +83,7 @@ pred_plotsServer <- function(id, project, spatdat, values){ 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), @@ -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") + + } - ) - } + } + ) +} @@ -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) diff --git a/inst/ShinyFiles/MainApp/server.R b/inst/ShinyFiles/MainApp/server.R index a01851cf..3f2e5dcd 100644 --- a/inst/ShinyFiles/MainApp/server.R +++ b/inst/ShinyFiles/MainApp/server.R @@ -321,18 +321,26 @@ server = function(input, output, session) { }, ignoreInit = TRUE, ignoreNULL=TRUE) - #Track Times tab selected - # vars<-reactiveValues() - # vars = reactiveValues(counter = 0) - # observe({ - # input$tabs - # if(input$tabs == 'upload'){ - # isolate({ - # vars$counter <- vars$counter + 1 - # }) - # } - # }) + # Track tabs selected and prompt user to save data, or not, when changing tabs + tab_tracker <- reactiveValues( + previous = "Background" + ) + observeEvent(input$tabs, { + if(!(tab_tracker$previous %in% c("Background", "Upload Data", "Map Viewer", "Bookmark Choices", + "Define Alternative Fishing Choices", "Expected Catch/Revenue", + "Models", "Zone Closure", "Run Policy"))){ + shinyWidgets::confirmSweetAlert( + inputId = "changeTabSave", + text = paste0("Would you like to save changes to your project database before moving on to the next tab?"), + type = "question", + btn_labels = c("No", "Yes"), + btn_colors = c("#AACDE5", "#274472"), + width = "50%" + )} + + tab_tracker$previous <- input$tabs + }) # --- # INFORMATION ---- @@ -7330,21 +7338,39 @@ server = function(input, output, session) { } }) - observeEvent(input$saveData, { - - req(project$name) - - q_test <- quietly_test(table_save) - saved <- q_test(values$dataset, project = project$name, type = "main") - - if (is.logical(saved) && saved) { + track_save <- reactiveValues( + saveData = 0, + changeTabSave = NULL + ) + + observeEvent(c(input$saveData, input$changeTabSave), { + if(is.null(input$changeTabSave) && input$saveData == track_save$saveData){ + # Don't save because user did not actually trigger the event. + # DO NOT DELETE IF STATEMENT: This if statement is needed to catch null values for input$changeTabSave - showNotification('Data saved to FishSET database', type = 'message', duration = 60) + } else if(input$saveData == track_save$saveData && !(input$changeTabSave)){ + # Notify user that changes were not saved and will be deleted from the session + showNotification("Changes not saved to the project database will be deleted after closing this session of FishSET", + type = "warning", + duration = 60) - } else { + } else if((input$saveData > track_save$saveData) || input$changeTabSave){ + # Save data + req(project$name) - showNotification("Table was not saved", type = "error", duration = 60) + q_test <- quietly_test(table_save) + saved <- q_test(values$dataset, project = project$name, type = "main") + + if (is.logical(saved) && saved) { + showNotification('Data saved to FishSET database', type = 'message', duration = 60) + + } else { + showNotification("Table was not saved", type = "error", duration = 60) + } } + + # Update input value + track_save$saveData <- input$saveData }) observeEvent(input$saveDataNewVars, {