diff --git a/app.R b/app.R index 9193427d36ec2db7966f2e84970fce572ce4a13b..dbe08b25fc546f465cc55b839ee2d3db2fb1db25 100644 --- a/app.R +++ b/app.R @@ -31,8 +31,6 @@ package.check <- lapply( ) devtools::load_all(".") -#library(peakfq) - ### Data structure set up ###################################################### @@ -44,18 +42,18 @@ psf_int_init <<- data.frame(matrix(ncol = 6, nrow = 0, dimnames = list(NULL, c(" psf_peaks_init <<- data.frame(matrix(ncol = 5, nrow = 0, dimnames = list(NULL, c("site_no", "label", "peak_WY", "peak_va", "comment")))) # Dataframes for RHOT tables -#Station specifications table (tab 1) - based on psf_opt -station_specs_df_init <<- data.frame(matrix(ncol = 14, dimnames = list(NULL, c("site_no", "BegYear", "EndYear", "HistPeriod", - "SkewOpt", "MapSkew", "GenSkew", "SkewSE", - "MeanSqErr", "LOType", "LoThresh", "Urb/Reg", - "Latitude", "Longitude"))), check.names = FALSE) -#Perceptible ranges table (tab 2, table 1) - based on psf_thresh -perc_ranges_df_init <<- data.frame(matrix(ncol = 6, nrow = 0, dimnames = list(NULL, c("site_no", "start", "end", "min", "max", "comment")))) - -#Data flow intervals table (tab 2, table 2) - based on psf_int -data_flow_int_df_init <<- data.frame(matrix(ncol = 7, nrow = 0, dimnames = list(NULL, c("site_no", "peak_WY", "peak_va", "remark_cd", - - "interval_low", "interval_up", "comment" )))) + + #Station specifications table (tab 1) - based on psf_opt + station_specs_df_init <<- data.frame(matrix(ncol = 14, dimnames = list(NULL, c("site_no", "BegYear", "EndYear", "HistPeriod", + "SkewOpt", "MapSkew", "GenSkew", "SkewSE", + "MeanSqErr", "LOType", "LoThresh", "Urb/Reg", + "Latitude", "Longitude"))), check.names = FALSE) + #Perceptible ranges table (tab 2, table 1) - based on psf_thresh + perc_ranges_df_init <<- data.frame(matrix(ncol = 6, nrow = 0, dimnames = list(NULL, c("site_no", "start", "end", "min", "max", "comment")))) + + #Data flow intervals table (tab 2, table 2) - based on psf_int + data_flow_int_df_init <<- data.frame(matrix(ncol = 7, nrow = 0, dimnames = list(NULL, c("site_no", "peak_WY", "peak_va", "remark_cd", + "interval_low", "interval_up", "comment" )))) # Blank site_info data.frame site_info_init <<- data.frame(matrix(ncol = 3, nrow = 0, dimnames = list(NULL, c("site_no", "Latitude", "Longitude")))) @@ -66,6 +64,7 @@ stations <- c() track_log <<- data.frame(matrix(nrow = 0, ncol = 1)) error_count <<- 0 +# Directories input_directory <<- NULL output_directory <<- NULL @@ -74,13 +73,11 @@ output_directory <<- NULL ui <- fluidPage( - #set the theme - theme = shinytheme("flatly"), - - #Shinyjs allows for toggled diplay of tabs - useShinyjs(), + #UI controls & set up ----- + theme = shinytheme("flatly"),#set the theme + useShinyjs(), #Shinyjs allows for toggled display of "TEST" tab - # App title & description + #App title block ----- fluidRow( style='color: white; background-color: black; padding: 10px; ', div(style='display: inline-block; color:white; text-align: center; vertical-align: center; margin: 2px; padding: 10px; float: left;', @@ -91,20 +88,26 @@ ui <- fluidPage( div(style='display: inline-block; color:white; text-align: center; vertical-align: center; margin: 0px;padding: 0px; float: left; margin-left:10px', h3("PeakFQ")), - ), #end title panel + ), + #App description block ----- fluidRow( style = 'background-color: #f5f5f5; border: 2px solid #e6ebf0; padding: 12px;', h4("Input peak flow data on the first tab."), h4("Update Station, Threshold, and Output specifications as desired."), h4("Click 'Run PeakFQ' button to generate results.") - ), #end description fluid row + ), fluidRow(br()), #whitespace before tabset panels + #Tabs for app navigation ----- tabsetPanel(type = "tabs", id = "navbar", + + #Tab 1: Station Specifications ----- tabPanel("Station & Output Specifications", + + #Data inputs block fluidRow( style = 'background-color: #e6ebf0; border: 2px solid #e6ebf0; border-radius: 5px; margin: 10px; padding: 10px;', # Get Peak Flow Data (pfd) input - input updates based on upload/input selection @@ -115,13 +118,17 @@ ui <- fluidPage( "Upload folder" = "input_folder")), hr(style = "border-top: 1px solid #525252;" ), #horizontal line for visual hierarchy uiOutput("pfd_input"), #Input type will depend on user-selected method - ), #end fluidRow - br(), #add some whitespace + ), + + br(), + + #Editable station specifications table fluidRow(style = 'height: 200px; padding: 2 px;', column(10, offset = 1, rHandsontableOutput("station_specs_rhot"))), + + #Output file specification block fluidRow( - #! GET RID OF GAP HERE style = 'border: 3px solid; border-color: rgba(255,255,255,0); border-radius: 10px; margin: 20px;' ), fluidRow( @@ -134,57 +141,76 @@ ui <- fluidPage( br(), tags$div(id = "inline", textInput(inputId = "input_base_file_name", label = "Base file name: ")) ), - fluidRow( - style = 'border: 3px solid lightgrey; border-radius: 10px; margin: 20px; padding: 20px;', - - tags$div(id = "inline", selectInput("input_plot_format", "Graphic Plot Format:", #!MODIFY WIDTH - c("None" = "None", - "PNG" = "PNG", - "JPEG" = "JPEG", - "SVG" = "SVG"), - #width = '400px' #not functioning - )), - br(), - tags$div(id = "inline", textInput(inputId = "input_plotPos", label = "Plotting Position: ", value = 0, placeholder = "Min 0, Max: 0.5")), - # checkboxInput("checkbox_print_Plot_Pos", "Print Plotting Positions", FALSE), - br(), - tags$div(id = "inline", textInput(inputId = "input_sym_conf", label = "Symmetric Confidence Interval: ", value=0.9, placeholder = "Min 0.5, Max: 1.0")), - textOutput("conf_limit"), - br(), - checkboxInput("checkbox_extend", "Extend Analysis", FALSE) - ) - ),#end first tab panel + + #Output format specification block + fluidRow( + style = 'border: 3px solid lightgrey; border-radius: 10px; margin: 20px; padding: 20px;', + + tags$div(id = "inline", selectInput("input_plot_format", "Graphic Plot Format:", #!MODIFY WIDTH + c("None" = "None", + "PNG" = "PNG", + "JPEG" = "JPEG", + "SVG" = "SVG"), + )), + br(), + tags$div(id = "inline", textInput(inputId = "input_plotPos", label = "Plotting Position: ", value = 0, placeholder = "Min 0, Max: 0.5")), + br(), + tags$div(id = "inline", textInput(inputId = "input_sym_conf", label = "Symmetric Confidence Interval: ", value=0.9, placeholder = "Min 0.5, Max: 1.0")), + textOutput("conf_limit"), + br(), + checkboxInput("checkbox_extend", "Extend Analysis", FALSE) + ) + ), + + #Tab 2: Input/View ----- tabPanel("Input/View", br(), + + #Drop down to select station selectInput("station", "Station:", choices = stations), + fluidRow( - column(5, #column for table inputs + + #Inputs column + column(5, + + #Editable perceptible ranges table "Perceptible Ranges", rHandsontableOutput("perc_ranges_rhot"), hr(style = "border-top: 1px solid #b5b5b5;"), #horizontal line for visual hierarchy + #Editable data/flow intervals table "Data/Flow Intervals", rHandsontableOutput("data_flow_int_rhot") ), - column(7, #column for graphic + + #Peak Plot Display column + column(7, + #Peak plot display plotOutput("peak_plot"), + + #Axes rescale fluidRow(height = "100%", column(9), column(3, actionButton("plot_axes_button", label = "Log axes"))) #Original has a button that converts between log/normal ) ), + br(), + + #Link to explanation of peak flow codes a(href="https://nwis.waterdata.usgs.gov/nwis/peak?help#flow_qual_cd", target="_blank", #open in new tab for browser users rel="noreferrer noopener", "Explanation of peak flow codes (link)") - ), #end second tab panel + ), + + #Tab 3: Results ----- tabPanel("Results", fluidRow( style = 'background-color: #f5f5f5; border: 2px solid #e6ebf0; border-radius: 5px; padding: 10px;', h5(htmlOutput("results_banner")), - # textOutput("run_errors") ), br(), h4(textOutput("ffa_header")), @@ -194,7 +220,9 @@ ui <- fluidPage( tableOutput("ema_frequency"), tableOutput("ema_rep"), tableOutput("ema_gb") - ), #End test view tab + ), + + #Tab 4: About ----- tabPanel("About", h3("Resources"), @@ -236,7 +264,9 @@ ui <- fluidPage( textOutput("run_errors") #Console to display errors generated after "Run PeakFQ" is clicked ) - ), #End "About" tab + ), + + #Tab 5: TEST (hidden unless debug_toggle == T) ----- tabPanel(title = "TEST", value = "test", "assignable text output:", @@ -253,23 +283,25 @@ ui <- fluidPage( tableOutput("psf_peaks"), "site_qt:", tableOutput("qt_df") - ) #End test view tab - + ) #end "TEST" tab ), #End tabset - # divider line, then 'Run PeakFQ' button, visible from any tab - hr(style = F ), #horizontal line for visual hierarchy - fluidRow(column(width = 4, offset = 9, - actionButton("SavePSF", label = "Save Specifications"), - actionButton("RunPeakFQ", label = "Run PeakFQ"))), - fluidRow(column(4, offset = 9, - htmlOutput("psf_ready"), - htmlOutput("results_ready"))), - br(), br() - - -) #End fluid page + #App-wide controls (visible from any tab) ----- + hr(style = F), + + #'Save Specifications' and 'Run PeakFQ' buttons + fluidRow(column(width = 4, offset = 9, + actionButton("SavePSF", label = "Save Specifications"), + actionButton("RunPeakFQ", label = "Run PeakFQ"))), + + #Output text (hidden until buttons trigger display) + fluidRow(column(4, offset = 9, + htmlOutput("psf_ready"), + htmlOutput("results_ready"))), + br(), br() +) #End fluid page & UI definition +#----- ############################ DEFINE APP SERVER ################################# @@ -278,13 +310,13 @@ server <- shinyServer(function(input, output, session) { ####---------------------- Check if in 'Debug' mode-------------------------#### - #'TEST' tab only displays in debug mode. + #'TEST' tab only displays in debug mode.---- toggle(condition = debug_toggle, selector = "#navbar li a[data-value=test]") ####-------------------------- Initialization ------------------------------#### - #Establish reactive values + #Establish reactive values ---- rv <- reactiveValues(pf_data = data.frame(), psf_df = data.frame(), site_info = site_info_init, @@ -296,11 +328,9 @@ server <- shinyServer(function(input, output, session) { perc_ranges_df = perc_ranges_df_init, data_flow_int_df = data_flow_int_df_init) - #Perpetually observe & update the siteQT dataframe and the peak plot + #Perpetually observe & update the siteQT dataframe and the peak plot ---- qt_df <- reactive({ - all_siteQT(rv$pf_data, rv$psf_int, rv$psf_thresh, rv$psf_peaks, rv$psf_opt) - }) pk_plot <- reactive({ @@ -336,375 +366,31 @@ server <- shinyServer(function(input, output, session) { } }) - #Display tables for specification inputs, even without data or PSF upload. + #Display tables for specification inputs, even without data or PSF upload. ---- output$station_specs_rhot <- renderRHandsontable(config_station_spec_RHOT(rv$station_specs_df[0,])) output$perc_ranges_rhot <- renderRHandsontable(config_perc_ranges_RHOT(rv$perc_ranges_df[0,])) output$data_flow_int_rhot <- renderRHandsontable(config_data_flow_int_RHOT(rv$data_flow_int_df[0,])) - #Display peak plot on tab 2, even without data or PSF upload + #Display peak plot on tab 2, even without data or PSF upload ---- output$peak_plot <- renderPlot(pk_plot()) - # output$peak_plot <- renderPlot(pk_plot()) - - # Results tab + + #Results tab output text ---- output$results_banner <- renderText("Results will be displayed here after the PeakFQ analysis is run.") output$output_path <- renderText(paste0("<b>Output folder: </b>", "<em>(none selected)</em>")) - #CHECKS + #CHECKS for TEST tab ---- output$psf_opt <- renderTable(rv$psf_opt) output$psf_thresh <- renderTable(rv$psf_thresh) output$psf_int <- renderTable(rv$psf_int) output$psf_peaks <- renderTable(rv$psf_peaks) output$qt_df <- renderTable(qt_df()) - output$ema_list <- renderTable(ema_list()) - - output$table_test <- renderTable(rv$data_flow_int_df) - -####--------------- Save Specifications Button Observer -------------------##### - - - observeEvent(c(input$SavePSF, input$RunPeakFQ), priority = 10, { # when either Save Specification or Run PeakFQ buttons are clicked - - req(input$SavePSF + input$RunPeakFQ > 0) # prevent the code from triggering when the buttons are first added to the form; Require at least one button click before triggering - - output$psf_ready <- renderText("") #Clear out text if already run - - # Use basename specified by user - out_basename <- input$input_base_file_name - - output_psf_datapath <<- paste0(output_directory, "/", out_basename,".psf") - - output_nwis_peak_datapath <<- paste0(output_directory, "/", out_basename, "_nwis_peak.txt") - output_nwis_site_datapath <<- paste0(output_directory, "/", out_basename, "_nwis_site.txt") - - # Check that there are psf dataframes to save out - if no psf_opt, no data - alert. - if(nrow(rv$psf_opt) == 0){ - shinyalert(title = "No data loaded", - text = "Data must be loaded before a specification file can be saved. Please load data and try again.", - type = "error") - - } else if(str_length(out_basename) == 0){ - # Check that there is a basename specified for the output. If not, alert. - - shinyalert(title = "Enter a base file name", - text = "Please enter a base file name that should be used for output files.", - type = "warning") - - } else if (is.null(output_directory) | output_directory == ""){ - - #Check that there is an output folder specified. If not, alert. - shinyalert(title = "Select output folder", - text = "Please select a folder to which output files should be saved.", - type = "warning") - - } else { - - - - if(input$pfd_input_type == "input_tab") { - - # Tab-delimited and site info filepath to write into spec file (text file uploads only) - # txt_filename <- basename(parseFilePaths(volumes, input$btn_txt)$datapath) - # site_filename <- basename(parseFilePaths(volumes, input$btn_site)$datapath) - - # Providing site info file is optional - output_psf <- try(writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, txt_path), silent = TRUE) - output_psf <- try(writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, txt_path, site_path), silent = TRUE) - - output$psf_ready <- renderText("Spec file saved in designated output folder") - - } else if(input$pfd_input_type == "input_folder") { - - for (i in 1:nrow(rv$psf_opt)) { - - target_site <- rv$psf_opt$site_no[i] - - target_opt <- rv$psf_opt[rv$psf_opt$site_no == target_site,] - target_thresh <- rv$psf_thresh[rv$psf_thresh$site_no == target_site,] - target_int <- rv$psf_int[rv$psf_int$site_no == target_site,] - target_peaks <- rv$psf_peaks[rv$psf_peaks$site_no == target_site,] - - target_tab_file <- tab_file_list[i] - target_site_file <- site_file_list[i] - - output_psf_datapath <<- paste0(output_directory, "/", target_site,".psf") - - output_psf <- writePSF(target_opt, target_thresh, target_int, target_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, target_tab_file, target_site_file) - - output$psf_ready <- renderText("Spec file saved in designated output folder") - - } - - } else if(input$pfd_input_type == "input_nwis") { - - output_psf <- writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, tab_file = output_nwis_peak_datapath, site_file = output_nwis_site_datapath) - - write_NWIS_peak(unique(rv$pf_data$site_no), output_nwis_peak_datapath) - write_NWIS_site(unique(rv$pf_data$site_no), output_nwis_site_datapath) - output$psf_ready <- renderText("Spec file saved in designated output folder") - - } else{ - target_tab_file <- attributes(rv$psf_opt)$peakFile - target_site_file <- attributes(rv$psf_opt)$siteinfoFile - - output_psf <- writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, target_tab_file, target_site_file) - - } - - output$psf_ready <- renderText("Spec file saved in designated output folder") - } - }) # end SavePSF observeEvent - - -####----------------------- Run Button Observer ---------------------------##### - - observeEvent(input$RunPeakFQ, { #when button is clicked - - # Re-initialize Log file variables - track_log <<- data.frame(matrix(nrow = 0, ncol = 1)) - error_count <<- 0 - - output$results_ready <- renderText("") #Clear out message if re-run - output$run_errors <- renderText("") #Clear out message if re-run - - #Check that there are psf dataframes to save out - if no psf_opt, no data - alert. - if(nrow(rv$psf_opt) == 0){ - - # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. - # shinyalert(title = "No data loaded", - # text = "Data must be loaded before the analysis can be run. Please load data and try again.", - # type = "error") - - } else if (is.null(output_directory) | output_directory == ""){ - - # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. - - } else { - - - # Produce output files - - # Use basename specified by user - out_basename <- input$input_base_file_name - - #Alert if basename is missing - if (str_length(out_basename) == 0) { - - # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. - # shinyalert(title = "Enter a base file name", - # text = "Please enter a base file name that should be used for output files before running the analysis.", - # type = "warning") - - } else { - - if(input$pfd_input_type == "input_tab") { - - #Try to save other data files - output_data <- try(peakfq(output_psf_datapath), silent = TRUE) - - if(is(output_data, 'error')|is(output_data, 'try-error')){ - - shinyalert(title = "Error running PeakFQ", - text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), - html = TRUE, - type = "error") - - output$run_errors <- renderText(output_data[1]) #Update error console on 'HELP' tab - - write_log(output_data <- peakfq(output_psf_datapath)) - - } else { - - # Save other data files - write_log(output_data <- peakfq(output_psf_datapath)) - full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") - write_log(write_mk_test(qt_df(), full_mk_path)) - - #alert - output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) - - } - - - } else if(input$pfd_input_type == "input_folder") { - - for (i in 1:nrow(rv$psf_opt)) { - - target_site <- rv$psf_opt$site_no[i] - - target_opt <- rv$psf_opt[rv$psf_opt$site_no == target_site,] - target_thresh <- rv$psf_thresh[rv$psf_thresh$site_no == target_site,] - target_int <- rv$psf_int[rv$psf_int$site_no == target_site,] - target_peaks <- rv$psf_peaks[rv$psf_peaks$site_no == target_site,] - - target_tab_file <- tab_file_list[i] - target_site_file <- site_file_list[i] - - # Try to save other data files - output_data <- try(peakfq(output_psf_datapath), silent = TRUE) - - if(is(output_data, 'error')|is(output_data, 'try-error')){ - - shinyalert(title = "Error running PeakFQ", - text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), - html = TRUE, - type = "error") - - output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab - - write_log(output_data <- peakfq(output_psf_datapath)) - - } else { - - # Save other data files - write_log(output_data <- peakfq(output_psf_datapath)) - full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") - write_log(write_mk_test(qt_df(), full_mk_path)) - - #alert - output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) - - } - - } - - } else if(input$pfd_input_type == "input_nwis") { - - - #No default folder path - make sure that one has been entered. - if(class(input$btn_output)[1] != "list"){ #This input is a list iff a file path has been selected. If it's not a list, alert and safe fail, - - # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. - # shinyalert(title = "Select output folder", - # text = "Please select a folder to which output files should be saved.", - # type = "warning") - - } else { - - # Try data saveout - output_data <- try(peakfq(output_psf_datapath), silent = TRUE) - - if(is(output_data, 'error')|is(output_data, 'try-error')){ - - shinyalert(title = "Error running PeakFQ", - text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), - html = TRUE, - type = "error") - - output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab - - write_log(output_data <- peakfq(output_psf_datapath)) - - } else { - - write_log(nwis_data <- readNWISpeak(unique(rv$pf_data$site_no), asDateTime = FALSE, convertType = FALSE)) - - #Save out peak flow data and site info - write_log(write_NWIS_peak(unique(rv$pf_data$site_no), output_nwis_peak_datapath)) - write_log(write_NWIS_site(unique(rv$pf_data$site_no), output_nwis_site_datapath)) - - #Save other data files - write_log(output_data <- peakfq(output_psf_datapath)) - full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") - write_log(write_mk_test(qt_df(), full_mk_path)) - - #Alert - output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) - - } - - } - - } else{ - - target_tab_file <- attributes(rv$psf_opt)$peakFile - target_site_file <- attributes(rv$psf_opt)$siteinfoFile - - #Try to save other data files - output_data <- try(peakfq(output_psf_datapath), silent = TRUE) - - if(is(output_data, 'error')|is(output_data, 'try-error')){ - - shinyalert(title = "Error running PeakFQ", - text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), - html = TRUE, - type = "error") - - output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab - - write_log(output_data <- peakfq(output_psf_datapath)) - - } else { - - # Save other data files - write_log(output_data <- peakfq(output_psf_datapath)) - full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") - write_log(write_mk_test(qt_df(), full_mk_path)) - - output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) - - } - - } # End save output files - - - # Produce plots on Results tab - write_log(list_site <- rv$psf_opt$site_no) - - write_log(lapply(seq_along(list_site), function(i){ - p <- output_data[[5]][i] - - output[[paste("plot", i, sep = "_")]] <- renderPlot({ - p - }, - width = 500, - height = 350) - })) - - # Create plot tag list - write_log(output$ffa_plots <- renderUI({ - plot_output_list <- lapply(seq_along(list_site), function(i) { - plotname <- paste("plot", i, sep = "_") - plotOutput(plotname, height = '250px', inline=TRUE) - }) - - - do.call(tagList, plot_output_list) - - })) - - output$results_banner <- renderText(paste0("<b>Additional results are saved in the designated output folder: </b>", output_directory)) - output$ffa_header <- renderText("FFA Plots") - - - # Save log file - - full_log_path <- paste0(output_directory, "/", out_basename,".txt") - write.table(track_log, full_log_path, row.names = F, col.names = F, quote = F,sep = '\t') - - # Alert if there was an error logged - # if(error_count > 0){ - # - # shinyalert(title = "Error in Run PeakFQ", - # text = paste0("Check the log file (", out_basename, ".txt) for a full list of errors and warnings"), - # type = "error") - # } - - } - - - - - } - }) # end observe event input$RunPeakFQ button - - ####----------------------- Input Panel Observers ---------------------------#### # Input Type Selector ---------------------------------------------------------- - # Control data input based on selected input type + # Control data input display based on selected input type observe( # Display the correct UI for the selected data load type @@ -758,26 +444,36 @@ server <- shinyServer(function(input, output, session) { }) ) +# Set up ShinyFiles ------------------------------------------------------------ +#ShinyFiles works locally for accessing file paths. Will not work for server. -# Peak Flow Data Input --------------------------------------------------------- - - observeEvent(input$btn_txt, { #when a .txt file is selected - - txt_path <<- parseFilePaths(volumes, input$btn_txt)$datapath - txt_filename <- basename(txt_path) - txt_dir <- dirname(txt_path) +volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()()) +shinyFileChoose(input, "btn_txt", roots = volumes, session = session) +shinyFileChoose(input, "btn_site", roots = volumes, session = session) +shinyFileChoose(input, "btn_psf", roots = volumes, session = session) +shinyDirChoose(input, "btn_folder", roots = volumes, session = session, restrictions = system.file(package = "base"), allowDirCreate = FALSE) +shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrictions = system.file(package = "base"), allowDirCreate = FALSE) + +# Peak Flow Data Input: tab-delim or NWIS--------------------------------------- + + #When file selector is clicked for Tab-Delim data load, retrieve file & directory name + observeEvent(input$btn_txt, { + + txt_path <<- parseFilePaths(volumes, input$btn_txt)$datapath + txt_filename <- basename(txt_path) + txt_dir <- dirname(txt_path) output$selected_txt_path <- renderText(paste0("Selected tab-delimited file: ", txt_filename)) #User feedback so they know it worked - # input_txt_directory <<- txt_dir output_directory <<- txt_dir }) - - # Handle peak flow data input - assign to pf_data + # Handle peak flow data input when "Load" button is clicked observeEvent(input$load_txt_shinyFile, { #when button is clicked + # Re-initialize variables ---- + #Clear out load text if already run output$data_load_text <- renderText("") output$folder_load_text <- renderText("") @@ -799,9 +495,10 @@ server <- shinyServer(function(input, output, session) { rv$perc_ranges_df = perc_ranges_df_init rv$data_flow_int_df = data_flow_int_df_init - #For file upload, handle tab delimited + #For Tab-delim input, upload file ---- if(input$pfd_input_type == "input_tab"){ + #Display the source directory as the default output folder output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) #Get data path from user input @@ -828,12 +525,12 @@ server <- shinyServer(function(input, output, session) { output$data_load_text <- renderText("Peak flow data loaded") - } - #For NWIS query, run DataRetrieval for station IDs + #For NWIS query, run DataRetrieval for station IDs ---- }else if (input$pfd_input_type == "input_nwis"){ + #Set directories to blank - no default for NWIS query input_directory <<- "" output_directory <<- "" output$output_path <- renderText(paste0("<b>Output folder: </b>", "<em>(none selected)</em>")) @@ -899,7 +596,7 @@ server <- shinyServer(function(input, output, session) { alert_text <- paste(inval_site_txt, nodata_site_txt, dupyear_site_txt) - #Alert of "no data" for some sites & reason + #Alert of "no data" for some sites & provide reason shinyalert(title = "Not all requested sites returned data", text = alert_text, html = TRUE, @@ -908,7 +605,7 @@ server <- shinyServer(function(input, output, session) { } } - #For folder upload, read directory + #For folder upload, read directory ---- }else if(input$pfd_input_type == "input_folder"){ shinyDirChoose(input, 'dir', roots = getVolumes()) @@ -916,6 +613,7 @@ server <- shinyServer(function(input, output, session) { output$dir <- renderPrint(dir()) } + # Updates relevant to either input type #Alert if data is blank/missing @@ -923,83 +621,68 @@ server <- shinyServer(function(input, output, session) { output$data_load_text <- renderText("Data not loaded - please try again.") } + #Proceed if data are provided. Generate server-side & UI dataframes & displays + if (nrow(rv$pf_data) != 0) { + + #Generate dataframes ---- + # TAB 1 + #Update specification table on first tab with dataset details + rv$station_specs_df <- generate_station_specifications(rv$pf_data, rv$psf_opt, rv$site_info) - if (nrow(rv$pf_data) != 0) { - - # TAB 1 - #Update specification table on first tab with dataset details - rv$station_specs_df <- generate_station_specifications(rv$pf_data, rv$psf_opt, rv$site_info) + # TAB 2 + #1 - Update Station list to reflect stations for which data has been loaded + updateSelectInput(session, "station", choices = unique(rv$pf_data$site_no)) + + #2 - Update perceptible ranges table with defaults (0 to inf) + rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) - # TAB 2 - #1 - Update Station list to reflect stations for which data has been loaded - updateSelectInput(session, "station", choices = unique(rv$pf_data$site_no)) + #3 - Update data/flow intervals with initial and default values, with safe handling for urb/reg only peaks + d <- try(generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt), silent = TRUE) - #2 - Update perceptible ranges table with defaults (0 to inf) - rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) + if(is(d, 'try-error') | is(d, 'error')){ - # #3 - Update data/flow intervals with initial and default values - #Safe handling for urb/reg only peaks - d <- try(generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt), silent = TRUE) - - if(is(d, 'try-error') | is(d, 'error')){ - - #Alert that all data is urban/regulated, which is not selected for inclusion - shinyalert(title = "Include Urban/Regulated Peaks to proceed", - text = "All data for all sites are Urban/Regulated peaks. Urban/Regulated peaks must be selected for inclusion to proceed with the analysis.", - type = "warning", - closeOnClickOutside = TRUE) - }else{ - - #If one or some (but not all) sites are urban/regulated peaks, identify the affected sites. - if(!is.null(d$urb_reg_only_sites)){ + #Alert that all data is urban/regulated, which is not selected for inclusion + shinyalert(title = "Include Urban/Regulated Peaks to proceed", + text = "All data for all sites are Urban/Regulated peaks. Urban/Regulated peaks must be selected for inclusion to proceed with the analysis.", + type = "warning", + closeOnClickOutside = TRUE) + }else{ + + #If one or some (but not all) sites are urban/regulated peaks, identify the affected sites. + if(!is.null(d$urb_reg_only_sites)){ - shinyalert(title = "Include Urban/Regulated Peaks to proceed", - text = paste0("All data for the following sites are Urban/Regulated peaks: ", d$urb_reg_only_sites, - "<br> <br> Urban/Regulated peaks must be selected for inclusion to proceed with the analysis for the above site(s)."), - html = TRUE, - type = "warning", - closeOnClickOutside = TRUE) + shinyalert(title = "Include Urban/Regulated Peaks to proceed", + text = paste0("All data for the following sites are Urban/Regulated peaks: ", d$urb_reg_only_sites, + "<br> <br> Urban/Regulated peaks must be selected for inclusion to proceed with the analysis for the above site(s)."), + html = TRUE, + type = "warning", + closeOnClickOutside = TRUE) - } - - rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df - - } - - # Update outputs - - #PSF dataframes - rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) - rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) - rv$psf_int <- create_psf_int(rv$data_flow_int_df) - # rv$psf_peaks <- create_psf_peaks(rv$data_flow_int_df) - - # RHOT tables - Update table displays with populated dfs, filtered to selected station where relevant - output$station_specs_rhot <- renderRHandsontable(config_station_spec_RHOT(rv$station_specs_df)) - output$perc_ranges_rhot <- renderRHandsontable(config_perc_ranges_RHOT(rv$perc_ranges_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context - output$data_flow_int_rhot <- renderRHandsontable(config_data_flow_int_RHOT(rv$data_flow_int_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context + } + rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df + } + + #Update outputs & displays ---- + + #PSF dataframes + rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) + rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) + rv$psf_int <- create_psf_int(rv$data_flow_int_df) - # Text - output$data_load_text <- renderText("Peak flow data loaded") + # RHOT tables - Update table displays with populated dfs, filtered to selected station where relevant + output$station_specs_rhot <- renderRHandsontable(config_station_spec_RHOT(rv$station_specs_df)) + output$perc_ranges_rhot <- renderRHandsontable(config_perc_ranges_RHOT(rv$perc_ranges_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context + output$data_flow_int_rhot <- renderRHandsontable(config_data_flow_int_RHOT(rv$data_flow_int_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context - } #End handler of pf_data upload + # Text + output$data_load_text <- renderText("Peak flow data loaded") - }) #End "Load data" button observer - -####-------------------------- ShinyFiles ------------------------------#### -#ShinyFiles works locally for accessing file paths. Will not work for server. + } + }) -volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()()) -shinyFileChoose(input, "btn_txt", roots = volumes, session = session) -shinyFileChoose(input, "btn_site", roots = volumes, session = session) -shinyFileChoose(input, "btn_psf", roots = volumes, session = session) -shinyDirChoose(input, "btn_folder", roots = volumes, session = session, restrictions = system.file(package = "base"), allowDirCreate = FALSE) -shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrictions = system.file(package = "base"), allowDirCreate = FALSE) - - # Spec file Input -------------------------------------------------------------- - + #When file selector is clicked for specification file, retrieve file & directory name observeEvent(input$btn_psf, { #when a specification files is selected psf_path <- parseFilePaths(volumes, input$btn_psf)$datapath @@ -1010,14 +693,15 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict save_path <- reactive(psf_dir) - # input_directory <<- psf_dir output_directory <<- psf_dir - }) - observeEvent(input$load_psf_shinyFile, { #When "Load Spec File" is clicked: + # Handle spec file input when "Load" button is clicked + observeEvent(input$load_psf_shinyFile, { + # Re-initialize variables ---- + #Clear out load text if already run output$data_load_text <- renderText("") output$folder_load_text <- renderText("") @@ -1039,16 +723,19 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict rv$perc_ranges_df = perc_ranges_df_init rv$data_flow_int_df = data_flow_int_df_init + # Process selected specification file. ---- + #Display default output path output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) + #Check selected file. Alert & safe-fail as needed. if(sum(is.na(input$btn_psf) | input$btn_psf == "0") > 0){ #Alert of invalid file load & safe fail shinyalert(title = "Check selected specification file", text = 'Please ensure that the selected file is a specification file in PSF format.', type = "error") - + }else{ #Get path & load spec file @@ -1061,9 +748,8 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict # 3. Dataframe with flow intervals # 4. Dataframe with user-specified peak values - # The 2nd dataframe with perception thresholds is displayed on the second tab, along with the input peak flow data. The input peak flow data may be added to or overwritten by 3rd and 4th dataframes with flow intervals and user-specified peak thresholds in a table similar to the table in the lower left of the second tab on the current PeakFQ. - - rv$psf_opt <- readPSFall(psf_path)[[1]] %>% #overall options/processing inputs - page/tab 1 + # Load first PSF dataframe with processing options + rv$psf_opt <- readPSFall(psf_path)[[1]] %>% mutate(`Urb/Reg` = ifelse(`Urb/Reg` == "YES", TRUE, ifelse(`Urb/Reg` == "NO", FALSE, NA))) @@ -1077,19 +763,20 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict type = "error") }else{ - + + #Load remaining 3 PSF dataframes ---- rv$psf_thresh <- readPSFthresholds(psf_path) # thresholds for perceptible ranges - tab 2, table 1 rv$psf_int <- readPSFintervals(psf_path) #Data/Flow intervals - tab 2, table 2. rv$psf_peaks <- readPSFpeaks(psf_path) #user-specific peaks - #Read in and handle data file (Watstore or tab-delim) and site info file specified in spec file + #Read in and handle data file (Watstore or tab-delim) and site info file specified in spec file ---- pf_outfile <- attributes(rv$psf_opt)$outFile pf_datafile <- attributes(rv$psf_opt)$peakFile pf_sitefile <- attributes(rv$psf_opt)$siteinfoFile pf_datapath <- file.path(dirname(psf_path), pf_datafile) pf_sitepath <- file.path(dirname(psf_path), pf_sitefile) - #Read in header information from spec file + #Read in header information from spec file ---- pf_basename <- gsub("\\.(TXT|PRT)$", "", pf_outfile, ignore.case = TRUE) pf_plot_format <- attributes(rv$psf_opt)$PlotFormat pf_plot_pos <- attributes(rv$psf_opt)$PlotPosition @@ -1152,11 +839,7 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict # Update outputs - # #PSF dataframes - DO NOT CREATE - USE EXACTLY WHAT IS PROVIDED BY SPEC - # rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df) - # rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) - # rv$psf_int <- create_psf_int(rv$data_flow_int_df) - # rv$psf_peaks <- create_psf_peaks(rv$data_flow_int_df) + # PSF dataframes DO NOT get updated. Use exactly what is provided in specification file. # RHOT tables - Update table displays with populated dfs, filtered to selected station where relevant output$station_specs_rhot <- renderRHandsontable(config_station_spec_RHOT(rv$station_specs_df)) @@ -1167,11 +850,12 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict output$psf_load_text <- renderText("Specification file & data loaded") } - }) # end load_psf_shinyFile observeEvent + }) # Folder Path Input -------------------------------------------------------------- + #When directory selector is clicked for folder upload, retrieve directory name observeEvent(input$btn_folder, { #when a folder is selected folder_path <- parseDirPath(volumes, input$btn_folder) @@ -1187,7 +871,10 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict getExtension <- function(filepath) {strsplit(filepath, ".", fixed=T)[[1]][-1]} - observeEvent(input$load_folder_shinyFile, { #When "Load Folder" is clicked: + # Handle folder input when "Load" button is clicked + observeEvent(input$load_folder_shinyFile, { + + # Re-initialize variables ---- #Clear out load text if already run output$data_load_text <- renderText("") @@ -1210,9 +897,6 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict rv$perc_ranges_df = perc_ranges_df_init rv$data_flow_int_df = data_flow_int_df_init - #Display default output path - output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) - # Initialize blank dataframes for collecting data pf_data_all <- data.frame( site_no = character(0), @@ -1262,16 +946,18 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict site_file_list <<- c() tab_file_list <<- c() - my_input_dir <- parseDirPath(volumes, input$btn_folder) - folder_list <- list.files(my_input_dir, full.names = T) - folder_df <- data.frame(filepath = folder_list) %>% - mutate(extension = sapply(filepath, getExtension)) %>% - mutate(extension = tolower(extension)) %>% # make lowercase - mutate(filename = basename(filepath)) - - #TEST - # output$test <- renderTable(folder_df) + #Display default output path ---- + output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) + #Get directory information from user input ---- + my_input_dir <- parseDirPath(volumes, input$btn_folder) + folder_list <- list.files(my_input_dir, full.names = T) + folder_df <- data.frame(filepath = folder_list) %>% + mutate(extension = sapply(filepath, getExtension)) %>% + mutate(extension = tolower(extension)) %>% # make lowercase + mutate(filename = basename(filepath)) + + #Alert if no folder selected if(nrow(folder_df) == 0){ @@ -1284,15 +970,14 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict output$folder_load_text <- renderText("Data not loaded - please try again.") }else{ - - # Find all spec files + + # Find & handle all spec files ---- psf_df <- folder_df %>% filter(extension == "psf") - + #Alert if no PSFs found in the folder for load. if(nrow(psf_df) == 0) { - - #Alert that all data is urban/regulated, which is not selected for inclusion + shinyalert(title = "No specification file(s) found in the selected folder", text = "No data could be loaded, as no specification file(s) found in the selected folder. Please try again.", type = "error", @@ -1303,12 +988,12 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict }else{ datapaths <- c() #vector to save out datapaths, allowing for alert if multiple psfs correspond to same input data - + for (row in 1:nrow(psf_df)) { - + #Handle all PSF components ---- psf_path <- psf_df$filepath[row] - - #psf_opt handling + + #psf_opt handling ---- psf_options <- readPSFall(psf_path)[[1]] %>% mutate(site_no = as.character(site_no), Interval = as.character(Interval), @@ -1318,37 +1003,39 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict SkewSE = as.double(SkewSE), LOType = as.character(LOType), LoThresh = as.double(LoThresh), - 'Urb/Reg' = as.logical('Urb/Reg'), - PCPT_Thresh = as.character(PCPT_Thresh)) + PCPT_Thresh = as.character(PCPT_Thresh)) %>% + mutate(`Urb/Reg` = ifelse(`Urb/Reg` == "YES", TRUE, + ifelse(`Urb/Reg` == "NO", FALSE, NA))) + psf_options_all <- psf_options_all %>% rbind(psf_options) - - #psf_thresh handling + + #psf_thresh handling ---- psf_thresh <- readPSFthresholds(psf_path) - + psf_thresh_all <- psf_thresh_all %>% rbind(psf_thresh) - - - #psf_int handling + + + #psf_int handling ---- psf_int <- readPSFintervals(psf_path) - + psf_int_all <- psf_int_all %>% rbind(psf_int) - - #psf_peaks handling + + #psf_peaks handling ---- psf_peaks <- readPSFpeaks(psf_path) - + psf_peaks_all <- psf_peaks_all %>% rbind(psf_peaks) - - - #Read in and handle data file (Watstore or tab-delim) and site info file specified in spec file + + + #Read in and handle data file (Watstore or tab-delim) and site info file specified in spec file ---- pf_datapath <- file.path(dirname(psf_path), attributes(psf_options)$peakFile) datapaths <- datapaths %>% append(pf_datapath) #keep track of datapaths to alert if multiple PSFs correspond to the same data file - + pf_data <- read_psf_linked_file(pf_datapath) %>% mutate(site_no = as.character(site_no), peak_dt = as.character(peak_dt), @@ -1360,16 +1047,16 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict peak_month = as.integer(peak_month), peak_day = as.integer(peak_day), peak_WY = as.integer(peak_WY)) - + pf_data_all <- pf_data_all %>% bind_rows(pf_data) - + tab_file_list <<- append(tab_file_list, paste0(output_directory, "/", attributes(psf_options)$peakFile)) site_file_list <<- append(site_file_list, paste0(output_directory, "/", attributes(psf_options)$siteinfoFile)) } # End spec file loop - + #Check & alert if multiple PSFs referencing same data file if(length(datapaths) > length(unique(datapaths))){ @@ -1383,7 +1070,7 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict } else { - #return to standard naming + #return to standard naming ---- rv$pf_data <- pf_data_all output$view_table <- renderTable(rv$pf_data) @@ -1392,7 +1079,7 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict rv$psf_peaks <- psf_peaks_all rv$psf_int <- psf_int_all - # Find all text files - test if in site information format + #Find all text files & load iff in site information format.---- txt_df <- folder_df %>% filter(extension == "txt") @@ -1411,15 +1098,14 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict rv$site_info <- site_info_all - #Read in header information from spec file + #Read in header information from spec file ---- pf_basename <- gsub("\\.(TXT|PRT)$", "", attributes(rv$psf_opt)$outFile, ignore.case = TRUE) pf_plot_format <- attributes(rv$psf_opt)$PlotFormat pf_plot_pos <- attributes(rv$psf_opt)$PlotPosition pf_sym_conf <- attributes(rv$psf_opt)$ConfInterval pf_extend <- attributes(rv$psf_opt)$extended - # Update output options - # updateTextInput(session, "input_base_file_name", label = "Base file name: ", value = pf_basename) # Basename needs to be specified manually for folder upload + #Update output options ---- if(!is.na(pf_plot_format) && !is.null(pf_plot_format)){ updateTextInput(session, "input_plot_format", label = "Graphic Plot Format: ", value = pf_plot_format)} if(!is.na(pf_plot_pos) && !is.null(pf_plot_pos)){ @@ -1429,48 +1115,49 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict if(!is.na(pf_extend) && !is.null(pf_extend)){ updateCheckboxInput(session, "checkbox_extend", label = "Extend Analysis", value = pf_extend)} + + #Update specification tables based on upload ----- + #Tab 1: Station Specifications table + rv$station_specs_df <- generate_station_specifications(rv$pf_data, rv$psf_opt, rv$site_info) - #Update specification tables based on upload - #Tab 1: Station Specifications table - rv$station_specs_df <- generate_station_specifications(rv$pf_data, rv$psf_opt, rv$site_info) - - #Tab 2: - - #Dropdown: Update Station list to reflect stations for which data has been loaded - updateSelectInput(session, "station", choices = unique(rv$pf_data$site_no)) - - # Table 1: Perceptible Ranges - rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) + #Tab 2: + #Dropdown: Update Station list to reflect stations for which data has been loaded + updateSelectInput(session, "station", choices = unique(rv$pf_data$site_no)) - # Table 2: Data/Flow Intervals - rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df + # Table 1: Perceptible Ranges + rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) - # Update outputs + # Table 2: Data/Flow Intervals + rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df + + # Update outputs ---- + #PSF dataframes rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) rv$psf_int <- create_psf_int(rv$data_flow_int_df) # rv$psf_peaks <- create_psf_peaks(rv$data_flow_int_df) - + # RHOT tables - Update table displays with populated dfs, filtered to selected station where relevant output$station_specs_rhot <- renderRHandsontable(config_station_spec_RHOT(rv$station_specs_df)) output$perc_ranges_rhot <- renderRHandsontable(config_perc_ranges_RHOT(rv$perc_ranges_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context output$data_flow_int_rhot <- renderRHandsontable(config_data_flow_int_RHOT(rv$data_flow_int_df %>% filter(site_no == input$station))) #Filter to site_no of interest within reactive context - + # Text output$folder_load_text <- renderText("Folder data loaded") } } } - }) # End load_folder_shinyFile observeEvent +}) -# Site Information Input ------------------------------------------------------ +# Site Information Input ------------------------------------------------------ - observeEvent(input$btn_site, { #when a site info file is selected + #When file selector is clicked for site info file, retrieve file & directory name + observeEvent(input$btn_site, { site_path <<- parseFilePaths(volumes, input$btn_site)$datapath site_filename <- basename(site_path) @@ -1483,10 +1170,13 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict }) + # Handle info file input when "Load" button is clicked observeEvent(input$load_site_shinyFile, { - output$site_info_load_text <- renderText("") #Clear out load text if already run + #Clear out load text if already run + output$site_info_load_text <- renderText("") + #Update default output directory output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) #Require that data are loaded before site info @@ -1501,7 +1191,6 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict #Get data path from user input data_path <- parseFilePaths(volumes, input$btn_site)$datapath - #Catch & safe fail if bad format for selected file t <- try(read_site_info(data_path), silent = TRUE) @@ -1514,50 +1203,50 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict rv$site_info <- read_site_info(data_path) #Check that the site info that has been loaded matches the data that have been loaded. Alert on any mismatches. - data_sites <- rv$pf_data$site_no %>% unique() info_sites <- rv$site_info$site_no %>% unique() - #The following sites are included in the data but not in the site_information - data_no_info_sites <- data_sites[data_sites %notin% info_sites] - - # The following sites are included in the site information but not in the data file - info_no_data_sites <- info_sites[info_sites %notin% data_sites] - - # None of the sites in site info file match the sites in the data file - if(length(data_no_info_sites) + length(info_no_data_sites) > 0){ + #The following sites are included in the data but not in the site_information + data_no_info_sites <- data_sites[data_sites %notin% info_sites] - if (identical(data_no_info_sites, data_sites) == TRUE){ - - alert_text <- "The site information file does not include the site(s) for which peak flow data have been provided. <br> - <br>The selected site information file will not be loaded; please check & try again." - - } else if(length(data_no_info_sites) > 0 & length(info_no_data_sites) > 0){ - - alert_text <- paste0("Site(s) included in the data, but not in the site information file: ", - data_no_info_sites, - "<br>Site(s) included in the site information, but not in the peak flow data: ", - info_no_data_sites) - - } else if (length(data_no_info_sites) > 0) { + # The following sites are included in the site information but not in the data file + info_no_data_sites <- info_sites[info_sites %notin% data_sites] + + # None of the sites in site info file match the sites in the data file + if(length(data_no_info_sites) + length(info_no_data_sites) > 0){ - alert_text <- paste0("Site(s) included in the data, but not in the site information file: ", - data_no_info_sites) + if (identical(data_no_info_sites, data_sites) == TRUE){ + + alert_text <- "The site information file does not include the site(s) for which peak flow data have been provided. <br> + <br>The selected site information file will not be loaded; please check & try again." + + } else if(length(data_no_info_sites) > 0 & length(info_no_data_sites) > 0){ + + alert_text <- paste0("Site(s) included in the data, but not in the site information file: ", + data_no_info_sites, + "<br>Site(s) included in the site information, but not in the peak flow data: ", + info_no_data_sites) + + } else if (length(data_no_info_sites) > 0) { + + alert_text <- paste0("Site(s) included in the data, but not in the site information file: ", + data_no_info_sites) + + } else { #last option - length(info_no_data_sites) > 0 + + alert_text <- paste0("Site(s) included in the site information, but not in the peak flow data: ", + info_no_data_sites, "<br> This information will not be loaded.") + } - } else { #last option - length(info_no_data_sites) > 0 + shinyalert(title = "Selected site information file does not match the site(s) in the peak flow data.", + text = alert_text, + html = TRUE, + type = "warning", + closeOnClickOutside = TRUE) - alert_text <- paste0("Site(s) included in the site information, but not in the peak flow data: ", - info_no_data_sites, "<br> This information will not be loaded.") - } - - shinyalert(title = "Selected site information file does not match the site(s) in the peak flow data.", - text = alert_text, - html = TRUE, - type = "warning", - closeOnClickOutside = TRUE) - } else { + #update station specifications RHOT with site info rv$station_specs_df <- generate_station_specifications(rv$pf_data, rv$psf_opt, rv$site_info) #Update outputs @@ -1569,292 +1258,603 @@ shinyDirChoose(input, "btn_output", roots = volumes, session = session, restrict } }) -# Output Path Selection ------------------------------------------------------ +# Output Path Selection ------------------------------------------------------ - observeEvent(input$btn_output, { #When "Set output folder" is clicked: - - # if(!is.null(input$btn_output)){ + #When "Set output folder" button is clicked, update and display + observeEvent(input$btn_output, { out_dir <- parseDirPath(volumes, input$btn_output) output_directory <<- out_dir output$output_path <- renderText(paste0("<b>Output folder: </b>", output_directory)) - # } - }) ####-------------------------- Tab 1 Observers -----------------------------#### +# Observe changes to station specifications table ---- +observeEvent(input$station_specs_rhot$changes$changes, { + + # Freeze a server-side dataframe to match the table displayed to the user.---- + station_spec_rhot_to_df <- hot_to_r(input$station_specs_rhot) #This will have the wrong column names relative to the station_spec_df + names(station_spec_rhot_to_df) <- names(rv$station_specs_df) + + # Domain/value checks & alerts: ---- + if(sum(station_spec_rhot_to_df$SkewSE < 0, na.rm = TRUE) > 0){ + shinyalert(title = "Regional skew standard error must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the regional skew standard error.", + type = "error") + } + + if(sum(station_spec_rhot_to_df$LoThresh < 0, na.rm = TRUE) > 0){ + shinyalert(title = "PILF (LO) Threshold must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the PILF (LO) Threshold.", + type = "error") + } + + # Calculate/populate contingent values ---- + station_spec_rhot_to_df <- station_spec_rhot_to_df %>% mutate(LoThresh = ifelse(.$LOType == "MGBT", 0, LoThresh), # MGBT is selected, LoThresh must be 0 + MapSkew = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), MapSkew, NA), # If station skew is selected, these are not needed + GenSkew = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), GenSkew, NA), # If station skew is selected, these are not needed + SkewSE = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), SkewSE, NA)) # If station skew is selected, these are not needed - # Observe changes to station specifications table #### - observeEvent(input$station_specs_rhot$changes$changes, { # https://www.youtube.com/watch?v=bjyAs8zud4E - - station_spec_rhot_to_df <- hot_to_r(input$station_specs_rhot) #Updates a server-side dataframe to match the StationSpecTable displayed to the user. This will have the wrong column names relative to the station_spec_df - - #Pull data into server-side station_specs_df, with proper names, updating contingent values - names(station_spec_rhot_to_df) <- names(rv$station_specs_df) - - #Domain/value checks & alerts: - if(sum(station_spec_rhot_to_df$SkewSE < 0, na.rm = TRUE) > 0){ - shinyalert(title = "Regional skew standard error must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the regional skew standard error.", - type = "error") - } - - if(sum(station_spec_rhot_to_df$LoThresh < 0, na.rm = TRUE) > 0){ - shinyalert(title = "PILF (LO) Threshold must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the PILF (LO) Threshold.", - type = "error") - } - - - station_spec_rhot_to_df <- station_spec_rhot_to_df %>% mutate(LoThresh = ifelse(.$LOType == "MGBT", 0, LoThresh), # MGBT is selected, LoThresh must be 0 - MapSkew = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), MapSkew, NA), # If station skew is selected, these are not needed - GenSkew = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), GenSkew, NA), # If station skew is selected, these are not needed - SkewSE = ifelse((is.na(.$SkewOpt) | .$SkewOpt != "Station"), SkewSE, NA)) # If station skew is selected, these are not needed - - #Only run map skew lookup if at least one row indicates that map skew should be used - save on processing time. + # Map Skew lookup ---- - if(sum(station_spec_rhot_to_df$MapSkew == TRUE, na.rm = TRUE)>0){ + if(sum(station_spec_rhot_to_df$MapSkew == TRUE, na.rm = TRUE)>0){ #Only run map skew lookup if at least one row indicates that map skew should be used - save on processing time. - t <- try(get_map_skew(station_spec_rhot_to_df), silent = TRUE) #add in map skews if relevant. + t <- try(get_map_skew(station_spec_rhot_to_df), silent = TRUE) #add in map skews if relevant. - if(is(t, 'error')|is(t,'try-error')) { + if(is(t, 'error')|is(t,'try-error')) { - shinyalert(title = "Map Skew Values could not be generated.", - text = "Map skew values are not available. Please enter a manual skew value.", - type = "error") + shinyalert(title = "Map Skew Values could not be generated.", + text = "Map skew values are not available. Please enter a manual skew value.", + type = "error") - } else if(length(t$missing_lat_long) > 0){ + } else if(length(t$missing_lat_long) > 0){ - shinyalert(title = "Map Skew Values require site latitude and longitude", - text = paste0("Map skew values cannot be used unless site information including latitude and longitude has been provided. - Please provide site information or enter a manual skew value for site(s): ", t$missing_lat_long), - type = "error") + shinyalert(title = "Map Skew Values require site latitude and longitude", + text = paste0("Map skew values cannot be used unless site information including latitude and longitude has been provided. + Please provide site information or enter a manual skew value for site(s): ", t$missing_lat_long), + type = "error") - station_spec_rhot_to_df <- t$station_specs_df + station_spec_rhot_to_df <- t$station_specs_df - } else if(length(t$missing_skew_val) > 0){ + } else if(length(t$missing_skew_val) > 0){ - shinyalert(title = "Map Skew values unavailable", - text = paste0("Map skew values are not available for site(s): ", t$missing_skew_val, - "Please enter a manual skew value."), - type = "error") + shinyalert(title = "Map Skew values unavailable", + text = paste0("Map skew values are not available for site(s): ", t$missing_skew_val, + "Please enter a manual skew value."), + type = "error") - station_spec_rhot_to_df <- t$station_specs_df + station_spec_rhot_to_df <- t$station_specs_df - } else { + } else { - station_spec_rhot_to_df <- t$station_specs_df - } + station_spec_rhot_to_df <- t$station_specs_df } + } - rv$station_specs_df <- station_spec_rhot_to_df + # Recreate server & UI-side dataframes in response to updates ---- + rv$station_specs_df <- station_spec_rhot_to_df # Recreate psf_opt from station_specs_df and other rv$psf_s (and minor inputs from perc_ranges and data_flow_int for Interval, Peak, PCPT_Thresh). rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) #Recreate perc_ranges and data_flow_intervals in case urb/reg specification changed - #2 - Update perceptible ranges table with defaults (0 to inf) - rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) + rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) + rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df + + #CHECK + output$psf_opt <- renderTable(rv$psf_opt) +}) - #3 - Update data/flow intervals with initial and default values - rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df +# Observe changes to output options ---- + lower_limit <- reactive((100 - as.numeric(input$input_sym_conf)*100)/2) + upper_limit <- reactive(100-((100 - as.numeric(input$input_sym_conf)*100)/2)) + + observe( + output$conf_limit <- renderText({ + if(!is.na(lower_limit())){ + + paste0(lower_limit(), "-percent and ", upper_limit(), "-percent confidence limits") + + } + }) + ) - #CHECK - output$psf_opt <- renderTable(rv$psf_opt) - }) +####-------------------------- Tab 2 Observers -----------------------------#### +# Observe changes to perceptible ranges table ---- +observeEvent(input$perc_ranges_rhot$changes$changes, { -####-------------------------- Tab 2 Observers -----------------------------#### + # Freeze a server-side dataframe to match the table displayed to the user.---- + perc_ranges_rhot_to_df <- hot_to_r(input$perc_ranges_rhot) - # Observe changes to perc range file table #### - observeEvent(input$perc_ranges_rhot$changes$changes, { + # Add station_ID based on current station selection ---- + perc_ranges_rhot_to_df <- perc_ranges_rhot_to_df %>% + add_column(site_no = input$station, .before = 1) - # Isolate rhot table to make conversions before it is saved back to perc_ranges_df - perc_ranges_rhot_to_df <- hot_to_r(input$perc_ranges_rhot) + # Restore standard names from server-side dataframe ---- + names(perc_ranges_rhot_to_df) <- names(rv$perc_ranges_df) - # Add station_ID based on current station selection - perc_ranges_rhot_to_df <- perc_ranges_rhot_to_df %>% - add_column(site_no = input$station, .before = 1) + # Domain/value checks & alerts ---- + if(sum(as.numeric(perc_ranges_rhot_to_df$min) < 0, na.rm = TRUE) > 0){ + shinyalert(title = "Threshold Lower Bound must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the Lower Bound.", + type = "error") + } - # Match names to perc_ranges_df - names(perc_ranges_rhot_to_df) <- names(rv$perc_ranges_df) + if(sum(as.numeric(perc_ranges_rhot_to_df$max) < 0 , na.rm = TRUE) > 0){ + shinyalert(title = "Threshold Upper Bound must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the Upper Bound.", + type = "error") + } - #Domain/value checks & alerts: - if(sum(as.numeric(perc_ranges_rhot_to_df$min) < 0, na.rm = TRUE) > 0){ - shinyalert(title = "Threshold Lower Bound must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the Lower Bound.", - type = "error") - } + # Update "Inf"s to global var Qmax (1e+20, but can be changed) ---- + perc_ranges_rhot_to_df <- perc_ranges_rhot_to_df %>% + mutate(min = ifelse(tolower(min) == "inf", Qmax, as.numeric(min)), + max = ifelse(tolower(max) == "inf", Qmax, as.numeric(max))) - if(sum(as.numeric(perc_ranges_rhot_to_df$max) < 0 , na.rm = TRUE) > 0){ - shinyalert(title = "Threshold Upper Bound must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the Upper Bound.", - type = "error") - } + # Recreate server & UI-side dataframes in response to updates ---- + + # Merge to perc_ranges_df - replace record for selected station + rv$perc_ranges_df <- rv$perc_ranges_df %>% filter(site_no != input$station) %>% #Remove existing records for selected station from df + rbind(perc_ranges_rhot_to_df) #Attach updated record for selected station to df - # Update "Inf"s to global var Qmax (1e+20, but can be changed) - perc_ranges_rhot_to_df <- perc_ranges_rhot_to_df %>% - mutate(min = ifelse(tolower(min) == "inf", Qmax, as.numeric(min)), - max = ifelse(tolower(max) == "inf", Qmax, as.numeric(max))) + # Recreate psf_thresh and psf_opt from perc_ranges_df + rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) + rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) - # Merge to perc_ranges_df - replace record for selected station - rv$perc_ranges_df <- rv$perc_ranges_df %>% filter(site_no != input$station) %>% #Remove existing records for selected station from df - rbind(perc_ranges_rhot_to_df) #Attach updated record for selected station to df + # Update data/flow intervals + rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df - # Recreate psf_thresh and psf_opt from perc_ranges_df - rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) - rv$psf_thresh <- create_psf_thresh(rv$perc_ranges_df) +}) - # #3 - Update data/flow intervals with initial and default values - rv$data_flow_int_df <- generate_data_flow_intervals(pf_data = rv$pf_data, psf_peaks = rv$psf_peaks, psf_int = rv$psf_int, psf_thresh = rv$psf_thresh, psf_opt = rv$psf_opt)$data_flow_int_df +# Observe changes to data/flow intervals table ---- +observeEvent(input$data_flow_int_rhot$changes$changes, { + + # Freeze a server-side dataframe to match the table displayed to the user. ---- + data_flow_int_rhot_to_df <- hot_to_r(input$data_flow_int_rhot) - }) + # Add station_ID based on current station selection ---- + data_flow_int_rhot_to_df <- data_flow_int_rhot_to_df %>% + add_column(site_no = input$station, .before = 1) - # Observe changes to data/flow intervals table #### - observeEvent(input$data_flow_int_rhot$changes$changes, { - - # Isolate rhot table to make conversions before it is saved back to data_flow_int_df - data_flow_int_rhot_to_df <- hot_to_r(input$data_flow_int_rhot) + # Restore standard names from server-side dataframe ---- + names(data_flow_int_rhot_to_df) <- names(rv$data_flow_int_df) + + #Domain/value checks & alerts ---- + if(sum(as.numeric(data_flow_int_rhot_to_df$interval_low) < 0, na.rm = TRUE) > 0){ + shinyalert(title = "Interval Lower Bound must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the Lower Bound.", + type = "error") + } - # Add station_ID based on current station selection - data_flow_int_rhot_to_df <- data_flow_int_rhot_to_df %>% - add_column(site_no = input$station, .before = 1) + if(sum(as.numeric(data_flow_int_rhot_to_df$interval_up) < 0, na.rm = TRUE) > 0){ - # Match names to perc_ranges_df - names(data_flow_int_rhot_to_df) <- names(rv$data_flow_int_df) - - #Domain/value checks & alerts: - if(sum(as.numeric(data_flow_int_rhot_to_df$interval_low) < 0, na.rm = TRUE) > 0){ - shinyalert(title = "Interval Lower Bound must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the Lower Bound.", - type = "error") - } + shinyalert(title = "Interval Upper Bound must be positive", + text = "Please enter a numeric value greater than or equal to 0 for the Upper Bound.", + type = "error") + } - if(sum(as.numeric(data_flow_int_rhot_to_df$interval_up) < 0, na.rm = TRUE) > 0){ - - shinyalert(title = "Interval Upper Bound must be positive", - text = "Please enter a numeric value greater than or equal to 0 for the Upper Bound.", - type = "error") - } + # Update "Inf"s to global var Qmax (1e+20, but can be changed) ---- + data_flow_int_rhot_to_df <- data_flow_int_rhot_to_df %>% + mutate(interval_low = ifelse(tolower(interval_low) == "inf", Qmax, as.numeric(interval_low)), + interval_up = ifelse(tolower(interval_up) == "inf", Qmax, as.numeric(interval_up))) + + # Alert if entered year is outside of perceptible ranges data year ---- + years_dfi <- unique(data_flow_int_rhot_to_df$peak_WY) %>% na.omit() #years in data flow intervals table + years_pr <- c() #years covered by perceptible ranges - generated below - # Update "Inf"s to global var Qmax (1e+20, but can be changed) - data_flow_int_rhot_to_df <- data_flow_int_rhot_to_df %>% - mutate(interval_low = ifelse(tolower(interval_low) == "inf", Qmax, as.numeric(interval_low)), - interval_up = ifelse(tolower(interval_up) == "inf", Qmax, as.numeric(interval_up))) - - # Alert if entered year is outside of perceptible ranges data year - years_dfi <- unique(data_flow_int_rhot_to_df$peak_WY) %>% na.omit() #years in data flow intervals table - years_pr <- c() #years covered by perceptible ranges - generated below + sel_psf_thresh <- rv$psf_thresh %>% filter(site_no == input$station) + + for(i in 1:nrow(sel_psf_thresh)){ - sel_psf_thresh <- rv$psf_thresh %>% filter(site_no == input$station) - - for(i in 1:nrow(sel_psf_thresh)){ + sel_row <- sel_psf_thresh[i,] - sel_row <- sel_psf_thresh[i,] + row_yrs <- seq(sel_row$start, sel_row$end, 1) + years_pr <- years_pr %>% c(row_yrs) - row_yrs <- seq(sel_row$start, sel_row$end, 1) - years_pr <- years_pr %>% c(row_yrs) + } - } + yrs_wo_pr <- years_dfi[years_dfi %notin% years_pr] - yrs_wo_pr <- years_dfi[years_dfi %notin% years_pr] + if(length(yrs_wo_pr) > 0){ - if(length(yrs_wo_pr) > 0){ + shinyalert(title = "Data flow interval year outside of defined perceptible ranges.", + text = paste0(yrs_wo_pr, " falls outside of the defined perceptible range(s). + Please update years for the perceptible range if you would like to include this interval in the analysis."), + type = "warning", + closeOnClickOutside = TRUE) - shinyalert(title = "Data flow interval year outside of defined perceptible ranges.", - text = paste0(yrs_wo_pr, " falls outside of the defined perceptible range(s). - Please update years for the perceptible range if you would like to include this interval in the analysis."), - type = "warning", - closeOnClickOutside = TRUE) + } + + # Alert if entered year is already included in record ---- + years_dfi_all <- data_flow_int_rhot_to_df$peak_WY %>% na.omit() #years in data flow intervals table. Omit NAs to avoid issues after deletions. - } + if(sum(duplicated(years_dfi_all)) > 0){ + + shinyalert(title = "Year already included in data/flow intervals.", + text = "The year entered is already included in the intervals table. Please update the existing record, rather than making a new entry.", + closeOnClickOutside = TRUE) + + } else { + + # Recreate server & UI-side dataframes in response to updates ---- + + # Merge to data_flow_int - replace record for selected station + rv$data_flow_int_df <- rv$data_flow_int_df %>% filter(site_no != input$station) %>% #Remove existing records for selected station from df + rbind(data_flow_int_rhot_to_df) #Attach updated record for selected station to df + + # Recreate psf_int from data_flow_int_df + rv$psf_int <- create_psf_int(rv$data_flow_int_df) + + # Recreate psf_opt integrating changes + rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) - # Alert if entered year is already included in record - years_dfi_all <- data_flow_int_rhot_to_df$peak_WY %>% na.omit() #years in data flow intervals table. Omit NAs to avoid issues after deletions. + # Update perceptible ranges table + rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) + } +}) + +# Observe plot axes button click ---- - if(sum(duplicated(years_dfi_all)) > 0){ +observeEvent(input$plot_axes_button, { + + #Buttons starts at 0 and labelled "log" (plot set to "Real") + output$button_check <- renderText(print(input$plot_axes_button)) + + #Odd numbers mean "Log" selected -> button says "real" and plot is log scaled. + if(input$plot_axes_button %% 2 == 1){ #Odd - log is selected. + updateActionButton(inputId = "plot_axes_button", label = "Real axes") + + # Rescale plot to log - handled in 'Reactive' on pkPlot + + }else{ - shinyalert(title = "Year already included in data/flow intervals.", - text = "The year entered is already included in the intervals table. Please update the existing record, rather than making a new entry.", - closeOnClickOutside = TRUE) + #Even numbers mean "Real" selected -> button says "Log" and plot is real scaled. + updateActionButton(inputId = "plot_axes_button", label = "Log axes") - } else { + # #Rescale plot to continuous - handled in 'Reactive' on pkPlot - # Merge to data_flow_int - replace record for selected station - rv$data_flow_int_df <- rv$data_flow_int_df %>% filter(site_no != input$station) %>% #Remove existing records for selected station from df - rbind(data_flow_int_rhot_to_df) #Attach updated record for selected station to df + } #End if/else +}) #End button click observer + + +####--------------- Save Specifications Button Observer -------------------##### + +# When "Save Specifications" button OR "Run PeakFQ" button is clicked ---- +observeEvent(c(input$SavePSF, input$RunPeakFQ), priority = 10, { # when either Save Specification or Run PeakFQ buttons are clicked + + req(input$SavePSF + input$RunPeakFQ > 0) # prevent the code from triggering when the buttons are first added to the form; Require at least one button click before triggering + + #Clear out text if already run + output$psf_ready <- renderText("") + + # Use basename specified by user + out_basename <- input$input_base_file_name + + output_psf_datapath <<- paste0(output_directory, "/", out_basename,".psf") + + output_nwis_peak_datapath <<- paste0(output_directory, "/", out_basename, "_nwis_peak.txt") + output_nwis_site_datapath <<- paste0(output_directory, "/", out_basename, "_nwis_site.txt") + + # Check that there are psf dataframes to save out - if no psf_opt, no data - alert. + if(nrow(rv$psf_opt) == 0){ + shinyalert(title = "No data loaded", + text = "Data must be loaded before a specification file can be saved. Please load data and try again.", + type = "error") + + } else if(str_length(out_basename) == 0){ + # Check that there is a basename specified for the output. If not, alert. + + shinyalert(title = "Enter a base file name", + text = "Please enter a base file name that should be used for output files.", + type = "warning") + + } else if (is.null(output_directory) | output_directory == ""){ + + #Check that there is an output folder specified. If not, alert. + shinyalert(title = "Select output folder", + text = "Please select a folder to which output files should be saved.", + type = "warning") + + } else { + + if(input$pfd_input_type == "input_tab") { + # Tab-delimited and site info filepath to write into spec file (text file uploads only) + # txt_filename <- basename(parseFilePaths(volumes, input$btn_txt)$datapath) + # site_filename <- basename(parseFilePaths(volumes, input$btn_site)$datapath) - # Recreate psf_int from data_flow_int_df - rv$psf_int <- create_psf_int(rv$data_flow_int_df) + # Providing site info file is optional + output_psf <- try(writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, txt_path), silent = TRUE) + output_psf <- try(writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, txt_path, site_path), silent = TRUE) - # Recreate psf_peaks from data_flow_int_df - # rv$psf_peaks <- create_psf_peaks(rv$data_flow_int_df) + output$psf_ready <- renderText("Spec file saved in designated output folder") - # Recreate psf_opt integrating changes - rv$psf_opt <- create_psf_opt(rv$station_specs_df, rv$perc_ranges_df, rv$data_flow_int_df, rv$psf_peaks) + } else if(input$pfd_input_type == "input_folder") { - #2 - Update perceptible ranges table with defaults (0 to inf) - rv$perc_ranges_df <- generate_perceptible_ranges(rv$pf_data, psf_thresh = rv$psf_thresh) - } - - }) - - # Observe plot axes button click #### - observeEvent(input$plot_axes_button, { - #Buttons starts at 0 and labelled "log" (plot set to "Real") - output$button_check <- renderText(print(input$plot_axes_button)) - - #Odd numbers mean "Log" selected -> button says "real" and plot is log scaled. - if(input$plot_axes_button %% 2 == 1){ #Odd - log is selected. - updateActionButton(inputId = "plot_axes_button", label = "Real axes") - - # Rescale plot to log - handled in 'Reactive' on pkPlot - - }else{ + for (i in 1:nrow(rv$psf_opt)) { + + target_site <- rv$psf_opt$site_no[i] + + target_opt <- rv$psf_opt[rv$psf_opt$site_no == target_site,] + target_thresh <- rv$psf_thresh[rv$psf_thresh$site_no == target_site,] + target_int <- rv$psf_int[rv$psf_int$site_no == target_site,] + target_peaks <- rv$psf_peaks[rv$psf_peaks$site_no == target_site,] + + target_tab_file <- tab_file_list[i] + target_site_file <- site_file_list[i] - #Even numbers mean "Real" selected -> button says "Log" and plot is real scaled. - updateActionButton(inputId = "plot_axes_button", label = "Log axes") + output_psf_datapath <<- paste0(output_directory, "/", target_site,".psf") - # #Rescale plot to continuous - handled in 'Reactive' on pkPlot + output_psf <- writePSF(target_opt, target_thresh, target_int, target_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, target_tab_file, target_site_file) - } #End if/else - }) #End button click observer + output$psf_ready <- renderText("Spec file saved in designated output folder") + + } + + } else if(input$pfd_input_type == "input_nwis") { + + output_psf <- writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, tab_file = output_nwis_peak_datapath, site_file = output_nwis_site_datapath) + + write_NWIS_peak(unique(rv$pf_data$site_no), output_nwis_peak_datapath) + write_NWIS_site(unique(rv$pf_data$site_no), output_nwis_site_datapath) + output$psf_ready <- renderText("Spec file saved in designated output folder") + + } else{ + target_tab_file <- attributes(rv$psf_opt)$peakFile + target_site_file <- attributes(rv$psf_opt)$siteinfoFile + + output_psf <- writePSF(rv$psf_opt, rv$psf_thresh, rv$psf_int, rv$psf_peaks, out_basename, output_psf_datapath, input$input_plot_format, input$input_plotPos, input$input_sym_conf, input$checkbox_extend, target_tab_file, target_site_file) + + } + + output$psf_ready <- renderText("Spec file saved in designated output folder") + } +}) -####-------------------------- Output Options -----------------------------#### - lower_limit <- reactive((100 - as.numeric(input$input_sym_conf)*100)/2) - upper_limit <- reactive(100-((100 - as.numeric(input$input_sym_conf)*100)/2)) + +####----------------------- Run Button Observer ---------------------------##### +observeEvent(input$RunPeakFQ, { #when button is clicked - observe( - output$conf_limit <- renderText({ - if(!is.na(lower_limit())){ - - paste0(lower_limit(), "-percent and ", upper_limit(), "-percent confidence limits") + # Re-initialize Log file variables + track_log <<- data.frame(matrix(nrow = 0, ncol = 1)) + error_count <<- 0 + + output$results_ready <- renderText("") #Clear out message if re-run + output$run_errors <- renderText("") #Clear out message if re-run + + #Check that there are psf dataframes to save out - if no psf_opt, no data - alert. + if(nrow(rv$psf_opt) == 0){ + + # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. + # shinyalert(title = "No data loaded", + # text = "Data must be loaded before the analysis can be run. Please load data and try again.", + # type = "error") + + } else if (is.null(output_directory) | output_directory == ""){ + + # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. + + } else { + + + # Produce output files + + # Use basename specified by user + out_basename <- input$input_base_file_name + + #Alert if basename is missing + if (str_length(out_basename) == 0) { + + # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. + # shinyalert(title = "Enter a base file name", + # text = "Please enter a base file name that should be used for output files before running the analysis.", + # type = "warning") + + } else { + + if(input$pfd_input_type == "input_tab") { + + #Try to save other data files + output_data <- try(peakfq(output_psf_datapath), silent = TRUE) + + if(is(output_data, 'error')|is(output_data, 'try-error')){ + + shinyalert(title = "Error running PeakFQ", + text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), + html = TRUE, + type = "error") + + output$run_errors <- renderText(output_data[1]) #Update error console on 'HELP' tab + + write_log(output_data <- peakfq(output_psf_datapath)) + + } else { + + # Save other data files + write_log(output_data <- peakfq(output_psf_datapath)) + full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") + write_log(write_mk_test(qt_df(), full_mk_path)) + + #alert + output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) + + } + + + } else if(input$pfd_input_type == "input_folder") { + + for (i in 1:nrow(rv$psf_opt)) { + + target_site <- rv$psf_opt$site_no[i] + + target_opt <- rv$psf_opt[rv$psf_opt$site_no == target_site,] + target_thresh <- rv$psf_thresh[rv$psf_thresh$site_no == target_site,] + target_int <- rv$psf_int[rv$psf_int$site_no == target_site,] + target_peaks <- rv$psf_peaks[rv$psf_peaks$site_no == target_site,] + + target_tab_file <- tab_file_list[i] + target_site_file <- site_file_list[i] + + # Try to save other data files + output_data <- try(peakfq(output_psf_datapath), silent = TRUE) + + if(is(output_data, 'error')|is(output_data, 'try-error')){ + + shinyalert(title = "Error running PeakFQ", + text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), + html = TRUE, + type = "error") + + output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab + + write_log(output_data <- peakfq(output_psf_datapath)) + + } else { + + # Save other data files + write_log(output_data <- peakfq(output_psf_datapath)) + full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") + write_log(write_mk_test(qt_df(), full_mk_path)) + + #alert + output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) + + } + + } + + } else if(input$pfd_input_type == "input_nwis") { + + + #No default folder path - make sure that one has been entered. + if(class(input$btn_output)[1] != "list"){ #This input is a list iff a file path has been selected. If it's not a list, alert and safe fail, + + # Alert is handled up with the observer on both button inputs. Just stop here - that alert will appear. + # shinyalert(title = "Select output folder", + # text = "Please select a folder to which output files should be saved.", + # type = "warning") + + } else { + + # Try data saveout + output_data <- try(peakfq(output_psf_datapath), silent = TRUE) + + if(is(output_data, 'error')|is(output_data, 'try-error')){ + + shinyalert(title = "Error running PeakFQ", + text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), + html = TRUE, + type = "error") + + output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab + + write_log(output_data <- peakfq(output_psf_datapath)) + + } else { + + write_log(nwis_data <- readNWISpeak(unique(rv$pf_data$site_no), asDateTime = FALSE, convertType = FALSE)) + + #Save out peak flow data and site info + write_log(write_NWIS_peak(unique(rv$pf_data$site_no), output_nwis_peak_datapath)) + write_log(write_NWIS_site(unique(rv$pf_data$site_no), output_nwis_site_datapath)) + + #Save other data files + write_log(output_data <- peakfq(output_psf_datapath)) + full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") + write_log(write_mk_test(qt_df(), full_mk_path)) + + #Alert + output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) + + } + + } + + } else{ + + target_tab_file <- attributes(rv$psf_opt)$peakFile + target_site_file <- attributes(rv$psf_opt)$siteinfoFile + + #Try to save other data files + output_data <- try(peakfq(output_psf_datapath), silent = TRUE) + + if(is(output_data, 'error')|is(output_data, 'try-error')){ + + shinyalert(title = "Error running PeakFQ", + text = paste0("PeakFQ returned the following error(s): <br> <br>", output_data[1]), + html = TRUE, + type = "error") + + output$run_errors <- renderText(paste(output_data[1])) #Update error console on 'HELP' tab + + write_log(output_data <- peakfq(output_psf_datapath)) + + } else { + + # Save other data files + write_log(output_data <- peakfq(output_psf_datapath)) + full_mk_path <- paste0(output_directory, "/", out_basename,"_trend.csv") + write_log(write_mk_test(qt_df(), full_mk_path)) + + output$results_ready <- renderText(paste0("PeakFQ Analysis Run. <br> Outputs have been saved to the specified folder.")) + + } + + } # End save output files + + + # Produce plots on Results tab + write_log(list_site <- rv$psf_opt$site_no) + + write_log(lapply(seq_along(list_site), function(i){ + p <- output_data[[5]][i] + + output[[paste("plot", i, sep = "_")]] <- renderPlot({ + p + }, + width = 500, + height = 350) + })) + + # Create plot tag list + write_log(output$ffa_plots <- renderUI({ + plot_output_list <- lapply(seq_along(list_site), function(i) { + plotname <- paste("plot", i, sep = "_") + plotOutput(plotname, height = '250px', inline=TRUE) + }) + + + do.call(tagList, plot_output_list) + + })) + + output$results_banner <- renderText(paste0("<b>Additional results are saved in the designated output folder: </b>", output_directory)) + output$ffa_header <- renderText("FFA Plots") + + + # Save log file + + full_log_path <- paste0(output_directory, "/", out_basename,".txt") + write.table(track_log, full_log_path, row.names = F, col.names = F, quote = F,sep = '\t') - } - }) - ) + } + } +}) ####------------------------------------------------------------------------#### }) # End Server Definition -#Call UI and server ------------------------------------------------------------ +############################# CALL UI & SERVER ################################# + # options(shiny.launch.browser = .rs.invokeShinyWindowExternal) # Force opening in default browser shinyApp(ui, server, options = list(width = 1200, height = 800)) #width and height taken as hints rather than requirements - -# runGadget(shinyApp(ui, server), -# viewer = browserViewer(browser = getOption("shiny.launch.browser"))) - -#################################### RESOURCES ################################# - -# https://cran.r-project.org/web/packages/rhandsontable/vignettes/intro_rhandsontable.html -# https://jrowen.github.io/rhandsontable/#Custom - \ No newline at end of file +################################################################################