Skip to contents

annual reporting

Source: vignettes/annual-reporting.Rmd
annual-reporting.Rmd
library(middlesnake)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(sf)
#> Linking to GEOS 3.12.2, GDAL 3.9.3, PROJ 9.4.1; sf_use_s2() is TRUE

Source File NRCS data

Provided via email from WA Conservation Commission
20040101-20240430 NRCS Practices_edited_v3.xlsx

Duplicated records were removed using middlesnake::clean_nrcs_data()

Source File CPDES

Provided via email from Columbia CD
ColumbiaProjectsReport.xlsx Duplicated records were removed using middlesnake::clean_bmp_data()

add HUC12 watersheds to CPDS 


# Load Columbia HUC12 Shapefile
columbia_huc_12 <- st_read("../../../Documents/all_columbia_huc_12s.shp")


clean_bmps_sf <- st_as_sf(
    clean_bmps,
    coords = c("longitude", "latitude"),
    crs = 4326,
    remove = FALSE
)

pts_huc12 <- st_join(
   clean_bmps_sf,
    columbia_huc_12,
    join = st_within,
    left = TRUE
)

Load Data 


# load cleaned NRCS
clean_nrcs <- data.table::fread("../../../Downloads/clean_nrcs_practices.csv") %>%
    mutate(timepoint=case_when(
        applied_year %in% 2011:2020 ~"2011-2020",
        applied_year %in% 2021:2025 ~"2021-2025",
        TRUE ~ NA_character_)
    )

# load cleaned CPDS
clean_bmps <- data.table::fread("../../../Downloads/clean_bmps_sf_with_huc.csv")%>%
    mutate(date=lubridate::mdy(completion_date),
        year = year(date),
        timepoint=case_when(
        year %in% 2011:2020 ~"2011-2020",
        year %in% 2021:2025 ~"2021-2025",
        TRUE ~ NA_character_
        ))
    

# load reporting codes
reporting_codes <- data.table::fread("../../../Downloads/reporting_codes_2025_12_20.csv") %>%
  arrange(Code) %>%
  distinct( Name, Code,Acres)

NRCS by program 


nrcs_by_program <- 
reporting_codes %>%
    distinct(Code) %>%
    purrr::map_dfr(~ clean_nrcs %>%
                   filter(!is.na(timepoint),
                          practice_code %in% c(.x)
                          ) %>%
                   group_by(timepoint,program,
                            practice_code,practice_name,
                            measurement_unit) %>%
                   summarise(
                   n=n(),
                   min=min(applied_year),
                   max=max(applied_year),
                   sum_applied_amount=sum(applied_amount),
                   sum_land_unit_acres=sum(land_unit_acres)) %>%
                   arrange(practice_code)
               ) 
data.table::fwrite(nrcs_by_program ,file = "../../../Downloads/nrcs_by_program.csv")
nrcs_total  <- 
reporting_codes %>%
    distinct(Code) %>%
    purrr::map_dfr(~ clean_nrcs %>%
                   filter(!is.na(timepoint),
                          practice_code %in% c(.x)
                          ) %>%
                   group_by(timepoint,practice_code,practice_name) %>%
                   summarise(
                   n=n(),
                   min=min(applied_year),
                   max=max(applied_year),
                   sum_applied_amount=sum(applied_amount),
                   sum_land_unit_acres=sum(land_unit_acres)) %>%
                   arrange(practice_code)
               )

# data.table::fwrite(nrcs_total,file = "../../../Downloads/nrcs_total.csv")

CSP 


pest_management <- clean_nrcs %>%
    filter(program=="CStwP", str_detect(practice_name,"Pest")) %>%
    distinct(land_unit_id,practice_code,applied_amount,.keep_all = TRUE) %>%
    group_by(program, practice_name,practice_code) %>%
    summarise(sum=sum(applied_amount)) %>%
    arrange(practice_code) %>%
    data.frame()
pest_management_csp <- pest_management %>%
  filter(program=="CStwP")

CPDS BMPs 


clean_bmps %>%
cnt(program,program_type) %>%
data.frame()

CPDS Access Control (472) 


