knitr::opts_chunk$set(echo = FALSE) options(knitr.kable.NA = '')
library(tidyverse) library(kableExtra) filepath <- "D:/NETN/Monitoring_Projects/Freshwater_Wetland/EPA_NWCA/2016_Data/2021_release/ACAD_only/" ACAD_codes <- c("DUCK", "WMTN", "BIGH", "GILM", "LIHU", "NEMI", "GRME", "HEBR", "HODG", "FRAZ") ACAD_sites <- c("Duck Pond Peatland", "Western Mountain Swamp", "Big Heath", "Gilmore Meadow", "Little Hunter Brook", "New Mills Meadow - NW", "Great Meadow (IAH)", "Heath Brook", "Hodgdon Swamp", "Frazer Fen") NWCA_codes <- c("NWCA16-R301", "NWCA16-R302", "NWCA16-R303", "NWCA16-R304", "NWCA16-R305", "NWCA16-R306", "NWCA16-R307", "NWCA16-R308", "NWCA16-R309", "NWCA16-R310") # Import ACAD Veg data from 2016 NWCA acad_veg <- read.csv(paste0(filepath, "DRAFT_NWCA2016_PlantSpeciesCoverHeight_20200416_ACAD.csv")) %>% select(UID, SITE_ID, Local_Name, PLOT, SPECIES, COVER, HEIGHT, NE, SW) acad_veg$COVER <- ifelse(acad_veg$COVER < 0.1, NA_real_, acad_veg$COVER) acad_p1 <- acad_veg %>% filter(PLOT == 1) %>% rename(P1_COV = COVER, P1_HT = HEIGHT, P1_NE = NE, P1_SW = SW) %>% select(-PLOT) acad_p2 <- acad_veg %>% filter(PLOT == 2) %>% rename(P2_COV = COVER, P2_HT = HEIGHT, P2_NE = NE, P2_SW = SW) %>% select(-PLOT) acad_p3 <- acad_veg %>% filter(PLOT == 3) %>% rename(P3_COV = COVER, P3_HT = HEIGHT, P3_NE = NE, P3_SW = SW) %>% select(-PLOT) acad_p4 <- acad_veg %>% filter(PLOT == 4) %>% rename(P4_COV = COVER, P4_HT = HEIGHT, P4_NE = NE, P4_SW = SW) %>% select(-PLOT) acad_p5 <- acad_veg %>% filter(PLOT == 5) %>% rename(P5_COV = COVER, P5_HT = HEIGHT, P5_NE = NE, P5_SW = SW) %>% select(-PLOT) acad_veg_wide <- Reduce(function(x,y) merge(x, y, all = TRUE, by = c("UID", "SITE_ID", "Local_Name", "SPECIES")), list(acad_p1, acad_p2, acad_p3, acad_p4, acad_p5)) %>% select(-UID) acad_veg_wide$SPECIES <- paste0(substr(acad_veg_wide$SPECIES, 1, 1), tolower(substr(acad_veg_wide$SPECIES, 2, nchar(acad_veg_wide$SPECIES)))) make_spp_kable <- function(site){ kable(acad_veg_wide %>% filter(Local_Name == site) %>% select(-SITE_ID, -Local_Name), col.names = c("Species", rep(c("% Cov.", "HT", "NE", "SW"), 5)), format = 'html', align = 'c') %>% add_header_above(c("", "Plot 1" = 4, "Plot 2" = 4, "Plot 3" = 4, "Plot 4" = 4, "Plot 5" = 4), extra_css = "border-bottom: 1px solid #000000; border-right: 3px solid #ffffff") %>% kable_styling(fixed_thead = TRUE, bootstrap_options = c('condensed'), full_width = TRUE, position = 'left', font_size = 12) %>% row_spec(0, extra_css = "border-bottom: 1px solid #000000;") %>% column_spec(c(1, 2, 6, 10, 14, 18), extra_css = "border-left: 1px solid #000000;") %>% column_spec(21, extra_css = "border-right: 1px solid #000000;") %>% row_spec(nrow(acad_veg_wide %>% filter(Local_Name == site)), extra_css = "border-bottom: 1px solid #000000;") }
for(i in seq_along(ACAD_codes)){ site = ACAD_codes[i] site_name = ACAD_sites[i] NWCA_code = NWCA_codes[i] cat("#### ", site, "\n") cat('<h4>', site_name, ": ", NWCA_code, '</h4>', "\n") print(make_spp_kable(ACAD_codes[i])) cat("\n") }
cov_cols <- c("P1_COV", "P2_COV", "P3_COV", "P4_COV", "P5_COV") acad_veg_wide[, cov_cols][is.na(acad_veg_wide[, cov_cols])] <- 0 acad_veg_wide[, cov_cols][acad_veg_wide[, cov_cols]>0] <- 1 full_spp <- acad_veg_wide %>% select(SITE_ID, Local_Name, SPECIES, all_of(cov_cols)) full_spp$Num_Plots <- rowSums(full_spp[,cov_cols]) full_spp$SITE <- substr(full_spp$SITE_ID, 8, 11) full_spp_wide <- full_spp %>% select(SITE, SPECIES, Num_Plots) %>% arrange(SITE, SPECIES) %>% pivot_wider(names_from = SITE, values_from = Num_Plots) %>% arrange(SPECIES) #write.csv(full_spp_wide, "Species_list_by_site.csv", row.names = F) spp_table <- kable(full_spp_wide, format = "html", align = c('l',rep('c', 10))) %>% add_header_above(c("", "DUCK", "WMTN", "BIGH", "GILM", "LIHU", "NEMI", "GRME", "HEBR", "HODG", "FRAZ")) %>% kable_styling(fixed_thead = TRUE, bootstrap_options = c('condensed'), full_width = FALSE, position = 'left', font_size = 12) %>% column_spec(c(1,11), extra_css = "border-right: 2px solid #000000;") %>% column_spec(1, extra_css = "border-left: 2px solid #000000;") %>% column_spec(2:10, extra_css = 'border-right: 1px solid #000000;') %>% row_spec(0, extra_css = "border-bottom: 1px solid #000000;") %>% row_spec(nrow(full_spp_wide), extra_css = "border-bottom: 1px solid #000000;")
spp_table
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.