index.Rmd

---
output: 
  html_document:
    includes:
      in_header: google-analytics.html
title: "Seagrass coverage estimates"
css: styles.css
runtime: shiny
---

# {.tabset}

This application provides a summary of seagrass areal coverage estimates for Tampa Bay, by [major bay segments](https://drive.google.com/file/d/1DIyZ_gH48t_gLSQGd23sAW-3AhAtoASZ/view?usp=sharing) and [seagrass management areas](https://drive.google.com/file/d/1mFRte9yfk9hV-tYRtdcwW7JpGgXmvHHX/view?usp=sharing).  Coverage estimates are provided for each year of available coverage data from the Southwest Florida Water Management District, published approximately biennially since the 1980s (available [here](https://data-swfwmd.opendata.arcgis.com/search?groupIds=d9a4213eb9ea4713bb710e03bdcc6648)). Historical coverages for 1950 and 1982 are only available for the continuous + patchy segment tab. Note that the nominal year for each layer provides a snapshot estimate of coverage from aerial photos taken at the end of the growing season for the year prior.  For example, the 2022 layer was based on images obtained in January 2021.  All estimates are provided in acres.  

The Tampa Bay tab provides a summary for the entire bay using historical estimates for past years.  The segment and management area tabs provide coverage summaries specific to the relevant boundaries in each tab. Comparisons between years can be made for the segment and management area tabs by selecting year pairs from the slider.  Changes in coverage between the selected years are shown on the far right columns of each table and as differences in the maps.  The final tab provides estimates of total area where seagrasses have occurred throughout the period of record. 

<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 application is licensed under a <a rel='license' href='http://creativecommons.org/licenses/by/4.0/'>Creative Commons Attribution 4.0 International License</a>. Please contact [Marcus Beck](mailto:mbeck@tbep.org) for more information. Source code is available [here](https://github.com/tbep-tech/seagrass-analysis).

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

```{r setup, message = F, warning = F, results = 'hide', echo = F}
knitr::opts_chunk$set(echo = TRUE, warning = F, message = F, echo = F, fig.path = 'figs/', fig.path = 'figures/')
box::use(
  here[...], 
  dplyr[...],
  shiny[...], 
  shinyWidgets[sliderTextInput],
  leaflet[renderLeaflet, leafletOutput],
  tidyr[spread, gather],
  reactable[reactableOutput, renderReactable], 
  knitr[include_graphics, kable], 
  R/funcs[sgrctfun, sgmapfun, sgchgfun, sgtotchgfun, allsgmapfun, allsgtabfun]
)
data(file = 'seagrass', package = 'tbeptools')
data(file = 'sgmanagement', package = 'tbeptools')
load(file = here('data/allsegests.RData'))
load(file = here('data/allmngests.RData'))
load(file = here('data/segclp.RData'))
load(file = here('data/allsgacres.RData'))

# years to select
yrs2 <- unique(allsegests$yr) %>% 
  sort %>% 
  .[1:(length(.))]
yrs1 <- c('1950', '1982', yrs2)

hec <- 0.404686

# leaflet height
lfht <- 600

# # style file
# styles <- readLines('https://raw.githubusercontent.com/tbep-tech/css-styling/master/styles.css')
# writeLines(styles, 'styles.css')
```

```{r reactives}
# segment combined estimates
segcmbests <- reactive({
  
  # input
  valtyp <- input$valtyp
  
  # combined segment estimates
  segcmb <- allsegests %>% 
    filter(Habitat %in% c('patchy', 'cont.')) %>% 
    group_by(yr, Segment) %>% 
    summarise(
      Acres = sum(Acres, na.rm = T), 
      .groups = 'drop'
      ) %>% 
    spread(yr, Acres, fill = 0)

  segcmbhst <- tibble(
      Segment = c("Boca Ciega Bay", "Hillsborough Bay", "Lower Tampa Bay", "Manatee River", 
                  "Middle Tampa Bay", "Old Tampa Bay", "Terra Ceia Bay"),
      `1950` = c(10800, 2300, 6100, 200, 9600, 10700, 700), 
      `1982` = c(5770, 0, 5016, 131, 4042, 5943, 751)
    )
  out <- segcmbhst %>% 
    full_join(segcmb, by = 'Segment')
    
  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
  
  return(out)
  
})

# segment continuous estimates
segcntests <- reactive({
  
  # input
  valtyp <- input$valtyp
  
  out <- allsegests %>% 
    filter(Habitat == 'cont.') %>% 
    select(yr, Segment, Acres) %>% 
    spread(yr, Acres, fill = 0)

  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
    
  return(out)
  
})

# segment patchy estimates
segptcests <- reactive({

  # input
  valtyp <- input$valtyp
  
  out <- allsegests %>% 
    filter(Habitat == 'patchy') %>% 
    select(yr, Segment, Acres) %>% 
    spread(yr, Acres, fill = 0)
  
  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
  
  return(out)
  
})

# max segment diff for map color scaling
segmaxv <- reactive({
  
  # inputs
  segcmbests <- segcmbests()
  segcntests <- segcntests()
  segptcests <- segptcests()
  yrsel1 <- input$yrsel1
  
  if(yrsel1[1] %in% c(1950, 1982))
    out <- bind_rows(segcmbests) %>%
      select(any_of(yrsel1)) %>% 
      mutate(
        maxv = do.call(pmax, .), 
        minv = do.call(pmin, .), 
        rng = maxv - minv
      ) %>% 
      pull(rng) %>% 
      max
  
  if(!yrsel1[1] %in% c(1950, 1982))
    out <- bind_rows(segcmbests, segcntests, segptcests) %>%
      select(any_of(yrsel1)) %>% 
      mutate(
        maxv = do.call(pmax, .), 
        minv = do.call(pmin, .), 
        rng = maxv - minv
      ) %>% 
      pull(rng) %>% 
      max
    
  return(out)
  
})

# managed combined estimates
mngcmbests <- reactive({

  # input
  valtyp <- input$valtyp
  
  out <- allmngests %>% 
    filter(Habitat %in% c('patchy', 'cont.')) %>% 
    group_by(yr, Areas) %>% 
    summarise(
      Acres = sum(Acres, na.rm = T), 
      .groups = 'drop'
      ) %>% 
    spread(yr, Acres, fill = 0)
    
  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
  
  return(out)  

})

# managed continuous estimates
mngcntests <- reactive({

  # input
  valtyp <- input$valtyp
  
  out <- allmngests %>% 
    filter(Habitat == 'cont.') %>% 
    select(yr, Areas, Acres) %>% 
    spread(yr, Acres, fill = 0)
    
  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
  
  return(out)    

})

# managed patchy estimates
mngptcests <- reactive({
  
  # input
  valtyp <- input$valtyp

  out <- allmngests %>% 
    filter(Habitat == 'patchy') %>% 
    select(yr, Areas, Acres) %>% 
    spread(yr, Acres, fill = 0)
  
  if(valtyp == 'Hectares')
    out <- out %>% 
      mutate_if(is.numeric, function(x) x * hec)
    
  return(out)
  
})

# max managed diff for map color scaling
mngmaxv <- reactive({
  
  # inputs
  mngcmbests <- mngcmbests()
  mngcntests <- mngcntests()
  mngptcests <- mngptcests()
  yrsel2 <- input$yrsel2

  out <- bind_rows(mngcmbests, mngcntests, mngptcests) %>%
    select(all_of(yrsel2)) %>% 
    mutate(
      maxv = do.call(pmax, .), 
      minv = do.call(pmin, .), 
      rng = maxv - minv
    ) %>% 
    pull(rng) %>% 
    max
  
  return(out)
  
})

# segment combined trend table
segcmbtab <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segcmbests <- segcmbests()

  out <- sgrctfun(segcmbests, 'Segment', yrsel = yrsel1)

  return(out)
  
})

# segment combined map
segcmbmap <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segcmbests <- segcmbests()
  segmaxv <- segmaxv()

  out <- sgmapfun(segcmbests, 'Segment', yrsel = yrsel1, bndin = segclp, maxv = segmaxv)

  return(out)
  
})

# segment cont trend table
segcnttab <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segcntests <- segcntests()
  
  out <- sgrctfun(segcntests, 'Segment', yrsel = yrsel1)

  return(out)
  
})

# segment cont map
segcntmap <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segcntests <- segcntests()
  segmaxv <- segmaxv()
  
  out <- sgmapfun(segcntests, 'Segment', yrsel = yrsel1, bndin = segclp, maxv = segmaxv)

  return(out)
  
})

# segment patchy trend table
segptctab <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segptcests <- segptcests()
  
  out <- sgrctfun(segptcests, 'Segment', yrsel = yrsel1)

  return(out)
  
})

# segment patchy map
segptcmap <- reactive({
  
  # inputs
  yrsel1 <- input$yrsel1
  segptcests <- segptcests()
  segmaxv <- segmaxv()
  
  out <- sgmapfun(segptcests, 'Segment', yrsel = yrsel1, bndin = segclp, maxv = segmaxv)

  return(out)
  
})

# management area combined trend table
mngcmbtab <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngcmbests <- mngcmbests()
  
  out <- sgrctfun(mngcmbests, 'Areas', yrsel = yrsel2)

  return(out)
  
})

# management area combined map
mngcmbmap <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngcmbests <- mngcmbests()
  mngmaxv <- mngmaxv()
  
  out <- sgmapfun(mngcmbests, 'Areas', yrsel = yrsel2, bndin = sgmanagement, maxv = mngmaxv)

  return(out)
  
})

# management area cont trend table
mngcnttab <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngcntests <- mngcntests()
  
  out <- sgrctfun(mngcntests, 'Areas', yrsel = yrsel2)

  return(out)
  
})

# management area cont map
mngcntmap <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngcntests <- mngcntests()
  mngmaxv <- mngmaxv()
  
  out <- sgmapfun(mngcntests, 'Areas', yrsel = yrsel2, bndin = sgmanagement, maxv = mngmaxv)

  return(out)
  
})

# management area patchy trend table
mngptctab <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngptcests <- mngptcests()
  
  out <- sgrctfun(mngptcests, 'Areas', yrsel = yrsel2)

  return(out)
  
})

# management area patchy map
mngptcmap <- reactive({
  
  # inputs
  yrsel2 <- input$yrsel2
  mngptcests <- mngptcests()
  mngmaxv <- mngmaxv()
  
  out <- sgmapfun(mngptcests, 'Areas', yrsel = yrsel2, bndin = sgmanagement, maxv = mngmaxv)

  return(out)
  
})

# tabular sum of allsgdat by bay segment
allsgtab <- reactive({
  
  # input
  valtyp <- input$valtyp
  
  out <- allsgtabfun(allsgacres, valtyp)
  
  return(out)
  
})
```

```{r}
selectInput('valtyp', 'Show all area results as:', choices = c('Acres', 'Hectares'), width = '400px')
```

## Tampa Bay

```{r}
seagrass %>% 
  mutate(
    Acres = formatC(Acres, format = "d", big.mark = ","), 
    Hectares = formatC(Hectares, format = "d", big.mark = ",")
  ) %>% 
  kable(caption = 'All estimates for all segments, based on historical coverages used to report on annual progress toward recovery goals.', align = 'lrr')
```

[download figure](https://github.com/tbep-tech/seagrass-analysis/raw/main/figures/seagrasscov.png){target="_blank"}

```{r, out.width = '100%'}
include_graphics('figures/seagrasscov.png')
```

## By segment {.tabset .tabset-pills}

```{r}
sliderTextInput('yrsel1', 'Select year comparison', choices = yrs1, grid = T, width = '600px', selected = c(yrs1[1], rev(yrs1)[1]))
```
Note: 1950, 1982 years are unavailable for continuous or patchy only comparisons.

### Continous + Patchy

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

```{r}
output$segcmbmap <- renderLeaflet(segcmbmap())
leafletOutput('segcmbmap', height = lfht)
```

### Continuous

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

```{r}
output$segcntmap <- renderLeaflet(segcntmap())
leafletOutput('segcntmap', height = lfht)
```

### Patchy

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

```{r}
output$segptcmap <- renderLeaflet(segptcmap())
leafletOutput('segptcmap', height = lfht)
```

## By management area {.tabset .tabset-pills}

```{r}
sliderTextInput('yrsel2', 'Select year comparison', choices = yrs2, grid = T, width = '600px', selected = c(yrs2[1], rev(yrs2)[1]))
```
Note: 1950, 1982 years are unavailable for all management area comparisons.

### Continous + Patchy

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

```{r}
output$mngcmbmap <- renderLeaflet(mngcmbmap())
leafletOutput('mngcmbmap', height = lfht)
```

### Continuous

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

```{r}
output$mngcntmap <- renderLeaflet(mngcntmap())
leafletOutput('mngcntmap', height = lfht)
```

### Patchy

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

```{r}
output$mngptcmap <- renderLeaflet(mngptcmap())
leafletOutput('mngptcmap', height = lfht)
```

## All maps combined

This tab shows a potential maximum of seagrass based on all coverage maps combined from 1988 to present (continuous and patchy).  The total area does not consider changing light conditions or bathymetry and is meant to show only areas where seagrasses have occurred in the period of record. 

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

```{r, out.height = 600, out.width="100%"}
allsgmapfun(segclp)
```