working on allsg table

Author: fawda123

R/dat_proc.R

@@ -13,7 +13,6 @@ library(raster)
 # this is the projection for the seagrass segment layer from the district
 prj <- 2882
 
-
 # bay segments clipped to shore -------------------------------------------
 
 load(file = url('https://github.com/tbep-tech/benthic-dash/raw/main/data/segmask.RData'))
@@ -89,3 +88,63 @@ for(i in 1:length(fls)){
   save(list = flnm, file = here('data', paste0('/', flnm, '.RData')), compress = 'xz')
 
 }
+
+# union of all sg layers as "potential" -------------------------------------------------------
+
+library(sf)
+library(tidyverse)
+library(here)
+
+res <- list.files('data', '^sgdat') %>% 
+  enframe() %>% 
+  group_by(value) %>% 
+  nest %>% 
+  mutate(
+    dat = purrr::map(value, function(x){
+      
+      cat(x, '\t')
+      
+      # import file
+      load(file = here(paste0('data/', x)))
+      dat <- get(gsub('\\.RData', '', x))
+      
+      dat_out <- dat |> 
+        filter(FLUCCSCODE %in% c(9113, 9116)) |> 
+        st_union() |> 
+        st_geometry()
+      
+      return(dat_out)
+      
+    })
+  )
+
+out <- res$dat[[1]]
+for(i in 2:nrow(res)){
+  
+  cat(i, '\t')
+  out <- st_union(out, res$dat[[i]])
+  
+}
+
+allsgdat <- out
+save(allsgdat, file = here('data/allsgdat.RData'))     
+
+
+# area sum of allsgdat ------------------------------------------------------------------------
+
+load(file = here('data/allsgdat.RData'))
+
+# area sum
+allsgacres <- allsgdat %>%
+  st_transform(crs = prj) %>%
+  st_intersection(sgseg, .) %>%
+  filter(!segment %in% c('Upper Sarasota Bay-m', 'Gulf of Mexico')) %>% 
+  mutate(
+    Acres = st_area(.), 
+    Acres = units::set_units(Acres, 'acres'), 
+    Acres = as.numeric(Acres)
+  ) %>%
+  st_set_geometry(NULL) |> 
+  arrange(segment)
+
+save(allsgacres, file = here('data/allsgacres.RData'))

R/funcs.R

@@ -237,4 +237,32 @@ sgmapfun <- function(datin, colnm = c('Segment', 'Areas'), yrsel, bndin, maxv){
 
   return(out)
 
+}
+
+#' @export
+allsgmapfun <- function(){
+  
+  box::use(
+    mapview[...], 
+    leaflet[...], 
+    dplyr[...], 
+    leafem[removeMouseCoordinates], 
+    here[...]
+  )
+  
+  load(file = here('data/allsgdat.RData'))
+
+  m <- mapview(allsgdat, homebutton = F, popup = NULL, legend = F, col.regions = '#006D2C', alpha = 0.8) %>% 
+    .@map %>% 
+    removeMouseCoordinates()
+  
+  return(m)
+  
+}
+
+#' @export
+allsgtabfun <- function(dat, valtyp){
+  
+  browser()
+  
 }

data/allsgacres.RData

@@ -29,13 +29,14 @@ box::use(
   tidyr[spread, gather],
   reactable[reactableOutput, renderReactable], 
   knitr[include_graphics, kable], 
-  R/funcs[sgrctfun, sgmapfun, sgchgfun, sgtotchgfun]
+  R/funcs[sgrctfun, sgmapfun, sgchgfun, sgtotchgfun, allsgmapfun]
 )
 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) %>% 
@@ -404,6 +405,18 @@ mngptcmap <- reactive({
 
   return(out)
   
+})
+
+# tabular sum of allsgdat by bay segment
+allsgtab <- reactive({
+  
+  # input
+  valtyp <- input$valtyp
+  
+  out <- allsgtabfun(allsgacres, valtyp)
+  
+  return(out)
+  
 })
 ```
 
@@ -513,3 +526,12 @@ reactableOutput('mngptctab')
 output$mngptcmap <- renderLeaflet(mngptcmap())
 leafletOutput('mngptcmap', height = lfht)
 ```
+
+## Potential
+
+```{r, out.height = 600, out.width="100%"}
+allsgmapfun()
+output$allsgtab <- renderReactable(allsgtab())
+reactableOutput('allsgtab')
+```
+