cdps_totals <-reporting_codes %>%
    distinct(Code) %>%
    purrr::map_dfr(~ clean_bmps %>%
                       filter(!is.na(timepoint),
                              value >0, 
                              nrcs_code %in% c(.x)
                       ) %>%
                       group_by(timepoint,nrcs_code,measurement,units,bmp_name) %>%
                       summarise(sum=sum(value))%>%
                       arrange(nrcs_code)
                   )

data.table::fwrite(cdps_totals,file = "../../../Downloads/cdps_totals.csv")


cdps_program <- reporting_codes %>%
    distinct(Code) %>%
    purrr::map_dfr(~ clean_bmps %>%
                       filter(!is.na(timepoint),
                              value >0, 
                              nrcs_code %in% c(.x)
                       ) %>%
                       group_by(timepoint,nrcs_code,measurement,
                                units,bmp_name,program,program_type) %>%
                       summarise(sum=sum(value))%>%
                       arrange(nrcs_code)
                   )

data.table::fwrite(cdps_program,file = "../../../Downloads/cdps_program.csv")




clean_bmps %>% 
    mutate(date=lubridate::mdy(completion_date),
           year = year(date))%>%
    filter(nrcs_code %in% 472) %>%
    group_by(units) %>%
   summarise(sum=sum(value))



clean_bmps_cpds <- clean_bmps %>% 
    mutate(date=lubridate::mdy(completion_date),
           year = year(date)) %>%
    filter(nrcs_code %in% 590) %>%
    mutate(timepoint=case_when(
        year %in% 2011:2020 ~"2011-2020",
        year %in% 2021:2025 ~"2021-2025",
        TRUE ~ NA_character_)
        )
nrcs_to_report_on <- clean_nrcs %>%
    filter(practice_code %in% reporting_codes$Code) %>%
    dmcognigen::cnt(practice_code,practice_name)

sessionInfo()
#> R version 4.4.2 (2024-10-31 ucrt)
#> Platform: x86_64-w64-mingw32/x64
#> Running under: Windows 10 x64 (build 19045)
#> 
#> Matrix products: default
#> 
#> 
#> locale:
#> [1] LC_COLLATE=English_United States.utf8 
#> [2] LC_CTYPE=English_United States.utf8   
#> [3] LC_MONETARY=English_United States.utf8
#> [4] LC_NUMERIC=C                          
#> [5] LC_TIME=English_United States.utf8    
#> 
#> time zone: America/Los_Angeles
#> tzcode source: internal
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] sf_1.0-19              dplyr_1.1.4            middlesnake_0.0.0.9000
#> 
#> loaded via a namespace (and not attached):
#>  [1] jsonlite_2.0.0     compiler_4.4.2     tidyselect_1.2.1   Rcpp_1.1.0        
#>  [5] stringr_1.5.1      snakecase_0.11.1   jquerylib_0.1.4    systemfonts_1.1.0 
#>  [9] textshaping_0.4.0  readxl_1.4.3       yaml_2.3.10        fastmap_1.2.0     
#> [13] R6_2.6.1           generics_0.1.3     classInt_0.4-10    knitr_1.50        
#> [17] htmlwidgets_1.6.4  tibble_3.3.0       janitor_2.2.1      desc_1.4.3        
#> [21] units_0.8-5        lubridate_1.9.4    DBI_1.2.3          bslib_0.9.0       
#> [25] pillar_1.11.1      rlang_1.1.4        stringi_1.8.4      cachem_1.1.0      
#> [29] xfun_0.51          fs_1.6.5           sass_0.4.9         timechange_0.3.0  
#> [33] cli_3.6.4          pkgdown_2.1.1      magrittr_2.0.4     class_7.3-22      
#> [37] digest_0.6.37      grid_4.4.2         rstudioapi_0.17.1  lifecycle_1.0.4   
#> [41] vctrs_0.6.5        KernSmooth_2.23-24 proxy_0.4-27       evaluate_1.0.3    
#> [45] glue_1.8.0         cellranger_1.1.0   ragg_1.3.3         e1071_1.7-16      
#> [49] rmarkdown_2.29     tools_4.4.2        pkgconfig_2.0.3    htmltools_0.5.8.1