add barplots of land use over time

R/funcs.R

@@ -203,6 +203,64 @@ lngtrmtab_fun <- function(datin, colnm, yrsel, firstwidth = 240){
 
 }
 
+# barplot function for acres over time
+barplot_fun <- function(datin, yrsel){
+
+  # custom color scale
+  cols <- c('#004F7E', '#00806E', '#427355', '#958984', '#5C4A42', 'grey') %>% 
+    colorRampPalette
+
+  toplo <- datin %>% 
+    ungroup() %>% 
+    complete(name, HMPU_TARGETS, fill = list(Acres = 0)) %>% 
+    filter(name >= yrsel[1] & name <= yrsel[2]) %>% 
+    pivot_wider(names_from = 'HMPU_TARGETS', values_from = 'Acres')
+
+  nhab <- length(unique(datin$HMPU_TARGETS))
+
+  # supra/inter
+  if(nhab == 10){
+
+    colsi <- cols(nhab)
+
+    p <- plot_ly(toplo, x = ~name, y = ~`Salt Marshes`, name = "Salt Marshes", type = 'bar', marker = list(color = colsi[10])) %>% 
+      add_trace(y = ~`Salt Barrens`, name = "Salt Barrens", marker = list(color = colsi[9])) %>%
+      add_trace(y = ~`Restorable`, name = "Restorable", marker = list(color = colsi[8])) %>%
+      add_trace(y = ~`Open Water`, name = "Open Water", marker = list(color = colsi[7])) %>% 
+      add_trace(y = ~`Non-Forested Freshwater Wetlands`, name = "Non-Forested Freshwater Wetlands", marker = list(color = colsi[6])) %>% 
+      add_trace(y = ~`Native Uplands`, name = "Native Uplands", marker = list(color = colsi[5])) %>%
+      add_trace(y = ~`Mangrove Forests`, name = "Mangrove Forests", marker = list(color = colsi[4])) %>% 
+      add_trace(y = ~`Forested Freshwater Wetlands`, name = "Forested Freshwater Wetlands", marker = list(color = colsi[3])) %>% 
+      add_trace(y = ~`Developed`, name = "Developed", marker = list(color = colsi[2])) %>% 
+      add_trace(y = ~`Coastal Uplands`, name = "Coastal Uplands", marker = list(color = colsi[1]))
+
+  }
+
+  # sub
+  if(nhab == 5){
+
+    colsi <- cols(nhab)
+
+    p <- plot_ly(toplo, x = ~name, y = ~`Tidal Flats`, name = "Tidal Flats", type = 'bar', marker = list(color = colsi[5])) %>% 
+      add_trace(y = ~`Seagrasses`, name = "Seagrasses", marker = list(color = colsi[3])) %>% 
+      add_trace(y = ~`Restorable`, name = "Restorable", marker = list(color = colsi[4])) %>% 
+      add_trace(y = ~`Oyster Bars`, name = "Oyster Bars", marker = list(color = colsi[2])) %>% 
+      add_trace(y = ~`Open Water`, name = "Open Water", marker = list(color = colsi[1]))
+
+  }
+
+  p <- p %>% 
+    layout(
+      yaxis = list(title = 'Acres'),
+      xaxis = list(title = NA),
+      barmode = 'stack'
+      )
+
+  return(p)
+
+}
+
+
 # alluvial plot function, for HMPU targets
 # https://www.data-to-viz.com/graph/sankey.html
 alluvout <- function(datin, fluccs, mrg){

index.Rmd

@@ -22,12 +22,13 @@ library(networkD3)
 library(shiny)
 library(shinyWidgets)
 library(reactablefmtr)
+library(plotly)
 
 data(acres)
 data(subtacres)
 data(chgdat)
 data(subtchgdat)
-data(flucss)
+data(fluccs)
 
 source('R/funcs.R')
 
@@ -119,13 +120,37 @@ subtchgdatpr <- reactive({
   
 })
 
+# bar plot
+barplot1 <- reactive({
+  
+  # inputs
+  yrsel1 <- input$yrsel1
+  
+  out <- barplot_fun(acres, yrsel1)
+  
+  return(out)
+    
+})
+
+# subtidal barplot
+barplot2 <- reactive({
+  
+  # inputs
+  yrsel2 <- input$yrsel2
+  
+  out <- barplot_fun(subtacres, yrsel2)
+  
+  return(out)
+  
+})
+
 # change analysis plot
 alluplo1 <- reactive({
   
   # inputs
   datin <- chgdatpr()
 
-  out <- alluvout2(datin, fluccs, mrg = 130)
+  out <- alluvout(datin, fluccs, mrg = 130)
   
   return(out)
   
@@ -137,7 +162,7 @@ alluplo2 <- reactive({
   # inputs
   datin <- subtchgdatpr()
 
-  out <- alluvout2(datin, fluccs, mrg = 0)
+  out <- alluvout(datin, fluccs, mrg = 0)
   
   return(out)
   
@@ -150,7 +175,7 @@ cmptab1 <- reactive({
   datin <- chgdatpr()
   yrsel1 <- input$yrsel1
   
-  out <- cmprctfun2(datin, fluccs, yrsel1[1], '2020')
+  out <- cmprctfun(datin, fluccs, yrsel1[1], '2020')
   
   return(out)
   
@@ -163,7 +188,7 @@ cmptab2 <- reactive({
   datin <- subtchgdatpr()
   yrsel2 <- input$yrsel2
   
-  out <- cmprctfun2(datin, fluccs, yrsel2[1], '2022', subt = T)
+  out <- cmprctfun(datin, fluccs, yrsel2[1], '2022', subt = T)
   
   return(out)
   
@@ -186,13 +211,20 @@ sliderTextInput('yrsel1', 'Select year comparison', choices = yrs1, grid = T, wi
 
 ##### `r renderText(input$yrsel1[1])` to `r renderText(input$yrsel1[2])` change {.tabset .tabset-pills} 
 
-###### Long-term trends
+###### Long-term trends table
 
 ```{r}
 output$trndtab1 <- renderReactable(trndtab1())
 reactableOutput('trndtab1')
 ```
 
+###### Long-term trends barplot
+
+```{r}
+output$barplot1 <- renderPlotly(barplot1())
+plotlyOutput('barplot1')
+```
+
 ###### Change analysis plot 
 
 ```{r}
@@ -215,13 +247,20 @@ sliderTextInput('yrsel2', 'Select year comparison', choices = yrs2, grid = T, wi
 
 ##### `r renderText(input$yrsel2[1])` to `r renderText(input$yrsel2[2])` change {.tabset .tabset-pills} 
 
-###### Long-term trends
+###### Long-term trends table
 
 ```{r}
 output$trndtab2 <- renderReactable(trndtab2())
 reactableOutput('trndtab2')
 ```
 
+###### Long-term trends barplot
+
+```{r}
+output$barplot2 <- renderPlotly(barplot2())
+plotlyOutput('barplot2')
+```
+
 ###### Change analysis plot
 
 ```{r}