working on 2023 update to gpra/neport summaries

R/dat_proc.R

@@ -1,67 +1,35 @@
 library(tidyverse)
 library(here)
-library(googlesheets4)
-library(googledrive)
 
-# auth google drive
-drive_auth(email = '[email protected]')
-gs4_auth(token = drive_token())
+# simple version of all restoration projects --------------------------------------------------
 
-# HMPU compiled table -------------------------------------------------------------------------
+# from https://github.com/tbep-tech/TBEP_Habitat_Restoration
+pth <- 'https://raw.githubusercontent.com/tbep-tech/TBEP_Habitat_Restoration/main/Habitat_Restoration_Clean.csv'
 
-# curated table, pull data prior to 2006 to join with GPRA
-# https://docs.google.com/spreadsheets/d/1IkGidfU4SQJ_ZtOEqfn8licNCuWGlq_MtGuWWuIL1Js/edit#gid=2008440809
-rstdat <- read_sheet('1IkGidfU4SQJ_ZtOEqfn8licNCuWGlq_MtGuWWuIL1Js', sheet = 'FullDatabase')
-
-rstdat <- rstdat %>% 
+rstdatall <- read.csv(pth, stringsAsFactors = F) %>% 
   select(
-    `Federal Fiscal Year` = `Year Reported`, 
-    `HMPU habitat 1` = `HMPU Habitat Type for Restoration`, 
-    Acres, 
-    `Activity Name` = `Basic Activity (Enhance/Rest)`, 
-    `Miles` = `Linear Miles`,
-    `Feet` = `Linear Feet`
-  ) %>% 
-  filter(`Federal Fiscal Year` < 2006)
-
-# GPRA raw data
-# https://docs.google.com/spreadsheets/d/1QFX5XXpTgAr4u9wrxa_TUOuF5roUqEhJzZEDUiHi3SE/edit?usp=sharing
-rstdat2 <- read_sheet('1QFX5XXpTgAr4u9wrxa_TUOuF5roUqEhJzZEDUiHi3SE')
-
-# GPRA to HMPU lookup table
-# https://docs.google.com/spreadsheets/d/1jYbODoAHXPqYC69fanINDoRkKmMl6oY9qltqdkC6UfM/edit#gid=741038946
-lkup <- read_sheet('1jYbODoAHXPqYC69fanINDoRkKmMl6oY9qltqdkC6UfM')
-
-# GRPA manually assigned lookup table
-# https://docs.google.com/spreadsheets/d/1bZtu4P1ji4pdSRcAnWSksHl1AJ-b3pFqxXedSdSHwBY/edit#gid=0
-lkupmanual <- read_sheet('1bZtu4P1ji4pdSRcAnWSksHl1AJ-b3pFqxXedSdSHwBY') %>% 
-  select(`View Detail`, `HMPU habitat 1`)
-
-# create input for table function
-rstdat2 <- rstdat2 %>% 
-  left_join(lkup, by = c('Habitat Type', 'Restoration Technique')) %>% 
-  left_join(lkupmanual, by = 'View Detail') %>% 
-  unite('HMPU habitat 1', `HMPU habitat 1.x`, `HMPU habitat 1.y`, na.rm = T)
-
-rstdatall <- bind_rows(rstdat, rstdat2) %>% 
-  select(
-    Year = `Federal Fiscal Year`, 
-    Category = `HMPU habitat 1`, 
-    Acres, 
-    Activity = `Activity Name`, 
-    `Linear Miles` = `Miles`,
-    `Linear Ft` = `Feet`
-  ) %>% 
-  rowwise() %>% 
+    Year = Federal_Fiscal_Year,
+    Category = PrimaryHabitat,
+    Activity = GeneralActivity,
+    Acres,
+    Miles,
+    Feet
+  ) %>%
+  filter(Category != 'Other') %>%
   mutate(
-    Miles = sum(`Linear Miles`,  `Linear Ft` / 5280, na.rm = T),
-    Activity = case_when(
-      Activity %in% c('Establishment', 'Reestablishment', 'Restoration') ~ 'Restoration', 
-      Activity %in% c('Enhancement', 'Maintenance', 'Protection', 'Rehabilitation') ~ 'Enhancement'
+    Category = case_when(
+      Category == 'Living shorelines' ~ 'Living Shorelines',
+      T ~ Category 
     ), 
-    Category = ifelse(Category == '', NA, Category)
+    Acres = gsub('Enhancement', '', Acres), 
+    Acres = as.numeric(Acres),
+    Miles = case_when(
+      is.na(Miles) & !is.na(Feet) ~ Feet / 5280,
+      T ~ Miles
+    ),
+    Category = ifelse(Category == '', NA, Category),
+    Activity = ifelse(Activity == '', NA, Activity)
   ) %>% 
-  ungroup() %>% 
   select(Year, Category, Activity, Acres, Miles)
 
 save(rstdatall, file = here('data/rstdatall.RData'))

R/figs.R

@@ -15,6 +15,8 @@ fml <- "roboto"
 
 source(here('R/funcs.R'))
 
+cur <- 2023
+
 # cumulative effort ---------------------------------------------------------------------------
 
 # data prep
@@ -330,11 +332,8 @@ rstsum <- rstdatall %>%
     allmiles = sum(Miles)
   ) 
 
