index.Rmd

---
title: "PINEY POINT ENVIRONMENTAL MONITORING DASHBOARD"
output: 
  flexdashboard::flex_dashboard:
    logo: www/tarponlogo.png
    social: menu
    source_code: "https://github.com/tbep-tech/piney-point"
    includes: 
      in_header: google-analytics.html
runtime: shiny
css: styles.css
---
  
```{r setup, include=F}
knitr::opts_chunk$set(echo = F, message = F, warning = F)

# libraries
library(shiny)
library(flexdashboard)
library(mapview)
library(leaflet)
library(tidyverse)
library(sf)
library(plotly)
library(leafem)
library(RColorBrewer)
library(scales)
library(reactable)
library(tbeptools)
library(patchwork)
library(shinyWidgets)
library(lubridate)

source('R/funcs.R')

load('data/bswqdat.RData')
load('data/bswqdatsub.RData')
load('data/bsstatloc.RData')
load('data/rswqdat.RData')
load('data/rsstatloc.RData')
load('data/parms.RData')
load('data/bstransect.RData')
load('data/bstransectocc.RData')
load('data/trnpts.RData')
load('data/trnlns.RData')
load('data/rstrnpts.RData')
load('data/rstrnlns.RData')
load('data/rstrndat.RData')
load('data/rsbntpts.RData')
load('data/rsbntdat.RData')
load('data/bswqrngs.RData')
load('data/rscntdat.RData')
load('data/rscntthr.RData')
load('data/rsphydat.RData')
load('data/rsphypts.RData')
load('data/rsallpts.RData')

# logs
rswqlog <- readLines('logs/rswqlog.txt')
rscntlog <- readLines('logs/rscntlog.txt')
rsphylog <- readLines('logs/rsphylog.txt')
rstrnlog <- readLines('logs/rstrnlog.txt')
rsbntlog <- readLines('logs/rsbntlog.txt')
  
##
# globals

# map types
mptyps <- c("CartoDB.Positron", "CartoDB.DarkMatter", "OpenStreetMap", "Esri.WorldImagery", "OpenTopoMap")

mapviewOptions(
    basemaps = c("Stamen.TonerLite", "Esri.OceanBasemap"),
    platform = "leaflet")

# proj
prj <- 4326

# font
fml <- 'Lato Light'

# line colors on baseline
cols <- colorRampPalette(RColorBrewer::brewer.pal(n = 8, name = 'Set1'))(6)

# station colors on maps
stacols <- colorRampPalette(RColorBrewer::brewer.pal(n = 8, name = 'Accent'))(length(unique(rsallpts$source_lng)))
names(stacols) <- sort(unique(rsallpts$source_lng))

# variable color on wq maps
vrscols <- RColorBrewer::brewer.pal(n = 9, name = 'Blues')

# variable color on cnt maps
cntcols <- RColorBrewer::brewer.pal(n = 9, name = 'Greens')

# variable color on 
# value box colors
boxcol <- '#00806E'

# piney point loc
pineypoint <- c(-82.52469352586753, 27.629819505234703)

# map center
mapcenter <- c(-82.57862105363802, 27.624588580411267)

# seagrass transect prj
st_crs(trnpts) <- 4326

# baseline wq stations
bsstas <- unique(bsstatloc$station) %>% sort

# non-bay stations
nonbay <- c('BH01', 'P Port 2', 'P Port 3', 'PM Out', '20120409-01', 'PPC41', 'P Port 4', 'PMB01', 'NGS-S Pond')

# seagrass species
spp <- c("Halodule", "Syringodium", "Thalassia", "Halophila", "Ruppia", "Caulerpa")

# seagrass transects near pp
trns <- sort(unique(bstransect$Transect))

# response transects near pp
rstrns <- sort(unique(rstrndat$station))

# benthic sites
rsbnts <- sort(unique(rsbntpts$station))

# benthoc months
rsbntsmodt <- sort(unique(rsbntdat$modt))

# phyto days
rsphydys <- sort(unique(rsphydat$date))

# phyto taxa
rsphysel <- sort(unique(rsphydat$species))

# options for phyto ui selection
rsphytyp <- c('By clicking a station on the map', 'By selecting taxa from a menu')
              
# sources lookup
srcs <- rsstatloc %>% 
  st_set_geometry(NULL) %>% 
  select(source_lng, source) %>% 
  unique

# phyto sources lookup
physrcs <- rsphypts %>% 
  st_set_geometry(NULL) %>% 
  select(source_lng, source) %>% 
  unique

# variables to select from available
vrs <- parms %>% 
  select(lbs, var) %>% 
  filter(var %in% rswqdat$var) %>% 
  deframe %>% 
  as.list

# contaminant variables
cntvrs <- rscntdat %>% 
  pull(var) %>% 
  unique %>% 
  sort

# phy cell count range
phymax <- rsphydat %>% 
  pull(val) %>% 
  max(., na.rm = T) %>% 
  `/` (1000)
```

```{r statics}
# response sampling locations
rslocs <- rsstatloc %>% 
  mutate(
    lon = st_coordinates(.)[, 1],
    lat = st_coordinates(.)[, 2]
  ) %>% 
  st_set_geometry(NULL) %>% 
  select(
    `Data source` = source_lng, 
    `Station` = station, 
    Longitude = lon, 
    Latitude = lat
  )

# baseline wq map
tomap <- as.list(stacols) %>% 
  enframe('source', 'col') %>% 
  unnest(col) %>% 
  left_join(bsstatloc, ., by = 'source')
tomapcols <- tomap %>% 
  st_set_geometry(NULL) %>% 
  select(source, col) %>% 
  unique
bswqmap <- mapview(tomap, homebutton = F, layer.name = 'Data source', map.types = mptyps, legend = F) %>%
  .@map %>% 
  clearMarkers() %>% 
  addCircleMarkers(
    data = tomap,
    layerId = ~station,
    stroke = TRUE,
    color = 'black',
    fill = TRUE,
    fillColor = tomap$col,
    weight = 1,
    fillOpacity = 1,
    radius= 6, 
    label = ~paste0('Station: ', station)
  ) %>% 
  addCircleMarkers(
      data = tomap[tomap$station %in% bsstas[1], ],
      layerId = 'selsta',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6, 
      label = ~paste0('Station: ', station)
    ) %>% 
  addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE)) %>% 
  addLegend("topright", title = 'Data source', opacity = 1, labels = tomapcols$source, colors = tomapcols$col) 

# current base map
rswqmap <- rsallpts %>% 
  mapview(zcol = 'source_lng', homebutton = F, layer.name = 'Data source', col.regions = stacols, map.types = mptyps, alpha.regions = 0.9) %>% 
  .@map %>% 
  addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE))

# summary of agencies reporting for value boxes
agns <- rsallpts %>% 
  pull(source_lng) %>% 
  unique %>% 
  length

# summary of variables measured for value boxes
vars <- rswqdat %>% 
  pull(var) %>% 
  unique %>% 
  length

# summary of days of sampling for value boxes
dysm <- rswqdat %>% 
  pull(date) %>% 
  unique %>% 
  length

# summary of sites being monitored for value boxes
stsm <- rsallpts %>% 
  pull(station) %>% 
  unique %>% 
  length

# summary of samples for value boxes
smsm <- rswqdat %>% 
  nrow

# seagrass base map
bssgmap <- mapview(trnpts, homebutton = F, legend = F, map.types = mptyps) %>% 
  .@map %>% 
  clearMarkers()
for(i in unique(trnlns$station))
  bssgmap <- bssgmap %>% 
    addPolylines(
      data = trnlns[trnlns$station %in% i, ], 
      lng = ~lng, 
      lat = ~lat, 
      color = 'grey', 
      label = ~station
    )
bssgmap <- bssgmap %>% 
  addCircleMarkers(
    data = trnpts,
    layerId = ~station,
    stroke = TRUE,
    color = 'black',
    fill = TRUE,
    fillColor = 'grey',
    weight = 1,
    fillOpacity = 1,
    radius= 4,
    label = ~paste0('Transect ', station)
  ) %>% 
  addStaticLabels(
    data = trnpts,
    label = trnpts$station, 
    direction = 'top', 
    textsize = '15px',
    offset = c(0, 1)
  ) %>% 
  addCircleMarkers(
    data = trnpts[trnpts$station %in% trns[1], ],
    layerId = 'seltrn',
    stroke = TRUE,
    color = 'black',
    fill = TRUE,
    fillColor = 'red',
    weight = 1,
    fillOpacity = 1,
    radius= 6,
    label = ~paste0('Transect ', station)
  ) %>% 
  addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE))

# rapid response transect base map
rstrnpts <- rstrnpts %>% 
  filter(station %in% rstrns)
rstrnlns <- rstrnlns %>% 
  filter(station %in% rstrns)
rstrnmap <- mapview(rstrnpts, homebutton = F, legend = F, map.types = mptyps) %>% 
  .@map %>% 
  clearMarkers()
for(i in unique(rstrnlns$station))
  rstrnmap <- rstrnmap %>% 
    addPolylines(
      data = rstrnlns[rstrnlns$station %in% i, ], 
      lng = ~lng, 
      lat = ~lat, 
      color = 'grey', 
      label = ~paste0('Transect ', station, ' (', toupper(source), ')')
    )
rstrnmap <- rstrnmap %>% 
  addCircleMarkers(
    data = rstrnpts,
    layerId = ~station,
    stroke = TRUE,
    color = 'black',
    fill = TRUE,
    fillColor = 'grey',
    weight = 1,
    fillOpacity = 1,
    radius= 4,
    label = ~paste0('Transect ', station, ' (', toupper(source), ')')
  ) %>% 
  addCircleMarkers(
      data = rstrnpts[rstrnpts$station %in% rstrns[1], ],
      layerId = 'seltrn',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Transect ', station, ' (', toupper(source), ')')
    ) %>% 
  addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE)) %>% 
  setView(mapcenter[1], mapcenter[2], zoom = 11)
```

