diff --git a/R/funcs.R b/R/funcs.R index 3679dc8..7f1821d 100644 --- a/R/funcs.R +++ b/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){ diff --git a/index.Rmd b/index.Rmd index 246fd79..ae8f4a8 100644 --- a/index.Rmd +++ b/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}