alluvial plots simplified, added to createfigs

R/funcs.R

@@ -1328,20 +1328,13 @@ sgsum_fun <- function(seagrass, sgmaxyr, refyr = 1988, topyr = 2016){
 
 # alluvial plot function, for HMPU targets
 # https://www.data-to-viz.com/graph/sankey.html
-alluvout2 <- function(datin, fluccs, family, maxyr, width, height, mrg){
+alluvout2 <- function(datin, family, maxyr, width, height, mrg, colrev = FALSE, title = TRUE){
 
   ttl <- paste('True change analysis, watershed land use from 1990 (left) to', maxyr, '(right)')
 
   if(any(grepl('^Seagrass', datin$source)))
     ttl <- paste('True change analysis, subtidal habitats (all categories) from 1988 (left) to', maxyr, '(right)')
 
-
-  clp <- fluccs %>%
-    pull(HMPU_TARGETS) %>% 
-    unique %>% 
-    c('Coastal Uplands', .) %>% 
-    sort
-
   sumdat <- datin %>% 
     rename(Acres = value) %>% 
     mutate(
@@ -1373,7 +1366,10 @@ alluvout2 <- function(datin, fluccs, family, maxyr, width, height, mrg){
     gsub('\\s$', '', .) %>% 
     unique %>% 
     length()
-  colin <- cols(ncol) %>% 
+  colin <- cols(ncol)
+  if(colrev)
+    colin <- rev(colin)
+  colin <- colin %>% 
     paste(collapse = '", "') %>% 
     paste('d3.scaleOrdinal(["', ., '"])')
 
@@ -1388,7 +1384,8 @@ alluvout2 <- function(datin, fluccs, family, maxyr, width, height, mrg){
                        margin = mrgs)
 
   # add caption
-  out <- htmlwidgets::prependContent(out, h5(class = "title", ttl))
+  if(title)
+    out <- htmlwidgets::prependContent(out, h5(class = "title", ttl))
 
   out <- htmlwidgets::onRender(
     out,

createfigs.R

@@ -10,6 +10,8 @@ library(grid)
 library(here)
 library(maptiles)
 library(tidyterra)
+library(networkD3)
+library(htmltools)
 
 loadfonts(device = 'win', quiet = T)
 
@@ -214,7 +216,7 @@ p1 <- ggplot(toplo1, aes(x = yr, y = pyro, group = yr)) +
     y = 'Bloom intensity (cells / L)', 
     x = NULL,
     title = expression(paste(italic('Pyrodinium bahamense'), ' bloom intensity in Old Tampa Bay')), 
-    subtitle = 'Observed cell counts and annual medians', 
+    subtitle = 'Observed cell counts > 0 and annual medians', 
     caption = 'Source: Florida Fish and Wildlife Conservation Commission'
   )
 
@@ -257,13 +259,43 @@ p2 <- ggplot(toplo2, aes(x = yr, y = val)) +
     x = NULL,
     y = 'Bloom intensity (cells / L)', 
     title = expression(paste(italic('Karenia brevis'), ' bloom intensity in Tampa Bay')), 
-    subtitle = 'Observed cell counts and annual medians', 
+    subtitle = 'Observed cell counts > 0 and annual medians', 
     caption = 'Source: NOAA NCEI Harmful Algal BloomS Observing System (HABSOS)'
   )
 
-p <- p1 + p2 + plot_layout(ncol = 1)
+p <- p1 + p2 + plot_layout(ncol = 1, axis_titles = 'collect')
 
 jpeg('figures/habs.jpg', family = fml, height = 5, width = 9, units = 'in', res = 300)
 print(p)
 dev.off()
 
+# simplified land use change ------------------------------------------------------------------
+
+load(url("https://github.com/tbep-tech/hmpu-workflow/raw/master/data/chgdat.RData"))
+
+toplo <- chgdat %>%
+  filter(grepl('1990', source)) %>% 
+  filter(grepl('2020', target)) %>% 
+  mutate(
+    source = case_when(
+      grepl('Mangrove|Salt|Wetlands|Uplands', source) ~ 'Forests/Wetlands, 1990',
+      T ~ source
+    ),
+    target = case_when(
+      grepl('Mangrove|Salt|Wetlands|Uplands', target) ~ 'Forests/Wetlands, 2020',
+      T ~ target
+    )
+  ) %>% 
+  summarise(
+    value = sum(value), 
+    .by = c('source', 'target')
+  ) %>% 
+  filter(!grepl('Open|other', source)) %>% 
+  filter(!grepl('Open|other', target))
+
+p <- alluvout2(toplo, family = fml, maxyr = 2020, width = 1000, height = 700, mrg = 95, 
+          colrev = T, title = F)
+
+htmlwidgets::saveWidget(p, here::here('figures/landusechange.html'), selfcontained = T)
+
+webshot::webshot(url = here::here('figures/landusechange.html'), file = here::here('figures/landusechange.png'))

docs/critical-coastal-habitat-trends.Rmd

@@ -12,7 +12,6 @@ load(url("https://github.com/tbep-tech/hmpu-workflow/raw/master/data/acres.RData
 load(url("https://github.com/tbep-tech/hmpu-workflow/raw/master/data/subtacres.RData"))
 load(url("https://github.com/tbep-tech/hmpu-workflow/raw/master/data/chgdat.RData"))
 load(url("https://github.com/tbep-tech/hmpu-workflow/raw/master/data/subtchgdat.RData"))
-fluccs <- read.csv('https://github.com/tbep-tech/hmpu-workflow/raw/master/data/FLUCCShabsclass.csv', stringsAsFactors = F)
 
 # subtidal max year
 submax <- '2022'
@@ -57,7 +56,13 @@ lngtrmtab_fun(subtacres, 'Category', typ = 'subtidal', yrsel = '1988', topyr = s
 ```
 
 ```{r}
-alluvout2(subtchgdat, fluccs, family = fml, maxyr = submax, width = 800, height = 900, mrg = 0)
+toplo <- subtchgdat %>% 
+  filter(grepl('1988', source)) %>%
+  filter(grepl(submax, target)) %>%
+  filter(grepl('Seagrasses|Tidal|Open', source)) %>% 
+  filter(grepl('Seagrasses|Tidal|Open', target))
+
+alluvout2(toplo, family = fml, maxyr = submax, width = 800, height = 500, mrg = 0)
 ```
 
 The intertidal habitat gains demonstrate the effectiveness of publicly-funded habitat restoration projects (see Habitat Restoration tab) and state and federal wetland regulatory programs. Increases in salt barrens may also reflect a landward expansion associated with sea level rise. However, a `r sprest['Developed']`% increase for developed lands and `r sprest['Restorable']`% loss for restorable lands in the watershed is a concern for continued habitat restoration and protection. A loss of upland habitats is the result of continued human population growth and urban development in the Tampa Bay watershed, and unless local protections for native upland habitats improve, this trend will likely continue.
@@ -67,7 +72,27 @@ lngtrmtab_fun(acres, 'Category', typ = 'supratidal', yrsel = '1990', topyr = spr
 ```
 
 ```{r}
-alluvout2(chgdat, fluccs, family = fml, maxyr = sprmax, width = 1000, height = 900, mrg = 95)
+toplo <- chgdat %>%
+  filter(grepl('1990', source)) %>% 
+  filter(grepl(sprmax, target)) %>% 
+  mutate(
+    source = case_when(
+      grepl('Mangrove|Salt|Wetlands|Uplands', source) ~ 'Forests/Wetlands, 1990',
+      T ~ source
+    ),
+    target = case_when(
+      grepl('Mangrove|Salt|Wetlands|Uplands', target) ~ paste('Forests/Wetlands,', sprmax),
+      T ~ target
+    )
+  ) %>% 
+  summarise(
+    value = sum(value), 
+    .by = c('source', 'target')
+  ) %>% 
+  filter(!grepl('Open|other', source)) %>% 
+  filter(!grepl('Open|other', target))
+
+alluvout2(toplo, family = fml, maxyr = sprmax, width = 1000, height = 500, mrg = 95, colrev = T)
 ```
 
 ## Seagrasses in Tampa Bay

docs/critical-coastal-habitat-trends_files/header-attrs-2.27/header-attrs.js

@@ -0,0 +1,12 @@
+// Pandoc 2.9 adds attributes on both header and div. We remove the former (to
+// be compatible with the behavior of Pandoc < 2.8).
+document.addEventListener('DOMContentLoaded', function(e) {
+  var hs = document.querySelectorAll("div.section[class*='level'] > :first-child");
+  var i, h, a;
+  for (i = 0; i < hs.length; i++) {
+    h = hs[i];
+    if (!/^h[1-6]$/i.test(h.tagName)) continue;  // it should be a header h1-h6
+    a = h.attributes;
+    while (a.length > 0) h.removeAttribute(a[0].name);
+  }
+});

docs/critical-coastal-habitat-trends_files/htmltools-fill-0.5.8.1/fill.css

@@ -0,0 +1,21 @@
+@layer htmltools {
+  .html-fill-container {
+    display: flex;
+    flex-direction: column;
+    /* Prevent the container from expanding vertically or horizontally beyond its
+    parent's constraints. */
+    min-height: 0;
+    min-width: 0;
+  }
+  .html-fill-container > .html-fill-item {
+    /* Fill items can grow and shrink freely within
+    available vertical space in fillable container */
+    flex: 1 1 auto;
+    min-height: 0;
+    min-width: 0;
+  }
+  .html-fill-container > :not(.html-fill-item) {
+    /* Prevent shrinking or growing of non-fill items */
+    flex: 0 0 auto;
+  }
+}