```{r reactives}
# water quality map, baseline data, bswqmap
bswqmap1 <- leafletProxy('bswqmap1')
observeEvent(input$bswqmap1_marker_click, {

  # input
  stasel1 <- input$bswqmap1_marker_click$id
  
  toadd <- bsstatloc %>% 
    filter(station %in% stasel1)

  bswqmap1 <- bswqmap1 %>%
    removeMarker('selsta') %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'selsta',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6, 
      label = ~paste0('Station: ', station)
    )
  
})

# complete time series, baseline data
baseplo1 <- reactive({

  # input
  stasel1 <- input$bswqmap1_marker_click$id
  
  if(is.null(stasel1))
    stasel1 <- bsstas[1]
  
  out <- plo_fun(bswqdat, stasel1, cols, parms)
  
  return(out)
  
})

# march/april time series, baseline data
baseplo2 <- reactive({
  
  # input
  stasel1 <- input$bswqmap1_marker_click$id
  
  if(is.null(stasel1))
    stasel1 <- bsstas[1]
  
  out <- plo_fun(bswqdatsub, stasel1, cols, parms)
  
  return(out)
  
})

# variable range
varrng1 <- reactive({
  
  # input
  varsel1 <- input$varsel1
  rmvsta1 <- input$rmvsta1
  
  out <- rswqdat %>% 
    filter(var %in% varsel1) 
  
  if(rmvsta1)
    out <- out %>% 
      filter(!station %in% nonbay)
  
  validate(
    need(nrow(out) > 0, 'No data...')
  )
  
  out <- out %>% 
    pull(val) %>% 
    range(na.rm = T)
  
  return(out)
  
})

# color palette function
colfun <- reactive({
  
  # input
  varsel1 <- input$varsel1
  varrng1 <- varrng1()
  
  req(varrng1)
  
  # color palette function
  out <- colorNumeric(
    palette = vrscols,
    na.color = 'yellow',
    domain = varrng1
    )
  
  return(out)
  
})

# response wq data
rsdat1 <- reactive({
  
  # input
  varsel1 <- input$varsel1
  dyssel1 <- input$dyssel1
  rmvsta1 <- input$rmvsta1
  colfun <- colfun()
  
  req(colfun)
  req(dyssel1)
  
  out <- rswqdat %>% 
    filter(var %in% varsel1) 

  if(rmvsta1)
    out <- out %>% 
      filter(!station %in% nonbay)

  # colors
  out <- out %>% 
    mutate(
      cols = colfun(val), 
      id = 1:nrow(.)
    ) 
 
  # sizes
  out$cexs <- scales::rescale(out$val, to = c(4, 17))
  
  # filter by dates
  out <- out %>% 
    filter(date >= dyssel1[1] & date <= dyssel1[2])

  return(out)
  
})

# response wq data table
rstab1 <- reactive({
  
  # input
  rsdat1 <- rsdat1()
  rngemph <- input$rngemph
  varsel1 <- input$varsel1
  rngsel1 <- input$rngsel1
  
  # variable label
  vrlb <- names(vrs)[vrs == varsel1]
  
  totab <- rsdat1 %>% 
    left_join(parms, by = 'var') %>% 
    left_join(srcs, by = 'source') %>% 
    select(
      Source = source_lng,
      Station = station ,
      Date = date, 
      `Reference station` = bswqstation, 
      `Normal range` = nrmrng,
      `In normal range?` = inrng,
      val 
    ) %>% 
    arrange(desc(Date))
  names(totab)[names(totab) == 'val'] <- vrlb
  
  # do not emphasize out of range
  if(!rngemph)
    out <- reactable(totab,
      defaultColDef = colDef(
        footerStyle = list(fontWeight = "bold"),
        format = colFormat(separators = F),
        resizable = TRUE, 
        align = 'left'
      ),
      filterable = T,
      defaultPageSize = nrow(totab)
      )
  
  # emphasize out or range
  if(rngemph){
    
    req(rngsel1)
    
    if(rngsel1 == 'above')
      out <- reactable(totab,
        defaultColDef = colDef(
          footerStyle = list(fontWeight = "bold"),
          format = colFormat(separators = F),
          resizable = TRUE, 
          align = 'left'
        ),
        filterable = T,
        defaultPageSize = nrow(totab),
        rowStyle = JS("function(rowInfo) {
          if (rowInfo.row['In normal range?'] == 'above') {
            return { background: 'rgba(0, 0, 0, 0.05)' }
          }
        }"),
        rowClass = JS("function(rowInfo) {
          if (rowInfo.row['In normal range?'] == 'above') {
            return 'bold'
          }
        }")
      )
    
    if(rngsel1 == 'below')  
      out <- reactable(totab,
        defaultColDef = colDef(
          footerStyle = list(fontWeight = "bold"),
          format = colFormat(separators = F),
          resizable = TRUE, 
          align = 'left'
        ),
        filterable = T,
        defaultPageSize = nrow(totab),
        rowStyle = JS("function(rowInfo) {
          if (rowInfo.row['In normal range?'] == 'below') {
            return { background: 'rgba(0, 0, 0, 0.05)' }
          }
        }"),
        rowClass = JS("function(rowInfo) {
          if (rowInfo.row['In normal range?'] == 'below') {
            return 'bold'
          }
        }")
      )
    
  }
  
  return(out)
  
})

# create plot on rsmap1 click
observeEvent(input$rsmap1_marker_click, {

  showModal(modalDialog(
      plotOutput('rswqpopup'), 
      easyClose = T, 
      fade = F, 
      footer = NULL
    ))

})

# create plot on rsmap1 click
rswqpopup <- eventReactive(input$rsmap1_marker_click, {
  
  station <- unique(input$rsmap1_marker_click$id)
  rsdat1 <- rsdat1()
  
  station <- rsdat1 %>% 
    filter(id == !!station) %>% 
    pull(station)
  
  out <- rswqpopup_plo(station, rsdat1)
  
  return(out)
  
})

# response wq data map
rsmap1 <- reactive({
  
  # input
  rsdat1 <- rsdat1()
  colfun <- colfun()
  varrng1 <- varrng1()
  varsel1 <- input$varsel1
  rngemph <- input$rngemph
  rngsel1 <- input$rngsel1
  
  req(rsdat1)

  # variable label
  vrlb <- names(vrs)[vrs == varsel1]

  # make sf
  tomap <- rsdat1 %>% 
    inner_join(rsstatloc, ., by = c('source', 'station')) 
    
  leglab <- vrlb
 
  if(nrow(tomap) == 0)
    m <- mapview()
  
  # show all equally 
  if(nrow(tomap) != 0 & !rngemph){
  
    # hover pt labels
    labs <- paste0('Station: ', tomap$station, ', Date: ', tomap$date, ', ', vrlb, ': ', round(tomap$val, 2))

    m <- mapview(tomap, cex = tomap$cexs, label = labs, legend = F, layer.name = F, col.regions = tomap$cols, homebutton = F, map.types = mptyps, popup = NULL, layerId = tomap$id)
    
  }
  
  # emphasize out of range
  if(nrow(tomap) != 0 & rngemph){
    
    req(rngsel1)

    tomap1 <- tomap %>% filter(inrng != !!rngsel1)
    tomap2 <- tomap %>% filter(inrng == !!rngsel1)
    
    # hover pt labels
    labs1 <- paste0('Station: ', tomap1$station, ', Date: ', tomap1$date, ', ', vrlb, ': ', round(tomap1$val, 2))
    labs2 <- paste0('Station: ', tomap2$station, ', Date: ', tomap2$date, ', ', vrlb, ': ', round(tomap2$val, 2))

    if(nrow(tomap1) == 0)
      m <- mapview(tomap2, cex = tomap2$cexs, label = labs2, legend = F, layer.name = F, col.regions = tomap2$cols, homebutton = F, map.types = mptyps, layerId = tomap2$id, popup = NULL)
  
    if(nrow(tomap2) == 0)
      m <- mapview(tomap1, cexbs = tomap1$cexs, label = labs1, legend = F, layer.name = F, col.regions = tomap1$cols, homebutton = F, map.types = mptyps, lwd = 0, layerId = tomap1$id, popup = NULL)
    
    if(nrow(tomap1) > 0 & nrow(tomap2) > 0)
      m <- mapview(tomap1, cex = tomap1$cexs, label = labs1, legend = F, layer.name = F, col.regions = tomap1$cols, homebutton = F, map.types = mptyps, lwd = 0, layerId = tomap1$id, popup = NULL) +
        mapview(tomap2, cex = tomap2$cexs, label = labs2, legend = F, layer.name = F, col.regions = tomap2$cols, homebutton = F, map.types = mptyps, layerId = tomap2$id, popup = NULL)
    
  }
  
  # add legend
  out <- m@map %>% 
    addLegend("bottomright", pal = colfun, title = leglab, opacity = 1, values = varrng1) %>% 
    setView(mapcenter[1], mapcenter[2], zoom = 11) %>% 
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE))
  
  return(out)
  
})

# contaminant variable range
cntrng1 <- reactive({
  
  # input
  cntsel1 <- input$cntsel1
  rmvsta2 <- input$rmvsta2
  
  out <- rscntdat %>% 
    filter(var %in% cntsel1) 

  if(rmvsta2)
    out <- out %>% 
      filter(!station %in% nonbay)
  
  validate(
    need(nrow(out) > 0, 'No data...')
  )
  
  out <- out %>% 
    pull(val) %>% 
    range(na.rm = T)
  
  return(out)
  
})

# contaminant color palette function
cntcolfun <- reactive({
  
  # input
  cntsel1 <- input$cntsel1
  cntrng1 <- cntrng1()
  
  req(cntrng1)
  
  # color palette function
  out <- colorNumeric(
    palette = cntcols,
    na.color = 'yellow',
    domain = cntrng1
    )
  
  return(out)
  
})

# response contaminant data
rscntdat1 <- reactive({
  
  # input
  cntsel1 <- input$cntsel1
  dyssel2 <- input$dyssel2
  rmvsta2 <- input$rmvsta2
  cntcolfun <- cntcolfun()
  
  req(cntcolfun)
  req(dyssel2)
  
  out <- rscntdat %>% 
    filter(var %in% cntsel1) 
  
  if(rmvsta2)
    out <- out %>% 
      filter(!station %in% nonbay)
    
  out <- out %>% 
    mutate(
      cols = cntcolfun(val)
    ) 
 
  # sizes
  out$cexs <- scales::rescale(out$val, to = c(4, 17))
  
  # filter by dates
  out <- out %>% 
    filter(date >= dyssel2[1] & date <= dyssel2[2])
    
  return(out)
  
})

# response contamint variable threshold
rscnttxt1 <- reactive({
  
  # input
  cntsel1 <- input$cntsel1

  tmp <- rscntthr %>% 
    filter(var == !!cntsel1) 
  
  if(is.na(tmp$thresh))
    txt <- "no threshold"
  
  if(!is.na(tmp$thresh))
    txt <- paste0(tmp$thresh, ' (', tmp$uni, ')')
  
  out <- HTML(paste('Relevant threshold (see information tab):<b>', txt, '</b><br></br>'))
  
  return(out)
  
})

# response contaminant data table
rscnttab1 <- reactive({
  
  # input
  rscntdat1 <- rscntdat1()
  cntsel1 <- input$cntsel1
  thremph <- input$thremph

  totab <- rscntdat1 %>% 
    select(
      Station = station ,
      Date = date, 
      val, 
      `Above threshold?` = inrng
    ) %>% 
    arrange(desc(Date))
  names(totab)[names(totab) == 'val'] <- cntsel1
  
  # do not emphasize out of range
  if(!thremph)
    out <- reactable(totab,
      defaultColDef = colDef(
        footerStyle = list(fontWeight = "bold"),
        format = colFormat(separators = F),
        resizable = TRUE, 
        align = 'left'
      ),
      filterable = T,
      defaultPageSize = nrow(totab)
      )
  
  # emphasize out or range  
  if(thremph)  
    out <- reactable(totab,
      defaultColDef = colDef(
        footerStyle = list(fontWeight = "bold"),
        format = colFormat(separators = F),
        resizable = TRUE, 
        align = 'left'
      ),
      filterable = T,
      defaultPageSize = nrow(totab),
      rowStyle = JS("function(rowInfo) {
        if (rowInfo.row['Above threshold?'] == 'above') {
          return { background: 'rgba(0, 0, 0, 0.05)' }
        }
      }"),
      rowClass = JS("function(rowInfo) {
        if (rowInfo.row['Above threshold?'] == 'above') {
          return 'bold'
        }
      }")
    )
  
  return(out)
  
})

# response data map
rscntmap1 <- reactive({
  
  # input
  rscntdat1 <- rscntdat1()
  cntcolfun <- cntcolfun()
  cntrng1 <- cntrng1()
  cntsel1 <- input$cntsel1
  thremph <- input$thremph
  
  req(nrow(rscntdat1) > 0)

  # make sf
  tomap <- rscntdat1 %>% 
    inner_join(rsstatloc, ., by = c('source', 'station'))

  leglab <- cntsel1
  vrlb <- cntsel1
  
  if(nrow(tomap) == 0)
    m <- mapview()

  # no threshold emphasis
  if(nrow(tomap) != 0 & !thremph){
    
    # hover pt labels
    labs <- paste0('Station: ', tomap$station, ', Date: ', tomap$date, ', ', cntsel1, ': ', round(tomap$val, 2))
  
    m <- mapview(tomap, cex = tomap$cexs, label = labs, legend = F, layer.name = F, col.regions = tomap$cols, homebutton = F, map.types = mptyps, popup = NULL)
    
  }
    
  # threshold emphasis
  if(nrow(tomap) != 0 & thremph){

    # check if no threshold
    chk <- any(tomap$inrng %in% 'no threshold')
    
    # exit if no threshold
    if(chk){
      
      # hover pt labels
      labs <- paste0('Station: ', tomap$station, ', Date: ', tomap$date, ', ', cntsel1, ': ', round(tomap$val, 2))
      
      m <- mapview(tomap, cex = tomap$cexs, label = labs, legend = F, layer.name = F, col.regions = tomap$cols, homebutton = F, map.types = mptyps, popup = NULL)
          
    }

    if(!chk){
      
      tomap1 <- tomap %>% filter(inrng == 'below')
      tomap2 <- tomap %>% filter(inrng == 'above')
    
      # hover pt labels
      labs1 <- paste0('Station: ', tomap1$station, ', Date: ', tomap1$date, ', ', vrlb, ': ', round(tomap1$val, 2))
      labs2 <- paste0('Station: ', tomap2$station, ', Date: ', tomap2$date, ', ', vrlb, ': ', round(tomap2$val, 2))
  
      if(nrow(tomap1) == 0)
        m <- mapview(tomap2, cex = tomap2$cexs, label = labs2, legend = F, layer.name = F, col.regions = tomap2$cols, homebutton = F, map.types = mptyps, popup = NULL)
    
      if(nrow(tomap2) == 0)
        m <- mapview(tomap1, cex = tomap1$cexs, label = labs1, legend = F, layer.name = F, col.regions = tomap1$cols, homebutton = F, map.types = mptyps, lwd = 0, popup = NULL)
      
      if(nrow(tomap1) > 0 & nrow(tomap2) > 0)
        m <- mapview(tomap1, cex = tomap1$cexs, label = labs1, legend = F, layer.name = F, col.regions = tomap1$cols, homebutton = F, map.types = mptyps, lwd = 0, popup = NULL) +
          mapview(tomap2, cex = tomap2$cexs, label = labs2, legend = F, layer.name = F, col.regions = tomap2$cols, homebutton = F, map.types = mptyps, popup = NULL)
      
    }    
    
  }
  
  # add legend
  out <- m@map %>% 
    addLegend("bottomright", pal = cntcolfun, title = leglab, opacity = 1, values = cntrng1) %>% 
    setView(mapcenter[1], mapcenter[2], zoom = 11) %>% 
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE))
  
  return(out)
  
})

# seagrass map selection, bssgmap1
bssgmap1 <- leafletProxy('bssgmap1')
observeEvent(input$bssgmap1_marker_click, {

  # input
  trnsel1 <- input$bssgmap1_marker_click$id
  
  toadd <- trnpts %>% 
    filter(station %in% trnsel1)
  bssgmap1 <- bssgmap1 %>% 
    removeMarker('seltrn') %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'seltrn',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Transect ', station)
    ) 
  
})

# seagrass transect plot over time
bssgtrnplo1 <- reactive({
  
  # input
  trnsel1 <- input$bssgmap1_marker_click$id
  
  if(is.null(trnsel1))
    trnsel1 <- trns[1]
  
  p <- show_transect(bstransect, site = trnsel1, species = spp, varplo = 'Abundance', plotly = T, base_size = 11, yrrng = c(1998, 2021)) %>% 
    layout(
      title = list(text = NA), 
      legend = list(title = list(text = 'Abundance (BB)'))
    )
  
  
  return(p)
  
})

# seagrass summary plot over time
bssgsumplo1 <- reactive({
  
  # input
  trnsel1 <- input$bssgmap1_marker_click$id
  
  if(is.null(trnsel1))
    trnsel1 <- trns[1]
  
  p <- show_transectsum(bstransectocc, site = trnsel1, species = spp, yrrng = c(1998, 2021)) %>% 
    layout(
      title = list(text = NA),
      legend = list(title = list(text = NA)),
      xaxis = list(title = list(text = 'Year'))
    )
  
  return(p)
  
})

# rapid response transect map selection, rstrnmap1
rstrnmap1 <- leafletProxy('rstrnmap1')
observeEvent(input$rstrnmap1_marker_click, {

  # input
  trnsel2 <- input$rstrnmap1_marker_click$id
  
  toadd <- rstrnpts %>% 
    filter(station %in% trnsel2)
  rstrnmap1 <- rstrnmap1 %>% 
    removeMarker('seltrn') %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'seltrn',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Transect ', station, ' (', toupper(source), ')')
    ) 
  
})

# rapid response sav selection
rstrnsavsel <- reactive({
 
  # input
  trnsel2 <- input$rstrnmap1_marker_click$id
  
  if(is.null(trnsel2))
    trnsel2 <- rstrns[1]

  datout <- rstrndat %>% 
    filter(station %in% !!trnsel2) %>% 
    filter(typ == 'sav') %>% 
    mutate(taxa = fct_drop(taxa))
    
  selout <- datout %>% 
    filter(bb > 0) %>% 
    pull(taxa) %>% 
    unique %>% 
    as.character

  out <- list(
    datout = datout, 
    selout = selout
  )
  
  return(out)
  
})

# rapid response mcr selection
rstrnmcrsel <- reactive({
  
  # input
  trnsel2 <- input$rstrnmap1_marker_click$id
  
  if(is.null(trnsel2))
    trnsel2 <- rstrns[1]

  datout <- rstrndat %>% 
    filter(station %in% !!trnsel2) %>% 
    filter(typ == 'mcr') %>% 
    mutate(taxa = fct_drop(taxa))
    
  selout <- datout %>% 
    filter(bb > 0) %>% 
    pull(taxa) %>% 
    unique %>% 
    as.character
  
  out <- list(
    datout = datout, 
    selout = selout
  )
  
  return(out)
  
})

# rapid response transect plot
rstrnplo1 <- reactive({
  
  # input
  savsel <- input$savsel
  mcrsel <- input$mcrsel
  rstrnsavsel <- rstrnsavsel()
  rstrnmcrsel <- rstrnmcrsel()
  
  req(!is.null(mcrsel) | !is.null(savsel))
  
  trndat <- rstrnsavsel$datout
  mcrdat <- rstrnmcrsel$datout
  
  p <- show_rstransect(trndat, mcrdat, savsel = savsel, mcrsel = mcrsel, base_size = 18) 
 
  return(p)
  
})

# binding for benthic marker select
makeReactiveBinding('stasel2')

# benthic station selection map click
observeEvent(input$rsbntmap1_marker_click, {
  stasel2 <<- input$rsbntmap1_marker_click$id
})

# rapid response base benthic map
rsbntmap <- reactive({
  
  # input
  bntsel <- input$bntsel

  # select month to map
  tomap <- rsbntdat %>% 
    filter(modt %in% bntsel) %>% 
    select(station, col, TBBICat) %>% 
    inner_join(rsbntpts, ., by = 'station')

  if(is.null(stasel2))
    stasel2 <- rsbnts[1]
  
  # response benthic sampling base map
  out <- mapview(tomap, homebutton = F, legend = F, map.types = mptyps) %>% 
    .@map %>% 
    clearMarkers() %>% 
    addCircleMarkers(
      data = tomap,
      layerId = ~station,
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = ~col,
      weight = 1,
      fillOpacity = 1,
      radius= 4,
      label = ~paste0('Station: ', station, ' (', source_lng, '), ', TBBICat)
    ) %>% 
    addCircleMarkers(
        data = tomap[tomap$station %in% stasel2, ],
        layerId = 'selpt',
        stroke = TRUE,
        color = 'black',
        fill = TRUE,
        fillColor = ~col,
        weight = 2,
        fillOpacity = 1,
        radius= 8,
        label = ~paste0('Station: ', station, ' (', source_lng, '), ', TBBICat)
      ) %>% 
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE)) %>% 
    addLegend("topright", title = 'Benthic condition', opacity = 1, labels = c('Healthy', 'Intermediate', 'Degraded'), colors = c('darkgreen', 'yellow', 'red')) %>% 
    setView(mapcenter[1], mapcenter[2], zoom = 11)
    
})

# rapid response benthic map selection, rsbntmap1
rsbntmap1 <- leafletProxy('rsbntmap1')
observeEvent(input$rsbntmap1_marker_click, {

  # input
  bntsel <- input$bntsel
  
  toadd <- rsbntdat %>% 
    filter(station %in% stasel2) %>% 
    filter(modt %in% bntsel) %>% 
    inner_join(rsbntpts, ., by = 'station') %>% 
    select(station, source_lng, TBBICat, col)
  
  rsbntmap1 <- rsbntmap1 %>% 
    removeMarker('selpt') %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'selpt',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = ~col,
      weight = 2,
      fillOpacity = 1,
      radius= 8,
      label = ~paste0('Station: ', station, ' (', source_lng, '), ', TBBICat)
    ) 
  
})

# rapid response benthic data 1
rsbntdat1 <- reactive({
  
  # input
  bntsel <- input$bntsel
  
  if(is.null(stasel2))
    stasel2 <- rsbnts[1]
  
  out <- rsbntdat %>% 
    filter(modt %in% bntsel) %>% 
    filter(station %in% stasel2)
  
  return(out)
  
})

# rapid response benthic gauge
rsbntgge1 <- reactive({
  
  # input
  rsbntdat1 <- rsbntdat1()

  out <- gauge(round(rsbntdat1$TBBI, 1), min = 0, max = 100, label = '', gaugeSectors(
    danger = c(0, 73), warning = c(73, 87), success = c(87, 100),
    colors = c('darkgreen', 'yellow', 'red')
  ))
  
  return(out)

})

# rapid response benthic plot 
rsbntplo1 <- reactive({
    
  # input
  bntscl<- input$bntscl
  rsbntdat1 <- rsbntdat1()
  
  toplo <- rsbntdat1 %>% 
    pull(family_abu) %>% 
    .[[1]] %>% 
    filter(!is.na(FAMILY)) %>% 
    arrange(TotalAbundance) 
  
  # orange color palette
  cols <- c("#FFF5EB", "#FEE6CE", "#FDD0A2", "#FDAE6B", "#FD8D3C", "#F16913", 
            "#D94801", "#A63603", "#7F2704")
  
  p <- ggplot(toplo, aes(y = reorder(FAMILY, TotalAbundance), x = TotalAbundance)) + 
    geom_bar(stat = 'identity', aes(fill = TotalAbundance), colour = 'black', alpha = 0.6) + 
    scale_x_continuous(expand = c(0, 0), limits = c(0, max(rsbntdat$TotalAbundance))) +
    scale_fill_gradientn(colours = cols) +
    theme_minimal(base_size = 16) + 
    theme(
      legend.position = 'none', 
      legend.title = element_blank(), 
      strip.background = element_blank(), 
      axis.title.y = element_blank(), 
      panel.grid.major.y = element_blank(), 
      panel.grid.minor.y = element_blank(), 
      axis.text.y = element_text(size = 9)
    ) + 
    labs(
      x = 'Abundance (indviduals / m2)'
    )
  
  if(bntscl)
    p <- p + 
      scale_x_log10(expand = c(0, 0), limits = c(1, max(rsbntdat$TotalAbundance))) +
      scale_fill_gradientn(colours = cols, trans = 'log10')
  
  return(p)

})

# binding for marker select and year
makeReactiveBinding('stasel3')

# phyto station selection map click
observeEvent(input$rsphymap1_marker_click, {
  stasel3 <<- input$rsphymap1_marker_click$id
})

# base phyto map
rsphymap <- reactive({
  
  # input
  dyssel3 <- input$dyssel3
  
  # response phytoplankton sampling base map
  phyleg <- rsphypts %>% 
    st_set_geometry(NULL) %>% 
    select(typ, col) %>% 
    unique
  
  # filter by dates
  tomap <- rsphydat %>% 
      select(date, station) %>% 
      unique %>% 
      filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
      pull(station)
  tomap <- filter(rsphypts, station %in% tomap)
  
  req(nrow(tomap) > 0)
  
  # default selection
  toadd <- tomap[1, ]
  
  # update stasel3 with default 
  stasel3 <<- toadd$station

  out <- mapview(tomap, homebutton = F, legend = F, map.types = mptyps) %>% 
    .@map %>% 
    clearMarkers() %>%
    addCircleMarkers(
      data = tomap,
      layerId = ~station,
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = tomap$col,
      weight = 1,
      fillOpacity = 1,
      radius= 4,
      label = ~paste0('Station: ', station, ' (', source_lng, ')')
    ) %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'selpt',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Station: ', station, ', Source: ', source_lng)
    ) %>%  
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE)) %>% 
    addLegend("topright", title = 'Data type', opacity = 1, labels = phyleg$typ, colors = phyleg$col)  %>% 
  setView(mapcenter[1], mapcenter[2], zoom = 11)
  
  return(out)
  
})

# rapid response phyto map selection, rsphymap1
rsphymap1 <- leafletProxy('rsphymap1')
observeEvent(input$rsphymap1_marker_click, {
  
  toadd <- rsphypts %>% 
    filter(station %in% stasel3)
  
  rsphymap1 <- rsphymap1 %>%
    removeMarker('selpt') %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'selpt',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Station: ', station, ' (', source_lng, ')')
    ) 
  
})

# change phyto map selection if dates used
observeEvent(input$dyssel3, {
  
  # input
  dyssel3 <- input$dyssel3
  
  # filter by dates
  tomap <- rsphydat %>% 
      select(date, station) %>% 
      unique %>% 
      filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
      pull(station)
  tomap <- filter(rsphypts, station %in% tomap)
  
  req(nrow(tomap) > 0)
  
  # default selection
  toadd <- tomap[1, ]
  
  # update stasel3 with default 
  stasel3 <<- toadd$station
  
  rsphymap1 <- rsphymap1 %>%
    clearMarkers() %>%
    addCircleMarkers(
      data = tomap,
      layerId = ~station,
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = tomap$col,
      weight = 1,
      fillOpacity = 1,
      radius= 4,
      label = ~paste0('Station: ', station, ' (', source_lng, ')')
    ) %>% 
    addCircleMarkers(
      data = toadd,
      layerId = 'selpt',
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = 'red',
      weight = 1,
      fillOpacity = 1,
      radius= 6,
      label = ~paste0('Station: ', station, ', Source: ', source_lng)
    ) %>% 
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE))
  
})

# rapid response phyto map selection, rsphymap2
rsphymap2 <- reactive({
  
  # input
  rsphydat2 <- rsphydat2()
  physel1 <- input$physel1
  dyssel3 <- input$dyssel3
  
  col <- "#76EE00"
  
  stas <- rsphydat %>% 
    filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
    pull(station) %>% 
    unique
  
  tomap <- rsphypts %>% 
    select(station, source_lng) %>% 
    filter(station %in% stas) %>% 
    mutate(
      label = case_when(
        station %in% rsphydat2$station ~ paste(physel1, 'present'), 
        T ~ paste(physel1, 'absent')
      ), 
      col = case_when(
        grepl('present', label) ~ col, 
        T ~ "#000000B2"
      ), 
      cex =  case_when(
        grepl('present', label) ~ 6, 
        T ~ 2
      )
    )
  
  out <- mapview(rsphypts, homebutton = F, legend = F, map.types = mptyps) %>% 
    .@map %>%
    clearMarkers() %>% 
    clearControls() %>% 
    addCircleMarkers(
      data = tomap,
      layerId = ~station,
      stroke = TRUE,
      color = 'black',
      fill = TRUE,
      fillColor = tomap$col,
      weight = 1,
      fillOpacity = 1,
      radius= tomap$cex,
      label = ~paste0('Station: ', station, ' (', source_lng, ')')
    ) %>% 
    addMarkers(lng = pineypoint[1], lat = pineypoint[2], label = 'Piney Point', options = markerOptions(interactive = FALSE)) %>%
    addLegend("topright", title = NULL, opacity = 1, labels = paste(physel1, 'present'), colors = col) 
    
  return(out)
  
})

# rapid response phyto data 1
rsphydat1 <- reactive({
  
  # input
  dyssel3 <- input$dyssel3
  
  if(is.null(stasel3)){
    
    # filter by dates
    tomap <- rsphydat %>% 
        select(date, station) %>% 
        unique %>% 
        filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
        pull(station)
    tomap <- filter(rsphypts, station %in% tomap)
    stasel3 <- tomap[1, 'station']
    
  }
  
  phyout <- rsphydat %>% 
    filter(station %in% stasel3) %>% 
    filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
    left_join(physrcs, by = 'source')
  
  wqout <- rswqdat %>% 
    filter(station %in% stasel3) %>%
    filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
    left_join(srcs, by = 'source')
  
  out <- list(
    wq = wqout, 
    phy = phyout
  )
  
  return(out)
  
})

# rapid response phyto data 2
rsphydat2 <- reactive({
  
  # input
  physel1 <- input$physel1
  dyssel3 <- input$dyssel3
  
  out <- rsphydat %>% 
    filter(species %in% physel1) %>% 
    filter(date >= dyssel3[1] & date <= dyssel3[2]) %>% 
    left_join(physrcs, by = 'source') %>% 
    select(
      source_lng,
      station,
      date, 
      species
      ) 
  
  return(out)
  
})

# rapid response phyto plot
rsphyplo1 <- reactive({
  
  # inputs
  rsphydat1 <- rsphydat1()

  phydat <- rsphydat1$phy
  
  typ <- phydat %>% 
    pull(typ) %>% 
    unique
  
  out <- NULL
  if(typ == 'Quantitative'){
    
    toplo <- phydat %>% 
      select(date, species, val, valqual) %>% 
      complete(species, date, fill = list(val = 0, valqual = 'Very low'))
    
    levs <- toplo %>% 
      filter(date == min(date)) %>% 
      arrange(val) %>% 
      pull(species)
    
    toplo <- toplo %>% 
      mutate(
        species = factor(species, levels = levs),
        val = val / 1000
        ) %>% 
      filter(val != 0)
    
    cols <- RColorBrewer::brewer.pal(length(levels(toplo$valqual)) - 1, 'Greens')
    cols <- c('white', cols)
    unidts <- length(unique(toplo$date))
    
    out <- ggplot(toplo, aes(y = species, x = val)) + 
      geom_bar(stat = 'identity', aes(fill = valqual), colour = 'black') + 
      scale_x_continuous(expand = c(0, 0), limits = c(0, phymax)) +
      scale_fill_manual(values = cols, drop = F) +
      facet_wrap(~date, ncol = unidts) + 
      theme_minimal(base_size = 16) + 
      theme(
        legend.position = 'top', 
        legend.title = element_blank(), 
        strip.background = element_blank(), 
        axis.title.y = element_blank()
        ) + 
      labs(
        x = '1000 x cells/L'
      )

  }
  
  return(out)
  
})

# rapid response phyto table 1
rsphytab1 <- reactive({
  
  # inputs
  rsphydat1 <- rsphydat1()

  phydat <- rsphydat1$phy
  
  typ <- phydat %>% 
    pull(typ) %>% 
    unique

  out <- NULL
  if(typ == 'Qualitative') 
    out <- phydat %>% 
      select(
        Source = source_lng,
        Station = station,
        Date = date, 
        `Taxa observed` = species
        ) %>% 
      unique %>%
      arrange(desc(Date)) %>% 
      reactable()
  
  return(out)
  
})

# rapid response phyto table 2
rsphytab2 <- reactive({
  
  # input
  rsphydat2 <- rsphydat2()
  
  out <- rsphydat2 %>% 
    select(
      Source = source_lng,
      Station = station,
      Date = date, 
      `Taxa observed` = species
      ) %>% 
    unique %>%
    arrange(desc(Date)) %>% 
    reactable()
  
  return(out)
  
})

# response wq data table to accompany phyto
rstab2 <- reactive({
  
  # input
  rsphydat1 <- rsphydat1()
  varsel2 <- input$varsel2
  
  req(varsel2)
  
  # variable label
  vrlb <- names(vrs)[vrs == varsel2]
  
  totab <- rsphydat1$wq %>% 
    filter(var %in% !!varsel2) %>% 
    left_join(parms, by = 'var') %>% 
    select(
      Source = source_lng,
      Station = station,
      Date = date, 
      `Reference station` = bswqstation, 
      `Normal range` = nrmrng,
      `In normal range?` = inrng,
      val 
    ) %>% 
    arrange(desc(Date))
  names(totab)[names(totab) == 'val'] <- vrlb
  
  out <- reactable(totab,
    defaultColDef = colDef(
      footerStyle = list(fontWeight = "bold"),
      format = colFormat(separators = F),
      resizable = TRUE, 
      align = 'left'
    ),
    defaultPageSize = nrow(totab)
  )
  
  return(out)
  
})
```

