├── www └── water.jpg ├── external ├── tabUI │ ├── instructions.R │ ├── home.R │ ├── tableTab.R │ ├── assessUTab.R │ ├── dataUpload.R │ ├── chartTab.R │ ├── templates.R │ ├── stationsTab.R │ ├── assessmentUnitsTab.R │ ├── CriteriaTab.R │ ├── metalsAnalysis.R │ ├── sidebar.R │ ├── mapTab.R │ └── analysisTab.R ├── WQP.R ├── Modules │ ├── sideboard1.R │ ├── misc.R │ ├── button.R │ ├── fileExport.R │ └── fileUpload.R ├── Metals_Analysis_Example.csv └── Functions │ └── functions.R ├── InputFiles ├── Metals_Analysis_Empty.csv ├── Assessment_Units-2017-08-02.csv ├── Criteria-2017-08-02 -sampleFraction.csv ├── generated from tool │ └── Metals-2017-09-08.csv ├── Metals-2017-08-24.csv └── Stations-2017-08-02.csv ├── README.md ├── ui.R ├── global.R ├── Launch_visualization.R ├── Metals_Analysis_Template.csv └── server.R /www/water.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/USEPA/Water-Quality-Data-Analysis-Tool/HEAD/www/water.jpg -------------------------------------------------------------------------------- /external/tabUI/instructions.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/USEPA/Water-Quality-Data-Analysis-Tool/HEAD/external/tabUI/instructions.R -------------------------------------------------------------------------------- /InputFiles/Metals_Analysis_Empty.csv: -------------------------------------------------------------------------------- 1 | PARM,Media,WBODY,ECOREGION,USE_OR_CLASS,Sample_Fraction,Units,Criterion,m,b,Hardness_default,CF 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Water-Quality-Data-Analysis-Tool 2 | 3 | DEPRECATED - This repository is no longer being maintained and is available for reuse. 4 | 5 | The WQP Data Analysis tool is a desktop application that provides an easy to use interface allowing users to analyze data that has been exported from the WQP Data Discovery Tool, or other similar applicaiton. The tool uses open source R, a statistical programming language and several add-on packages, to compare the data against water quality criteria, determine trends, and visualize that analysis. 6 | -------------------------------------------------------------------------------- /external/WQP.R: -------------------------------------------------------------------------------- 1 | 2 | WQP <- reactive({ 3 | if(is.null(dataFile())){ 4 | return(NULL) 5 | } else { 6 | dat <- dataFile() 7 | dat <- data.table(dat) 8 | # dat[, c("X", "X.1", "X.2") := NULL] 9 | dat[, ActivityStartDate := as.Date(ActivityStartDate, '%m/%d/%Y')] # '%Y-%m-%d') 10 | dat <- data.table(dat) 11 | dat$Result <- as.numeric(dat$Result) 12 | dat <- dat[!is.na(Result)] 13 | return(dat) 14 | 15 | }}) 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /external/tabUI/home.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | function(){ 4 | tabItem( 5 | tabName = "home", 6 | br(), 7 | fluidRow(#column(4), 8 | column(12, 9 | box(title = h2("Data Analysis Tool", align = "justify"), color = "olive", width = "100%"), 10 | br() 11 | )), 12 | br(), 13 | br(), 14 | fluidRow(img(src="water.jpg", width = "100%", height = "100%")) 15 | 16 | ) 17 | 18 | } 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /external/tabUI/tableTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "table", 5 | br(), 6 | br(), 7 | fluidRow(column(5), column(2, downloadButton("Save_Analysis", "Save Analysis Data"))), 8 | bsPopover("Save_Analysis", "Save Data", "Click to download a .csv file containing the complete analysis data set.", 9 | "top", trigger = "hover", options = list(container = "body")), 10 | br(), 11 | fluidRow( 12 | column(10, offset = 0.5, 13 | DT::dataTableOutput("analysis_table") 14 | ) 15 | 16 | ) 17 | ) 18 | } 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /external/Modules/sideboard1.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Module UI function 4 | menuitemUI <- function(id, label, shape) { 5 | # Create a namespace function using the provided id 6 | ns <- NS(id) 7 | menuItem(ns("sidemenu"), 8 | text = label, 9 | icon = icon(shape)) 10 | 11 | } 12 | 13 | 14 | 15 | 16 | 17 | # 18 | # 19 | # # Module UI function 20 | # menuitemUI <- function(id, label, icons = "table") { 21 | # # Create a namespace function using the provided id 22 | # ns <- NS(id) 23 | # menuItem(ns("sidemenu"), text = label, icon = icon(icons)) 24 | # 25 | # } 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /external/Modules/misc.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Module UI function 4 | displayTableUI <- function(id) { 5 | # Create a namespace function using the provided id 6 | ns <- NS(id) 7 | DT::dataTableOutput(ns("table")) 8 | 9 | } 10 | 11 | displayTable <- function(input, output, session, data){ 12 | output$tbl = DT::renderDataTable( 13 | data(), row.names = FALSE) 14 | 15 | } 16 | 17 | # Module for download handler 18 | downloadFileUI <- function(id, label) { 19 | ns <- NS(id) 20 | downloadButton(ns("download"), label, icon = icon("download")) 21 | } 22 | 23 | 24 | downloadFile <- function(input, output, session, data) { 25 | 26 | { 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /external/Modules/button.R: -------------------------------------------------------------------------------- 1 | 2 | # Module UI function 3 | downloadbuttonUI <- function(id, label = "Download the file") { 4 | # Create a namespace function using the provided id 5 | ns <- NS(id) 6 | 7 | tagList( 8 | # fileInput(ns("file"), label) 9 | downloadButton(ns("download"), label, icon = icon("download")) 10 | ) 11 | 12 | 13 | } 14 | 15 | # Module server function 16 | downloadbutton <- function(input, output, session, labels, data) { 17 | 18 | output$download <- downloadHandler( 19 | filename = function() { 20 | labels 21 | }, 22 | content = function(con) { 23 | write.table(data(), con, row.names = FALSE, sep = ",") 24 | }) 25 | } 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /external/tabUI/assessUTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "assessUSummary", 5 | br(), 6 | br(), 7 | h4(uiOutput('AssesU_Summary_select', style = "text-align:center")), 8 | h4(uiOutput('AssessU_text', style = "text-align:center")), 9 | wellPanel(h4("Assessment Unit Time Series Chart", style = "text-align:center"), 10 | h4(uiOutput('Assess_Use_select', style = "text-align:center")), 11 | uiOutput('Assess_time', style = "text-align:center"), 12 | showOutput('timeseries_assess', 'highcharts') 13 | ), 14 | br(), 15 | fluidRow( 16 | column(10, offset = 0.5, 17 | DT::dataTableOutput("assess_Stat_table") 18 | )) 19 | ) 20 | } 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /InputFiles/Assessment_Units-2017-08-02.csv: -------------------------------------------------------------------------------- 1 | AssessmentUnit,USE_OR_CLASS,WBODY,ECOREGION 2 | BCMainstem1,Primary Contact Recreation,, 3 | BCMainstem1,Fish Consumption,, 4 | BCMainstem1,Agriculture,, 5 | BCMainstem1,Drinking Water Supply,, 6 | BCMainstem1,Aquatic Life,, 7 | BCTrib1,Primary Contact Recreation,, 8 | BCTrib1,Fish Consumption,, 9 | BCTrib1,Agriculture,, 10 | BCTrib1,Drinking Water Supply,, 11 | BCTrib1,Aquatic Life,, 12 | BCTrib2,Primary Contact Recreation,, 13 | BCTrib2,Agriculture,, 14 | BCTrib2,Drinking Water Supply,, 15 | BCTrib2,Aquatic Life,, 16 | BCTrib3,Primary Contact Recreation,, 17 | BCTrib3,Fish Consumption,, 18 | BCTrib3,Agriculture,, 19 | BCTrib3,Drinking Water Supply,, 20 | BCTrib3,Aquatic Life,, 21 | BCTrib4,Primary Contact Recreation,, 22 | BCTrib4,Fish Consumption,, 23 | BCTrib4,Agriculture,, 24 | BCTrib4,Drinking Water Supply,, 25 | BCTrib4,Aquatic Life,, 26 | BCTrib5,Primary Contact Recreation,, 27 | BCTrib5,Fish Consumption,, 28 | BCTrib5,Agriculture,, 29 | BCTrib5,Drinking Water Supply,, 30 | BCTrib5,Aquatic Life,, 31 | -------------------------------------------------------------------------------- /external/tabUI/dataUpload.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "data", 5 | br(), 6 | br(), 7 | h3("Upload data from the Data Discovery Tool"), 8 | br(), 9 | fluidRow(column(8, 10 | bsCollapse(open = c("Upload panel"), 11 | multiple = TRUE, 12 | bsCollapsePanel(title = "Upload panel", style = "info", 13 | csvFileInput("dataFile", "Upload the data file (.csv format)")) 14 | 15 | 16 | ) 17 | ), 18 | br(), 19 | br(), 20 | br(), 21 | br(), 22 | fluidRow(column(10, offset =1, 23 | uiOutput("meta"), 24 | br(), 25 | br(), 26 | DT::dataTableOutput("discoveryDataTable") 27 | )) 28 | ) 29 | ) 30 | } 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | -------------------------------------------------------------------------------- /external/tabUI/chartTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "chart", 5 | uiOutput("chart_text"), 6 | # br(), 7 | # br(), 8 | h4(uiOutput("Station_Summary_Panel"), style = "text-align:center"), 9 | h5(uiOutput("Station_Summary_select"), style = "text-align:center"), 10 | h5(uiOutput("Station_Summary_text"), style = "text-align:center"), 11 | br(), 12 | # showOutput("station_scatter", "highcharts"), 13 | showOutput("barplot", "highcharts"), 14 | h4("Sampling Frequency", style = "text-align:center"), 15 | plotOutput("Station_data_time_plot"), 16 | h5("* Red points indicate exceedances"), 17 | fluidRow(column(3, offset = 5, 18 | downloadButton('freq_chart', h5('Save Image'), icon = icon("download")) 19 | )), 20 | br(), 21 | wellPanel(h4("Time Series Chart", style = "text-align:center"), 22 | uiOutput('Station_time', style = "text-align:center"), 23 | showOutput('timeseries', 'highcharts') 24 | ) 25 | ) 26 | } 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /ui.R: -------------------------------------------------------------------------------- 1 | 2 | # Header ----------------------------------------------------------- 3 | 4 | header <- dashboardHeader(title = "", titleWidth = 250) 5 | 6 | # Sidebar -------------------------------------------------------------- 7 | 8 | sidebar <- dashboardSidebar(width = 250, sm) 9 | 10 | # Dashboard body -------------------------------------------------- 11 | 12 | body <- dashboardBody( 13 | tags$head(tags$style(HTML(' 14 | .content-wrapper, 15 | .right-side { 16 | background-color: #ffffff; 17 | } 18 | ') 19 | ) 20 | ), 21 | tabItems( 22 | homePanel(), 23 | instructionsPanel(), 24 | dataUploadPanel(), 25 | stationsPanel(), 26 | assessmentUnitsPanel(), 27 | criteriaPanel(), 28 | metalsPanel(), 29 | analysisPanel(), 30 | mapPanel(), 31 | chartPanel(), 32 | # tablePanel() 33 | assessUPanel() 34 | ) 35 | ) 36 | 37 | # Setup Shiny app UI components ------------------------------------------- 38 | 39 | ui <- dashboardPage(header, sidebar, body, skin = "blue") 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /external/Modules/fileExport.R: -------------------------------------------------------------------------------- 1 | 2 | # Module UI function 3 | 4 | downloadFileOutput <- function(id, label = "CSV file") { 5 | # Create a namespace function using the provided id 6 | ns <- NS(id) 7 | 8 | tagList( 9 | fileInput(ns("file"), label) 10 | 11 | ) 12 | } 13 | 14 | 15 | # Module server function 16 | 17 | downloadFile <- function(input, output, session, header = TRUE, stringsAsFactors = FALSE) { 18 | # The selected file, if any 19 | userFile <- reactive({ 20 | # If no file is selected, don't do anything 21 | validate(need(input$file, message = FALSE)) 22 | input$file 23 | }) 24 | 25 | # The user's data, parsed into a data frame 26 | dataframe <- reactive({ 27 | read.table(userFile()$datapath, 28 | header = header, 29 | # quote = input$quote, 30 | stringsAsFactors = stringsAsFactors) 31 | }) 32 | 33 | # We can run observers in here if we want to 34 | observe({ 35 | msg <- sprintf("File %s was uploaded", userFile()$name) 36 | cat(msg, "\n") 37 | }) 38 | 39 | # Return the reactive that yields the data frame 40 | return(dataframe) 41 | } 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /external/tabUI/templates.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "criteria", 5 | br(), 6 | fluidRow(column(8, #offset =1, 7 | bsCollapse(open = c("Download panel"), 8 | multiple = TRUE, 9 | bsCollapsePanel(title = "Download panel", style = "info", 10 | downloadButton("download", "Download the criteria template", icon = icon("download"))) 11 | ) 12 | ) 13 | ), 14 | br(), 15 | fluidRow(column(8, 16 | bsCollapse(open = c("Upload panel"), 17 | multiple = TRUE, 18 | bsCollapsePanel(title = "Upload panel", style = "info", 19 | csvFileInput("criteriaFile", "Upload the criteria file (.csv format)")) 20 | 21 | 22 | ) 23 | ), 24 | br(), 25 | br(), 26 | fluidRow(column(10, offset =1, 27 | dataTableOutput("table") 28 | )) 29 | ) 30 | ) 31 | } 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /external/tabUI/stationsTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "stations", 5 | br(), 6 | fluidRow(column(8, #offset =1, 7 | bsCollapse(open = c("Download panel"), 8 | multiple = TRUE, 9 | bsCollapsePanel(title = "Download panel", style = "info", 10 | downloadButton("Station_outfile", "Download the stations template", icon = icon("download")) 11 | ) 12 | ) 13 | ) 14 | ), 15 | br(), 16 | fluidRow(column(8, 17 | bsCollapse(open = c("Upload panel"), 18 | multiple = TRUE, 19 | bsCollapsePanel(title = "Upload panel", style = "info", 20 | csvFileInput("stationsFile", "Upload the stations file (.csv format)")) 21 | 22 | 23 | ) 24 | ), 25 | br(), 26 | br(), 27 | fluidRow(column(10, offset =1, 28 | DT::dataTableOutput("stations_table") 29 | )) 30 | ) 31 | ) 32 | } 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /external/tabUI/assessmentUnitsTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "assessmentUnits", 5 | br(), 6 | fluidRow(column(8, #offset =1, 7 | bsCollapse(open = c("Download panel"), 8 | multiple = TRUE, 9 | bsCollapsePanel(title = "Download panel", style = "info", 10 | downloadButton("AssessmentUnit_outfile", "Download the assessment units template", icon = icon("download"))) 11 | ) 12 | ) 13 | ), 14 | br(), 15 | fluidRow(column(8, 16 | bsCollapse(open = c("Upload panel"), 17 | multiple = TRUE, 18 | bsCollapsePanel(title = "Upload panel", style = "info", 19 | csvFileInput("assessmentUnitFile", "Upload the assessment units file (.csv format)")) 20 | 21 | 22 | ) 23 | ), 24 | br(), 25 | br(), 26 | fluidRow(column(10, offset =1, 27 | DT::dataTableOutput("assessmentUnit_table") 28 | )) 29 | ) 30 | ) 31 | } 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /external/Modules/fileUpload.R: -------------------------------------------------------------------------------- 1 | 2 | # Module UI function 3 | csvFileInput <- function(id, label = "CSV file") { 4 | # Create a namespace function using the provided id 5 | ns <- NS(id) 6 | 7 | tagList( 8 | fileInput(ns("file"), label) 9 | # checkboxInput(ns("heading"), "Has heading", value = TRUE), 10 | # selectInput(ns("quote"), "Quote", c( 11 | # "None" = "", 12 | # "Double quote" = "\"", 13 | # "Single quote" = "'" 14 | # )) 15 | ) 16 | 17 | } 18 | 19 | # Module server function 20 | csvFile <- function(input, output, session, stringsAsFactors, skip = 0) { 21 | # The selected file, if any 22 | userFile <- reactive({ 23 | # If no file is selected, don't do anything 24 | validate(need(input$file, message = FALSE)) 25 | input$file 26 | }) 27 | 28 | # The user's data, parsed into a data frame 29 | dataframe <- reactive({ 30 | read.csv(userFile()$datapath, 31 | header = TRUE, 32 | skip = skip, 33 | stringsAsFactors = stringsAsFactors) 34 | }) 35 | 36 | # We can run observers in here if we want to 37 | observe({ 38 | msg <- sprintf("File %s was uploaded", userFile()$name) 39 | cat(msg, "\n") 40 | }) 41 | 42 | # Return the reactive that yields the data frame 43 | return(dataframe) 44 | } 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /external/tabUI/CriteriaTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "criteria", 5 | br(), 6 | fluidRow(column(8, #offset =1, 7 | bsCollapse(open = c("Download panel"), 8 | multiple = TRUE, 9 | bsCollapsePanel(title = "Download panel", style = "info", 10 | downloadButton("Criteria_outfile", "Download the criteria template", icon = icon("download"))) 11 | #downloadbuttonUI("criteria", label = "Download the criteria file") 12 | 13 | ) 14 | )), 15 | br(), 16 | fluidRow(column(8, 17 | bsCollapse(open = c("Upload panel"), 18 | multiple = TRUE, 19 | bsCollapsePanel(title = "Upload panel", style = "info", 20 | csvFileInput("criteriaFile", "Upload the criteria file (.csv format)")) 21 | 22 | 23 | ) 24 | ), 25 | br(), 26 | br(), 27 | fluidRow(column(10, offset =1, 28 | DT::dataTableOutput("criteria_table") 29 | )) 30 | ) 31 | ) 32 | } 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /external/tabUI/metalsAnalysis.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "metals", 5 | br(), 6 | fluidRow(column(8, #offset =1, 7 | bsCollapse(open = c("Download panel"), 8 | multiple = TRUE, 9 | bsCollapsePanel(title = "Download panel", style = "info", 10 | downloadButton("Criteria_metals", "Download a metals analysis spreadsheet example", icon = icon("download"))) 11 | #downloadbuttonUI("criteria", label = "Download the criteria file") 12 | 13 | ) 14 | )), 15 | br(), 16 | fluidRow(column(8, 17 | bsCollapse(open = c("Upload panel"), 18 | multiple = TRUE, 19 | bsCollapsePanel(title = "Upload panel", style = "info", 20 | csvFileInput("metalscriteriaFile", "Upload the parameter file (.csv format)")) 21 | 22 | 23 | ) 24 | ), 25 | br(), 26 | br(), 27 | fluidRow(column(10, offset =1, 28 | DT::dataTableOutput("metals_table") 29 | ) 30 | ) 31 | ) 32 | ) 33 | } 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /external/tabUI/sidebar.R: -------------------------------------------------------------------------------- 1 | 2 | sm <- sidebarMenu( 3 | br(), 4 | menuItem(tabName = "home", 5 | text = "Home", 6 | icon = icon("home")), 7 | menuItem(tabName = "instructions", 8 | text = "Instructions", 9 | icon = icon("list")), 10 | menuItem(tabName = "data", 11 | text = "Data Upload", 12 | icon = icon("upload")), 13 | menuItem(tabName = "stations", 14 | text = "Stations", 15 | icon = icon("institution")), 16 | menuItem(tabName = "assessmentUnits", 17 | text = "Assessment Units", 18 | icon = icon("object-group")), 19 | menuItem(tabName = "criteria", 20 | text = "Criteria", 21 | icon = icon("table")), 22 | menuItem(tabName = "metals", 23 | text = "Metals Analysis", 24 | icon = icon( "flask")), 25 | menuItem(tabName = "analysis", 26 | text = "Analysis", 27 | icon = icon("line-chart")), 28 | menuItem(tabName = "map", 29 | text = "Map", 30 | icon = icon( "map")), 31 | menuItem(tabName = "summary", 32 | text = "Station summary", 33 | icon = icon("book"), 34 | menuSubItem(tabName = "chart", 35 | text = "Charts", 36 | icon = icon("bar-chart"))), 37 | # menuSubItem(tabName = "table", 38 | # text = "Table", 39 | # icon = icon("table")), 40 | menuItem(tabName = "assessUSummary", 41 | text = "Assessment Unit Summary", 42 | icon = icon("file")) 43 | 44 | 45 | ) 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | -------------------------------------------------------------------------------- /global.R: -------------------------------------------------------------------------------- 1 | 2 | library(data.table) 3 | library(dplyr) 4 | library(ggplot2) 5 | library(htmltools) 6 | library(leaflet) 7 | library(magrittr) 8 | library(rCharts) 9 | library(rkt) 10 | library(scales) 11 | library(shiny) 12 | library(shinyBS) 13 | library(shinydashboard) 14 | #library(sparkline) 15 | library(stringr) 16 | library(grid) 17 | 18 | 19 | 20 | 21 | 22 | # Sourcing functions files 23 | source("external/Functions/functions.R") 24 | 25 | # Sourcing module files 26 | source("external/Modules/fileUpload.R") 27 | source("external/Modules/button.R") 28 | 29 | # File with the sidebar code 30 | source("external/tabUI/sidebar.R", local = TRUE) 31 | 32 | # The separate files composing the panels 33 | homePanel <- source("external/tabUI/home.R", local = TRUE)$value 34 | instructionsPanel <- source("external/tabUI/instructions.R", local = TRUE)$value 35 | dataUploadPanel <- source("external/tabUI/dataUpload.R", local = TRUE)$value 36 | 37 | #templatePanel <- source("external/tabUI/templates.R", local = TRUE)$value 38 | stationsPanel <- source("external/tabUI/stationsTab.R", local = TRUE)$value 39 | assessmentUnitsPanel <- source("external/tabUI/assessmentUnitsTab.R", local = TRUE)$value 40 | criteriaPanel <- source("external/tabUI/CriteriaTab.R", local = TRUE)$value 41 | analysisPanel <- source("external/tabUI/analysisTab.R", local = TRUE)$value 42 | mapPanel <- source("external/tabUI/mapTab.R", local = TRUE)$value 43 | chartPanel <- source("external/tabUI/chartTab.R", local = TRUE)$value 44 | tablePanel <- source("external/tabUI/tableTab.R", local = TRUE)$value 45 | assessUPanel <- source("external/tabUI/assessUTab.R", local = TRUE)$value 46 | metalsPanel <- source("external/tabUI/metalsAnalysis.R", local = TRUE)$value 47 | 48 | # Import the metals criteria file 49 | metalsCriteria <- read.csv("external/Metals_Analysis_Example.csv") 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | -------------------------------------------------------------------------------- /Launch_visualization.R: -------------------------------------------------------------------------------- 1 | ifelse(as.numeric(R.Version()$major)<3, 2 | {writeLines("You are running an old version of R. \nPlease Update to R Version 3.2 or higher. \nThe Quick Start Guide provides step by step instructions to update R.")},{ 3 | #ifelse(as.numeric(R.Version()$major)==3 & as.numeric(R.Version()$minor)<2.1, 4 | #{writeLines("You are running an old version of R. \nPlease Update to R Version 3.2.1 or higher. \nThe Quick Start Guide provides step by step instructions to update R.")}, { 5 | # Install packages if needed 6 | # if ("dataRetrieval" %in% rownames(installed.packages()) ){ 7 | # packinfo<-installed.packages(fields = c("Package", "Version")) 8 | # if (as.numeric(substr(packinfo["dataRetrieval", "Version"], 1, 3))<2.3){ 9 | # remove.packages("dataRetrieval") 10 | # install.packages("dataRetrieval", repos='http://cran.cnr.Berkeley.edu') 11 | # } 12 | # } 13 | packageNeeds <- c('shiny', 'shinyBS', 'data.table', 'DT', 14 | 'dplyr', 'dataRetrieval', 'devtools', 'httr', 'grid', 15 | 'ggplot2', 'stringr', 'scales', 'rkt', 'magrittr', 'htmltools', 'shinydashboard') 16 | packageNeeds <- packageNeeds[!packageNeeds %in% rownames(installed.packages())] 17 | if(length(packageNeeds)>0){ 18 | install.packages(packageNeeds, repos='http://cran.cnr.Berkeley.edu') 19 | } 20 | devPackages<-c("leaflet", "rCharts") 21 | devPackages <- devPackages[!devPackages %in% rownames(installed.packages())] 22 | if (length(devPackages)>0){ 23 | require(devtools) 24 | if ("rCharts" %in% devPackages){ 25 | devtools::install_github('ramnathv/rCharts') 26 | } 27 | if("leaflet" %in% devPackages){ 28 | devtools::install_github("rstudio/leaflet") 29 | } 30 | } 31 | ## run the app 32 | require(shiny) 33 | runApp(launch.browser = T) 34 | }) 35 | 36 | -------------------------------------------------------------------------------- /external/Metals_Analysis_Example.csv: -------------------------------------------------------------------------------- 1 | PARM,Media,WBODY,USE_OR_CLASS,Sample_Fraction,Unit,Criteria,m,b,Hardness_default,CF 2 | Arsenic,Water,,,,ug/L,Freshwater Acute,,,3,1 3 | Arsenic,Water,,,,ug/L,Freshwater Chronic,,,4,1 4 | Arsenic,Water,,,,ug/L,Saltwater Acute,,,, 5 | Arsenic,Water,,,,ug/L,Saltwater Chronic,,,, 6 | Cadmium,Water,,,,ug/L,Freshwater Acute,0.9789,-3.866,2, 7 | Cadmium,Water,,,,ug/L,Freshwater Chronic,0.7977,-3.909,2.5, 8 | Cadmium,Water,,,,ug/L,Saltwater Acute,,,, 9 | Cadmium,Water,,,,ug/L,Saltwater Chronic,,,, 10 | Chromium III,Water,,,,ug/L,Freshwater Acute,0.819,3.7256,5,0.316 11 | Chromium III,Water,,,,ug/L,Freshwater Chronic,0.819,0.6848,1,0.86 12 | Chromium III,Water,,,,ug/L,Saltwater Acute,,,, 13 | Chromium III,Water,,,,ug/L,Saltwater Chronic,,,, 14 | Chromium VI,Water,,,,ug/L,Freshwater Acute,,,4.5,0.982 15 | Chromium VI,Water,,,,ug/L,Freshwater Chronic,,,6,0.962 16 | Chromium VI,Water,,,,ug/L,Saltwater Acute,,,, 17 | Chromium VI,Water,,,,ug/L,Saltwater Chronic,,,, 18 | Copper,Water,,,,ug/L,Freshwater Acute,,,3.5,0.96 19 | Copper,Water,,,,ug/L,Freshwater Chronic,,,2,0.96 20 | Copper,Water,,,,ug/L,Saltwater Acute,,,, 21 | Copper,Water,,,,ug/L,Saltwater Chronic,,,, 22 | Lead,Water,,,,ug/L,Freshwater Acute,1.273,-1.46,4, 23 | Lead,Water,,,,ug/L,Freshwater Chronic,1.273,-4.705,4.4, 24 | Lead,Water,,,,ug/L,Saltwater Acute,,,, 25 | Lead,Water,,,,ug/L,Saltwater Chronic,,,, 26 | Mercury,Water,,,,ug/L,Freshwater Acute,,,2,0.85 27 | Mercury,Water,,,,ug/L,Freshwater Chronic,,,3,0.85 28 | Mercury,Water,,,,ug/L,Saltwater Acute,,,, 29 | Mercury,Water,,,,ug/L,Saltwater Chronic,,,, 30 | Nickel,Water,,,,ug/L,Freshwater Acute,0.846,2.255,4,0.998 31 | Nickel,Water,,,,ug/L,Freshwater Chronic,0.846,0.0584,5,0.997 32 | Nickel,Water,,,,ug/L,Saltwater Acute,,,, 33 | Nickel,Water,,,,ug/L,Saltwater Chronic,,,, 34 | Selenium,Water,,,,ug/L,Freshwater Acute,,,, 35 | Selenium,Water,,,,ug/L,Freshwater Chronic,,,, 36 | Selenium,Water,,,,ug/L,Saltwater Acute,,,, 37 | Selenium,Water,,,,ug/L,Saltwater Chronic,,,, 38 | Silver,Water,,,,ug/L,Freshwater Acute,1.72,-6.59,3,0.85 39 | Silver,Water,,,,ug/L,Freshwater Chronic,,,, 40 | Silver,Water,,,,ug/L,Saltwater Acute,,,, 41 | Silver,Water,,,,ug/L,Saltwater Chronic,,,, 42 | Zinc,Water,,,,ug/L,Freshwater Acute,0.8473,0.884,7,0.978 43 | Zinc,Water,,,,ug/L,Freshwater Chronic,0.8473,0.884,8,0.986 44 | Zinc,Water,,,,ug/L,Saltwater Acute,,,, 45 | Zinc,Water,,,,ug/L,Saltwater Chronic,,,, 46 | -------------------------------------------------------------------------------- /InputFiles/Criteria-2017-08-02 -sampleFraction.csv: -------------------------------------------------------------------------------- 1 | PARM,Units,USE_OR_CLASS,Media,WBODY,ECOREGION,Sample_Fraction,Criterion,Limit,Comparison,AverageTime,MinSamples,SeasonStartDate,SeasonEndDate 2 | Conductivity,uS/cm,Aquatic Life,Water,,,Total,Upper,1000,GT,,,, 3 | Dissolved Oxygen (DO),mg/l,Aquatic Life,Water,,,NA,Lower,4,LT,,,, 4 | Escherichia Coli,MPN/100 ml,Primary Contact Recreation,Water,,,NA,Geomean,100,GT,30,,, 5 | Fluoride,mg/l,Aquatic Life,Water,,,Dissolved,Upper,1.4,GT,,,, 6 | Fluoride,mg/l,Aquatic Life,Water,,,Total,Upper,1.4,GT,,,, 7 | Iron,ug/l,Aquatic Life,Water,,,Total,Upper,1000000,GT,,,, 8 | Iron,ug/l,Aquatic Life,Water,,,Dissolved,Upper,1000008,GT,,,, 9 | Iron,mg/kg ,Aquatic Life,Sediment,,,Total,Upper,1000008,GT,,,, 10 | Kjeldahl Nitrogen,mg/l,Aquatic Life,Water,,,Total,Upper,4,GT,,,, 11 | Kjeldahl Nitrogen,mg/l as N,Aquatic Life,Water,,,Dissolved,Upper,4,GT,,,, 12 | Kjeldahl Nitrogen,mg/kg ,Aquatic Life,Water,,,Sediment,Upper,3,,,,, 13 | Manganese,mg/kg,Drinking Water Supply,Water,,,Total,Upper,1,GT,,,, 14 | Manganese,ug/l,Drinking Water Supply,Water,,,Dissolved,Upper,1000,GT,,,, 15 | Nitrate,mg/l as N,Aquatic Life,Water,,,Dissolved,Upper,10,GT,,,, 16 | Nitrogen,mg/l,Agriculture,Water,,,Dissolved,Upper,10,GT,,,, 17 | "Nitrogen, Mixed Forms (Nh3), (Nh4), Organic, (No2) And (No3)",mg/l,Agriculture,Water,,,Dissolved,Upper,10,GT,,,, 18 | Ph,None,Aquatic Life,Water,,,NA,Lower,6.5,LT,,,, 19 | Ph,None ,Aquatic Life,Water,,,NA,Upper,9,GT,,,, 20 | Phosphate-Phosphorus As P,mg/l ,Aquatic Life,Water,,,Dissolved,Upper,0.007,GT,,,, 21 | Phosphorus,mg/l,Aquatic Life,Water,,,Total,Upper,0.007,GT,,,, 22 | Phosphorus,mg/l as P,Aquatic Life,Water,,,Total,Upper,0.007,GT,,,, 23 | Phosphorus,ug/l,Aquatic Life,Water,,,NA,Upper,7,GT,,,, 24 | Specific Conductance,umho/cm,Aquatic Life,Water,,,NA,Upper,1000,GT,,,, 25 | Specific Conductance,uS/cm ,Aquatic Life,Water,,,NA,Upper,10,GT,,,, 26 | Specific Conductance,uS/cm @25C,Aquatic Life,Water,,,Total,Upper,10,GT,,,, 27 | "Temperature, Water",deg C,Aquatic Life,Water,,,NA,seasonal,16,GT,,,101,331 28 | "Temperature, Water",deg C,Aquatic Life,Water,,,NA,seasonal,32,GT,,,401,631 29 | Total Coliform,MPN/100 ml,Primary Contact Recreation,Water,,,Total,Geomean,200,GT,,,, 30 | Total Coliform,MPN/100 ml,Primary Contact Recreation,Water,,,Total,RollingAvg,100,GT,30,,, 31 | Total Dissolved Solids,mg/l,Primary Contact Recreation,Water,,,Dissolved,Upper,180,GT,,,, 32 | Turbidity,NTU,Aquatic Life,Water,,,NA,Upper,15,GT,,,, 33 | -------------------------------------------------------------------------------- /InputFiles/generated from tool/Metals-2017-09-08.csv: -------------------------------------------------------------------------------- 1 | "Metal","Media","WBODY","USE_OR_CLASS","Sample_Fraction","Unit","Criteria.Type","m","b","Hardness_default","CF" 2 | "Arsenic","Water",NA,NA,NA,"ug/L","Freshwater Acute",NA,NA,3,1 3 | "Arsenic","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,4,1 4 | "Arsenic","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 5 | "Arsenic","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 6 | "Cadmium","Water",NA,NA,NA,"ug/L","Freshwater Acute",0.9789,-3.866,2,NA 7 | "Cadmium","Water",NA,NA,NA,"ug/L","Freshwater Chronic",0.7977,-3.909,2.5,NA 8 | "Cadmium","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 9 | "Cadmium","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 10 | "Chromium III","Water",NA,NA,NA,"ug/L","Freshwater Acute",0.819,3.7256,5,0.316 11 | "Chromium III","Water",NA,NA,NA,"ug/L","Freshwater Chronic",0.819,0.6848,1,0.86 12 | "Chromium III","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 13 | "Chromium III","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 14 | "Chromium VI","Water",NA,NA,NA,"ug/L","Freshwater Acute",NA,NA,4.5,0.982 15 | "Chromium VI","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,6,0.962 16 | "Chromium VI","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 17 | "Chromium VI","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 18 | "Copper","Water",NA,NA,NA,"ug/L","Freshwater Acute",NA,NA,3.5,0.96 19 | "Copper","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,2,0.96 20 | "Copper","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 21 | "Copper","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 22 | "Lead","Water",NA,NA,NA,"ug/L","Freshwater Acute",1.273,-1.46,4,NA 23 | "Lead","Water",NA,NA,NA,"ug/L","Freshwater Chronic",1.273,-4.705,4.4,NA 24 | "Lead","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 25 | "Lead","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 26 | "Mercury","Water",NA,NA,NA,"ug/L","Freshwater Acute",NA,NA,2,0.85 27 | "Mercury","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,3,0.85 28 | "Mercury","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 29 | "Mercury","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 30 | "Nickel","Water",NA,NA,NA,"ug/L","Freshwater Acute",0.846,2.255,4,0.998 31 | "Nickel","Water",NA,NA,NA,"ug/L","Freshwater Chronic",0.846,0.0584,5,0.997 32 | "Nickel","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 33 | "Nickel","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 34 | "Selenium","Water",NA,NA,NA,"ug/L","Freshwater Acute",NA,NA,NA,NA 35 | "Selenium","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,NA,NA 36 | "Selenium","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 37 | "Selenium","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 38 | "Silver","Water",NA,NA,NA,"ug/L","Freshwater Acute",1.72,-6.59,3,0.85 39 | "Silver","Water",NA,NA,NA,"ug/L","Freshwater Chronic",NA,NA,NA,NA 40 | "Silver","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 41 | "Silver","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 42 | "Zinc","Water",NA,NA,NA,"ug/L","Freshwater Acute",0.8473,0.884,7,0.978 43 | "Zinc","Water",NA,NA,NA,"ug/L","Freshwater Chronic",0.8473,0.884,8,0.986 44 | "Zinc","Water",NA,NA,NA,"ug/L","Saltwater Acute",NA,NA,NA,NA 45 | "Zinc","Water",NA,NA,NA,"ug/L","Saltwater Chronic",NA,NA,NA,NA 46 | -------------------------------------------------------------------------------- /InputFiles/Metals-2017-08-24.csv: -------------------------------------------------------------------------------- 1 | PARM,Media,WBODY,USE_OR_CLASS,Sample_Fraction,Unit,Criterion,m,b,Hardness_default,CF 2 | Arsenic,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,NA,NA,3,1 3 | Arsenic,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,4,1 4 | Arsenic,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 5 | Arsenic,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 6 | Cadmium,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,0.9789,-3.866,2,NA 7 | Cadmium,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,0.7977,-3.909,2.5,NA 8 | Cadmium,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 9 | Cadmium,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 10 | Chromium III,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,0.819,3.7256,5,0.316 11 | Chromium III,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,0.819,0.6848,1,0.86 12 | Chromium III,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 13 | Chromium III,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 14 | Chromium VI,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,NA,NA,4.5,0.982 15 | Chromium VI,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,6,0.962 16 | Chromium VI,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 17 | Chromium VI,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 18 | Copper,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,NA,NA,3.5,0.96 19 | Copper,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,2,0.96 20 | Copper,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 21 | Copper,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 22 | Lead,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,1.273,-1.46,4,NA 23 | Lead,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,1.273,-4.705,4.4,NA 24 | Lead,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 25 | Lead,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 26 | Mercury,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,NA,NA,2,0.85 27 | Mercury,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,3,0.85 28 | Mercury,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 29 | Mercury,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 30 | Nickel,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,0.846,2.255,4,0.998 31 | Nickel,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,0.846,0.0584,5,0.997 32 | Nickel,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 33 | Nickel,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 34 | Selenium,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,NA,NA,NA,NA 35 | Selenium,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,NA,NA 36 | Selenium,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 37 | Selenium,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 38 | Silver,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,1.72,-6.59,3,0.85 39 | Silver,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,NA,NA,NA,NA 40 | Silver,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 41 | Silver,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 42 | Zinc,Water,NA,Aquatic Life,NA,ug/L,Freshwater Acute,0.8473,0.884,7,0.978 43 | Zinc,Water,NA,Aquatic Life,NA,ug/L,Freshwater Chronic,0.8473,0.884,8,0.986 44 | Zinc,Water,NA,Aquatic Life,NA,ug/L,Saltwater Acute,NA,NA,NA,NA 45 | Zinc,Water,NA,Aquatic Life,NA,ug/L,Saltwater Chronic,NA,NA,NA,NA 46 | -------------------------------------------------------------------------------- /Metals_Analysis_Template.csv: -------------------------------------------------------------------------------- 1 | PARM,Media,WBODY,USE_OR_CLASS,Sample_Fraction,Units,Criterion,m,b,Hardness_default,CF 2 | Arsenic,Water,,WWAL,,ug/l,Freshwater Acute,,,3,1 3 | Arsenic,Water,,WWAL,,ug/l,Freshwater Chronic,,,4,1 4 | Arsenic,Water,,DWI,,ug/l,Freshwater Acute,,,3,1 5 | Arsenic,Water,,DWI,,ug/l,Freshwater Chronic,,,4,1 6 | Arsenic,Water,,PCR,,ug/l,Freshwater Acute,,,3,1 7 | Arsenic,Water,,PCR,,ug/l,Freshwater Chronic,,,4,1 8 | Arsenic,Water,,WWAL,,ug/l,Saltwater Acute,,,, 9 | Arsenic,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 10 | Cadmium,Water,,WWAL,,ug/l,Freshwater Acute,0.9789,-3.866,2, 11 | Cadmium,Water,,WWAL,,ug/l,Freshwater Chronic,0.7977,-3.909,2.5, 12 | Cadmium,Water,,DWI,,ug/l,Freshwater Acute,0.9789,-3.866,2, 13 | Cadmium,Water,,DWI,,ug/l,Freshwater Chronic,0.7977,-3.909,2.5, 14 | Cadmium,Water,,PCR,,ug/l,Freshwater Acute,0.9789,-3.866,2, 15 | Cadmium,Water,,PCR,,ug/l,Freshwater Chronic,0.7977,-3.909,2.5, 16 | Cadmium,Water,,WWAL,,ug/l,Saltwater Acute,,,, 17 | Cadmium,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 18 | Chromium III,Water,,WWAL,,ug/l,Freshwater Acute,0.819,3.7256,5,0.316 19 | Chromium III,Water,,WWAL,,ug/l,Freshwater Chronic,0.819,0.6848,1,0.86 20 | Chromium III,Water,,WWAL,,ug/l,Saltwater Acute,,,, 21 | Chromium III,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 22 | Chromium VI,Water,,WWAL,,ug/l,Freshwater Acute,,,4.5,0.982 23 | Chromium VI,Water,,WWAL,,ug/l,Freshwater Chronic,,,6,0.962 24 | Chromium VI,Water,,WWAL,,ug/l,Saltwater Acute,,,, 25 | Chromium VI,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 26 | Copper,Water,,WWAL,,ug/l,Freshwater Acute,,,3.5,0.96 27 | Copper,Water,,WWAL,,ug/l,Freshwater Chronic,,,2,0.96 28 | Copper,Water,,WWAL,,ug/l,Saltwater Acute,,,, 29 | Copper,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 30 | Lead,Water,,WWAL,,ug/l,Freshwater Acute,1.273,-1.46,4, 31 | Lead,Water,,WWAL,,ug/l,Freshwater Chronic,1.273,-4.705,4.4, 32 | Lead,Water,,WWAL,,ug/l,Saltwater Acute,,,, 33 | Lead,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 34 | Mercury,Water,,WWAL,,ug/l,Freshwater Acute,,,2,0.85 35 | Mercury,Water,,WWAL,,ug/l,Freshwater Chronic,,,3,0.85 36 | Mercury,Water,,WWAL,,ug/l,Saltwater Acute,,,, 37 | Mercury,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 38 | Nickel,Water,,WWAL,,ug/l,Freshwater Acute,0.846,2.255,4,0.998 39 | Nickel,Water,,WWAL,,ug/l,Freshwater Chronic,0.846,0.0584,5,0.997 40 | Nickel,Water,,WWAL,,ug/l,Saltwater Acute,,,, 41 | Nickel,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 42 | Selenium,Water,,WWAL,,ug/l,Freshwater Acute,,,, 43 | Selenium,Water,,WWAL,,ug/l,Freshwater Chronic,,,, 44 | Selenium,Water,,WWAL,,ug/l,Saltwater Acute,,,, 45 | Selenium,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 46 | Silver,Water,,WWAL,,ug/l,Freshwater Acute,1.72,-6.59,3,0.85 47 | Silver,Water,,WWAL,,ug/l,Freshwater Chronic,,,, 48 | Silver,Water,,DWI,,ug/l,Freshwater Acute,1.72,-6.59,3,0.85 49 | Silver,Water,,DWI,,ug/l,Freshwater Chronic,,,, 50 | Silver,Water,,PCR,,ug/l,Freshwater Acute,1.72,-6.59,3,0.85 51 | Silver,Water,,PCR,,ug/l,Freshwater Chronic,,,, 52 | Silver,Water,,WWAL,,ug/l,Saltwater Acute,,,, 53 | Silver,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 54 | Zinc,Water,,WWAL,,ug/l,Freshwater Acute,0.8473,0.884,7,0.978 55 | Zinc,Water,,WWAL,,ug/l,Freshwater Chronic,0.8473,0.884,8,0.986 56 | Zinc,Water,,WWAL,,ug/l,Saltwater Acute,,,, 57 | Zinc,Water,,WWAL,,ug/l,Saltwater Chronic,,,, 58 | Zinc,Water,,DWI,,ug/l,Freshwater Acute,0.8473,0.884,7,0.978 59 | Zinc,Water,,DWI,,ug/l,Freshwater Chronic,0.8473,0.884,8,0.986 60 | Zinc,Water,,PCR,,ug/l,Freshwater Acute,0.8473,0.884,7,0.978 61 | Zinc,Water,,PCR,,ug/l,Freshwater Chronic,0.8473,0.884,8,0.986 62 | -------------------------------------------------------------------------------- /external/tabUI/mapTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "map", 5 | br(), 6 | br(), 7 | uiOutput("non_display"), 8 | fluidRow(column(4, offset = 8, 9 | selectizeInput('mapcolor', h4("Select the criterion for coloring map markers:"), 10 | choices = c("Exceedances", 11 | "Assessment_Units")) 12 | )), 13 | leafletOutput("map"), 14 | br(), 15 | uiOutput("map_text"), 16 | # p("The station markers are scaled based on the # of exceedances/# of measurements."), 17 | # p("Stations marked with black circles have no exceedance records in the dataset."), 18 | br(), 19 | DT::dataTableOutput("map_data"), 20 | bsCollapsePanel(h3("Apply Filters to Map",style = "text-align:center"), style = "info", 21 | fluidRow(column(5), 22 | column(2, bsButton("submit_filters", "Submit!")), 23 | bsPopover("submit_filters", "Click Submit after applying filters", "Only filters with items selected will be applied. Note: At least one station must be selected.", 24 | "top", trigger = "hover", options = list(container = "body"))), 25 | fluidRow(column(6, 26 | h4(radioButtons('useclass_sel', "", c("Select All"=1, "Deselect All"=2), selected =1))), 27 | column(6, 28 | h4(radioButtons('media_sel', "", c("Select All"=1, "Deselect All"=2), selected =1)) 29 | )), 30 | fluidRow(column(6, 31 | h4(uiOutput("Class_Use_MAP"), style = "text-align:center")), 32 | column(6, 33 | h4(uiOutput("MediaMAP"), style = "text-align:center"))), 34 | fluidRow(column(6, 35 | h4(radioButtons('eco_sel', "", c("Select All"=1, "Deselect All"=2), selected =1) 36 | )), 37 | column(6, 38 | h4(radioButtons('wb_sel', "", c("Select All"=1, "Deselect All"=2), selected =1)))), 39 | fluidRow(column(6, 40 | h4(uiOutput("Eco_MAP"), style = "text-align:center")), 41 | column(6, 42 | h4(uiOutput("WB_MAP"), style = "text-align:center") 43 | )), 44 | fluidRow(column(6, 45 | h4(radioButtons('sample_sel', "", c("Select All"=1, "Deselect All"=2), selected =1))), 46 | column(6, 47 | h4(radioButtons('param_sel', "", c("Select All"=1, "Deselect All"=2), selected =1)) 48 | )), 49 | fluidRow(column(6, 50 | h4(uiOutput("SampleMAP"), style = "text-align:center") 51 | ), 52 | column(6, 53 | h4(uiOutput("ParamMAP"), style = "text-align:center"))), 54 | br() 55 | ) 56 | ) 57 | } 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /external/Functions/functions.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | # Function to calculate a geometeric mean 4 | geomean <- function(y) { 5 | n <- length(y) 6 | ansgeo <- prod(y, na.rm = TRUE)^(1/n) 7 | ansgeo 8 | } 9 | 10 | # Function to assign a verdict as to the significance and sign of the slope of trend analysis 11 | trend_sig <- function(slope, p_est, p) { 12 | if(!is.null(p_est) & !is.na(p_est)){ 13 | if(p_est <= p) { 14 | signif <- "Significant" 15 | } else { 16 | signif <- "Insignificant" 17 | } 18 | 19 | if(slope > 0) { 20 | sign <- "Positive" 21 | } else if (slope < 0) { 22 | sign <- "Negative" 23 | } else { 24 | sign <- "Zero slope" 25 | } 26 | 27 | verdict <- paste(sign, signif, sep = ", ") 28 | 29 | } else { 30 | verdict <- "" 31 | } 32 | 33 | return(verdict) 34 | } 35 | 36 | # Function to generate the needed variables for running the trends analysis 37 | trends_data <- function(data) { 38 | data <- data[, list(Station, Result, ActivityStartDate, AssessmentUnit)] 39 | data <- data[!duplicated(data)] 40 | data[, date_char := as.character(ActivityStartDate)] 41 | data[, year := as.numeric(tstrsplit(date_char, "-")[[1]])] 42 | data[, month := as.numeric(tstrsplit(date_char, "-")[[2]])] 43 | data[, month_dec := month * (1/12) ] 44 | data[, date := year + month_dec] 45 | data[, stationID := as.numeric(factor(Station))] 46 | data[, assessUID := as.numeric(factor(AssessmentUnit))] 47 | 48 | return(data) 49 | 50 | } 51 | 52 | # Generate year, month and day columns for the activity start date 53 | gen_date <- function(data){ 54 | data[, date_char := as.character(ActivityStartDate)] 55 | data[, year := as.numeric(tstrsplit(date_char, "-")[[1]])] 56 | data[, month := as.numeric(tstrsplit(date_char, "-")[[2]])] 57 | data[, day := as.numeric(tstrsplit(date_char, "-")[[3]])] 58 | data[, monthday := as.numeric(paste0(month, day))] 59 | return(data) 60 | } 61 | 62 | # Calculate the rolling averages 63 | roll <- function(data, start, end) { 64 | subData <- data[ActivityStartDate >= start & ActivityStartDate <= end] 65 | subData[, .(value = mean(Result, na.rm = TRUE))] 66 | return(unique(subData$value)) 67 | } 68 | 69 | # Converting number to month-day vector of class date 70 | toDate <- function(v) { 71 | if(nchar(v) < 4){ 72 | v <- as.character(paste0("0", v)) 73 | } else { 74 | v <- as.character(v) 75 | } 76 | 77 | d <- paste0("2000", v) 78 | d <- as.Date(d, format = "%Y%m%d") 79 | dd <- format(d, format = "%m-%d") 80 | return(dd) 81 | } 82 | 83 | na_to_name <- function(x, name) { 84 | if(is.na(x) | x == "") x <- name 85 | } 86 | 87 | # Function to compute hardness-dependant metals' criteria 88 | 89 | limit_CMC <- function(h, mA, bA, cf) { 90 | limit <- (exp(mA * log(h) + bA)) * cf 91 | } 92 | 93 | limit_CCC <- function(h, mC, bC, cf) { 94 | limit <- (exp(mC * log(h) + bC)) * cf 95 | } 96 | 97 | # Functions for calculating conversion factors for lead and cadmium (where the conversion factors are hardness-dependent) 98 | # Lead: acute and chronic have the same formula but for cadmium, they differ 99 | 100 | leadCF <- function(hardness) { 101 | cf <- 1.46203 - (log(hardness) * 0.145712) 102 | } 103 | 104 | cadCF_acute <- function(hardness) { 105 | cf <- 1.136672 - (log(hardness) * 0.041838) 106 | } 107 | 108 | cadCF_chronic <- function(hardness) { 109 | 1.101672 - (log(hardness) * 0.041838) 110 | } 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | -------------------------------------------------------------------------------- /external/tabUI/analysisTab.R: -------------------------------------------------------------------------------- 1 | 2 | function(){ 3 | tabItem( 4 | tabName = "analysis", 5 | h3(""), 6 | bsCollapse(open = "Run analysis for criteria", 7 | bsCollapsePanel(title = "Run analysis for criteria", style = "info", 8 | fluidRow(#column(6, 9 | # numericInput("duration", h4("Number of days for calculating rolling averages"), 10 | # value = 30) 11 | # ), 12 | column(6, offset = 5, 13 | actionButton("RunAnalysis", h4('Run Analysis')) 14 | )), 15 | br()#, 16 | 17 | # DT::dataTableOutput("metalsTest") 18 | ), 19 | bsCollapsePanel(title = "Run trends analysis", style = "info", 20 | uiOutput("trend_selects") , 21 | fluidRow(column(4, offset = 5, 22 | actionButton("RunTrendAnalysis", h4('Run Trends Analysis')), 23 | br() 24 | 25 | 26 | ))), 27 | bsCollapsePanel(title = "Results of criteria analysis", style = "info", 28 | fluidRow(column(5), 29 | column(2, downloadButton("Save_Analysis", "Save Analysis Data"))), 30 | bsPopover("Save_Analysis", "Save Data", "Click to download a .csv file containing the complete analysis data set.", 31 | "top", trigger = "hover", options = list(container = "body")), 32 | br(), 33 | fluidRow( 34 | column(10, offset = 0.5, 35 | 36 | DT::dataTableOutput("analysis_table") 37 | ) 38 | 39 | ) 40 | ), 41 | bsCollapsePanel(title = "ATTAINS-compatible analysis summary", style = "info", 42 | fluidRow(column(5), 43 | column(2, 44 | downloadButton('Save_ATTAINS_table', h5('Save Table'), icon = icon("download")), 45 | br(), 46 | br())), 47 | fluidRow(DT::dataTableOutput("attains_table") 48 | ) 49 | 50 | 51 | ), 52 | bsCollapsePanel(title = "Results of trends analysis", style = "info", 53 | h4("Please note that with large files this may take a few moments."), 54 | br(), 55 | fluidRow(column(5), 56 | column(2, 57 | downloadButton('Save_Analysis_trends', h5('Save Table'), icon = icon("download")), 58 | br(), 59 | br())), 60 | DT::dataTableOutput("trends_table") 61 | # textOutput("tbl_text") 62 | ) 63 | 64 | 65 | ) 66 | 67 | 68 | ) 69 | } 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | -------------------------------------------------------------------------------- /InputFiles/Stations-2017-08-02.csv: -------------------------------------------------------------------------------- 1 | Station,Name,Organization,OrganizationFormalName,LatitudeMeasure,LongitudeMeasure,AssessmentUnit 2 | ILRIVERWATCH-R0408701,W Bureau Cr,ILRIVERWATCH,Illinois RiverWatch Network,41.38,-89.53,BCMainstem1 3 | ILRIVERWATCH-R0409701,Spring Cr at Spring Valley Golf Course,ILRIVERWATCH,Illinois RiverWatch Network,41.36,-89.18,BCTrib5 4 | ILRIVERWATCH-R0415001,E Bureau Cr,ILRIVERWATCH,Illinois RiverWatch Network,41.33,-89.58,BCMainstem1 5 | ILRIVERWATCH-R0415301,Unnamed Big Bureau Cr Trib,ILRIVERWATCH,Illinois RiverWatch Network,41.46,-89.39,BCTrib1 6 | IL_EPA-DQ-03,BIG BUREAU CREEK,IL_EPA,Illinois EPA,41.36734,-89.49799,BCTrib1 7 | IL_EPA-DQD-01,WEST BUREAU CREEK,IL_EPA,Illinois EPA,41.36495,-89.56835,BCTrib3 8 | IL_EPA-RDU-1,DEPUE,IL_EPA,Illinois EPA,41.310837,-89.319448,BCMainstem1 9 | IL_EPA-RDU-2,DEPUE,IL_EPA,Illinois EPA,41.318337,-89.311392,BCMainstem1 10 | IL_EPA-RDU-3,DEPUE,IL_EPA,Illinois EPA,41.320559,-89.299171,BCMainstem1 11 | IL_EPA_WQX-DQ-10,BIG BUREAU CREEK,IL_EPA_WQX,illinois epa,41.5245,-89.325,BCTrib1 12 | IL_EPA_WQX-DQA-02,EAST BUREAU CREEK,IL_EPA_WQX,illinois epa,41.4367,-89.3489,BCTrib5 13 | IL_EPA_WQX-DQA-03,EAST BUREAU CREEK,IL_EPA_WQX,illinois epa,41.3349,-89.382,BCTrib2 14 | IL_EPA_WQX-DQDB-01,LIME CREEK,IL_EPA_WQX,illinois epa,41.4519,-89.526,BCTrib3 15 | NARS-OWW04440-0016,EAST BUREAU CREEK,NARS,EPA National Aquatic Resource Survey Data,41.34,-89.37,BCTrib2 16 | NARS_WQX-OWW04440-0016,EAST BUREAU CREEK,NARS_WQX,EPA National Aquatic Resources Survey (NARS),41.349286,-89.378115,BCTrib2 17 | OST_SHPD-NRSA1314-ILR9-0902,Green River,OST_SHPD,"USEPA, Office of Water, Office of Science and Technology, Standards and Health Protection Division",41.48585,-89.84848,BCTrib5 18 | USGS-05447390,"COAL CREEK AT SHEFFIELD, IL",USGS-IL,USGS Illinois Water Science Center,41.361147,-89.7453784,BCTrib4 19 | USGS-05447391,"COAL CREEK NEAR MINERAL, IL",USGS-IL,USGS Illinois Water Science Center,41.3869799,-89.7981584,BCTrib4 20 | USGS-05447392,"LAWSON CREEK TRIB NO 1 NEAR NEPONSET, IL",USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7926025,BCTrib4 21 | USGS-05447395,"LAWSON CREEK TRIB NO 2 NEAR NEPONSET, IL",USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7923247,BCTrib4 22 | USGS-05447396,"LAWSON CREEK TRIB NO 3 NEAR NEPONSET, IL",USGS-IL,USGS Illinois Water Science Center,41.3378139,-89.790658,BCTrib4 23 | USGS-05447400,"KING CREEK AT MINERAL, IL",USGS-IL,USGS Illinois Water Science Center,41.3833687,-89.8428825,BCTrib4 24 | USGS-05556090,"SPRING CREEK AT SPRING VALLEY, IL",USGS-IL,USGS Illinois Water Science Center,41.336424,-89.1870297,BCMainstem1 25 | USGS-05556500,"BIG BUREAU CREEK AT PRINCETON, IL",USGS-IL,USGS Illinois Water Science Center,41.3672222,-89.4977778,BCTrib1 26 | USGS-05557000,"WEST BUREAU CREEK AT WYANET, IL",USGS-IL,USGS Illinois Water Science Center,41.3650363,-89.5689842,BCTrib2 27 | USGS-05557500,"EAST BUREAU CREEK NEAR BUREAU, IL",USGS-IL,USGS Illinois Water Science Center,41.3347222,-89.3819444,BCTrib5 28 | USGS-05558000,"BIG BUREAU CREEK AT BUREAU, IL",USGS-IL,USGS Illinois Water Science Center,41.2778144,-89.3834234,BCMainstem1 29 | USGS-411659089500601,15N 6E-17.7c,USGS-IL,USGS Illinois Water Science Center,41.2819222,-89.8347667,BCTrib4 30 | USGS-411722089221201,15N10E-17.7g1,USGS-IL,USGS Illinois Water Science Center,41.2894809,-89.3700897,BCMainstem1 31 | USGS-411727089302101,15N 9E-18.7h,USGS-IL,USGS Illinois Water Science Center,41.2908704,-89.5059264,BCMainstem1 32 | USGS-411727089302102,15N 9E-18.7g2,USGS-IL,USGS Illinois Water Science Center,41.2908704,-89.5059264,BCMainstem1 33 | USGS-411917089182801,16N10E-35.5a1,USGS-IL,USGS Illinois Water Science Center,41.3214247,-89.307866,BCMainstem1 34 | USGS-411918089182501,16N10E-35.5a2,USGS-IL,USGS Illinois Water Science Center,41.3217025,-89.3070326,BCMainstem1 35 | USGS-411928089403801,16N 7E-34.6c3,USGS-IL,USGS Illinois Water Science Center,41.324481,-89.6773207,BCTrib4 36 | USGS-411928089403901,16N 7E-34.6c1,USGS-IL,USGS Illinois Water Science Center,41.324481,-89.6775985,BCTrib4 37 | USGS-411928089403902,16N 7E-34.6c2,USGS-IL,USGS Illinois Water Science Center,41.324481,-89.6775985,BCTrib4 38 | USGS-411944089121501,16N11E-34.2e1,USGS-IL,USGS Illinois Water Science Center,41.3289241,-89.2042523,BCMainstem1 39 | USGS-411959089124501,16N11E-34.6h1,USGS-IL,USGS Illinois Water Science Center,41.3330908,-89.2125858,BCMainstem1 40 | USGS-412006089472601,SHEFFIELD SE FLUME #1,USGS-IL,USGS Illinois Water Science Center,41.3350362,-89.790658,BCTrib4 41 | USGS-412015089472201,16N 6E-27.4b3,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7887135,BCTrib4 42 | USGS-412015089473101,SHEFFIELD WELL H,USGS-IL,USGS Illinois Water Science Center,41.3375361,-89.7920469,BCTrib4 43 | USGS-412015089473901,SHEFFIELD WELL M,USGS-IL,USGS Illinois Water Science Center,41.3375361,-89.7942693,BCTrib4 44 | USGS-412016089472301,16N 6E-27.5b19,USGS-IL,USGS Illinois Water Science Center,41.3378139,-89.789269,BCTrib4 45 | USGS-412016089472601,SHEFFIELD WELL G,USGS-IL,USGS Illinois Water Science Center,41.3378139,-89.790658,BCTrib4 46 | USGS-412017089472201,16N 6E-27.4b1,USGS-IL,USGS Illinois Water Science Center,41.3383695,-89.7889913,BCTrib4 47 | USGS-412017089472401,16N 6E-27.5b7,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7898246,BCTrib4 48 | USGS-412017089472701,16N 6E-27.5b9,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7903802,BCTrib4 49 | USGS-412017089472901,16N 6E-27.5b11,USGS-IL,USGS Illinois Water Science Center,41.3383695,-89.7912136,BCTrib4 50 | USGS-412017089472902,16N 6E-27.5b10,USGS-IL,USGS Illinois Water Science Center,41.3383695,-89.7912136,BCTrib4 51 | USGS-412017089473101,16N 6E-27.6b8,USGS-IL,USGS Illinois Water Science Center,41.3383695,-89.7912136,BCTrib4 52 | USGS-412017089473102,16N 6E-27.6b10,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7917692,BCTrib4 53 | USGS-412017089473201,16N 6E-27.6b2,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7920469,BCTrib4 54 | USGS-412017089473401,16N 6E-27.6b9,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7923247,BCTrib4 55 | USGS-412017089473701,SHEFFIELD NO. 531,USGS-IL,USGS Illinois Water Science Center,41.3380917,-89.7931581,BCTrib4 56 | USGS-412018089471601,16N 6E-27.4b2,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.7870467,BCTrib4 57 | USGS-412018089472601,16N 6E-27.5b13,USGS-IL,USGS Illinois Water Science Center,41.3383695,-89.7903802,BCTrib4 58 | USGS-412018089473801,16N 6E-27.6b1,USGS-IL,USGS Illinois Water Science Center,41.3383694,-89.7934359,BCTrib4 59 | USGS-412019089472501,16N 6E-27.5b4,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7898246,BCTrib4 60 | USGS-412019089472701,16N 6E-27.5b8,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7903802,BCTrib4 61 | USGS-412019089472801,16N 6E-27.5b14,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.790658,BCTrib4 62 | USGS-412019089472802,16N 6E-27.5b15,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.790658,BCTrib4 63 | USGS-412019089472901,16N 6E-27.5b6,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7909358,BCTrib4 64 | USGS-412019089472902,16N 6E-27.5b17,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7909358,BCTrib4 65 | USGS-412019089473301,16N 6E-27.6b12,USGS-IL,USGS Illinois Water Science Center,41.3386472,-89.7926025,BCTrib4 66 | USGS-412020089472664,LYSIMETER 64 21142154,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 67 | USGS-412020089472665,LYSIMETER 65 21252154,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 68 | USGS-412020089472668,LYSIMETER 68 21062153,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 69 | USGS-412020089472681,LYSIMETER 81 20562154,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 70 | USGS-412020089472682,LYSIMETER 82 20405154,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 71 | USGS-412020089472696,LYSIMETER 96 20922153,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.790658,BCTrib4 72 | USGS-412020089473301,SHEFFIELD WELL V,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.7926025,BCTrib4 73 | USGS-412020089473601,16N 6E-27.6b4,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.7928803,BCTrib4 74 | USGS-412020089473602,16N 6E-27.6b13,USGS-IL,USGS Illinois Water Science Center,41.338925,-89.7928803,BCTrib4 75 | USGS-412021089471301,16N 6E-27.4c2,USGS-IL,USGS Illinois Water Science Center,41.3394806,-89.7873245,BCTrib4 76 | USGS-412021089473102,16N 6E-27.6c10,USGS-IL,USGS Illinois Water Science Center,41.3392028,-89.7917692,BCTrib4 77 | USGS-412021089473901,16N 6E-27.6b3,USGS-IL,USGS Illinois Water Science Center,41.3392028,-89.7937137,BCTrib4 78 | USGS-412021089473902,16N 6E-27.7b1,USGS-IL,USGS Illinois Water Science Center,41.3392028,-89.7942693,BCTrib4 79 | USGS-412022089471301,16N 6E-27.3c1,USGS-IL,USGS Illinois Water Science Center,41.3397583,-89.7864912,BCTrib4 80 | USGS-412022089472301,16N 6E-27.5c1,USGS-IL,USGS Illinois Water Science Center,41.3394806,-89.789269,BCTrib4 81 | USGS-412022089472401,16N 6E-27.5c2,USGS-IL,USGS Illinois Water Science Center,41.3394806,-89.7898246,BCTrib4 82 | USGS-412022089472502,16N 6E-27.5c27,USGS-IL,USGS Illinois Water Science Center,41.3397583,-89.7898246,BCTrib4 83 | USGS-412023089470401,16N 6E-27.4c6,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7842688,BCTrib4 84 | USGS-412023089470402,SHEFFIELD LAKE SAMPLE #1,USGS-IL,USGS Illinois Water Science Center,41.3397583,-89.7845466,BCTrib4 85 | USGS-412023089472301,16N 6E-27.4c4,USGS-IL,USGS Illinois Water Science Center,41.3397583,-89.7889913,BCTrib4 86 | USGS-412023089472501,16N 6E-27.5c28,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7898246,BCTrib5 87 | USGS-412024089472101,16N 6E-27.4c11,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7887135,BCTrib4 88 | USGS-412024089472102,16N 6E-27.4c15,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7887135,BCTrib5 89 | USGS-412024089472301,16N 6E-27.4c3,USGS-IL,USGS Illinois Water Science Center,41.3394806,-89.7873245,BCTrib5 90 | USGS-412024089472302,16N 6E-27.4c12,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7889913,BCTrib5 91 | USGS-412024089472501,16N 6E-27.4c10,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7895468,BCTrib4 92 | USGS-412024089472502,16N 6E-27.5c26,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7898246,BCTrib4 93 | USGS-412024089472601,16N 6E-27.5c25,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7901024,BCTrib4 94 | USGS-412024089473301,16N 6E-27.6c5,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7923247,BCTrib4 95 | USGS-412024089473801,16N 6E-27.6c4,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7934359,BCTrib4 96 | USGS-412025089471201,16N 6E-27.3c2,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7862134,BCTrib4 97 | USGS-412025089471701,16N 6E-27.4c21,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7876023,BCTrib4 98 | USGS-412025089471901,16N 6E-27.4c17,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7881579,BCTrib4 99 | USGS-412025089472101,16N 6E-27.4c7,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7887135,BCTrib4 100 | USGS-412025089472102,16N 6E-27.4c13,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7887135,BCTrib4 101 | USGS-412025089472201,16N 6E-27.4c8,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7889913,BCTrib4 102 | USGS-412025089472301,16N 6E-27.4c14,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7889913,BCTrib4 103 | USGS-412025089472701,16N 6E-27.5c8,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.790658,BCTrib4 104 | USGS-412025089472801,16N 6E-27.5c22,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7912136,BCTrib4 105 | USGS-412025089472901,16N 6E-27.5c10,USGS-IL,USGS Illinois Water Science Center,41.3403139,-89.7912136,BCTrib4 106 | USGS-412025089473601,16N 6E-27.6c7,USGS-IL,USGS Illinois Water Science Center,41.3400361,-89.7931581,BCTrib4 107 | USGS-412026089471701,16N 6E-27.4c1,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7876023,BCTrib4 108 | USGS-412026089471702,16N 6E-27.4c20,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7876023,BCTrib4 109 | USGS-412026089471703,16N 6E-27.4c22,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7878801,BCTrib4 110 | USGS-412026089471704,16N 6E-27.4c23,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7876023,BCTrib4 111 | USGS-412026089471901,16N 6E-27.4c18,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7881579,BCTrib4 112 | USGS-412026089472001,16N 6E-27.4c19,USGS-IL,USGS Illinois Water Science Center,41.3405917,-89.7884357,BCTrib4 113 | USGS-412026089472702,SHEFFIELD WELL MOW-1,USGS-IL,USGS Illinois Water Science Center,41.3405916,-89.7909358,BCTrib4 114 | USGS-412027089471302,SHEFFIELD LAKE #1,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7870467,BCTrib4 115 | USGS-412027089472501,16N 6E-27.5c5,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7901024,BCTrib4 116 | USGS-412027089472701,16N 6E-27.5c4,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7909358,BCTrib4 117 | USGS-412027089472901,16N 6E-27.5c6,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7912136,BCTrib4 118 | USGS-412027089473201,16N 6E-27.6c2,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.792047,BCTrib4 119 | USGS-412027089473401,16N 6E-27.6c3,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7928803,BCTrib4 120 | USGS-412027089473701,16N 6E-27.6c14,USGS-IL,USGS Illinois Water Science Center,41.3408694,-89.7934359,BCTrib4 121 | USGS-412028089472301,16N 6E-27.4d1,USGS-IL,USGS Illinois Water Science Center,41.3411472,-89.7889913,BCTrib4 122 | USGS-412029089472201,SHEFFIELD NE STREAM #1,USGS-IL,USGS Illinois Water Science Center,41.341425,-89.7895468,BCTrib4 123 | USGS-412029089472402,SHEFFIELD WELL MOW-2,USGS-IL,USGS Illinois Water Science Center,41.341425,-89.7901024,BCTrib4 124 | USGS-412030089472001,16N 6E-27.4d3,USGS-IL,USGS Illinois Water Science Center,41.3417028,-89.7884357,BCTrib4 125 | USGS-412032089472201,16N 6E-27.4d2,USGS-IL,USGS Illinois Water Science Center,41.3422583,-89.7889913,BCTrib4 126 | USGS-412109089315401,16N 8E-23.2b2,USGS-IL,USGS Illinois Water Science Center,41.3525365,-89.5317608,BCTrib1 127 | USGS-412111089315301,16N 8E-23.2b1,USGS-IL,USGS Illinois Water Science Center,41.3530921,-89.531483,BCTrib1 128 | USGS-412121089441701,16N 7E-19.7d5,USGS-IL,USGS Illinois Water Science Center,41.3558693,-89.7381559,BCTrib4 129 | USGS-412123089441701,16N 7E-19.7d4,USGS-IL,USGS Illinois Water Science Center,41.3564249,-89.7381559,BCTrib4 130 | USGS-412134089105201,16N11E-24.8f2,USGS-IL,USGS Illinois Water Science Center,41.3594793,-89.1811962,BCMainstem1 131 | USGS-412136089105201,16N11E-24.1d1,USGS-IL,USGS Illinois Water Science Center,41.3600348,-89.1811962,BCMainstem1 132 | USGS-412157089350202,16N 8E-16.7a2,USGS-IL,USGS Illinois Water Science Center,41.3658696,-89.5839847,BCTrib3 133 | USGS-412157089350301,16N 8E-16.7a1,USGS-IL,USGS Illinois Water Science Center,41.3658696,-89.5842625,BCTrib3 134 | USGS-412219089291301,16N 9E-17.8e2,USGS-IL,USGS Illinois Water Science Center,41.3719809,-89.4870374,BCTrib1 135 | USGS-412220089291201,16N 9E-17.8e1,USGS-IL,USGS Illinois Water Science Center,41.3722586,-89.4867596,BCTrib1 136 | USGS-412222089292101,16N 9E-18.1e1,USGS-IL,USGS Illinois Water Science Center,41.3728142,-89.4892597,BCTrib1 137 | USGS-412232089274801,16N 9E-16.6g4,USGS-IL,USGS Illinois Water Science Center,41.3755918,-89.4634257,BCTrib1 138 | USGS-412232089275101,16N 9E-16.6g3,USGS-IL,USGS Illinois Water Science Center,41.3755918,-89.464259,BCTrib1 139 | USGS-412232089275201,16N 9E-16.6g2,USGS-IL,USGS Illinois Water Science Center,41.3755918,-89.4645368,BCTrib1 140 | USGS-412238089291001,16N 9E-17.8h1,USGS-IL,USGS Illinois Water Science Center,41.3772586,-89.486204,BCTrib1 141 | USGS-412238089291201,16N 9E-17.8h2,USGS-IL,USGS Illinois Water Science Center,41.3772586,-89.4867596,BCTrib1 142 | USGS-412242089125101,16N11E-15.6h,USGS-IL,USGS Illinois Water Science Center,41.3783681,-89.2142525,BCTrib5 143 | USGS-412242089125201,16N11E-15.6h2,USGS-IL,USGS Illinois Water Science Center,41.3783681,-89.2145303,BCTrib5 144 | USGS-412259089501101,16N 6E- 8.8b1,USGS-IL,USGS Illinois Water Science Center,41.383091,-89.8364934,BCTrib4 145 | USGS-412338089280401,16N09E- 4.1h,USGS-IL,USGS Illinois Water Science Center,41.393925,-89.4678703,BCTrib1 146 | USGS-412340089292301,16N 9E- 6.1a1,USGS-IL,USGS Illinois Water Science Center,41.3944807,-89.4898153,BCTrib1 147 | USGS-412341089292301,16N 9E- 6.1a2,USGS-IL,USGS Illinois Water Science Center,41.3947585,-89.4898153,BCTrib1 148 | USGS-412534089215601,17N10E-29.5c1,USGS-IL,USGS Illinois Water Science Center,41.4261464,-89.3656453,BCTrib5 149 | USGS-412538089215801,17N10E-29.5c2,USGS-IL,USGS Illinois Water Science Center,41.4271944,-89.3665278,BCTrib5 150 | USGS-412608089234501,17N 9E-25.1h1,USGS-IL,USGS Illinois Water Science Center,41.435591,-89.395924,BCTrib1 151 | USGS-412654089133301,17N11E-21.3f,USGS-IL,USGS Illinois Water Science Center,41.4482778,-89.2257222,BCTrib2 152 | USGS-412703089134401,17N11E-21.4h2,USGS-IL,USGS Illinois Water Science Center,41.4508675,-89.2289749,BCTrib2 153 | USGS-412703089134402,17N11E-21.4h1,USGS-IL,USGS Illinois Water Science Center,41.4508675,-89.2289749,BCTrib2 154 | USGS-412721089401201,17N 7E-15.2b1,USGS-IL,USGS Illinois Water Science Center,41.4558684,-89.6700986,BCTrib5 155 | USGS-412724089401401,17N 7E-15.2c1,USGS-IL,USGS Illinois Water Science Center,41.4567017,-89.6706542,BCTrib5 156 | USGS-412827089145201,17N11E- 8.4e2,USGS-IL,USGS Illinois Water Science Center,41.4742008,-89.2478642,BCTrib2 157 | USGS-412827089145202,17N11E- 8.4e1,USGS-IL,USGS Illinois Water Science Center,41.4742008,-89.2478642,BCTrib2 158 | USGS-413147089165501,18N10E-24.3c1,USGS-IL,USGS Illinois Water Science Center,41.5297562,-89.2820327,BCTrib1 159 | USGS-413147089165701,18N10E-24.3c2,USGS-IL,USGS Illinois Water Science Center,41.5297562,-89.2825883,BCTrib1 160 | USGS-413323089275201,18N 9E- 9.6b1,USGS-IL,USGS Illinois Water Science Center,41.5564238,-89.4645388,BCTrib3 161 | USGS-413328089274501,18N 9E- 9.5c2,USGS-IL,USGS Illinois Water Science Center,41.5578127,-89.4625943,BCTrib3 162 | USGS-413330089353701,18N 8E- 8.2d2,USGS-IL,USGS Illinois Water Science Center,41.5583678,-89.5937093,BCTrib5 163 | USGS-413335089353601,18N 8E- 8.2d3,USGS-IL,USGS Illinois Water Science Center,41.5597567,-89.5934316,BCTrib5 164 | USGS-413336089353601,18N 8E- 8.2c1,USGS-IL,USGS Illinois Water Science Center,41.5600345,-89.5934316,BCTrib5 165 | -------------------------------------------------------------------------------- /server.R: -------------------------------------------------------------------------------- 1 | # server.R file 2 | options(shiny.maxRequestSize=60*1024^2) 3 | 4 | server <- function(input, output, session) { 5 | # for Desktop bat file 6 | session$onSessionEnded(function() { 7 | stopApp() 8 | }) 9 | ############# Data Tab ########################## 10 | dataFile <- callModule(csvFile, "dataFile", 11 | stringsAsFactors = FALSE, skip = 10) 12 | 13 | WQP <- reactive({ 14 | if(is.null(dataFile())){ 15 | return(NULL) 16 | } else { 17 | dat <- dataFile() 18 | dat <- data.table(dat) 19 | dat[, Characteristic := str_to_title(as.character(Characteristic))] # Capitalizing all first letters of words since there was duplication caused by inconsistency in whether words were capitalized or not 20 | dat[, ActivityStartDate := as.Date(ActivityStartDate)] # '%Y-%m-%d') 21 | dat[, MonthDay := format(ActivityStartDate, format = "%m-%d")] 22 | dat$Result <- as.numeric(dat$Result) 23 | dat <- dat[!is.na(Result)] 24 | setnames(dat, c("ActivityMediaName", "ResultSampleFractionText"), c("Media", "Sample_Fraction")) 25 | datcols <- c("LatitudeMeasure", "LongitudeMeasure") 26 | dat[, (datcols) := lapply(.SD, as.numeric), .SDcols = datcols] 27 | 28 | return(dat) 29 | 30 | }}) 31 | 32 | output$meta <- renderUI({ 33 | data <- WQP() 34 | records <- nrow(data) 35 | char <- length(unique(data$Characteristic)) 36 | station <- length(unique(data$Station)) 37 | org <- length(unique(data$OrganizationFormalName)) 38 | minDate <- min(data$ActivityStartDate) 39 | maxDate <- max(data$ActivityStartDate) 40 | 41 | fluidRow(p(h4(paste("The file contains data from", station, "stations in", 42 | org, "organization(s) for the period", minDate, "to", maxDate, 43 | ". The data include", char, "characteristics (parameters) in", records, "rows.")))) 44 | }) 45 | 46 | output$discoveryDataTable <- DT::renderDataTable( 47 | data.frame(WQP()), escape = -1, rownames = FALSE, 48 | extensions = 'Buttons', options = list(dom = 'lfrBtip', buttons = I('colvis'), 49 | pageLength = 100, 50 | lengthMenu = c(100, 200, 500), 51 | columnDefs = list(list(visible = FALSE, targets = list(1,3,4,6,8,9,10,11,12, 52 | 13, 14, 15, 16, 17, 18, 53 | 19, 20, 21, 22, 23, 24, 54 | 25, 26, 27, 28, 29, 30, 55 | 32, 35, 36, 37, 38, 39, 40, 56 | 41, 42, 43, 44, 45, 46, 47, 57 | 48, 49, 50, 51, 52, 53, 54, 58 | 55, 56, 57, 58, 59, 60, 61, 59 | 62, 63, 64, 65, 66, 67, 68))) 60 | ), server = TRUE 61 | ) 62 | 63 | 64 | ############# Criteria Tab ########################## 65 | 66 | 67 | # Generate the empty criteria template 68 | criteria_gen <- reactive({ 69 | 70 | Criteria <- data.table(WQP()) 71 | Criteria <- Criteria[,.(Count = .N), by = c("Characteristic", "Unit", "Media", "Sample_Fraction") ] 72 | setnames(Criteria, c("Characteristic", "Unit"), c("PARM", "Units") ) 73 | Criteria <- Criteria[, .(PARM, Units, Media, Sample_Fraction)] 74 | Criteria$USE_OR_CLASS <- "" 75 | Criteria$WBODY <- "" 76 | Criteria$ECOREGION <- "" 77 | Criteria$Criterion <- "" 78 | Criteria$Limit <- "" 79 | Criteria$Comparison <- "" 80 | Criteria$AverageTime <- "" 81 | Criteria$MinSamples <- "" 82 | Criteria$SeasonStartDate <- "" 83 | Criteria$SeasonEndDate <- "" 84 | 85 | return(Criteria) 86 | 87 | }) 88 | 89 | output$Criteria_outfile <- downloadHandler( 90 | filename = function() { 91 | paste('Criteria-', Sys.Date(), '.csv', sep='') 92 | }, 93 | content = function(con) { 94 | write.table(criteria_gen(), con, row.names = FALSE, quote = TRUE, sep = ",") 95 | }) 96 | 97 | criteriaFile <- callModule(csvFile, "criteriaFile", 98 | stringsAsFactors = FALSE) 99 | 100 | output$criteria_table <- DT::renderDataTable( 101 | criteriaFile(), escape = -1, rownames = FALSE 102 | ) 103 | 104 | ############# Metals analysis Tab ########################## 105 | 106 | output$Criteria_metals <- downloadHandler( 107 | filename = function() { 108 | paste('Metals-', Sys.Date(), '.csv', sep='') 109 | }, 110 | content = function(con) { 111 | write.table(metalsCriteria, con, row.names = FALSE, quote = TRUE, sep = ",") 112 | }) 113 | 114 | metalsFile <- callModule(csvFile, "metalscriteriaFile", 115 | stringsAsFactors = FALSE) 116 | 117 | output$metals_table <- DT::renderDataTable( 118 | metalsFile(), escape = -1, rownames = FALSE 119 | ) 120 | 121 | # Prepping the metals file and combining it with the criteria file 122 | metalsPrep <- reactive({ 123 | metals <- data.table(metalsFile()) 124 | metals[is.na(metals)] <- "" 125 | cols <- c("m", "b", "Hardness_default", "CF") 126 | metals[, (cols) := lapply(.SD, as.numeric), .SDcols = cols] 127 | 128 | # Calculate conversion factors (CF) that are hardness-dependent 129 | metals[is.na(CF) & !is.na(Hardness_default) & PARM == "Lead", CF := leadCF(Hardness_default)] 130 | metals[is.na(CF) & !is.na(Hardness_default) & PARM == "Cadmium" 131 | & grepl("acute", Criterion, ignore.case = TRUE), CF := cadCF_acute(Hardness_default)] 132 | metals[is.na(CF) & !is.na(Hardness_default) & PARM == "Cadmium" 133 | & grepl("chronic", Criterion, ignore.case = TRUE), CF := cadCF_chronic(Hardness_default)] 134 | 135 | # Calculating the limits (criteria) against which the result will be compared 136 | metals[grepl("acute", Criterion, ignore.case = TRUE), 137 | Limit := round(limit_CMC(Hardness_default, m, b, CF), 2)] 138 | metals[grepl("chronic", Criterion, ignore.case = TRUE), 139 | Limit := round(limit_CCC(Hardness_default, m, b, CF), 2)] 140 | 141 | # Removing columns no longer required 142 | metals[, c("m", "b", "Hardness_default", "CF") := NULL] 143 | 144 | # Adding a "Comparison" column to calculate exceedences later on 145 | metals[, Comparison := "GT"] 146 | metals[, ECOREGION := ""] 147 | 148 | # Renaming criteria names 149 | metals[Criterion == "Freshwater Acute", Criterion := "FW_Acute"] 150 | metals[Criterion == "Freshwater Chronic", Criterion := "FW_Chronic"] 151 | metals[Criterion == "Saltwater Acute", Criterion := "SW_Acute"] 152 | metals[Criterion == "Saltwater Chronic", Criterion := "sW_Chronic"] 153 | return(data.frame(metals)) 154 | 155 | }) 156 | 157 | criteria <- reactive({ 158 | metals <- data.table(metalsPrep()) 159 | criterion <- data.table(criteriaFile()) 160 | 161 | # combining the metals and criteria files 162 | criterion <- rbind(criterion, metals, use.names = TRUE, fill = TRUE) 163 | 164 | return(criterion) 165 | }) 166 | 167 | 168 | ############################# Stations tab ############################### 169 | # Generate the empty stations template 170 | 171 | station_gen<-reactive({ 172 | if(is.null(WQP())){ 173 | return(NULL) 174 | } else { 175 | dat <- data.table(WQP()) 176 | stations <- dat[,.(Name = last(Name), Organization=last(Organization), OrganizationFormalName=last(OrganizationFormalName), LatitudeMeasure = last(LatitudeMeasure), 177 | LongitudeMeasure = last(LongitudeMeasure)), by = Station ] 178 | 179 | stations$AssessmentUnit <- "" 180 | return(stations) 181 | }}) 182 | 183 | 184 | 185 | output$Station_outfile <- downloadHandler( 186 | filename = function() { 187 | paste('Stations-', Sys.Date(), '.csv', sep='') 188 | }, 189 | content = function(con) { 190 | write.table(station_gen(), con, row.names = FALSE, sep = ",") 191 | }) 192 | 193 | stationsFile <- callModule(csvFile, "stationsFile", 194 | stringsAsFactors = FALSE) 195 | 196 | output$stations_table <- DT::renderDataTable( 197 | stationsFile(), escape = -1, rownames = FALSE 198 | ) 199 | 200 | ############################# Assessment Units tab ############################### 201 | # Generate the empty assessment units template 202 | 203 | assessunit_gen<-reactive({ 204 | if(is.null(stationsFile())){ 205 | return(NULL) 206 | } else { 207 | dat <- data.table(stationsFile()) 208 | AssesU <- dat[ , list(AssessmentUnit)] 209 | AssesU$USE_OR_CLASS <- "" 210 | AssesU$WBODY <- "" 211 | AssesU$ECOREGION <- "" 212 | return(AssesU) 213 | 214 | }}) 215 | 216 | 217 | output$AssessmentUnit_outfile <- downloadHandler( 218 | filename = function() { 219 | paste('Assessment_Units-', Sys.Date(), '.csv', sep='') 220 | }, 221 | content = function(con) { 222 | write.table(assessunit_gen(), con, row.names = FALSE, sep = ",") 223 | }) 224 | 225 | 226 | assessmentUnitFile <- callModule(csvFile, "assessmentUnitFile", 227 | stringsAsFactors = FALSE) 228 | 229 | output$assessmentUnit_table <- DT::renderDataTable( 230 | assessmentUnitFile(), escape = -1, rownames = FALSE 231 | ) 232 | 233 | ######################## Analysis tab ################################### 234 | 235 | data_prep <- reactive({ 236 | 237 | # Organize the inputs 238 | dat <- WQP() 239 | stations <- stationsFile() 240 | assesU <- assessmentUnitFile() 241 | criterion <- criteria() 242 | 243 | stations[is.na(stations)] <- "" 244 | assesU[is.na(assesU)] <- "" 245 | criterion[is.na(criterion)] <- "" 246 | 247 | stations <- data.table(stations) 248 | assesU <- data.table(assesU) 249 | criterion <- data.table(criterion) 250 | 251 | criterion[, nc := nchar(SeasonStartDate)] 252 | criterion[, SeasonStartDate := as.character(SeasonStartDate)] 253 | criterion[nc < 4, SeasonStartDate := paste0("0", SeasonStartDate)] 254 | criterion[, SeasonStartDate := paste0("2000", SeasonStartDate)] 255 | criterion[, SeasonStartDate := as.Date(SeasonStartDate, format = "%Y%m%d")] 256 | criterion[, SeasonStartDate := format(SeasonStartDate, format = "%m-%d")] 257 | 258 | criterion[, nc := nchar(SeasonEndDate)] 259 | criterion[, SeasonEndDate := as.character(SeasonEndDate)] 260 | criterion[nc < 4, SeasonEndDate := paste0("0", SeasonEndDate)] 261 | criterion[, SeasonEndDate := paste0("2000", SeasonEndDate)] 262 | criterion[, SeasonEndDate := as.Date(SeasonEndDate, format = "%Y%m%d")] 263 | criterion[, SeasonEndDate := format(SeasonEndDate, format = "%m-%d")] 264 | criterion[, nc := NULL] 265 | 266 | cols <- c("WBODY", "ECOREGION", "Sample_Fraction", "Media", "Criterion", "Comparison", "Units") 267 | criterion[, (cols) := lapply(.SD, as.character), .SDcols = cols] 268 | 269 | # To be used with "Filtered data" 270 | cols2 <- c("Station", "Characteristic", "Unit", "Media","Sample_Fraction", "Name", "OrganizationFormalName") 271 | dat[, (cols2) := lapply(.SD, as.character), .SDcols = cols2] 272 | 273 | assesU[, AssessmentUnit := as.character(AssessmentUnit)] 274 | stations[, AssessmentUnit := as.character(AssessmentUnit)] 275 | 276 | step1 <- merge(stations, assesU, by = "AssessmentUnit", allow.cartesian = TRUE) 277 | 278 | step2A <- merge(step1, criterion, by=c("USE_OR_CLASS", "WBODY", "ECOREGION"), allow.cartesian = TRUE) 279 | setnames(step2A, "PARM", "Characteristic") 280 | setnames(dat, "Unit", "Units") 281 | step3A <- merge(step2A, dat, by = c("Station", "Characteristic", "Units", "Media","Sample_Fraction", 282 | "Name", "Organization", "OrganizationFormalName", 283 | "LatitudeMeasure", "LongitudeMeasure"), all = TRUE, 284 | allow.cartesian = TRUE) 285 | step3A <- step3A[!is.na(Result)] 286 | cols3 <- c("Station", "Characteristic", "Units", "Sample_Fraction", 287 | "OrganizationFormalName", "WBODY", "Media", "ECOREGION", 288 | "Criterion", "USE_OR_CLASS") 289 | step3A[, (cols3) := lapply(.SD, as.character), .SDcols = cols3] 290 | 291 | return(step3A) 292 | }) 293 | 294 | rolling <- reactive({ 295 | data <- data_prep() 296 | data <- data[grepl("rolling", Criterion, ignore.case = TRUE)] 297 | 298 | data[, maxDate := max(ActivityStartDate, na.rm = TRUE), by = c("Station", "Characteristic", 299 | "AssessmentUnit", "Units", 300 | "USE_OR_CLASS", "WBODY", "Media","Sample_Fraction", 301 | "Sample_Fraction", "ECOREGION" )] 302 | data[, MinSamples := as.numeric(MinSamples)] 303 | data[is.na(MinSamples), MinSamples := 0] 304 | 305 | data[, id := paste(Station, Characteristic, 306 | AssessmentUnit, Units, 307 | USE_OR_CLASS, WBODY, Media, 308 | Sample_Fraction, ECOREGION, sep = "_")] 309 | data[, count := .N, by ="id"] 310 | data <- data[count >= MinSamples] 311 | 312 | ids <- unique(data$id) 313 | all_ids <- lapply(ids, function(y){ 314 | sub_date <- data[id == y] 315 | dates <- as.Date(unique(sub_date$ActivityStartDate)) 316 | if(!is.na(dates)){ 317 | sapply(dates, function(x) { 318 | endDate <- x + as.numeric(unique(sub_date$AverageTime)) 319 | if(is.null(endDate)){ 320 | paste("EndDate doesn't exist") 321 | } else { 322 | if(endDate > unique(sub_date$maxDate)) { 323 | # return() 324 | res = "End date is after the latest date for this parameter/station combination" 325 | } else { 326 | subsub <- sub_date[ActivityStartDate >= as.Date(x) & ActivityStartDate <= endDate] 327 | res <- mean(subsub$Result, na.rm = TRUE) 328 | } 329 | sub_date[ActivityStartDate == as.Date(x), RollingAvg := res] 330 | } 331 | }) 332 | return(sub_date) 333 | } else { 334 | return() 335 | } 336 | }) 337 | 338 | rollingAverages <- rbindlist(all_ids, use.names = TRUE) 339 | rollingAverages[, c("id", "count") := NULL] 340 | rollingAverages <- rollingAverages[, list(Station, Characteristic, ActivityStartDate, 341 | AssessmentUnit, Units, USE_OR_CLASS, WBODY, 342 | Media, Sample_Fraction, ECOREGION, RollingAvg)] 343 | setkey(rollingAverages) 344 | rollingAverages <- rollingAverages[!duplicated(rollingAverages)] 345 | 346 | return(rollingAverages) 347 | 348 | }) 349 | 350 | ANALYSIS <- eventReactive(input$RunAnalysis, { 351 | 352 | test <- data_prep() 353 | rollingAverages <- rolling() 354 | test <- merge(test, rollingAverages, by = c("Station", "Characteristic", "ActivityStartDate", 355 | "AssessmentUnit", "Units" , "USE_OR_CLASS", "Media", 356 | "WBODY","Sample_Fraction","ECOREGION" ), all = TRUE) 357 | 358 | # Identifying exceedences 359 | test[, Exceed := FALSE] 360 | test[Comparison == "GT" & Result > Limit, Exceed := TRUE] 361 | test[Comparison == "LT" & Result < Limit, Exceed := TRUE] 362 | test[, Geomean_AU := geomean(Result), by = c("AssessmentUnit", "Characteristic", 363 | "Units", "USE_OR_CLASS", "WBODY", "Media", 364 | "Sample_Fraction", "ECOREGION")] 365 | test[, Geomean_Station := geomean(Result), by = c("Station", "Characteristic", 366 | "Units", "USE_OR_CLASS", "WBODY", "Media", 367 | "Sample_Fraction", "ECOREGION")] 368 | 369 | test[Criterion == "Geomean_Station" & Geomean_Station > Limit, 370 | Exceed := TRUE] 371 | test[Criterion == "Geomean_AU" & Geomean_AU > Limit, 372 | Exceed := TRUE] 373 | 374 | test[, `:=` (SeasonStartDate = as.character(SeasonStartDate), 375 | SeasonEndDate = as.character(SeasonEndDate))] 376 | test[grepl("season", Criterion, ignore.case = TRUE) & !is.na(SeasonEndDate) & !is.na(SeasonStartDate) & Result > Limit & 377 | MonthDay > SeasonStartDate & MonthDay < SeasonEndDate, 378 | Exceed := TRUE] 379 | 380 | test[grepl("Roll", Criterion, ignore.case = TRUE), Exceed := FALSE] 381 | test[grepl("Roll", Criterion, ignore.case = TRUE) & 382 | !is.na(RollingAvg) & 383 | RollingAvg > Limit, Exceed := TRUE] 384 | 385 | return(test) 386 | }) 387 | 388 | table_dat<-reactive({ 389 | table_dat<-ANALYSIS() 390 | table_dat[is.na(table_dat)]<-0 391 | cols <- c("Station", "Characteristic", "USE_OR_CLASS", "WBODY", "Sample_Fraction", 392 | "ECOREGION", "Criterion", "Name", "Organization") 393 | table_dat[, (cols) := lapply(.SD, as.character), .SDcols = cols] 394 | 395 | table_dat[, `:=` (num_exceed_total = sum(Exceed), 396 | count_total = .N), by = c("Station", 397 | "Characteristic", 398 | "USE_OR_CLASS", 399 | "WBODY", 400 | "ECOREGION", 401 | "Media", 402 | "Sample_Fraction", 403 | "Criterion", 404 | "Comparison")] 405 | table_dat<-table_dat[, .(AssessmentUnit = last(AssessmentUnit), 406 | Name = last(Name), 407 | num_exceed = sum(Exceed), 408 | count = .N, 409 | num_exceed_total = last(num_exceed_total), 410 | count_total = last(count_total), 411 | Lat = last(LatitudeMeasure), 412 | Long = last(LongitudeMeasure)), by = c("Station", 413 | "Characteristic", 414 | "USE_OR_CLASS", 415 | "WBODY", 416 | "ECOREGION", 417 | "Media", 418 | "Sample_Fraction", 419 | "Criterion", 420 | "Comparison")] 421 | 422 | 423 | table_dat[, Perc_Exceed := round((num_exceed_total/count_total) * 100, digits = 2)] 424 | table_dat[, Perc_Exceed_Map := ifelse(Perc_Exceed == 0, 1, Perc_Exceed)] 425 | table_dat[Criterion == 0, Criterion := "Not Analyzed"] 426 | table_dat[USE_OR_CLASS == 0, USE_OR_CLASS := "Not Analyzed"] 427 | table_dat[AssessmentUnit == 0, AssessmentUnit := "Not Specified"] 428 | table_dat[Sample_Fraction == 0, Sample_Fraction := "Not Specified"] 429 | 430 | # Moving the assessment unit column to the first position 431 | setcolorder(table_dat, c("AssessmentUnit", setdiff(names(table_dat), "AssessmentUnit"))) 432 | return(table_dat) 433 | 434 | }) 435 | 436 | output$Save_Analysis <- downloadHandler( 437 | filename = function() { 438 | paste('Analysis-', Sys.Date(), '.csv', sep='') 439 | }, 440 | content = function(con) { 441 | write.table(ANALYSIS(), con, row.names = F, col.names = TRUE, sep = ",") 442 | }) 443 | 444 | output$analysis_table = 445 | DT::renderDataTable(table_dat(), 446 | rownames = FALSE, 447 | filter = 'top', 448 | extensions = 'Buttons', escape = -1, options = list(dom = 'lfrBtip', buttons = I('colvis'), 449 | columnDefs = list(list(visible = FALSE, targets = list(4, 5, 6, 7, 9, 10, 13, 14, 15, 17)) 450 | )) 451 | 452 | 453 | ) 454 | 455 | ################## Attains-compatible output ############################################ 456 | attains <- reactive({ 457 | stations <- data.table(stationsFile()) 458 | assesU <- data.table(assessmentUnitFile()) 459 | stations[is.na(stations)] <- "" 460 | assesU[is.na(assesU)] <- "" 461 | assesU[, AssessmentUnit := as.character(AssessmentUnit)] 462 | stations[, AssessmentUnit := as.character(AssessmentUnit)] 463 | table_dat <- table_dat() 464 | 465 | stationNames <- stations[, list(Station, AssessmentUnit)] 466 | stations2 <- merge(stationNames, assesU, by = "AssessmentUnit", allow.cartesian = TRUE) 467 | au <- merge(stations2, table_dat, by = c("Station", "USE_OR_CLASS", "WBODY","ECOREGION", "AssessmentUnit") ) 468 | au[, station_count := length(unique(Station)), by = "AssessmentUnit"] 469 | au2 <- au[, .(num_exceed_total = sum(num_exceed_total, na.rm = TRUE), 470 | count_total = sum(count_total, na.rm = TRUE) 471 | ), 472 | by = c("AssessmentUnit", "USE_OR_CLASS", "Characteristic", "station_count")] 473 | au2[, Perc_Exceed := round((num_exceed_total/count_total) * 100, 1)] 474 | au2[, USE_ATTAINMENT_CODE := ""] 475 | setnames(au2, c("AssessmentUnit", "USE_OR_CLASS", "Characteristic"), 476 | c("ASSESSMENT_UNIT_ID", "USE_NAME", "PARAM_NAME")) 477 | setcolorder(au2, c("ASSESSMENT_UNIT_ID", "USE_NAME", "USE_ATTAINMENT_CODE", 478 | "PARAM_NAME","num_exceed_total", "count_total", 479 | "Perc_Exceed", "station_count")) 480 | 481 | return(au2) 482 | }) 483 | 484 | output$attains_table = 485 | DT::renderDataTable(attains(), 486 | rownames = FALSE, 487 | filter = 'top') 488 | 489 | 490 | # Downloading the ATTAINS analysis table 491 | output$Save_ATTAINS_table <- downloadHandler( 492 | filename = function() { 493 | paste('ATTAINS-', Sys.Date(), '.csv', sep='') 494 | }, 495 | content = function(con) { 496 | write.table(attains(), con, row.names = F, col.names = TRUE, sep = ",") 497 | }) 498 | 499 | ########### Trends analysis ############################################ 500 | output$trend_selects <- renderUI({ 501 | fluidRow(column(6, 502 | selectizeInput("time_choice", h4("Select time unit of analysis"), 503 | choices = c("Month", "Year")), 504 | selectizeInput("tie", h4("If multiple observations exist for same date, use:"), 505 | choices = c("Mean" = "a", 506 | "Median" = "m")), 507 | checkboxInput("correct", h4("Correct for correlation between blocks (should only be chosen if there are more than nine years of data)"), 508 | value = FALSE) 509 | 510 | ), 511 | column(6, 512 | selectizeInput("block_choice", h4("Select unit of analysis"), 513 | choices = c("Stations", "Assessment Units")), 514 | numericInput("p_choice", h4("Select the p-value"), 515 | value = 0.05) 516 | 517 | ) 518 | ) 519 | }) 520 | 521 | trends_prep <- reactive({ 522 | data <- copy(WQP()) #[Characteristic == input$parm_trend] 523 | if(is.element("Unit", names(data))){ 524 | setnames(data, "Unit", "Units") 525 | } 526 | data <- merge(data, stationsFile(), by = "Station") 527 | data_trend <- merge(data, assessmentUnitFile(), 528 | "AssessmentUnit", allow.cartesian = TRUE) 529 | 530 | data <- data_trend[, list(Station, Characteristic, Units, Result, ActivityStartDate, AssessmentUnit)] 531 | data <- data[!duplicated(data)] 532 | data <- gen_date(data) 533 | data[, date_char := as.character(ActivityStartDate)] 534 | data[, year := as.numeric(tstrsplit(date_char, "-")[[1]])] 535 | data[, month := as.numeric(tstrsplit(date_char, "-")[[2]])] 536 | data[, month_dec := month * (1/12) ] 537 | data[, date := year + month_dec] 538 | data[, stationID := as.numeric(factor(Station))] 539 | data[, assessUID := as.numeric(factor(AssessmentUnit))] 540 | return(data) 541 | }) 542 | 543 | 544 | trends_result <- eventReactive(input$RunTrendAnalysis, { 545 | dataT <- trends_prep() 546 | dataT[, charunit := paste(Characteristic, Units, sep = "_")] 547 | 548 | if(input$block_choice == "Stations"){ 549 | if(input$time_choice == "Year"){ 550 | dataT[, count := length(unique(year)), by = c("Station", "Characteristic", "Units")] 551 | } else { 552 | dataT[, count := length(unique(date)), by = c("Station", "Characteristic", "Units")] 553 | } 554 | 555 | data_less <- dataT[count < 4] 556 | data_less <- data_less[, list(Station, Characteristic, Units)] 557 | data_less <- data_less[!duplicated(data_less)] 558 | if(input$time_choice == "Year"){ 559 | data_less[, Kendall_score := "Less than four years in the sample"] 560 | } else { 561 | data_less[, Kendall_score := "Less than four months in the sample"] 562 | } 563 | dataT <- dataT[count >= 4] 564 | if(nrow(dataT) > 0) { 565 | stations <- unique(dataT$Station) 566 | 567 | all_results <- lapply(stations, function(x){ 568 | data_s <- dataT[Station == x] 569 | chars <- unique(data_s$charunit) 570 | 571 | station_result <- lapply(chars, function(y){ 572 | data <- data_s[charunit == y] 573 | if(input$time_choice == "Year"){ 574 | timeUnit <- data$year 575 | } else { 576 | timeUnit <- data$date 577 | } 578 | trend <- rkt(timeUnit, data$Result, rep = "a") 579 | character <- unique(data[charunit == y, Characteristic]) 580 | unit <- unique(data[charunit == y, Units]) 581 | result <- data.table(Station = x, 582 | Characteristic = character, 583 | Units = unit, 584 | Kendall_score = round(trend[[2]], 4), 585 | Theil_Sen_slope = round(trend[[3]], 4), 586 | Kendall_tau = round(trend[[12]], 4), 587 | p_value = round(trend[[1]], 4), 588 | variance = round(trend[[4]], 4) 589 | ) 590 | return(result) 591 | 592 | }) 593 | 594 | sub_result <- rbindlist(station_result, use.names = TRUE) 595 | 596 | }) 597 | 598 | 599 | all <- rbindlist(all_results, use.names = TRUE) 600 | all[, Trend := trend_sig(Theil_Sen_slope, p_value, input$p_choice), by = c("Station", "Characteristic", "Units")] 601 | 602 | } else { 603 | if(input$time_choice == "Year"){ 604 | all <- data.table(Station = "No station/characteristic pair has at least four sampling years") 605 | } else { 606 | all <- data.table(Station = "No station/characteristic pair has at least four sampling months") 607 | } 608 | } 609 | all <- rbind(all, data_less, use.names = TRUE, fill = TRUE) 610 | 611 | } else if(input$block_choice == "Assessment Units") { 612 | if(input$time_choice == "Year"){ 613 | dataT[, count := length(unique(year)), by = c("AssessmentUnit", "Characteristic", "Units")] 614 | } else { 615 | dataT[, count := length(unique(date)), by = c("AssessmentUnit", "Characteristic", "Units")] 616 | } 617 | 618 | data_less <- dataT[count < 4] 619 | data_less <- data_less[, list(AssessmentUnit, Characteristic, Units)] 620 | data_less <- data_less[!duplicated(data_less)] 621 | if(input$time_choice == "Year"){ 622 | data_less[, Kendall_score := "Less than four years in the sample"] 623 | } else { 624 | data_less[, Kendall_score := "Less than four months in the sample"] 625 | } 626 | 627 | dataT <- dataT[count >= 4] 628 | 629 | if(nrow(dataT) > 0) { 630 | 631 | AU <- unique(dataT$AssessmentUnit) 632 | 633 | all_results <- lapply(AU, function(x){ 634 | data_s <- dataT[AssessmentUnit == x] 635 | chars <- unique(data_s$charunit) 636 | 637 | au_result <- lapply(chars, function(y){ 638 | data <- data_s[charunit == y] 639 | if(input$time_choice == "Year"){ 640 | timeUnit <- data$year 641 | } else { 642 | timeUnit <- data$date 643 | } 644 | trend <- rkt(timeUnit, data$Result, data$stationID, rep = input$tie) 645 | character <- unique(data[charunit == y, Characteristic]) 646 | unit <- unique(data[charunit == y, Units]) 647 | result <- data.table(AssessmentUnit = x, 648 | Characteristic = y, 649 | Units = unit, 650 | Kendall_score = round(trend[[2]], 4), 651 | Theil_Sen_slope = round(trend[[3]], 4), 652 | Kendall_tau = round(trend[[12]], 4), 653 | p_value = round(trend[[1]], 4), 654 | variance = round(trend[[4]], 4) 655 | ) 656 | return(result) 657 | 658 | }) 659 | 660 | sub_result <- rbindlist(au_result, use.names = TRUE) 661 | 662 | }) 663 | 664 | 665 | all <- rbindlist(all_results, use.names = TRUE) 666 | all[, Trend := trend_sig(Theil_Sen_slope, p_value, input$p_choice), by = c("AssessmentUnit", "Characteristic")] 667 | } else { 668 | if(input$time_choice == "Year"){ 669 | all <- data.table(AssessmentUnit = "No assessment unit/characteristic pair has at least four sampling years") 670 | } else { 671 | all <- data.table(AssessmentUnit = "No assessment unit/characteristic pair has at least four sampling months") 672 | } 673 | } 674 | all <- rbind(all, data_less, use.names = TRUE, fill = TRUE) 675 | } 676 | return(all) 677 | }) 678 | 679 | output$trends_table <- DT::renderDataTable( 680 | trends_result(), escape = -1, rownames = FALSE, 681 | filter = 'top' 682 | ) 683 | 684 | # Downloading the criteria analysis table 685 | output$Save_Analysis_trends <- downloadHandler( 686 | filename = function() { 687 | paste('Trends_Analysis-', Sys.Date(), '.csv', sep='') 688 | }, 689 | content = function(con) { 690 | write.table(trends_result(), con, row.names = F, col.names = TRUE, sep = ",") 691 | }) 692 | 693 | output$tbl_text <- renderText({ 694 | str(trends_prep()) 695 | }) 696 | 697 | ################################ Map tab ########################################## 698 | 699 | output$ParamMAP <- renderUI({ 700 | data <- ANALYSIS() 701 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 702 | 703 | selectizeInput("param_map", label = p("Select a parameter"), 704 | choices = unique(data[, CharUnit]), multiple = TRUE, 705 | selected = if(input$param_sel==1){ 706 | unique(data[, CharUnit]) 707 | } else {NULL}) 708 | }) 709 | 710 | output$Class_Use_MAP <- renderUI({ 711 | data <- ANALYSIS() 712 | selectizeInput("useclass_map", label = p("Select a use or class"), 713 | choices = unique(data[!is.na(USE_OR_CLASS), USE_OR_CLASS]), multiple = TRUE, 714 | selected = if(input$useclass_sel==1){ 715 | unique(data[!is.na(USE_OR_CLASS), USE_OR_CLASS]) 716 | } else {NULL}) 717 | }) 718 | 719 | output$Eco_MAP <- renderUI({ 720 | data <- ANALYSIS() 721 | selectizeInput("eco_map", label = p("Select an ecoregion"), 722 | choices = unique(data[, ECOREGION]), multiple = TRUE, 723 | selected = if(input$eco_sel==1){ 724 | unique(data[, ECOREGION]) 725 | } else {NULL}) 726 | }) 727 | 728 | output$MediaMAP <- renderUI({ 729 | data <- ANALYSIS() 730 | selectizeInput("media_map", label = p("Select media "), 731 | choices = unique(data[, Media]), multiple = TRUE, 732 | selected = if(input$media_sel == 1){ 733 | unique(data[, Media]) 734 | } else {NULL}) 735 | }) 736 | 737 | output$SampleMAP <- renderUI({ 738 | data <- ANALYSIS() 739 | selectizeInput("sample_map", label = p("Select a sample fraction"), 740 | choices = unique(data[, Sample_Fraction]), multiple = TRUE, 741 | selected = if(input$sample_sel==1){ 742 | unique(data[, Sample_Fraction]) 743 | } else {NULL}) 744 | }) 745 | 746 | output$WB_MAP <- renderUI({ 747 | data <- ANALYSIS() 748 | selectizeInput("wb_map", label = p("Select a water body"), 749 | choices = unique(data[, WBODY]), multiple = TRUE, 750 | selected = if(input$wb_sel==1){ 751 | unique(data[, WBODY]) 752 | } else {NULL}) 753 | }) 754 | 755 | spfilter_dat <- eventReactive (input$submit_filters, { 756 | data <- ANALYSIS() 757 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 758 | if(!is.null(input$param_map) & !unique(data$CharUnit) %in% c("", NA)) { 759 | data <- data[CharUnit %in% input$param_map] 760 | } 761 | if(!is.null(input$useclass_map) & !unique(data$USE_OR_CLASS) %in% c("", NA)){ 762 | data <- data[USE_OR_CLASS %in% input$useclass_map] 763 | } 764 | if(!is.null(input$eco_map) & !unique(data$ECOREGION) %in% c("", NA)){ 765 | data <- data[ECOREGION %in% input$eco_map] 766 | } 767 | if(!is.null(input$media_map) & !unique(data$Media) %in% c("", NA)){ 768 | data <- data[Media %in% input$media_map] 769 | } 770 | if(!is.null(input$sample_map) & !unique(data$Sample_Fraction) %in% c("", NA)){ 771 | data <- data[Sample_Fraction %in% input$sample_map] 772 | } 773 | if(!is.null(input$wb_map) & !unique(data$WBODY) %in% c("", NA)){ 774 | data <- data[WBODY %in% input$wb_map] 775 | } 776 | return(data) 777 | }) 778 | 779 | displayed_data <- reactive({ 780 | if(input$submit_filters == 0){ 781 | data <- ANALYSIS() 782 | } else { 783 | data <- spfilter_dat() 784 | } 785 | 786 | return(data) 787 | }) 788 | 789 | # Adding text if the analysis hasn't been run and the map isn't displayed 790 | output$non_display <- renderUI({ 791 | h3("") 792 | if(input$RunAnalysis){ 793 | h3("") 794 | } else { 795 | h3("Please run the criteria analysis in the Analysis tab by clicking the 'Run Analysis' button ", 796 | style = "text-align:center ; color: #990000 ;") 797 | } 798 | }) 799 | 800 | # Adding text under map only if the map will be drawn 801 | output$map_text <- renderUI({ 802 | if(input$RunAnalysis){ 803 | tags$ul(tags$li("The station markers are scaled based on the # of exceedances/# of measurements."), 804 | tags$li("Stations marked with black circles have no exceedance records in the dataset.")) 805 | } 806 | }) 807 | 808 | min_date <- reactive({ 809 | data <- displayed_data() 810 | min_date <- min(unique(data$ActivityStartDate), na.rm = TRUE) 811 | }) 812 | 813 | max_date <- reactive({ 814 | data <- displayed_data() 815 | max_date <- max(unique(data$ActivityStartDate), na.rm = TRUE) 816 | }) 817 | 818 | map_df <- reactive({ 819 | data <- displayed_data() 820 | data[, `:=` (num_exceed_total = sum(Exceed, na.rm = TRUE), 821 | count_total = .N), by = c("Station")] 822 | data <- data[, .(Name = last(Name), 823 | num_exceed = sum(Exceed), 824 | count = .N, 825 | num_exceed_total = last(num_exceed_total), 826 | count_total = last(count_total), 827 | Lat = last(as.numeric(as.character(LatitudeMeasure))), 828 | Long = last(as.numeric(as.character(LongitudeMeasure))), 829 | AssessmentUnit = last(AssessmentUnit) 830 | ), by = c("Station")] 831 | 832 | 833 | data[, Perc_Exceed := (num_exceed_total/count_total) * 100] 834 | data[, Perc_Exceed_Map := ifelse(Perc_Exceed == 0, 1, Perc_Exceed)] 835 | 836 | return(data) 837 | }) 838 | 839 | output$map_data = 840 | DT::renderDataTable(spfilter_dat(), 841 | rownames = FALSE, 842 | filter = 'top') 843 | 844 | output$map<-renderLeaflet({ 845 | radiusFactor <- 50 846 | 847 | leaflet(map_df()) %>% 848 | fitBounds(lng1 = ~min(Long), lat1 = ~min(Lat), lng2 = ~max(Long), lat2 = ~max(Lat)) %>% 849 | addTiles( "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png") %>% 850 | clearMarkers() %>% 851 | addCircleMarkers( 852 | lat =~Lat, 853 | lng = ~Long, 854 | radius = ~(log(Perc_Exceed_Map) + 2) * radiusFactor / 5^2, 855 | layerId = row.names(map_df()), 856 | clusterOptions = markerClusterOptions() 857 | 858 | ) 859 | }) 860 | 861 | # Render polygons 862 | observe({ 863 | pal <- colorFactor("Set1", domain = map_df()$AssessmentUnit) 864 | radiusFactor <- 50 865 | map <- leafletProxy("map", data = map_df()) 866 | map %>% clearMarkers() 867 | if(input$mapcolor == "Assessment_Units") { 868 | map %>% clearMarkerClusters() %>% 869 | addCircleMarkers(data = map_df(), 870 | color = ~pal(AssessmentUnit), 871 | lat =~Lat, 872 | lng = ~Long, 873 | radius = ~(log(Perc_Exceed_Map) + 2) * radiusFactor / 5^2, 874 | layerId = row.names(map_df()), 875 | clusterOptions = markerClusterOptions() 876 | ) 877 | } else if(input$mapcolor == "Exceedances") { 878 | map %>% clearMarkerClusters() %>% 879 | addCircleMarkers(data = map_df(), 880 | color = ~ifelse(num_exceed_total == 0, 'black','blue'), 881 | lat =~Lat, 882 | lng = ~Long, 883 | radius = ~(log(Perc_Exceed_Map) + 2) * radiusFactor / 5^2, 884 | layerId = row.names(map_df()), 885 | clusterOptions = markerClusterOptions() 886 | ) 887 | 888 | } 889 | 890 | }) 891 | 892 | observeEvent(input$map_marker_click, { 893 | leafletProxy("map") %>% clearPopups() 894 | content<- as.character(tagList( 895 | tags$html( 896 | tags$div(style = 'color: #24476B', 897 | tags$ul( 898 | tags$li(h4(paste("Station ID: ", map_df()[row.names(map_df()) == input$map_marker_click["id"], ][["Station"]]))), 899 | tags$li(h4(paste("Station name: ", map_df()[row.names(map_df()) == input$map_marker_click["id"], ][["Name"]]))), 900 | tags$li(h4(paste("Start date: ", min_date()))), 901 | tags$li(h4(paste("End date: ", max_date()))) 902 | 903 | ) 904 | ) 905 | ) 906 | 907 | )) 908 | 909 | leafletProxy("map") %>% addPopups(lat = input$map_marker_click$lat, lng = input$map_marker_click$lng, 910 | paste(content, '

', 911 | actionButton("Stat_Summary", "Select this Location", 912 | onclick = 'Shiny.onInputChange(\"button_click\", Math.random())'), 913 | sep = "")) 914 | }) 915 | 916 | ################################# Station Summary ########################################## 917 | 918 | # *** Specifying station to be summarized 919 | station_info <- eventReactive(input$button_click,{ 920 | map_df()[row.names(map_df()) == input$map_marker_click$id] 921 | }) 922 | 923 | station_data1 <- eventReactive(input$button_click, { 924 | data <- ANALYSIS()[Station == station_info()$Station ] 925 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 926 | return(data) 927 | }) 928 | 929 | station_data <- reactive({ 930 | data <- station_data1() 931 | data <- data[USE_OR_CLASS == input$Select_Use ] 932 | return(data) 933 | }) 934 | 935 | output$Station_Summary_Panel <- renderUI({ 936 | h4(paste("Summary for station ", station_info()$Name)) 937 | }) 938 | 939 | output$Station_Summary_select<-renderUI({ 940 | data <- station_data1() 941 | if(is.null(data)){ 942 | h3("Please select a station on the map in the Map tab") 943 | 944 | } else { 945 | use_list<-as.character(unique(data[!is.na(USE_OR_CLASS), USE_OR_CLASS])) 946 | fluidRow(column(4), column(4, selectizeInput("Select_Use", "Select a Use or Class", choices = use_list, selected = use_list[1]))) 947 | } 948 | 949 | }) 950 | 951 | station_summary <- reactive({ 952 | data <- station_data() 953 | stat_summary <- data[, list(Characteristic, ActivityStartDate, Criterion, Exceed)] 954 | stat_summary <- stat_summary[!duplicated(stat_summary)] 955 | stat_summary <- stat_summary[, `:=` (Exceedances = sum(Exceed, na.rm = TRUE), 956 | Measurements = .N), by = c("Characteristic")] 957 | stat_summary <- stat_summary[!duplicated(stat_summary[, list(Characteristic, Exceedances, Measurements)])] 958 | stat_summary[, Exceed := NULL] 959 | 960 | }) 961 | 962 | output$Station_Summary_text<-renderUI({ 963 | data <- station_data() 964 | use_list <- as.character(unique(data$USE_OR_CLASS)) 965 | name <- station_info()$Name 966 | stat_summary <- station_summary() 967 | 968 | measurements <- dim(data)[1] 969 | chars <- length(unique(WQP()[Station == station_info()$Station]$Characteristic)) 970 | criterion <- length(stat_summary$Characteristic) 971 | date_low <- min(data$ActivityStartDate) 972 | date_high <- max(data$ActivityStartDate) 973 | fluidRow( 974 | column(7, 975 | p(tagList( 976 | tags$html( 977 | tags$div(style = 'text-align:left', 978 | tags$ul( 979 | tags$li(h5(paste("Station name: ", name))), 980 | tags$li(h5(paste("Start date: ", date_low))), 981 | tags$li(h5(paste("End date: ", date_high))), 982 | tags$li(h5(paste("Class/use: ", input$Select_Use))), 983 | tags$li(h5(paste("Unique characteristics: ", chars))), 984 | tags$li(h5(paste("Measurements: ", measurements))), 985 | tags$li(h5(paste("Number of criteria: ", criterion))) 986 | ) 987 | ) 988 | ) 989 | 990 | )) 991 | ) 992 | ) 993 | 994 | }) 995 | 996 | # Adding text when no station is selected 997 | output$chart_text <- renderUI({ 998 | h4("If no charts are rendered on this page, please choose a station on the map") 999 | }) 1000 | 1001 | frequency_plot <- function(){ 1002 | data <- station_data() 1003 | p1 <- ggplot(data, aes(x = ActivityStartDate, y = Characteristic)) + 1004 | geom_point(color = ifelse(data$Exceed == TRUE, "red", "black"), 1005 | size = 5, alpha = 1/2)+ 1006 | labs(x = '',y='') + 1007 | theme_bw()+ 1008 | scale_y_discrete(labels = function(y) str_wrap(y, width = 20)) + 1009 | scale_x_date(labels = date_format("%b-%d-%y"))+ 1010 | theme(axis.text.x=element_text(angle=35, vjust=1, hjust=1), 1011 | legend.position = "bottom") 1012 | print(p1) 1013 | } 1014 | 1015 | output$Station_data_time_plot<-renderPlot({ 1016 | frequency_plot() 1017 | }) 1018 | 1019 | # Download the frequency chart 1020 | output$freq_chart <- downloadHandler( 1021 | filename = function() { 1022 | paste0("Frequency_chart-", Sys.Date(), '.png') 1023 | }, 1024 | content = function(file) { 1025 | png(file) 1026 | frequency_plot() 1027 | dev.off() 1028 | }, 1029 | contentType = "image/png") 1030 | 1031 | 1032 | output$barplot <- renderChart2({ 1033 | 1034 | check <- station_summary() 1035 | 1036 | a <- rCharts:::Highcharts$new() 1037 | a$chart(type = "bar") 1038 | a$title(text = "Measurements vs. Exceedances") 1039 | if(length(unique(check$Characteristic)) == 1){ 1040 | a$xAxis(categories = list(check$Characteristic), labels = list(reserveSpace = 'false')) 1041 | } else { 1042 | a$xAxis(categories = check$Characteristic, labels = list(reserveSpace = 'false')) 1043 | } 1044 | a$data(check[, .(Exceedances, Measurements)]) 1045 | a$exporting(enabled = TRUE) 1046 | return(a) 1047 | }) 1048 | 1049 | output$Station_time <- renderUI({ 1050 | data <- charunit() 1051 | data <- data[!duplicated(data[, list(Date, CharUnit)])] 1052 | selectizeInput("CHAR_UNITS", label = p("Please Choose Criteria"), 1053 | choices = unique(data[, CharUnit]), multiple = FALSE) 1054 | }) 1055 | 1056 | isolate({ 1057 | charunit <- reactive({ 1058 | data<-data.table(station_data()) 1059 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 1060 | setnames(data, "ActivityStartDateTime", "Date") 1061 | data <- data[, list(Result, CharUnit, Date, Characteristic)] 1062 | data[, charlength := length(Date), by = 'CharUnit'] 1063 | data <- data[charlength > 0] 1064 | return(data) 1065 | }) 1066 | 1067 | timedata <- reactive({ 1068 | data <- charunit() 1069 | data[, Result := as.numeric(Result)] 1070 | data <- data[CharUnit == input$CHAR_UNITS] 1071 | data <- data[!duplicated(data[, list(Date, CharUnit)])] 1072 | testc <- dcast(data, Date ~ CharUnit, value.var = 'Result') 1073 | return(testc) 1074 | }) 1075 | }) 1076 | 1077 | criteriaValues <- reactive({ 1078 | data <- station_data()[CharUnit == input$CHAR_UNITS] 1079 | data <- data[, list(Criterion, Limit)] 1080 | data <- data[!duplicated(data)] 1081 | criteria <- data$Criterion 1082 | lim <- data$Limit 1083 | return(list(criteria = criteria, lim = lim)) 1084 | }) 1085 | 1086 | output$timeseries <- renderChart2({ 1087 | datatime <- data.table(timedata()) 1088 | # datatime[, Date := gsub(" UTC", "", Date)] 1089 | datatime[, Date := as.numeric(as.POSIXct(datatime$Date, format = "%m/%d/%Y", tz = "" ))*1000] 1090 | 1091 | datatime <- datatime[order(Date)] 1092 | values <- criteriaValues() 1093 | 1094 | ln <- rCharts::Highcharts$new() 1095 | ln$colors("#08519C","#D94801" ) 1096 | ln$xAxis(type = 'datetime', labels = list(format = '{value:%m/%d/%Y}')) 1097 | if(!is.null(values)){ 1098 | ln$yAxis( plotLines = list( 1099 | list(value = values[[2]][1], color= 'red', dashStyle= 'shortdash', width=2, 1100 | label = list(text = values[[1]][1], align = 'left')), 1101 | list(value = values[[2]][2], color= 'red', dashStyle= 'shortdash', width=2, 1102 | label = list(text = values[[1]][2], align = 'left')), 1103 | list(value = values[[2]][3], color= 'red', dashStyle= 'shortdash', width=2, 1104 | label = list(text = values[[1]][3], align = 'left')), 1105 | list(value = values[[2]][4], color= 'red', dashStyle= 'shortdash', width=2, 1106 | label = list(text = values[[1]][4], align = 'left')), 1107 | list(value = values[[2]][5], color= 'red', dashStyle= 'shortdash', width=2, 1108 | label = list(text = values[[1]][5], align = 'left')) 1109 | ) 1110 | ) 1111 | } 1112 | for(i in 2:ncol(datatime)) { 1113 | ln$series( 1114 | data = toJSONArray2(datatime[, c(1,i), with = FALSE], names = FALSE, json = FALSE), 1115 | name = names(datatime)[i], 1116 | type = 'spline', 1117 | yAxis = (i-2) 1118 | ) 1119 | } 1120 | 1121 | ln$plotOptions(spline = list(connectNulls = TRUE)) 1122 | ln$chart(marginTop = 70, zoomType = 'xy', panKey = 'shift', panning = TRUE) 1123 | ln$exporting(filename = "Line chart") 1124 | 1125 | return(ln) 1126 | }) 1127 | ################################# Assessment Unit Summary ########################################## 1128 | # *** Specifying assessment unit to be summarized 1129 | output$AssesU_Summary_select<-renderUI({ 1130 | data <- assessmentUnitFile() 1131 | assess_list <- as.character(unique(data$AssessmentUnit)) 1132 | fluidRow(column(4), column(4, selectizeInput("Select_AssessU", "Select an Assessment Unit", choices = assess_list, selected = assess_list[1]))) 1133 | }) 1134 | 1135 | assess_summary<-reactive({ 1136 | data<-data.table(ANALYSIS()) 1137 | data<-data[AssessmentUnit == input$Select_AssessU] 1138 | return(data) 1139 | }) 1140 | 1141 | output$AssessU_text<-renderUI({ 1142 | x<-length(unique(assess_summary()$Station)) 1143 | fluidRow(p(paste("You are viewing a summary of the assessment unit ", input$Select_AssessU, " .", 1144 | "This assessment unit contains ", x, " station(s)."))) 1145 | }) 1146 | 1147 | 1148 | isolate({ 1149 | output$Assess_Use_select<-renderUI({ 1150 | data <- assess_summary() 1151 | assess_use_list <- as.character(unique(data$USE_OR_CLASS)) 1152 | fluidRow(column(4), column(4, selectizeInput("Select_Assess_Use", "Select a Use/Class from this Assessment Unit", choices = assess_use_list, selected = assess_use_list[1]))) 1153 | }) 1154 | 1155 | 1156 | assess_stat_summary<-reactive({ 1157 | asData <- assess_summary() 1158 | asData[, Exceedances := sum(Exceed, na.rm = TRUE), by = c("Station", 1159 | "Criterion", 1160 | "Characteristic", 1161 | "Units", 1162 | "USE_OR_CLASS", 1163 | "WBODY", 1164 | "Media", 1165 | "Sample_Fraction", 1166 | "ECOREGION", 1167 | "Sample_Fraction")] 1168 | asData[, Measurements := .N, by = c("Station", 1169 | "Criterion", 1170 | "Characteristic", 1171 | "Units", 1172 | "USE_OR_CLASS", 1173 | "WBODY", 1174 | "Media", 1175 | "Sample_Fraction", 1176 | "ECOREGION", 1177 | "Sample_Fraction")] 1178 | asData <- asData[, list(Station, Characteristic,USE_OR_CLASS, WBODY, Media, Sample_Fraction, ECOREGION, Sample_Fraction, Criterion, 1179 | Measurements, Exceedances)] 1180 | asData <- asData[!duplicated(asData)] 1181 | 1182 | 1183 | return(asData) 1184 | }) 1185 | 1186 | output$assess_Stat_table = 1187 | DT::renderDataTable(assess_stat_summary(), 1188 | rownames = FALSE) 1189 | }) 1190 | 1191 | output$Assess_time <- renderUI({ 1192 | data <- charunit_assess() 1193 | data <- data[!duplicated(data[, list(Date, CharUnit)])] 1194 | selectizeInput("CHAR_UNITS_A", label = p("Please Choose Criteria"), 1195 | choices = unique(data[, CharUnit]), selected = unique(data[, CharUnit])[1], multiple = FALSE) 1196 | }) 1197 | 1198 | isolate({ 1199 | charunit_assess <- reactive({ 1200 | data<-data.table(assess_summary()[USE_OR_CLASS == input$Select_Assess_Use]) 1201 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 1202 | setnames(data, "ActivityStartDateTime", "Date") 1203 | data <- data[, list(Result, CharUnit, Date, Characteristic, Station)] 1204 | data[, charlength := length(Date), by = 'CharUnit'] 1205 | data <- data[charlength > 0] 1206 | return(data) 1207 | }) 1208 | 1209 | timedata_assess <- reactive({ 1210 | data <- charunit_assess() 1211 | data[, Result := as.numeric(Result)] 1212 | data <- data[CharUnit == input$CHAR_UNITS_A] 1213 | data <- data[!duplicated(data[, list(Date, Station)])] 1214 | testc <- dcast(data, Date ~ Station, value.var = 'Result') 1215 | return(testc) 1216 | }) 1217 | }) 1218 | 1219 | criteriaValues2 <- reactive({ 1220 | data <- assess_summary()[USE_OR_CLASS == input$Select_Assess_Use] 1221 | data[, CharUnit := paste(Characteristic, " (", Units, ")", sep = "")] 1222 | data <- data[CharUnit == input$CHAR_UNITS_A] 1223 | 1224 | data <- data[, list(Criterion, Limit)] 1225 | data <- data[!duplicated(data)] 1226 | criteria <- data$Criterion 1227 | lim <- data$Limit 1228 | return(list(criteria = criteria, lim = lim)) 1229 | }) 1230 | 1231 | 1232 | output$timeseries_assess <- renderChart2({ 1233 | datatime <- data.table(timedata_assess()) 1234 | datatime[, Date := gsub(" UTC", "", Date)] 1235 | datatime$Date = as.numeric(as.POSIXct(datatime$Date, "%m/%d/%Y", tz = "" ))*1000 1236 | datatime <- datatime[order(Date)] 1237 | values <- criteriaValues2() 1238 | 1239 | ln <- rCharts:::Highcharts$new() 1240 | ln$xAxis(type = 'datetime', labels = list(format = '{value:%m/%d/%Y}')) 1241 | for(i in 2:ncol(datatime)) { 1242 | ln$series( 1243 | data = toJSONArray2(datatime[, c(1,i), with = FALSE], names = FALSE, json = FALSE), 1244 | name = names(datatime)[i], 1245 | type = 'spline' 1246 | )} 1247 | 1248 | if(!is.null(values)){ 1249 | ln$yAxis( plotLines = list( 1250 | list(value = values[[2]][1], color= 'red', dashStyle= 'shortdash', width=2, 1251 | label = list(text = values[[1]][1], align = 'left')), 1252 | list(value = values[[2]][2], color= 'red', dashStyle= 'shortdash', width=2, 1253 | label = list(text = values[[1]][2], align = 'left')), 1254 | list(value = values[[2]][3], color= 'red', dashStyle= 'shortdash', width=2, 1255 | label = list(text = values[[1]][3], align = 'left')), 1256 | list(value = values[[2]][4], color= 'red', dashStyle= 'shortdash', width=2, 1257 | label = list(text = values[[1]][4], align = 'left')), 1258 | list(value = values[[2]][5], color= 'red', dashStyle= 'shortdash', width=2, 1259 | label = list(text = values[[1]][5], align = 'left')) 1260 | ) 1261 | ) 1262 | } 1263 | 1264 | ln$plotOptions(spline = list(connectNulls = TRUE, marker = list(enabled = TRUE))) 1265 | ln$chart(marginTop = 70, zoomType = 'xy', panKey = 'shift', panning = TRUE) 1266 | ln$exporting(filename = "Line chart") 1267 | 1268 | return(ln) 1269 | }) 1270 | 1271 | } 1272 | 1273 | 1274 | 1275 | 1276 | 1277 | 1278 | 1279 | 1280 | 1281 | 1282 | 1283 | 1284 | 1285 | 1286 | 1287 | 1288 | 1289 | 1290 | 1291 | 1292 | 1293 | 1294 | 1295 | 1296 | 1297 | 1298 | 1299 | --------------------------------------------------------------------------------