-
-cols <- qualitative_hcl(length(unique(tnanndat$SOURCE)), palette = "Dynamic")
-
 toplo <- rstsum %>% 
-  filter(Year >= 2020) %>% 
+  filter(Year >= (cur - 2)) %>% 
   mutate(
     allacres2 = formatC(round(allacres, 1), format= "f", big.mark = ",", digits = 1), 
     allmiles2 = formatC(round(allmiles, 1), format= "f", big.mark = ",", digits = 1)
@@ -394,10 +393,10 @@ png(here('docs/figs/milespie.png'), height = 4, width = 7, family = 'serif', uni
 print(p)
 dev.off()
 
-# 2022 only -----------------------------------------------------------------------------------
+# cur only ------------------------------------------------------------------------------------
 
 toplo <- rstsum %>% 
-  filter(Year == 2022) %>% 
+  filter(Year == cur) %>% 
   mutate(
     Category = reorder(Category, tot),
     acreslab = formatC(round(Acres, 1), big.mark = ",", format = 'f', digits = 1), 
@@ -456,7 +455,7 @@ p3 <- ggplot(toplo, aes(x = Miles, y = Category, fill = Category)) +
 p <- p1 + p2 + p3 + plot_layout(ncol = 3)
 
 
-png(here('docs/figs/bar2022.png'), height = 5, width = 8, family = 'serif', units = 'in', res = 500)
+png(here('docs/figs/barcur.png'), height = 5, width = 8, family = 'serif', units = 'in', res = 500)
 print(p)
 dev.off()
 

R/funcs.R

@@ -10,10 +10,11 @@ rstdat_tab <- function(dat, yrrng, fntsz = 14, family){
     sort() %>% 
     c(., 'Mix/undocumented') %>% 
     tibble(Category = . )
-  
+
   # data prep
   rstsum <- dat %>% 
     filter(Year <= yrrng[2] & Year >= yrrng[1]) %>% 
+    filter(!is.na(Activity)) %>% 
     group_by(Category, Activity) %>% 
     summarise(
       tot= n(),
@@ -28,7 +29,10 @@ rstdat_tab <- function(dat, yrrng, fntsz = 14, family){
     ungroup() %>% 
     pivot_longer(c('Acres', 'Miles'), names_to = 'var', values_to = 'val') %>% 
     unite('var', Activity, var, sep = ', ') %>% 
-    pivot_wider(names_from = 'var', values_from = 'val', values_fill = 0) %>% 
+    mutate(
+      var = factor(var, levels = c('Restoration, Acres', 'Restoration, Miles', 'Enhancement, Acres', 'Enhancement, Miles'))
+    ) %>% 
+    pivot_wider(names_from = 'var', values_from = 'val', values_fill = 0, names_expand = T) %>% 
     select(Category, tot, `Restoration, Acres`, `Restoration, Miles`, `Enhancement, Acres`, `Enhancement, Miles`) %>% 
     mutate(
       Category = ifelse(is.na(Category), 'Mix/undocumented', Category)

R/tabs.R

@@ -15,17 +15,18 @@ source(here('R/funcs.R'))
 
 load(file = here('data/rstdatall.RData'))
 
+cur <- 2023
+
 # HMPU compiled table -------------------------------------------------------------------------
 
 # all years
-taball <- rstdat_tab(rstdatall, yrrng = c(2006, 2022), family = fml)
+taball <- rstdat_tab(rstdatall, yrrng = c(2006, cur), family = fml)
 
-# 2022
-tab2022 <- rstdat_tab(rstdatall, yrrng = 2022, family = fml)
+# current year
+tabcur <- rstdat_tab(rstdatall, yrrng = cur, family = fml)
 
 save(taball, file = here('tabs/taball.RData'))
-save(tab2022, file = here('tabs/tab2022.RData'))
-
+save(tabcur, file = here('tabs/tabcur.RData'))
 
 # hmpu targets/goals tables by subtidal, not subtidal -----------------------------------------