OVERVIEW {data-orientation=rows}
=======================================================================

Row
-------------------------------------

### __DASHBOARD INFORMATION__

<div class = "row">
<div class = "col-md-1"></div>
<div class = "col-md-10">

```{r out.width='100%', fig.align='center'}
knitr::include_graphics('www/Piney_Dashboard_Header.png')
```

[__JUMP TO LATEST DATA__](#water-quality-results), last water quality update `r rswqlog`

From March 30th to April 9th, approximately 215 million gallons of wastewater from Piney Point were released into Tampa Bay.  The Tampa Bay Estuary Program is working with regional partners to coordinate and synthesize water quality, benthic, seagrass, and fisheries monitoring data. We are also consulting with USF to model forecasted plume trajectory from the Piney Point discharge. 

The primary pollutants of concern for this discharge are phosphorus and nitrogen (primarily ammonia nitrogen), which may stimulate an algae response and cause adverse effects on seagrass, fish, and other wildlife.

The dashboard is a synthesis of data that can be used to assess baseline conditions prior to discharge and to evaluate changing water quality conditions as new data become available.  __All data are provisional and subject to revision.__ The dashboard is arranged as follows:

1) __CURRENT DATA__: Current [water quality](#water-quality-results), [algal surveys](#algal-surveys), [seagrass/macroalgae](#rapid-response-seagrassmacroalgae-surveys), [contaminant](#contaminant-results), and [sediment biology](#benthic-biology) results are presented.
1) __BASELINE DATA__: Long-term [water quality](#water-quality) and [seagrass data](#seagrasses) over a 25 year period.  

#### Additional resources

* Florida DEP Piney Point regional notification: [link](https://protectingfloridatogether.gov/PineyPointUpdate){target="_blank"}
* USF Piney Point circulation modeling: [link](http://ocgweb.marine.usf.edu/~liu/Tracer/){target="_blank"}
* NOAA algal bloom satellite imagery: [link](https://coastalscience.noaa.gov/research/stressor-impacts-mitigation/hab-monitoring-system/red-tide-from-satellite-for-southwest-florida/tampa-bay/){target="_blank"}
* USF Optical Oceanography Lab algal bloom satellite imagery: [link](https://optics.marine.usf.edu/cgi-bin/animation?productSensor=MPH.olcis3a&amp;animateFrom=03/29/2021&amp;animateTo=04/30/2021&amp;roi=CWFL){target="_blank"}

#### Website information

Want to learn how to use this dashboard? Check out our video tutorial [here](https://youtu.be/KIki3yOTiWc){target="_blank"}.

The page source content can be viewed on [Github](https://github.com/tbep-tech/piney-point). Questions and comments about the dashboard can be sent to [Marcus Beck](mailto:mbeck@tbep.org).

<a rel='license' href='http://creativecommons.org/licenses/by/4.0/'><img alt='Creative Commons License' style='border-width:0' src='https://i.creativecommons.org/l/by/4.0/88x31.png' /></a>&nbsp;&nbsp;This dashboard is licensed under a <a rel='license' href='http://creativecommons.org/licenses/by/4.0/'>Creative Commons Attribution 4.0 International License</a>.

[![DOI](https://zenodo.org/badge/353409644.svg)](https://zenodo.org/badge/latestdoi/353409644)

</div>
<div class = "col-md-1"></div>
</div>

### __LOCATIONS WITH DATA - PINEY POINT AT MARKER__ 

```{r}
rswqmap
```

Row
-----------------------------------------------------------------------

### 

```{r}
valueBox(agns, 'Agencies reporting', color = boxcol, icon = 'fa-university')
```

### 

```{r}
valueBox(vars, 'Parameters monitored', color = boxcol, icon = 'fa-vial')
```

### 

```{r}
valueBox(dysm, 'Days with samples', color = boxcol, icon = 'fa-calendar')
```

### 

```{r}
valueBox(stsm, 'Sites with data', color = boxcol, icon = 'fa-map-marked')
```

### 

```{r}
valueBox(smsm, 'Measurements available', color = boxcol, icon = 'fa-tint')
```


WATER QUALITY RESULTS {data-navmenu="CURRENT DATA"}
=======================================================================

Column {data-width=400}
-----------------------------------------------------------------------

### __STATION LOCATIONS - PINEY POINT AT MARKER__, last update `r rswqlog`

```{r}
output$rswqpopup <- renderPlot(rswqpopup())
output$rsmap1 <- renderLeaflet(rsmap1())
leafletOutput('rsmap1')
```

Column {.tabset .tabset-fade}
-----------------------------------------------------------------------

<br>
```{r}
column(12,
  column(3, HTML('<b>ALL DATA ARE PROVISIONAL, click on a station to graph results</b><br></br>')),
  column(9,
    materialSwitch(inputId = 'rmvsta1', label = 'Remove stations on land near Piney Point (these can skew in-bay results)?', value = T, width = '100%')
  )
)
column(12,
  column(3, 
    selectInput('varsel1', HTML('<b>Select variable:</b>'), choices = vrs, selected = 'chla')       
  ), 
  column(9, 
    renderUI({
      
      # inputs
      varsel1 <- input$varsel1
 
      dys <- rswqdat %>% 
        filter(var %in% varsel1) %>% 
        pull(date) %>% 
        unique
      
      sliderInput('dyssel1', 'Select date range:', min = min(dys), max = max(dys), value = range(dys), animate = T, timeFormat="%m-%d-%Y", width = '100%')
  
    })     
  )
)
column(12, 
  column(3,
    HTML('<br></br>')
  ), 
  column(9,
    fillRow(
    materialSwitch(inputId = 'rngemph', label = 'Emphasize results out of normal range?', value = T, width = '100%'),
    renderUI({
      
      # input
      rngemph <- input$rngemph
      
      if(rngemph)
        selectInput('rngsel1', NULL, choices = c('above', 'below'), selected = 'above')
      
    })
  )
))
```

### __TABLE DATA__

```{r}
output$rstab1 <- renderReactable(rstab1())
reactableOutput('rstab1')
```

### __INFORMATION__

Use the variable selection menu on the top to view results for a measured water quality parameter of interest.  The map on the left will show results at locations that have been sampled for the parameter, with the same results shown in the table.  All points on the map are sized and colored by the range of values in the data for the selected parameter and based on the selected viewing options.  There are a few options for how the results are shown in the map and table: 

1. You can choose to show all samples or remove those that are on land near Piney Point (i.e., creeks or other discharge points where wastewater is leaving the holding ponds).  Removing sampling stations on land will typically shift the color and sizing on the map to a narrower range that provides a better representation of impacts in the bay. 
1. You can choose to show all dates or filter by a particular date range. If results are filtered by date, hit the "play" button below the date slider to view a time lapse of data. The data table will show only results for the selected range.  __You can also click on a station to view the complete time series for a parameter of interest.__
1. You can choose to emphasize results that are out of the normal range of values for the March/April period in Tampa Bay.  Points within the normal range will no longer be outlined on the map, making those outside of range easier to view.  The same values that are out of range will be highlighted in the table.  

What is the normal range for a parameter?

The "normal range" is based on the long-term average plus and minus 1 standard deviation of the mean for the month of observation of each parameter. The long-term values that are compared to the current results are from baseline data at the permanent (reference) station nearest to the current water quality station where data are available. Many, but not all, of the current sampling stations are new locations selected to best characterize potential changes in water quality near Piney Point. See the [REFERENCE STATIONS](https://shiny.tbep.org/piney-point/#section-reference-stations) map to view the current water quality stations relative to the reference stations used to establish the normal range. The station used as reference for the normal range is shown in the table, together with the estimated normal range. The normal ranges change by location and month. If a parameter measured at the current station is unavailable for comparison for the nearest reference station and given month, the normal range is used from the next closest reference station where the parameter is available. 

How are the data interpreted? 

As of `r rswqlog`, data from `r vars` parameters and `r agns` agencies have been added to this dashboard.  These parameters were chosen primarily to track the flow of nutrients from wastewater being discharged into the bay.  The primary environmental threat is an algae response as a result of high concentrations of nutrients in this wastewater. Excess algal can have adverse effects on seagrass, fish, and other wildlife.  __Nitrogen, either total nitrogen (TN) or total ammonia nitrogen (NH3, NH4+), is the primary concern for tracking potential impacts of discharge from Piney Point.__

The parameters being monitored include: 

__Chlorophyll-a (ug/L)__: Chlorophyll is present in algal tissue and concentrations in the water column provide a measure of algae production. 

__Color (PCU)__: Water color in platinum cobalt units, changes in color can suggest a wastewater or stormwater source with different characteristics from ambient conditions. Higher PCU means darker waters.

__BOD (mg/L)__: Biological (or biochemical) oxygen demand (mg/L) as a measure of the amount of oxygen consumed by microorganisms in decomposing organic matter or the chemical oxidation of inorganic matter.  Higher BOD may indicate higher productivity associated with an algal bloom.

__DO (mg/L)__: A measure of dissolved oxygen in the water column as a concentration (mg/L). Low dissolved oxygen less than 3 mg/L may indicate hypoxic conditions potentially harmful to biological organisms.

__DO (% saturation)__: A measure of dissolved oxygen in the water column as percent saturation. Low percent saturation less than 30 %  may indicate hypoxic conditions potentially harmful to biological organisms. Supersaturated values (>100%) indicate enhanced algal or seagrass primary production.

__NH3, NH4+ (mg/L)__: Total ammonia nitrogen concentration as a component of total nitrogen, includes unionized ammonia (NH3) and ionized ammonium (NH4+).  Excess total ammonia nitrogen can stimulate algal production.

__Nitrate/Nitrite (mg/L)__: Nitrate/nitrite concentration as a component of total nitrogen.  Excess nitrate/nitrite can stimulate algal production.  Concentrations are presented as the sum of both.

__Ortho-P (mg/L)__: Orthophosphate concentration as a component of total phosphorus. Excess orthophosphate can stimulate algal production, although this is less of a concern than nitrogen in Tampa Bay.

__pH__: pH as a measure of water acidity. Normal estuary acidity ranges from 7 - 8.5.  Lower pH values can harm plants and wildife in the Bay. 

__Sal (ppt)__: Salinity in parts per thousand.  Estuaries can range from 0 when dominated by freshwater inflows to >32 when dominated by Gulf tidal inflows. Lower salinities can indicate a strong freshwater source, potentially from wastewater or other natural sources.

__Secchi (m)__: Secchi depth as a measure of water clarity. Higher values mean clearer water.  Lower values may indicate high algae production.

__Temp (C)__: Water temperature. 

__TKN (mg/L)__: Total Kjeldahl nitrogen concentration as a component of total nitrogen. TKN is the sum of ammonia, organic, and reduced nitrogen.  Excess TKN can stimulate algal production.

__TN (mg/L)__: Total nitrogen concentration is the sum of TKN (ammonia, organic, and reduced nitrogen) and nitrate/nitrite. Excess total nitrogen can stimulate algal production.

__TP (mg/L)__: Total phosphorus concentration is the sum of orthophosphate, condensed phosphate, and organic phosphate. Excess total phosphorus can stimulate algal production, although this is less of a concern than nitrogen in Tampa Bay.

__TSS (mg/l)__: Total suspended solids is a general measure of water clarity that includes silt and clay particles, plankton, algae, fine organic matter, and other particulate matter. Higher values can indicate algal response or other matter from external sources. 

### __REFERENCE STATIONS__

```{r, out.width = '100%'}
knitr::include_url('data/wqrefmap.html', height = '100%')
```

ALGAL SURVEYS {data-navmenu="CURRENT DATA"}
=======================================================================

Column {data-width=400}
-----------------------------------------------------------------------

### __STATION LOCATIONS - PINEY POINT AT MARKER__, last update `r rsphylog`

```{r}
output$phytouimap <- renderUI({
  
  # input
  phytyp <- input$phytyp

  if(phytyp == rsphytyp[1]){
    output$rsphymap1 <- renderLeaflet(rsphymap())
    out <- leafletOutput('rsphymap1')  
  }
  
  if(phytyp == rsphytyp[2]){
    output$rsphymap2 <- renderLeaflet(rsphymap2())
    out <- leafletOutput('rsphymap2')
  }
  
  return(out)
  
})
uiOutput('phytouimap')
```

Column {data-width=650 .tabset .tabset-fade}
-----------------------------------------------------------------------

<br>
```{r}
output$phytoui1 <- renderUI({
  
  # inputs
  phytyp <- input$phytyp

  if(phytyp == rsphytyp[1]){
    
    out <- renderUI({

      # inputs
      rsphydat1 <- rsphydat1()

      req(nrow(rsphydat1$wq) > 0)
    
      tosel <- rsphydat1$wq %>%
        select(var) %>%
        left_join(parms, by = 'var') %>%
        select(lbs, var) %>%
        unique %>%
        deframe %>%
        as.list

      selectInput('varsel2', HTML('Select water quality variable:'), choices = tosel, selected = tosel[1])

    })
  
  }
  
  if(phytyp == rsphytyp[2])
    out <- selectInput('physel1', HTML('Select taxa:'), choices = rsphysel, selected = rsphysel[1])
    
  out <- div(out)
  
  return(out)
  
})

column(12, 
  column(6, 
    selectInput('phytyp', HTML('<b>How do you want to view results?</b>'), choices = rsphytyp)
  ),
  column(6, 
    uiOutput('phytoui1')
  )
)
column(12, 
  column(9,
    sliderInput('dyssel3', 'Select date range:', min = min(rsphydys), max = max(rsphydys), value = range(rsphydys), animate = T, timeFormat="%m-%d-%Y", width = '100%')
  )   
)
```

### __SUMMARY__

```{r}
output$rsphyplo1 <- renderPlot(rsphyplo1())
output$rsphytab1 <- renderReactable(rsphytab1())
output$rsphytab2 <- renderReactable(rsphytab2())
output$rstab2 <- renderReactable(rstab2())
output$physum1 <- renderUI({
  
  # input
  rsphydat1 <- rsphydat1()
  
  typ <- rsphydat1$phy %>% 
    pull(typ) %>% 
    unique
  
  validate(
    need(length(typ) > 0, 'No data...')
  )
  
  if(typ == 'Quantitative'){
    plotOutput('rsphyplo1')
  } else {
    if(typ == 'Qualitative')
      reactableOutput('rsphytab1')
  }
  
})

output$phytoui2 <- renderUI({
  
  # inputs
  phytyp <- input$phytyp
  
  if(phytyp == rsphytyp[1])
    out <- fillCol(flex = c(NA, 1, NA, 0.5),
      HTML('<b>Algal results</b>'),
      uiOutput('physum1'), 
      HTML('<b>Paired water quaility results</b>'),
      reactableOutput('rstab2')
    )
    
  if(phytyp == rsphytyp[2])
    out <- reactableOutput('rsphytab2')
                
  return(out)
  
})
uiOutput('phytoui2')
```

### __INFORMATION__

This tab shows phytoplankton (algae) data from recent surveys near Piney Point. __The maps and tables combine data from different processing labs.  Taxa specificity and enumeration methods vary.__  

There are two ways to view the data.

#### Clicking a station on the map

Select this option to view results by selecting a station from the map.  This will show all taxa at a station and available water quality data.  

The phytoplankton data are either qualitative (e.g., description of taxa observed at a site) or quantitative (counts of taxa observed at a site) depending on the data source.  Phytoplankton are also collected at many, but not all, of the same stations where water quality samples are collected, which allows a comparison of both to determine potential associations between water quality (e.g., nutrient concentrations) and changes in the algal community.  

Select the station to view by clicking a marker on the map.  The station map on the left shows which stations provide qualitative or quantitative data.  If a qualitative station is selected, a tabular summary of species observed by date will be shown.  If a quantitative station is selected, a plot of algal cell counts (a measure of abundance) by date will be shown.  The cell counts are categorized into relative amounts (Very low, Low, etc.) following breakpoints used by FWC-FWRI for *Karenia brevis* ([https://myfwc.com/research/redtide/statewide/](https://myfwc.com/research/redtide/statewide/)).  Note that these breakpoints may not have ecological relevance for algal taxa in Lower Tampa Bay and are only provided as guidelines to assess relative differences.  Results for nanoplankton have been removed because of typically high concentrations that cannot be enumerated in the lab.  

For all stations, water quality data collected at the station will also be shown in a table below the algal results, if available.  You can choose which water quality variable is shown from the selection menu at the top. 

Stations on the map that have different names but occur at the same location are slightly offset from each other for easier viewing.  Data (phytoplankton or water quality) from stations at the same location are not combined in the tables or plots to not mix data collected with potentially different methods used by different labs.

#### Selecting taxa from a menu

Select this option to view a map of where selected taxa (species, genus, or higher level) have been sampled.  Using this option will change the menu on the top right to provide an option for selecting which taxa to view.  Large green points on the map will show where the taxa was observed.  The smaller black points are other locations that were sampled but where the selected taxa was not observed.  All dates are shown on the map. The table shows the results for the same data. 

RAPID RESPONSE SEAGRASS/MACROALGAE SURVEYS {data-navmenu="CURRENT DATA"}
=======================================================================

Column {data-width=400}
-----------------------------------------------------------------------

### __TRANSECT LOCATIONS - PINEY POINT AT MARKER__, last update `r rstrnlog`

```{r}
output$rstrnmap1 <- renderLeaflet(rstrnmap)
leafletOutput('rstrnmap1')
```

Column {data-width=650 .tabset .tabset-fade}
-----------------------------------------------------------------------

<br>
```{r}
column(12,
  column(4,
    HTML('<b>Select a transect by clicking a marker on the map</b>'),
  ), 
  column(4,
    renderUI(
      selectInput(inputId = 'savsel', label = HTML('<b>Select SAV species:</b>'), choices = rstrnsavsel()$selout, selected = rstrnsavsel()$selout, multiple = T, selectize = T, width = '100%')
    )
  ),
  column(4,
    renderUI(
      selectInput(inputId = 'mcrsel', label = HTML('<b>Select macroalgae group:</b>'), choices = rstrnmcrsel()$selout, selected = rstrnmcrsel()$selout, multiple = T, selectize = T, width = '100%')
    )
  )
)
```

### __TRANSECT RESULTS__

```{r}
output$rstrnplo1 <- renderPlot(rstrnplo1())
plotOutput('rstrnplo1', height = '100%', width = '100%')
```

### __INFORMATION__

This tab shows results for the rapid response submerged aquatic vegetation (SAV) and macroalgae surveys.  These surveys are similar to the seagrass surveys shown on the [baseline seagrass](https://shiny.tbep.org/piney-point/#section-seagrasses)  page, with some modifications to the survey design for rapid assessment of biological response to changing conditions at Piney Point.  Each survey includes abundance of SAV and macroalgae species along a 50m transect at each location.  Species are sampled every 10m along the transect.

The locations and names of the transects are shown in the map (transect locations tab on the left). Select a transect by clicking the marker on the map.  The selected transect is shown as a red dot.

Results for the selected transect are shown in the plot, with SAV abundance in the top plot and macroalgae abundance on the bottom plot. The points in each plot show species abundances for each date and at each location along the selected transect (in meters). The plot provides a detailed assessment of where species were located on a transect and how those locations may have changed over time. The species are color-coded as shown in the legends. Each point is sized by the recorded abundance for a species (as a percentage of cover in the sample quadrat at each location). Points that were sampled but had no seagrass are shown as small black points. 

The seagrass species shown in the plots include the five dominant species found in Tampa Bay: 

* *Halodule wrightii*: shoal grass
* *Syringodium filiforme*: manatee grass
* *Thalassia testudinum*: turtle grass
* *Halophila engalmanii*: star grass
* *Ruppia maritima*: widgeon grass

Macroalgae are large algae seen without aid from a microscope and are commonly found in Tampa Bay seagrass beds. At low abundance, macroalgae increase habitat diversity and provide shelter for many invertebrates, including sea stars and snails. At greater abundance, macroalgae block light from reaching seagrasses. Macroalgae obtain nutrients from the water and can undergo rapid growth when excess nutrients are present.  They may respond more rapidly to nutrient inputs than SAV and may serve as early warning indicators for biological response to changing water quality.

Macroalgae taxa shown in the plot are categorized by major phyla:

* *Red*: Rhodophyta
* *Green*: Chlorophyta
* *Brown*: Phaeophyta
* *Cyanobacteria*

CONTAMINANT RESULTS {data-navmenu="CURRENT DATA"}
=======================================================================

Column {data-width=400}
-----------------------------------------------------------------------

### __STATION LOCATIONS - PINEY POINT AT MARKER__, last update `r rscntlog`

```{r}
output$rscntmap1 <- renderLeaflet(rscntmap1())
leafletOutput('rscntmap1')
```

Column {.tabset .tabset-fade}
-----------------------------------------------------------------------

<br>
```{r}
column(12,
  column(3, HTML('<b>ALL DATA ARE PROVISIONAL</b><br></br>')),
  column(9,
    materialSwitch(inputId = 'rmvsta2', label = 'Remove stations on land near Piney Point (these can skew in-bay results)?', width = '100%')
  )
)
column(12,
  column(3,
    selectInput('cntsel1', HTML('<b>Select variable:</b>'), choices = cntvrs)
  ),
  column(9,
    renderUI({

      # inputs
      cntsel1 <- input$cntsel1

      dys <- rscntdat %>%
        filter(var %in% cntsel1) %>%
        pull(date) %>%
        unique

      sliderInput('dyssel2', 'Select date:', min = min(dys), max = max(dys), value = range(dys), animate = T, timeFormat="%m-%d", width = '100%')

    })
  )
)
column(12, 
  column(3, 
    renderUI(rscnttxt1())
  ), 
  column(9,
    fillRow(
      # renderUI({
      #   
      #   # input
      #   cntsel1 <- input$cntsel1
      # 
      #   tmp <- rscntthr %>% 
      #     filter(var == !!cntsel1) 
      #   
      #   if(is.na(tmp$thresh))
      #     return()
      #   
        materialSwitch(inputId = 'thremph', label = 'Emphasize results above threshold (only applies if one is available)?', width = '100%')
      # })
  )
))
```

### __TABLE DATA__

```{r}
output$rscnttab1 <- renderReactable(rscnttab1())
reactableOutput('rscnttab1')
```

### __INFORMATION__

This tab shows results for contaminants collected by Florida DEP at the same locations where water quality samples have been collected.  Most of the contaminants are metals.  Limited data are available for concentrations of toxins associated with harmful algal blooms.  

Use the variable selection menu on the top to view results for a contaminant of interest. The map on the left will show results at locations that have been sampled for the contaminant, with the same results shown in the table. All points on the map are sized and colored by the range of values in the data for the selected contaminant and based on the selected viewing options. There are a few options for how the results are shown in the map and table:

1. You can choose to show all samples or remove those that are on land near Piney Point (i.e., creeks or other discharge points where wastewater is leaving the holding ponds). Removing sampling stations on land will typically shift the color and sizing on the map to a narrower range that provides a better representation of impacts in the bay.
1. You can choose to show all dates or filter by a particular date range. If results are filtered by date, hit the “play” button below the date slider to view a time lapse of data. The data table will show only results for the selected range.
1. You can choose to emphasize results that are above a threshold for the contaminant (see the information below).  Points below the threshold will no longer be outlined on the map, making those above the threshold easier to view. The same values that are above the threshold will be highlighted in the table. The threshold that applies to each contaminant is displayed as text below the selection options.  Some contaminants do not have a threshold.  If this is the case, the switch to emphasize values will do nothing.

__All results shown relative to a threshold are provided as reference only and do not indicate regulatory non-compliance.__ The thresholds apply to surface water quality standards from Florida DEP for Class II (shellfish propagation and harvest) or Class III marine waters (fish consumption, recreation, propagation and maintenance of a healthy, well-balanced population of fish and wildlife).  Standards are not available for all contaminants on the dashboard.  The lower standard was used in instances when two different standards for Class II or III waters applied to a parameter.  Some standards are also based on annual averages and not from a single observation.  

BENTHIC BIOLOGY {data-navmenu="CURRENT DATA"}
=======================================================================

Column {data-width=400}
-----------------------------------------------------------------------

### __STATION LOCATIONS - PINEY POINT AT MARKER__, last update `r rsbntlog`

```{r}
output$rsbntmap1 <- renderLeaflet(rsbntmap())
leafletOutput('rsbntmap1')
```

Column {.tabset .tabset-fade}
-----------------------------------------------------------------------

<br>
```{r}
column(12, 
  column(4, 
    HTML('<b>Select a station by clicking a marker on the map</b>') 
  ),
  column(4, 
    selectInput(inputId = 'bntsel', label = HTML('<b>Select sample date:</b>'), choices = rsbntsmodt)
  ), 
  column(4, 
       materialSwitch(inputId = 'bntscl', label = 'Show abundance in log-scale?', value = T, width = '100%')     
  )
)
```

### __STATION RESULTS__

```{r}
output$rsbntgge1 <- renderGauge(rsbntgge1())
output$rsbntplo1 <- renderPlot(rsbntplo1())
output$rsbnttxt1 <- renderUI(HTML(paste0('<b>Benthic condition</b>: ', rsbntdat1()$TBBICat)))

fillCol(flex = c(NA, NA, NA, 1),
  uiOutput('rsbnttxt1'),
  gaugeOutput('rsbntgge1', width = 400, height = 900), 
  HTML('<b>Family abundance</b>'), 
  plotOutput('rsbntplo1')
)
```

### __INFORMATION__

Initial sediment samples near Piney Point were collected 2021-04-07. These samples will be compared with samples collected in the fall to determine a potential impact of Piney Point on the benthic communities. 

For each sample at each station, benthic organisms living in the sediment were identified and enumerated.  This information is used to calculate the Tampa Bay Benthic Index (TBBI) to quantify the ecological health of the benthic community as affected by the the quality of the sediments they inhabit.  Samples are scored as Healthy, Intermediate, or Degraded based on continuous TBBI scores from 0 - 100 (negative scores are possible). Contaminants and other pollutants from the Piney Point effluent may negatively impact benthic communities and the TBBI will reflect these changes. 

The graphics on the __STATION RESULTS__ tab show the estimated TBBI score for the selected site (top) and a plot of the abundances of organisms found at the site (bottom). 

Additional information regarding the Tampa Bay Benthic Monitoring Program is available at <a href="https://tbep.org/tampa-bay-benthic-index/">https://tbep.org/tampa-bay-benthic-index/</a>.

WATER QUALITY {data-navmenu="BASELINE DATA"}
=======================================================================

Column {data-width=275}
-----------------------------------------------------------------------

### __STATION LOCATIONS - PINEY POINT AT MARKER__

```{r}
output$bswqmap1 <- renderLeaflet(bswqmap)
leafletOutput('bswqmap1')
```

Column {.tabset .tabset-fade data-width=650}
-----------------------------------------------------------------------

```{r}
column(12, HTML('<b>Select a station by clicking a marker on the map</b>'))
```

### __COMPLETE TIME SERIES__

```{r}
output$baseplo1 <- renderPlotly(baseplo1())
plotlyOutput('baseplo1')
```

### __MARCH, APRIL ONLY__

```{r}
output$baseplo2 <- renderPlotly(baseplo2())
plotlyOutput('baseplo2')
```

### __INFORMATION__

This tab shows approximately 25 years of data at long-term water quality monitoring stations near Piney Point.  __The ranges of values for each of these parameters provide a baseline of comparison for the [current results](https://shiny.tbep.org/piney-point/#section-water-quality-results).__  Data are shown from Hillsborough County Environmental Protection Commission (orange points on map) and Manatee County Parks and Natural Resources Department (yellow points on map).  Original data can be downloaded from the [USF Water Atlas](https://tampabay.wateratlas.usf.edu/datadownload/disclaimer.aspx).

Data for an individual station can be viewed by clicking a marker on the map. Each station shows data for the complete record available and for March, April months only.  The latter is provided as a baseline of comparison during the same months when discharge occurred at Piney Point to reduce seasonal variation.  Hillsborough County data have been collected monthly, whereas the Manatee County are collected quarterly. 

When available, each dataset shows results for the following: 

* TP: total phosphorus in mg/L
* TN: total nitrogen in mg/L
* NH3: ammonia in mg/L
* Chl-a: chlorophyll-a in ug/L
* pH: pH, unitless from 0 to 12
* Sal: salinity in parts per thousand

An explanation of these parameters can be found on the *INFORMATION* tab of the [current results](https://shiny.tbep.org/piney-point/#section-water-quality-results) page. 

Each plot is interactive.  Data at each point can be viewed on mouseover and plots can be zoomed or scrolled by dragging the mouse.

SEAGRASSES {data-navmenu="BASELINE DATA"}
=======================================================================

Column {data-width=275}
-----------------------------------------------------------------------

### __TRANSECT LOCATIONS - PINEY POINT AT MARKER__

```{r}
output$bssgmap1 <- renderLeaflet(bssgmap)
leafletOutput('bssgmap1')
```

Column {data-width=650 .tabset .tabset-fade}
-----------------------------------------------------------------------

### __TRANSECT DATA__

```{r}
fillCol(flex = c(0.03, 1),
  column(12, 
    HTML('<b>Select a station by clicking a marker on the map</b>')
  ),
  fillCol(flex = c(1, 1),
    renderPlotly(bssgtrnplo1()),
    renderPlotly(bssgsumplo1())
  )
)
```

### __INFORMATION__

This tab shows results for individual transects near Piney Point.  The plots show detailed information for all dates, species, and sites (quadrats) for the selected transect. 

The locations and names of the transects are shown in the map (transect locations tab on the left). Select a transect by clicking the marker on the map.  The selected transect is shown as a red dot.

The seagrass species shown in the plots include the five dominant species found in Tampa Bay: 

* *Halodule wrightii*: shoal grass
* *Syringodium filiforme*: manatee grass
* *Thalassia testudinum*: turtle grass
* *Halophila engalmanii*: star grass
* *Ruppia maritima*: widgeon grass

The __top plot__ shows seagrass abundances for each species, for each date, and at each location along the selected transect (in meters).  This plot provides a detailed assessment of where species were located on a transect and how those locations may have changed over time.  The species are color-coded as shown in the legend.  Each point is sized by the recorded abundance for a species (as Braun-Blanquet, 0-5).  Points that were sampled but had no seagrass are shown as small black points.

The __bottom plot__ plot shows similar information as the top plot, except the observations for each species along a transect for a given date are shown as overall frequency occurrence estimates.  This can be conceptualized as aggregating the data in the top plot along the x-axis and rotating the plot ninety degrees.  Each vertical grey line in the plot is a sample date.  The plot provides an aggregated assessment of how species abundances are changing over time and which species are dominant at a transect.