Supplemental Materials - EVMP Raw Data Processing
Introduction
This document contains code for combining, cleaning, and exploring raw Elk Vegetation Management Plan (EVMP) data collected through the 2018 sampling season. The code and results are provided as a supplement to the NPS NRR Report “Monitoring of Vegetation Response to Elk Population and Habitat Management in Rocky Mountain National Park - Analysis of Elk Vegetation Management Plan monitoring Data: 2008–2018”. For information on sampling and the broader analysis and interpretation of the results, refer to this report, past analyses, and the original EVMP monitoring plan Linda C. Zeigenfuss and Johnson (2015) Linda C. Zeigenfuss, Johnson, and Wiebe (2011).
##### READ IN CSV FILES EXPORTED FROM EXCEL TABS
## all the csv names and paths as list column
csv.all <- tibble(ffname = fs::dir_ls("data/EVMP_data/csv",glob = "*.csv"))
## purrr to read csv into list column
csv.all.lc <- csv.all %>%
mutate(data = map(ffname,read_csv))#### maps
### The following code extracts out the most recent 'site info' file, creates a sf object for plotting and further spatial analysis. Note this is different than below where a different file ('VEG_SITES_MSTR_DATABASE.xlsx') provided by the park is interrogated. Here, it's the 'site info' tab within the spreadsheet
# site info
# the following interogates the park's "site info" column
sinfo <- csv.all.lc %>%
filter(str_detect(ffname, "z2018 Site Info.csv"))
sinfo.df <- sinfo %>%
pluck(2) %>%
pluck(1)
#### Fix inconsistent labeling of some SITE_ID values
sinfo.df <- sinfo.df %>%
mutate(SITE_ID = case_when(SITE_ID == "WC1" ~ "WC01",
SITE_ID == "WC2" ~ "WC02",
SITE_ID == "WC3" ~ "WC03",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC5" ~ "WC05",
SITE_ID == "WC6" ~ "WC06",
SITE_ID == "WC7" ~ "WC07",
SITE_ID == "WC8" ~ "WC08",
SITE_ID == "WC9" ~ "WC09",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC2" ~ "WNC02",
SITE_ID == "WNC3" ~ "WNC03",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC5" ~ "WNC05",
SITE_ID == "WNC6" ~ "WNC06",
SITE_ID == "WNC7" ~ "WNC07",
SITE_ID == "WNC8" ~ "WNC08",
SITE_ID == "WNC9" ~ "WNC09",
SITE_ID == "WK1" ~ "WK01",
SITE_ID == "WK2" ~ "WK02",
SITE_ID == "WK3" ~ "WK03",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK5" ~ "WK05",
SITE_ID == "WK6" ~ "WK06",
SITE_ID == "WK7" ~ "WK07",
SITE_ID == "WK8" ~ "WK08",
SITE_ID == "WK9" ~ "WK09",
TRUE ~ as.character(SITE_ID))
)# define path to the veg site master file
path.si <- ("data/EVMP_data/VEG_SITES_MSTR_DATABASE.xlsx")
#### Read in the worksheets and create list of df
# each tab is a df in the list object
si.d <- path.si %>%
excel_sheets() %>%
set_names() %>%
map(read_excel, path = path.si) #
## this retrieved ALL of the tabs. Subset the list to get to the desired tabs
site.info.willow <- si.d$'WILLOW SITES MASTER'
site.info.aspen <- si.d$'ASPEN SITES MASTER'
site.info.upland <- si.d$'UPLAND SITES MASTER'
## note: each of the tabs call the UTM coordinate columns something different. For simplicity, I changed them to be consistent in the source file
# and the active master tab.
site.info.active <- si.d$'ACTIVE VEG SITE LOCATION MASTER'
## they don't have the same column names. The following vector is a subset in common
# csel <- c("SITE_ID","UTM_E_NAD83","UTM_N_NAD83","FENCED","VALLEY","UTM_N_NAD83","BURNED")
csel <- c("SITE_ID","UTM_E_NAD83","UTM_N_NAD83","FENCED","BURNED","REMOVED")
site.info.willow <- select(site.info.willow,csel) %>% # all_of(csel)
mutate(pType = "willow")
site.info.aspen <- select(site.info.aspen,csel) %>%
mutate(pType = "aspen")
site.info.upland <- select(site.info.upland,csel) %>%
mutate(pType = "upland")
## remove the "-R" from site id.
site.info.willow <- site.info.willow %>%
mutate(SITE_ID = str_remove(SITE_ID,"-R"))
## combine the aspen, willow, and upland plots
site.info.all <- rbind(site.info.willow, site.info.aspen, site.info.upland)
# join in the range type from site.info.active tab
rtype <- site.info.active %>%
dplyr::select(SITE_ID, WILDERNESS, RANGE_TYPE)
## join in the info
site.info.all <- left_join(site.info.all, rtype, by = "SITE_ID")
#### Change the NA range types fields
site.info.all <- site.info.all %>%
# distinct(RANGE_TYPE)
mutate(RANGE_TYPE = case_when(grepl("WC", SITE_ID) ~ "core winter range",
grepl("WNC", SITE_ID) ~ "non-core winter range",
grepl("AC", SITE_ID) ~ "core winter range",
grepl("ANC", SITE_ID) ~ "non-core winter range",
grepl("UNC", SITE_ID) ~ "non-core winter range",
grepl("UC", SITE_ID) ~ "core winter range",
grepl("K", SITE_ID) ~ "Kawuneeche Valley"
)
) ####################### Clean #########################
#### Remove records with "NA" for coordinates or ones with
#### Any non-NA for the "REMOVE" field
## I discovered further down that WK03-R was retained as it is NA for the 'REMOVED' attribute.
## I'm manually removing
site.info.clean <- site.info.all %>%
dplyr::na_if(.,"NA") %>% # replacing all the text NA with real NA
filter(!is.na(UTM_E_NAD83)) %>% # only keeping points with coordinates
filter(!is.na(UTM_N_NAD83)) %>%
filter(is.na(REMOVED)) %>%
filter(SITE_ID != "WK03-R")
site.info.clean <- site.info.clean %>%
mutate(FENCED = case_when(is.na(FENCED) ~ "N",
TRUE ~ as.character(FENCED)))## lookup of removed plots
lu.removed.plot <- site.info.all %>%
filter(!is.na(REMOVED)) %>%
distinct(SITE_ID) %>%
rename(sid = SITE_ID) %>%
mutate(SITE_ID = str_remove(sid,"-R")) %>%
distinct(SITE_ID)## read in the file with the manually attributed valley type field (this was not fully attributed in the provided data)
## Data attributed visually in ArcGIS.
vt <- st_read("./data/EVMP_derived/site_info_all_sf.shp", quiet = TRUE)
vt <- vt %>%
rename(SITE_ID = SITE_) %>%
rename(VALLEY = VALLE) %>%
as_tibble() %>%
select(SITE_ID, VALLEY)
site.info.clean <- left_join(site.info.clean, vt, by = "SITE_ID")
## recode some of the valley ids
site.info.clean <- site.info.clean %>%
mutate(VALLEY = recode(VALLEY,
'FRE' = "HSP")) %>%
mutate(VALLEY = recode(VALLEY,
'LHP' = "HSP"))
## add more valley info from a lookup table
valley_lu <- read_csv("./data/EVMP_derived/VALLEY_lu.csv")
## join in the valley info
site.info.clean <- left_join(site.info.clean, valley_lu, by = "VALLEY")
# Eliminate all the vague burned categories, collapsing them to a binary burned/not-burned category
site.info.clean <-
site.info.clean %>%
mutate(BURNED = case_when(BURNED == "Unburned" ~ "Unburned",
BURNED == "N Y" ~ "Unburned",
BURNED == "Completely" ~ "Burned",
BURNED == "Moderately" ~ "Burned",
BURNED == "Moderately to Completely" ~ "Burned",
BURNED == "Y" ~ "Burned",
BURNED == "N" ~ "Unburned",
BURNED == "Not burned" ~ "Unburned",
is.na(BURNED) ~ "Unburned",
TRUE ~ BURNED)
) %>%
mutate(FENCED = case_when(FENCED == "Y_but_fence_down_since_2013" ~ "Unfenced",
FENCED == "Y" ~ "Fenced",
FENCED == "N" ~ "Unfenced"))
## note: all "NA" for burned are assumed to be unburned and recoded as such
###
## WK03 missing VALLEY attribute
site.info.clean <- site.info.clean %>%
mutate(VALLEY = case_when(SITE_ID == "WK03" ~ "KV",
TRUE ~ VALLEY)) %>%
mutate(valley_full = case_when(SITE_ID == "WK03" ~ "Kawuneeche Valley",
TRUE ~ valley_full))## write site info to csv
write_csv(site.info.clean, "./data/EVMP_derived/site_info_clean.csv")Site information:
## create some tables
site.info.clean %>%
dplyr::select(-REMOVED) %>%
dplyr::select(1:6) %>%
datatable(caption = "Valid EVMP plots",
rownames = FALSE)## create Site info UTM coord lu
site.id.coords <- site.info.clean %>%
mutate_at(2:3, as.numeric) %>%
select(SITE_ID, UTM_E_NAD83, UTM_N_NAD83) %>%
filter(!is.na(UTM_N_NAD83)) # create a table of vilid plots
gt.siteinfo <- site.info.clean %>%
dplyr::select(-c(REMOVED,WILDERNESS,EastWest,contains("UTM"))) %>%
gt::gt() %>%
tab_header(title = md("**Valid EVMP plots from 'site_info' worksheet**"))#### create SF from coordinates
site.info.clean.sf <- site.info.clean %>%
mutate_at(2:3, as.numeric) %>%
st_as_sf(coords = c("UTM_E_NAD83", "UTM_N_NAD83"), crs = 26913)
## write the site info to shapefile
# st_write(site.info.clean.sf, "./data/EVMP_derived/site_info_clean.shp")Methods and exploratory analyses
Raw data provided by RMNP as various excel workbooks are combined and
cleaned in this code to facilitate exploratory data analyses, quality
assurance, and statistical modeling. Specific issues encountered and
addressed include:
* Inconsistently named/typed factors
* Missing values
* Data values outside of expected range or showing unusual
patterns
Derived data sets are produced and exported for use in statistical
analyses presented in other report appendices.
Study area and sampling design
Excluding plots removed from the data set due to issues like the 2013 flood, their were 241 plots in total. Approximately 49% (n=118) were willow plots, followed in abundance by aspen and upland plots:
site.info.clean.sf %>%
as_tibble() %>%
filter(!is.na(VALLEY)) %>%
tabyl(pType) %>%
rename('Plot type' = pType) %>%
gt::gt() %>%
fmt_percent(
columns = vars(percent),
decimals = 1
) %>%
tab_header(title="Plot counts across range types")| Plot counts across range types | ||
| Plot type | n | percent |
|---|---|---|
| aspen | 75 | 31.1% |
| upland | 48 | 19.9% |
| willow | 118 | 49.0% |
site.info.clean.sf %>%
as_tibble() %>%
tabyl(valley_full) %>%
arrange(-n) %>%
rename('Location' = valley_full) %>%
gt::gt() %>%
fmt_percent(
columns = vars(percent),
decimals = 1
) %>%
tab_header(title="Plot counts across locations", subtitle = "All plot types")| Plot counts across locations | ||
| All plot types | ||
| Location | n | percent |
|---|---|---|
| Moraine Park | 62 | 25.7% |
| Horseshoe Park | 45 | 18.7% |
| Upper Beaver Meadows | 32 | 13.3% |
| Hollowell Park | 21 | 8.7% |
| Kawuneeche Valley | 18 | 7.5% |
| Cow Creek | 15 | 6.2% |
| Hidden Valley | 14 | 5.8% |
| Deer Mountain | 12 | 5.0% |
| EndoValley | 9 | 3.7% |
| Beaver Meadows Entrance | 5 | 2.1% |
| Glacier Basin | 3 | 1.2% |
| Emerald Mountain | 2 | 0.8% |
| Roaring River | 2 | 0.8% |
| Black Canyon Creek | 1 | 0.4% |
site.info.clean.sf %>%
as_tibble() %>%
filter(!is.na(VALLEY)) %>%
tabyl(valley_full, pType) %>%
rename('Location' = valley_full) %>%
arrange(-willow) %>%
gt::gt() %>%
tab_header(title="Plot counts across locations", subtitle = "Separated by plot type")| Plot counts across locations | |||
| Separated by plot type | |||
| Location | aspen | upland | willow |
|---|---|---|---|
| Moraine Park | 17 | 5 | 40 |
| Horseshoe Park | 26 | 3 | 16 |
| Upper Beaver Meadows | 7 | 12 | 13 |
| Hidden Valley | 2 | 0 | 12 |
| Hollowell Park | 3 | 6 | 12 |
| Kawuneeche Valley | 8 | 0 | 10 |
| Cow Creek | 2 | 5 | 8 |
| EndoValley | 3 | 1 | 5 |
| Glacier Basin | 0 | 1 | 2 |
| Beaver Meadows Entrance | 1 | 4 | 0 |
| Black Canyon Creek | 0 | 1 | 0 |
| Deer Mountain | 5 | 7 | 0 |
| Emerald Mountain | 0 | 2 | 0 |
| Roaring River | 1 | 1 | 0 |
#### Map of fenced and unfenced areas - all plots
# Change basemap or pan and zoom.
# mapviewOptions(basemaps = c("Esri.WorldImagery"), # Esri.WorldShadedRelief "Esri.WorldImagery"
# vector.palette = colorRampPalette(c("snow", "cornflowerblue", "grey10")),
# na.color = "magenta",
# layers.control.pos = "topright")
site.info.clean.sf %>%
mapview(zcol='FENCED')site.info.clean.sf %>%
as_tibble() %>%
filter(!is.na(VALLEY)) %>%
tabyl(FENCED) %>%
gt::gt() %>%
fmt_percent(
columns = vars(percent),
decimals = 1
)| FENCED | n | percent |
|---|---|---|
| Fenced | 51 | 21.2% |
| Unfenced | 190 | 78.8% |
# Approximately 21% of plots occur in fenced locations# A total of 17 plots occur in the Kawuneeche Valley:
site.info.clean.sf %>%
as_tibble() %>%
filter(VALLEY == "KV") %>%
select(-c(geometry, REMOVED, EastWest, WILDERNESS, RANGE_TYPE)) %>%
rename('Valley code' = VALLEY) %>%
rename('Valley name' = valley_full) %>%
gt::gt() %>%
tab_header(title = "Kawuneeche Valley Plots")| Kawuneeche Valley Plots | |||||
| SITE_ID | FENCED | BURNED | pType | Valley code | Valley name |
|---|---|---|---|---|---|
| WK01 | Fenced | Unburned | willow | KV | Kawuneeche Valley |
| WK02 | Fenced | Unburned | willow | KV | Kawuneeche Valley |
| WK03 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK04 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK05 | Fenced | Unburned | willow | KV | Kawuneeche Valley |
| WK06 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK07 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK08 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK09 | Unfenced | Unburned | willow | KV | Kawuneeche Valley |
| WK10 | Fenced | Unburned | willow | KV | Kawuneeche Valley |
| AK01 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK02 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK03 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK04 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK05 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK06 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK07 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
| AK08 | Unfenced | Unburned | aspen | KV | Kawuneeche Valley |
site.info.clean.sf %>%
group_by(valley_full, pType) %>%
tally() %>%
ggplot(aes(reorder(valley_full, n),n)) +
geom_pointrange(ymin=0, aes(ymax=n)) +
geom_point(color="ivory3", size = 6) +
geom_point(color="white", size = 4) +
geom_text(aes(label=n), size=3) +
theme_minimal() +
coord_flip() +
facet_wrap(~pType) +
labs(x="Valley", y = "Count", title = "Count of EVMP sampling sites by location")
# ggsave("./output/figures_202108/rev_plotcnt_pTypeXvalley.png", width = 7, height = 3.75)### Counts of plots in fenced and unfenced contexts
## plot the count of plots by valley and fenced status
pl.hm1 <- site.info.clean.sf %>%
as_tibble() %>%
distinct() %>%
filter(!is.na(FENCED)) %>%
group_by(FENCED,valley_full, pType) %>%
tally() %>%
ungroup() %>%
ggplot(aes(FENCED, valley_full)) +
geom_tile(aes(fill = n), color= 'white') +
# geom_text(aes(label=n), size=4, color = 'white') +
# geom_text(aes(label=n), size=4, color = 'black', alpha=.75) +
theme_minimal() +
scale_fill_gradientn(colours = colfunc2(5)) +
# scale_fill_viridis() +
facet_wrap(~pType) +
labs(x="", y = "", title = "Count of EVMP sampling sites")
ggsave(plot = pl.hm1, filename = "./output/figures_202108/cnt_plot_valley_x_fenced.png", width = 7, height = 5, dpi = 300)
pl.hm1
# pl.hm2
# paneled version of above
# cowplot::plot_grid(pl.hm1, pl.hm2, labels = "AUTO", ncol=1,rel_heights = c(2,1))
# ggsave(plot = cow1, filename = "./output/figures_202108/cnt_ptype_valle_x_fenced.png", width = 5, height = 4, dpi = 300)# Raw data files entered by RMNP staff from field data forms were processed using functions in in the R statistical package. Raw data were provided as 4 Excel files, with data split by year and type into various tabs. Data were consolidated and to facilitate cleaning and comparisons.
### Data cleaning and wrangling
## base R approach
file.listing <- list.files(path = "./data/EVMP_data/TenYearReview") %>%
enframe() %>%
select(value) %>%
rename(fileName = value)
# create a table
file.listing %>%
rename('Raw File Name' = fileName) %>%
gt() %>%
tab_header(title = "List of Raw Files")| List of Raw Files |
| Raw File Name |
|---|
| Aspen_Data_Baseline_through_2018.xlsx |
| Upland_Line_Intercept_2007_2013_2018.xlsx |
| VEG_SITES_MSTR_DATABASE.csv |
| Willow_Cumulative_Data_Baseline_Through_2018.xlsx |
| Willow_Offtake_Data_2009_Through_2018.xlsx |
### Willow cumulative data baseline through 2018
#### There are two duplicate sets of files, one with a 'z' in the name, one without, but otherwise the same. In this chunk, picking one set (the zed set)
csv.all.lc <- csv.all.lc %>%
filter(str_detect(ffname, "z")) ######### CREATE TYPE FIELD #########
## this will make parsing variables in into groups easier
csv.all.lc <- csv.all.lc %>%
mutate(file_name_abr = str_replace(string = ffname, pattern = "data/EVMP_data/csv/Willow_Cumulative_Data_Baseline_Through_2018-", replacement = ""))
## case when into type
csv.all.lc <- csv.all.lc %>%
dplyr::select(-ffname) %>%
mutate(vType = case_when(grepl("Macro", file_name_abr) ~ "Macroplot",
grepl("site", file_name_abr, ignore.case = TRUE) ~ "Site_info",
grepl("Key", file_name_abr, ignore.case = TRUE) ~ "Key",
grepl("Line", file_name_abr, ignore.case = TRUE) ~ "Line_int"
)
)## Variable names across input files
# extract the field names from each csv
csv.all.lc <- csv.all.lc %>%
mutate(field_names = map(data, names))
# unnest to get at field names
# across all csv files
csv.all.lc %>%
unnest(field_names) %>%
distinct(file_name_abr,field_names) %>%
datatable(rownames = FALSE, caption = "Distinct field names acrosss all csv files correponding to tabs in master workbooks provided by RMNP.")#### Line intercept
csv.all.lc.li <- csv.all.lc %>%
filter(vType == "Line_int") #### Select multiple columns. To combine, need the same fields to be present in each tab.
filtFunSel <- function(x){
x %>% dplyr::select(c(DATE,
SITE_TYPE,
SITE_NUMBER,
SITE_ID,
SPECIES_CODE,
MAX_HEIGHT_CM,
BROWSED,
INTERCEPT_LENGTH_M,
GENUS))
}
### the above is used throughout below
# but now I want to grab the shrub intercept bits
filtFunSel_li <- function(x){
x %>% dplyr::select(c(DATE,
SITE_TYPE,
SITE_NUMBER,
SITE_ID,
SPECIES_CODE,
SHRUB_INTERCEPT_START_M,
SHRUB_INTERCEPT_STOP_M,
MAX_HEIGHT_CM,
DEAD,
BROWSED,
INTERCEPT_LENGTH_M,
GENUS))
}
# create new list column with the selected rows as specified in the function
csv.all.lc.li <- csv.all.lc.li %>%
mutate(data.sel = map(.x = data, filtFunSel))
## purrr extract
csv.all.lc.li.df <- csv.all.lc.li %>%
pluck(1) %>%
map(filtFunSel) %>%
reduce(.f = rbind)
# SITE_ID columns are NOT CONSISTENTLY NAMED
# eg WC1 and WC01
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(SITE_ID = case_when(SITE_ID == "WC1" ~ "WC01",
SITE_ID == "WC2" ~ "WC02",
SITE_ID == "WC3" ~ "WC03",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC5" ~ "WC05",
SITE_ID == "WC6" ~ "WC06",
SITE_ID == "WC7" ~ "WC07",
SITE_ID == "WC8" ~ "WC08",
SITE_ID == "WC9" ~ "WC09",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC2" ~ "WNC02",
SITE_ID == "WNC3" ~ "WNC03",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC5" ~ "WNC05",
SITE_ID == "WNC6" ~ "WNC06",
SITE_ID == "WNC7" ~ "WNC07",
SITE_ID == "WNC8" ~ "WNC08",
SITE_ID == "WNC9" ~ "WNC09",
SITE_ID == "WK1" ~ "WK01",
SITE_ID == "WK2" ~ "WK02",
SITE_ID == "WK3" ~ "WK03",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK5" ~ "WK05",
SITE_ID == "WK6" ~ "WK06",
SITE_ID == "WK7" ~ "WK07",
SITE_ID == "WK8" ~ "WK08",
SITE_ID == "WK9" ~ "WK09",
TRUE ~ as.character(SITE_ID))
)
## join in additional site info from the master plot list
csv.all.lc.li.df <- left_join(csv.all.lc.li.df, site.info.clean, by = 'SITE_ID')## add fields/convert types
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(DATE = as.Date(DATE)) %>%
mutate(yr = as.factor(year(DATE))) %>%
mutate(mo = month(DATE))
## convert "NA" for fencing to "Unfenced"
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(FENCED = case_when(is.na(FENCED) ~ "Unfenced",
TRUE ~ as.character(FENCED)))
## create timeClass field with BL including 2008 and 2009
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(timeClass = case_when(yr == 2008 ~ "BL",
yr == 2009 ~ "BL",
TRUE ~ as.character(yr))) %>%
mutate(timeClass = as.factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "2018", "2013", "BL"))## Create a spatial lookup table for joining site info [in workbook tab].
sp.lu <- sinfo.df %>%
dplyr::select(-c(SITE_TYPE,DATE,SITE_NUMBER, GPS_ACCURACY_M))
## make sure the 'SITE_ID' columns are consistent. This is a recurring issue.
sp.lu <- sp.lu %>%
mutate(SITE_ID = case_when(
SITE_ID == "WC1" ~ "WC01",
SITE_ID == "WC2" ~ "WC02",
SITE_ID == "WC3" ~ "WC03",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC5" ~ "WC05",
SITE_ID == "WC6" ~ "WC06",
SITE_ID == "WC7" ~ "WC07",
SITE_ID == "WC8" ~ "WC08",
SITE_ID == "WC9" ~ "WC09",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC2" ~ "WNC02",
SITE_ID == "WNC3" ~ "WNC03",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC5" ~ "WNC05",
SITE_ID == "WNC6" ~ "WNC06",
SITE_ID == "WNC7" ~ "WNC07",
SITE_ID == "WNC8" ~ "WNC08",
SITE_ID == "WNC9" ~ "WNC09",
SITE_ID == "WK1" ~ "WK01",
SITE_ID == "WK2" ~ "WK02",
SITE_ID == "WK3" ~ "WK03",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK5" ~ "WK05",
SITE_ID == "WK6" ~ "WK06",
SITE_ID == "WK7" ~ "WK07",
SITE_ID == "WK8" ~ "WK08",
SITE_ID == "WK9" ~ "WK09",
TRUE ~ as.character(SITE_ID))
)#### Macroplot
csv.all.lc.mcro <- csv.all.lc %>%
filter(vType == "Macroplot") ## extract the macroplot data
FunSelMacro <- function(x){
x %>% dplyr::select(c(DATE,
SITE_TYPE,
SITE_NUMBER,
SITE_ID,
SPECIES_CODE,
PERCENT_PLANT_IN_PLOT,
CANOPY_DIA_1_CM,
CANOPY_DIA_2_CM,
PLANT_HT_CM,
HT_TO_TALLEST_BUDSCAR_CM))
}
csv.all.lc.mcro <- csv.all.lc.mcro %>%
mutate(data.sel = map(.x = data, FunSelMacro))
## purrr extract
csv.all.lc.mcro.df <- csv.all.lc.mcro %>%
pluck(1) %>%
map(FunSelMacro) %>%
reduce(.f = rbind)
# SITE_ID is not consistent.
# recode
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(SITE_ID = case_when(SITE_ID == "WC1" ~ "WC01",
SITE_ID == "WC2" ~ "WC02",
SITE_ID == "WC3" ~ "WC03",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC4" ~ "WC04",
SITE_ID == "WC5" ~ "WC05",
SITE_ID == "WC6" ~ "WC06",
SITE_ID == "WC7" ~ "WC07",
SITE_ID == "WC8" ~ "WC08",
SITE_ID == "WC9" ~ "WC09",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC1" ~ "WNC01",
SITE_ID == "WNC2" ~ "WNC02",
SITE_ID == "WNC3" ~ "WNC03",
SITE_ID == "WNC4" ~ "WNC04",
SITE_ID == "WNC5" ~ "WNC05",
SITE_ID == "WNC6" ~ "WNC06",
SITE_ID == "WNC7" ~ "WNC07",
SITE_ID == "WNC8" ~ "WNC08",
SITE_ID == "WNC9" ~ "WNC09",
SITE_ID == "WK1" ~ "WK01",
SITE_ID == "WK2" ~ "WK02",
SITE_ID == "WK3" ~ "WK03",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK5" ~ "WK05",
SITE_ID == "WK6" ~ "WK06",
SITE_ID == "WK7" ~ "WK07",
SITE_ID == "WK8" ~ "WK08",
SITE_ID == "WK9" ~ "WK09",
TRUE ~ as.character(SITE_ID))
)## SITE_TYPE 2008 2009 2013 2015 2016 2017 2018
## WC 726 214 1776 222 387 1108 2872
## WK 0 0 0 0 161 273 341
## WNC 528 0 518 0 0 0 916# fields not in all of the tabs
csv.all.lc.mcro %>%
unnest(field_names) %>%
group_by(field_names) %>%
tally() %>%
arrange(n) %>%
filter(n<6) %>%
datatable(rownames = FALSE, caption = "Macroplot inventory variable NOT present in every year's tab")# Macroplot processing
# use a custom function to select columns before rbinding
# note these are different field names than li that need to be matched
# this function snags only those fields in common between all of the tabs
FunSelMcro <- function(x){
x %>% dplyr::select(c(CANOPY_DIA_1_CM,
CANOPY_DIA_2_CM,
DATE,
GENUS,
HT_TO_TALLEST_BUDSCAR_CM,
PERCENT_PLANT_IN_PLOT,
PLANT_HT_CM,
SITE_ID,
SITE_NUMBER,
SITE_TYPE,
SPECIES_CODE))
}
## apply function to select variables in common between all csv
csv.all.lc.mcro <- csv.all.lc.mcro %>%
mutate(data.sel = map(.x = data, FunSelMcro)) %>%
select(-field_names)
csv.all.lc.mcro <- csv.all.lc.mcro %>%
mutate(field_names = map(data.sel, names))
# csv.all.lc.mcro is a list column format. Unpack the data## combine all using purrr:
# csv.all.lc.mcro.df <- csv.all.lc.mcro %>%
# pluck(4) %>% # note the specific index position
# reduce(.f = rbind) # did this above
## add yr and month columns
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(yr = year(DATE)) %>%
mutate(mo = lubridate::month(DATE))
## join the site info
# csv.all.lc.mcro.df <- left_join(csv.all.lc.mcro.df, site.info.clean, by = "SITE_ID")## more cleaning...
## change case on species code (there is currently a mix of upper and lower cases)
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(SPECIES_CODE = toupper(SPECIES_CODE))
## import species code look up table
spp.lu <- read_csv("./data/EVMP_derived/species_code_lu.csv")
## Problems with 'Fenced' status. Many NA
## Presuming here that all NA are not fenced
## Reclassify 'NA' for fenced to 'N'
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(FENCED = case_when(is.na(FENCED) ~ "N",
TRUE ~ as.character(FENCED))) ### !!!
# Remove plots on the "removed" list in the site info through anti-join
# lu.removed.plot
# csv.all.lc.li.df
# remove all the removed plots identified in the site info tab if raw files
csv.all.lc.mcro.df <- anti_join(csv.all.lc.mcro.df, lu.removed.plot, by="SITE_ID")Willow plots: line intercept data
### Counts of plots in fenced and unfenced contexts
## address missing attributes for pType
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(pType = case_when(is.na(pType) ~ "willow",
TRUE ~ pType))
## address missing attributes for RANGE_TYPE
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(RANGE_TYPE = case_when(is.na(RANGE_TYPE) & SITE_TYPE == "WC" ~ "core winter range",
TRUE ~ RANGE_TYPE))## Make NA unburned; presumes NA are "unburned"
## standardize encoding of BURNED
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(BURNED = case_when(is.na(BURNED) ~ "Unburned",
BURNED == "Not burned" ~ "Unburned",
TRUE ~ BURNED))
## reverse factor levels
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(timeClass = forcats::fct_rev(timeClass))
## Reorder levels
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(SITE_TYPE = as_factor(SITE_TYPE)) %>%
mutate(SITE_TYPE = forcats::fct_relevel(SITE_TYPE, "WK", after = 2))## Address missing RANGE_TYPE attribution
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(RANGE_TYPE = case_when(SITE_TYPE == "WC" ~ "core winter range",
TRUE ~ RANGE_TYPE)) %>%
distinct() %>%
mutate(zCond = case_when(BURNED == "Burned" & FENCED == "Unfenced" ~ "BG",
BURNED == "Burned" & FENCED == "Fenced" ~ "BF",
BURNED == "Unburned" & FENCED == "Unfenced" ~ "UG",
BURNED == "Unburned" & FENCED == "Fenced" ~ "UF"
)) %>%
mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) ## these are the classes used in the weighting scheme in Zeigenfuss 2015# lu.removed.plot
# csv.all.lc.li.df
# remove all the removed plots identified in the site info tab if raw files
csv.all.lc.li.df <- anti_join(csv.all.lc.li.df, lu.removed.plot, by="SITE_ID")write_csv(csv.all.lc.li.df, "./data/EVMP_derived/line_intercept_willow_cleaned.csv")Height: all shrubs
All shrubs, site type
## Boxplot (no wk)
csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill = FENCED), outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,300) +
labs(x="", y= "Height (cm)", title = "Maximum shrub height", caption = "All shrub species line intercept plots", fill="") +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
theme(legend.position = "bottom") +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(~SITE_TYPE)
ggsave("./output/figures_202108/WCWNCWK_LI_shrubHt_boxplot.png", width = 6.5, height = 4.875)#### Table of mean max height
csv.all.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "LI, Mean max height", subtitle = "All shrub species, all site types")| LI, Mean max height | |||||||||
| All shrub species, all site types | |||||||||
| timeClass | SITE_TYPE | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|
| BL | WC | MAX_HEIGHT_CM | 82.7 | 75.5 | 3.0 | 60 | 440 | 129 | 92.8 |
| BL | WNC | MAX_HEIGHT_CM | 166.6 | 128.4 | 25.0 | 120 | 520 | 79 | 92.9 |
| 2013 | WC | MAX_HEIGHT_CM | 95.7 | 95.7 | 15.0 | 60 | 750 | 206 | 95.8 |
| 2013 | WNC | MAX_HEIGHT_CM | 222.2 | 138.8 | 15.0 | 210 | 500 | 95 | 96.0 |
| 2018 | WC | MAX_HEIGHT_CM | 114.0 | 93.3 | 0.7 | 80 | 810 | 391 | 96.5 |
| 2018 | WNC | MAX_HEIGHT_CM | 174.7 | 129.3 | 10.0 | 130 | 610 | 163 | 97.0 |
| 2018 | WK | MAX_HEIGHT_CM | 81.7 | 44.3 | 15.0 | 75 | 250 | 47 | 97.9 |
All shrubs, site type, fenced/unfenced
#### Table of mean max height
csv.all.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE, FENCED) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "LI, Mean max height", subtitle = "All shrubs, all site types, fenced/unfenced")| LI, Mean max height | ||||||||||
| All shrubs, all site types, fenced/unfenced | ||||||||||
| timeClass | SITE_TYPE | FENCED | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | WC | Fenced | MAX_HEIGHT_CM | 66.8 | 31.8 | 5.0 | 65 | 190 | 63 | 94.0 |
| BL | WC | Unfenced | MAX_HEIGHT_CM | 97.9 | 98.8 | 3.0 | 60 | 440 | 66 | 91.7 |
| BL | WNC | Unfenced | MAX_HEIGHT_CM | 166.6 | 128.4 | 25.0 | 120 | 520 | 79 | 92.9 |
| 2013 | WC | Fenced | MAX_HEIGHT_CM | 82.6 | 59.5 | 15.0 | 65 | 300 | 89 | 94.7 |
| 2013 | WC | Unfenced | MAX_HEIGHT_CM | 105.6 | 115.2 | 15.0 | 60 | 750 | 117 | 96.7 |
| 2013 | WNC | Unfenced | MAX_HEIGHT_CM | 222.2 | 138.8 | 15.0 | 210 | 500 | 95 | 96.0 |
| 2018 | WC | Fenced | MAX_HEIGHT_CM | 121.1 | 68.5 | 10.0 | 120 | 290 | 199 | 97.5 |
| 2018 | WC | Unfenced | MAX_HEIGHT_CM | 106.7 | 113.1 | 0.7 | 60 | 810 | 192 | 95.5 |
| 2018 | WNC | Unfenced | MAX_HEIGHT_CM | 174.7 | 129.3 | 10.0 | 130 | 610 | 163 | 97.0 |
| 2018 | WK | Fenced | MAX_HEIGHT_CM | 108.3 | 24.0 | 65.0 | 110 | 155 | 23 | 100.0 |
| 2018 | WK | Unfenced | MAX_HEIGHT_CM | 56.2 | 44.8 | 15.0 | 50 | 250 | 24 | 96.0 |
All shrubs, site type, fenced/unfenced, burned/unburned
## Boxplot
csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill = FENCED), outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,300) +
labs(x="", y= "Height (cm)", title = "Maximum shrub height", caption = "All shrub species line intercept plots", fill="") +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
theme(legend.position = "bottom") +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(BURNED~SITE_TYPE)
ggsave("./output/figures_202108/WCWNC_LI_shrubHt_FenBur_boxplot.png", width = 6.5, height = 4.875)##
# revised
# WC, WNC - All shrub species line intercept plots
plx1 <- csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SITE_TYPE == "WC") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill = FENCED), outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,300) +
labs(x="", y= "Height (cm)", title = "Core Winter Range", fill="") +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
theme(legend.position = "right") +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(~BURNED)
plx2 <- csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SITE_TYPE == "WNC") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(fill = "grey50", outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,300) +
labs(x="", y= "Height (cm)", title = "Noncore Winter Range", caption = "", fill="") +
# scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
# theme(legend.position = "top") +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(~BURNED)
plx3 <- csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SITE_TYPE == "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(fill = "grey50", outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,300) +
labs(x="", y= "Height (cm)", title = "Kawuneeche Valley", caption = "Maximum shrub height, all species", fill="") +
# scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
# theme(legend.position = "top") +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(~BURNED)
# combine
plx1 + plx2 + plx3 +
plot_layout(widths = c(3, 1, 1)) +
plot_annotation(tag_levels = 'A')
# ggsave("./output/figures_202108/Revised_WCWNCWK_LI_shrubHt_FenBur_boxplot.png", width = 8, height = 4.875)Height: willow species only
All willow species, site type
Max shrub height in-line intercept
csv.wil.lc.li.df <- csv.all.lc.li.df %>%
filter(str_detect(SPECIES_CODE, "^SA"))
## Boxplot
csv.wil.lc.li.df %>%
filter(pType == "willow") %>%
# filter(SITE_TYPE == "WC") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
# mutate(yr = as.double(yr)) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill = FENCED), outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,600) +
labs(x="", y= "Height (cm)", title = "Maximum willow height", caption = "WC, All willow species line intercept plots", fill="") +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(~SITE_TYPE)
# ggsave("./output/figures_202108/WCWNCWK_LI_willHt_boxplot.png", width = 6.5, height = 4.875)#### Table of mean max height
csv.wil.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "LI, Mean max height", subtitle = "All willow species, all site types")| LI, Mean max height | |||||||||
| All willow species, all site types | |||||||||
| timeClass | SITE_TYPE | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|
| BL | WC | MAX_HEIGHT_CM | 94.2 | 87.5 | 3 | 70 | 440 | 80 | 96.4 |
| BL | WNC | MAX_HEIGHT_CM | 170.0 | 127.4 | 25 | 120 | 520 | 74 | 100.0 |
| 2013 | WC | MAX_HEIGHT_CM | 127.7 | 97.3 | 25 | 100 | 470 | 105 | 100.0 |
| 2013 | WNC | MAX_HEIGHT_CM | 221.2 | 139.4 | 15 | 215 | 500 | 82 | 100.0 |
| 2018 | WC | MAX_HEIGHT_CM | 141.9 | 79.9 | 20 | 140 | 450 | 227 | 99.6 |
| 2018 | WNC | MAX_HEIGHT_CM | 175.3 | 119.9 | 10 | 135 | 610 | 139 | 100.0 |
| 2018 | WK | MAX_HEIGHT_CM | 83.0 | 35.4 | 30 | 75 | 155 | 41 | 100.0 |
All willow species, site type, fenced/unfenced
#### Table of mean max height
csv.wil.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE, FENCED) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "LI, Mean max height", subtitle = "All willow, all site types, fenced/unfenced")| LI, Mean max height | ||||||||||
| All willow, all site types, fenced/unfenced | ||||||||||
| timeClass | SITE_TYPE | FENCED | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | WC | Fenced | MAX_HEIGHT_CM | 72.7 | 36.0 | 10 | 70.0 | 190 | 38 | 97.4 |
| BL | WC | Unfenced | MAX_HEIGHT_CM | 113.5 | 113.1 | 3 | 60.0 | 440 | 42 | 95.5 |
| BL | WNC | Unfenced | MAX_HEIGHT_CM | 170.0 | 127.4 | 25 | 120.0 | 520 | 74 | 100.0 |
| 2013 | WC | Fenced | MAX_HEIGHT_CM | 109.2 | 62.4 | 25 | 97.5 | 300 | 52 | 100.0 |
| 2013 | WC | Unfenced | MAX_HEIGHT_CM | 145.8 | 120.1 | 30 | 105.0 | 470 | 53 | 100.0 |
| 2013 | WNC | Unfenced | MAX_HEIGHT_CM | 221.2 | 139.4 | 15 | 215.0 | 500 | 82 | 100.0 |
| 2018 | WC | Fenced | MAX_HEIGHT_CM | 151.3 | 59.2 | 30 | 145.0 | 290 | 135 | 99.3 |
| 2018 | WC | Unfenced | MAX_HEIGHT_CM | 128.1 | 101.9 | 20 | 92.5 | 450 | 92 | 100.0 |
| 2018 | WNC | Unfenced | MAX_HEIGHT_CM | 175.3 | 119.9 | 10 | 135.0 | 610 | 139 | 100.0 |
| 2018 | WK | Fenced | MAX_HEIGHT_CM | 108.3 | 24.0 | 65 | 110.0 | 155 | 23 | 100.0 |
| 2018 | WK | Unfenced | MAX_HEIGHT_CM | 50.8 | 15.5 | 30 | 52.5 | 75 | 18 | 100.0 |
All willow species, site type, fenced/unfenced, burned/unburned
## Boxplot
csv.wil.lc.li.df %>%
filter(pType == "willow") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
ggplot(aes(timeClass, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill = FENCED), outlier.shape = NA) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,600) +
labs(x="", y= "Height (cm)", title = "Maximum shrub height", caption = "WC, All willow species line intercept plots", fill="") +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
# theme(axis.text.x=element_text(angle = 45, hjust = 1)) #+
facet_wrap(BURNED~SITE_TYPE)
# ggsave("./output/figures_202108/WCWNCWK_LI_willHt_FenBur_boxplot.png", width = 6.5, height = 4.875)#### Table of mean max height
csv.wil.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE, FENCED, BURNED) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "LI, Mean max height", subtitle = "All willow, all site types, fenced/unfenced, burned/unburned")| LI, Mean max height | |||||||||||
| All willow, all site types, fenced/unfenced, burned/unburned | |||||||||||
| timeClass | SITE_TYPE | FENCED | BURNED | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | WC | Fenced | Burned | MAX_HEIGHT_CM | 46.9 | 31.6 | 10 | 45.0 | 110 | 8 | 100.0 |
| BL | WC | Fenced | Unburned | MAX_HEIGHT_CM | 79.6 | 34.4 | 30 | 70.0 | 190 | 30 | 96.8 |
| BL | WC | Unfenced | Burned | MAX_HEIGHT_CM | 108.2 | 95.1 | 40 | 76.0 | 275 | 5 | 100.0 |
| BL | WC | Unfenced | Unburned | MAX_HEIGHT_CM | 114.3 | 116.4 | 3 | 60.0 | 440 | 37 | 94.9 |
| BL | WNC | Unfenced | Unburned | MAX_HEIGHT_CM | 170.0 | 127.4 | 25 | 120.0 | 520 | 74 | 100.0 |
| 2013 | WC | Fenced | Burned | MAX_HEIGHT_CM | 66.7 | 28.1 | 25 | 60.0 | 110 | 18 | 100.0 |
| 2013 | WC | Fenced | Unburned | MAX_HEIGHT_CM | 131.8 | 64.1 | 40 | 112.5 | 300 | 34 | 100.0 |
| 2013 | WC | Unfenced | Burned | MAX_HEIGHT_CM | 45.0 | 21.2 | 30 | 45.0 | 60 | 2 | 100.0 |
| 2013 | WC | Unfenced | Unburned | MAX_HEIGHT_CM | 149.7 | 120.7 | 30 | 105.0 | 470 | 51 | 100.0 |
| 2013 | WNC | Unfenced | Unburned | MAX_HEIGHT_CM | 221.2 | 139.4 | 15 | 215.0 | 500 | 82 | 100.0 |
| 2018 | WC | Fenced | Burned | MAX_HEIGHT_CM | 134.6 | 37.8 | 50 | 142.5 | 225 | 66 | 100.0 |
| 2018 | WC | Fenced | Unburned | MAX_HEIGHT_CM | 167.2 | 70.8 | 30 | 175.0 | 290 | 69 | 98.6 |
| 2018 | WC | Unfenced | Burned | MAX_HEIGHT_CM | 32.5 | 6.5 | 25 | 32.5 | 40 | 4 | 100.0 |
| 2018 | WC | Unfenced | Unburned | MAX_HEIGHT_CM | 132.4 | 102.1 | 20 | 97.5 | 450 | 88 | 100.0 |
| 2018 | WNC | Unfenced | Unburned | MAX_HEIGHT_CM | 175.3 | 119.9 | 10 | 135.0 | 610 | 139 | 100.0 |
| 2018 | WK | Fenced | Unburned | MAX_HEIGHT_CM | 108.3 | 24.0 | 65 | 110.0 | 155 | 23 | 100.0 |
| 2018 | WK | Unfenced | Unburned | MAX_HEIGHT_CM | 50.8 | 15.5 | 30 | 52.5 | 75 | 18 | 100.0 |
# Shrub Line Intercept Datataset
csv.wil.lc.li.df %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
filter(!is.na(FENCED)) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
# group_by(yr,SITE_TYPE, FENCED, SITE_ID, SPECIES_CODE) %>%
# filter(SITE_TYPE == "WC") %>%
group_by(timeClass,SITE_TYPE, FENCED, SPECIES_CODE) %>%
summarise(mean.max.ht = round(mean(MAX_HEIGHT_CM, na.rm=TRUE),0)) %>%
filter(FENCED != "Y_but_fence_down_since_2013") %>%
filter(SPECIES_CODE != "SAXX") %>%
ggplot(aes(timeClass, SPECIES_CODE)) +
geom_tile(aes(fill=mean.max.ht),color = 'white') +
# scale_fill_viridis(option = "A") +
scale_fill_gradientn(colours = colfunc2(5)) +
geom_text(aes(label=mean.max.ht), color = 'white', size = 3.75) +
geom_text(aes(label=mean.max.ht), color = 'grey', size = 3.75, alpha=0.7) +
theme_minimal() +
labs(title = "Maximum shrub height", subtitle = "Mean of shrub height pooled by fenced status", x = "Year", y = "Species", fill = "cm") +
facet_grid(SITE_TYPE~FENCED)
# ggsave("./output/figures_202108/WCWNCWK_maxWilHt_by_spp_lbl.png", width = 6.5, height = 6.5, dpi = 300)Individual willow species
pl.li.samo.density <- csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE != "WK") %>%
filter(SPECIES_CODE == "SAMO") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR"& SPECIES_CODE !="SAER") %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = MAX_HEIGHT_CM, y = yr), alpha = 0.45, ) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~SITE_TYPE, ncol = 1) +
labs(x = "Max height (cm)", y = "Year", title = "SAMO")
pl.li.sage.density <- csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE != "WK") %>%
filter(SPECIES_CODE == "SAGE") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR"& SPECIES_CODE !="SAER") %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = MAX_HEIGHT_CM, y = yr), alpha = 0.45, ) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~SITE_TYPE, ncol = 1) +
labs(x = "Max height (cm)", y = "Year", title = "SAGE")
pl.li.sapl.density <- csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE != "WK") %>%
filter(SPECIES_CODE == "SAPL") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR"& SPECIES_CODE !="SAER") %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = MAX_HEIGHT_CM, y = yr), alpha = 0.45, ) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~SITE_TYPE, ncol = 1) +
labs(x = "Max height (cm)", y = "Year", title = "SAPL")
pl.li.samo.density + pl.li.sage.density + pl.li.sapl.density +
patchwork::plot_layout(ncol=3)
csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE != "WK") %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL" ) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
# filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR"& SPECIES_CODE !="SAER") %>%
# filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
geom_boxplot(aes(x = yr, y = MAX_HEIGHT_CM), fill = "grey90") +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,600) +
theme_minimal() +
facet_grid(SITE_TYPE ~ SPECIES_CODE) +
# facet_wrap(~SITE_TYPE, ncol = 1) +
labs(y = "Max height (cm)", x = "Year", caption = "SAMO")
Line intercept summary table
csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE != "WK") %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL" ) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
group_by(SPECIES_CODE, timeClass, FENCED) %>%
descr(MAX_HEIGHT_CM, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
gt() %>%
tab_header(title = "Line intercept: species comparisons")| Line intercept: species comparisons | ||||||||||
| SPECIES_CODE | timeClass | FENCED | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|
| SAGE | BL | Unfenced | MAX_HEIGHT_CM | 230.2 | 150.4 | 3 | 267.5 | 455 | 18 | 100 |
| SAGE | 2013 | Fenced | MAX_HEIGHT_CM | 123.0 | 35.1 | 85 | 115.0 | 180 | 5 | 100 |
| SAGE | 2013 | Unfenced | MAX_HEIGHT_CM | 258.3 | 138.4 | 40 | 310.0 | 490 | 23 | 100 |
| SAGE | 2018 | Fenced | MAX_HEIGHT_CM | 156.0 | 65.6 | 60 | 155.0 | 270 | 15 | 100 |
| SAGE | 2018 | Unfenced | MAX_HEIGHT_CM | 157.6 | 129.0 | 30 | 85.0 | 410 | 25 | 100 |
| SAMO | BL | Fenced | MAX_HEIGHT_CM | 71.1 | 36.8 | 10 | 70.0 | 190 | 35 | 100 |
| SAMO | BL | Unfenced | MAX_HEIGHT_CM | 128.0 | 118.2 | 15 | 70.0 | 440 | 67 | 100 |
| SAMO | 2013 | Fenced | MAX_HEIGHT_CM | 113.3 | 74.1 | 30 | 95.0 | 300 | 23 | 100 |
| SAMO | 2013 | Unfenced | MAX_HEIGHT_CM | 170.7 | 133.2 | 15 | 105.0 | 500 | 66 | 100 |
| SAMO | 2018 | Fenced | MAX_HEIGHT_CM | 155.7 | 71.4 | 40 | 147.5 | 280 | 42 | 100 |
| SAMO | 2018 | Unfenced | MAX_HEIGHT_CM | 161.6 | 116.5 | 10 | 130.0 | 610 | 125 | 100 |
| SAPL | BL | Fenced | MAX_HEIGHT_CM | 82.5 | 17.7 | 70 | 82.5 | 95 | 2 | 100 |
| SAPL | BL | Unfenced | MAX_HEIGHT_CM | 173.8 | 119.3 | 40 | 150.0 | 520 | 17 | 100 |
| SAPL | 2013 | Fenced | MAX_HEIGHT_CM | 108.8 | 66.8 | 25 | 97.5 | 270 | 16 | 100 |
| SAPL | 2013 | Unfenced | MAX_HEIGHT_CM | 160.0 | 122.7 | 40 | 110.0 | 450 | 32 | 100 |
| SAPL | 2018 | Fenced | MAX_HEIGHT_CM | 147.3 | 68.0 | 30 | 140.0 | 290 | 28 | 100 |
| SAPL | 2018 | Unfenced | MAX_HEIGHT_CM | 124.0 | 95.3 | 20 | 95.0 | 380 | 36 | 100 |
Salix gereyiana
## another species: SAGE
csv.all.lc.li.df %>%
filter(yr !=2009 & yr != 2015 & yr !=2017) %>%
filter(SITE_TYPE == "WC") %>%
filter(SPECIES_CODE == "SAGE") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR"& SPECIES_CODE !="SAER") %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = MAX_HEIGHT_CM, y = yr, fill = FENCED), alpha = 0.45, ) +
scale_fill_manual(values = colfunc2(2)) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
# facet_wrap(~SITE_TYPE, ncol = 1) +
facet_grid(SPECIES_CODE~SITE_TYPE) +
labs(x = "Max height (cm)", y = "Year", caption = "Line intercept data")
### Max shrub height
csv.all.lc.li.df %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR" & SPECIES_CODE !="SAER") %>%
# names() %>%
# group_by(yr,SITE_TYPE, SPECIES_CODE, MAX_HEIGHT_CM) %>%
# summarise(mean.max.ht = mean(MAX_HEIGHT_CM,na.rm=TRUE)) %>%
ggplot(aes(yr, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill=SITE_TYPE), color = 'black') +
scale_fill_manual(values = colfunc2(3)) +
# scale_fill_viridis(discrete = TRUE) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,600) +
theme_minimal() +
labs(title = "Maximum shrub height by year, species and Site Type", x = "Year", y = "Species")+
facet_wrap(~SPECIES_CODE, ncol = 3)#### Core winter range: fenced vs unfenced
## all willow spp
csv.all.lc.li.df %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SITE_TYPE == "WC") %>%
ggplot(aes(yr, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill=FENCED), color = 'black', outlier.shape = NA) +
theme_minimal() +
ylim(0, 350) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
# scale_fill_manual(pal.5a) +
# scale_fill_manual(values = c("ivory2","lightblue")) +
scale_fill_manual(values = c("grey90","grey50")) +
labs(x = "", y = "Max height (cm)", fill = "", title = "Core Winter Range Plots: All Willow Species", caption = "Line intercept data, WC \n lineInt_willHt_wc_all_willow_boxplot01.png")
ggsave("./output/lineInt_willHt_wc_all_willow_boxplot01.png", width = 6, height = 4.5, dpi= 300)## salix monitcola
csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
# filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR" & SPECIES_CODE !="SAER") %>%
filter(SPECIES_CODE =="SAMO") %>%
filter(SITE_TYPE == "WC") %>%
ggplot(aes(yr, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill=FENCED), color = 'black', outlier.shape = NA) +
theme_minimal() +
ylim(0,320) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
scale_fill_manual(values = c("grey90","grey50")) +
labs(x = "Year", y = "Max height (cm)", fill = "Fenced") +
labs(x = "Year", y = "Max height (cm)", fill = "", title = "Core Winter Range Plots: SAMO only", caption = "Line intercept data \n lineInt_WC_ht_SAMO_bxplt01.png")
ggsave("./output/figures_202108/lineInt_WC_ht_SAMO_bxplt01.png", width = 6, height = 4.5, dpi= 300)## all shrub species
csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(SITE_TYPE == "WC") %>%
ggplot(aes(yr, MAX_HEIGHT_CM)) +
geom_boxplot(aes(fill=FENCED), color = 'black', outlier.shape = NA) +
# scale_fill_viridis(discrete = TRUE) +
# theme_minimal() +
theme_minimal() +
ylim(0,320) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
scale_fill_manual(values = c("grey90","grey50")) +
# labs(x = "Year", y = "Max height (cm)", fill = "Fenced?") +
labs(x = "Year", y = "Max height (cm)", fill = "", title = "Core Winter Range Plots: All Shrub Species", caption = "Line intercept data \n lineInt_wht_wc_allShrubSpp_bxplt01.png")
ggsave("./output/figures_202108/lineInt_wht_wc_allShrubSpp_bxplt01.png", width = 6, height = 4.5, dpi= 300)csv.all.lc.li.df %>%
filter(pType == "willow") %>%
filter(SPECIES_CODE != "SAXX") %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
# filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(FENCED == "Unfenced" | FENCED == "Fenced") %>%
group_by(yr, SPECIES_CODE, FENCED) %>%
# summarise(mean.ht = mean(MAX_HEIGHT_CM, na.rm = TRUE), sd.ht = sd(MAX_HEIGHT_CM, na.rm = TRUE)) %>%
summarise(mean.ht = mean(MAX_HEIGHT_CM, na.rm = TRUE)) %>%
pivot_wider(names_from = yr, values_from = c(mean.ht)) %>%
gt::gt() %>%
fmt_number(
columns = vars('2008','2013','2018'),
decimals = 1,
use_seps = FALSE
) %>%
tab_header("Mean height by shrub species")| Mean height by shrub species | |||
| FENCED | 2008 | 2013 | 2018 |
|---|---|---|---|
| BEGL | |||
| Fenced | 41.7 | 130.0 | 165.0 |
| Unfenced | NA | 126.7 | 108.8 |
| BEOC | |||
| Unfenced | 251.7 | 382.5 | 176.9 |
| Fenced | NA | 45.0 | 82.5 |
| DAFR | |||
| Fenced | 60.0 | 42.9 | 52.4 |
| Unfenced | 52.1 | 48.7 | 51.3 |
| SAGE | |||
| Unfenced | 230.2 | 258.3 | 153.7 |
| Fenced | NA | 123.0 | 141.5 |
| SALUC | |||
| Unfenced | 80.0 | NA | NA |
| SAMO | |||
| Fenced | 71.1 | 113.3 | 149.9 |
| Unfenced | 128.0 | 170.7 | 157.6 |
| SAPL | |||
| Fenced | 82.5 | 108.8 | 144.8 |
| Unfenced | 173.8 | 160.0 | 107.2 |
| ALIN | |||
| Unfenced | NA | 285.6 | 345.3 |
| Fenced | NA | NA | 170.0 |
| LOIN | |||
| Fenced | NA | 40.0 | 93.3 |
| Unfenced | NA | 112.5 | 122.5 |
| POTR | |||
| Unfenced | NA | 64.2 | NA |
| RIIN | |||
| Unfenced | NA | 91.2 | 57.9 |
| ROWO | |||
| Unfenced | NA | 34.4 | 41.2 |
| Fenced | NA | NA | 33.2 |
| SABE | |||
| Unfenced | NA | 239.6 | 137.8 |
| Fenced | NA | NA | 131.1 |
| SADR | |||
| Unfenced | NA | 420.0 | 253.1 |
| Fenced | NA | NA | 114.2 |
| SAPE | |||
| Fenced | NA | 86.2 | 147.3 |
| Unfenced | NA | NA | 63.3 |
| JUCO | |||
| Unfenced | NA | NA | 40.0 |
| RUID | |||
| Unfenced | NA | NA | 35.0 |
| SABR | |||
| Unfenced | NA | NA | 40.0 |
| SAER | |||
| Fenced | NA | NA | 156.0 |
# Maximum Core winter range sites, maximum shrub height by species, fencing treatment, and year in line interecept dataset.**
csv.all.lc.li.df %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(FENCED == "Unfenced" | FENCED == "Fenced") %>%
# filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR" & SPECIES_CODE !="SAER") %>%
filter(SITE_TYPE == "WC") %>%
group_by(SPECIES_CODE,yr,FENCED) %>%
dplyr::summarise(mean.max.ht = mean(MAX_HEIGHT_CM, na.rm = TRUE)) %>%
ungroup() %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = anytime::anytime(yr)) %>%
ggplot(aes(x = yr, y = mean.max.ht)) +
geom_smooth(aes(color = FENCED), method = "lm", se = FALSE, alpha = .5) +
geom_point(aes(color = FENCED)) +
scale_shape_manual(values = c(21,24)) +
scale_color_manual(values = c("blue", "black")) +
theme_minimal() +
labs(caption = "Core winter range sites: maximum shrub height by year, fencing", x = "Year", y = "Height (cm)", color = "") +
facet_wrap(~SPECIES_CODE, ncol = 2)## reclass the burned NA
csv.all.lc.li.df <- csv.all.lc.li.df %>%
mutate(BURNED = case_when(is.na(BURNED) ~ "Unburned",
TRUE ~ as.character(BURNED)))
csv.all.lc.li.df %>%
filter(BURNED != "BURNED") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE != "SAXX") %>%
filter(yr == 2008 | yr == 2009 | yr == 2013 | yr == 2018) %>%
filter(FENCED == "Unfenced" | FENCED == "Fenced") %>%
# filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR" & SPECIES_CODE !="SAER") %>%
filter(SITE_TYPE == "WC") %>%
# distinct(SPECIES_CODE) %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = anytime::anytime(yr)) %>%
# mutate(yr = as.integer(yr)) %>%
ggplot(aes(x = yr, y = MAX_HEIGHT_CM)) +
# geom_smooth(aes(color = FENCED), se = FALSE) +
geom_smooth(aes(color = FENCED), method = "lm", se = FALSE) +
geom_jitter(aes(color = FENCED, shape = FENCED)) +
scale_color_manual(values = c("blue", "black")) +
scale_shape_manual(values = c(21,24)) +
theme_minimal() +
# scale_fill_manual(values = c("ivory2","lightblue")) +
labs(title = "Core winter range sites: maximum shrub height by year, fencing", x = "Year", color = "", shape = "", y = "Height (cm)", caption = "SAMO,SAPL, SAGE, SABE,SADR,SAPE,SAER \n lineInt_ht_wc_burned_v_unburned.png") +
facet_wrap(~BURNED)
ggsave("./output/figures_202108/lineInt_ht_wc_burned_v_unburned.png", width = 6.5, height = 4.5, dpi=300)## Core winter range sites: maximum shrub height by year, fencing -- point plot with LM trend line
csv.all.lc.li.df %>%
filter(BURNED != "BURNED") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
filter(FENCED == "Unfenced" | FENCED == "Fenced") %>%
filter(SPECIES_CODE != "SAXX") %>%
# filter(SPECIES_CODE !="SAPE" & SPECIES_CODE !="SAWO" & SPECIES_CODE !="SAXX" & SPECIES_CODE !="SALUC" & SPECIES_CODE !="SABR" & SPECIES_CODE !="SAER") %>%
filter(SITE_TYPE == "WC") %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = anytime::anytime(yr)) %>%
ggplot(aes(x = yr, y = MAX_HEIGHT_CM)) +
geom_smooth(aes(color = FENCED, lty = FENCED), method = "lm", se = FALSE) +
# geom_point(aes(color = FENCED, shape = FENCED)) +
geom_jitter(aes(color = FENCED, shape = FENCED)) +
scale_color_manual(values = c("blue", "black")) +
scale_shape_manual(values = c(21,24)) +
theme_minimal() +
labs(title = "Core winter range sites: maximum shrub height by year, fencing", x = "Year", color = "", shape = "", y = "Height (cm)", lty = "", caption = "SAMO,SAPL, SAGE, SABE,SADR,SAPE,SAER") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# burned faceted
csv.all.lc.li.df %>%
filter(BURNED != "BURNED") %>%
filter(!is.na(MAX_HEIGHT_CM)) %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
filter(SPECIES_CODE != "SAXX") %>%
filter(yr == 2008 | yr == 2009 | yr == 2013 | yr == 2018) %>%
filter(FENCED == "Unfenced" | FENCED == "Fenced") %>%
filter(SITE_TYPE == "WC") %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = anytime::anytime(yr)) %>%
ggplot(aes(x = yr, y = MAX_HEIGHT_CM)) +
geom_smooth(aes(color = FENCED, lty = FENCED), method = "lm", se = FALSE) +
geom_jitter(aes(color = FENCED, shape = FENCED)) +
scale_shape_manual(values = c(21,24)) +
scale_color_manual(values = c("blue", "black")) +
theme_minimal() +
labs(title = "Core winter range: maximum shrub height, fencing, burning", x = "Year", color = "", shape = "", lty = "", y = "Height (cm)", caption = "Pooled SAMO,SAPL, SAGE, SABE,SADR,SAPE,SAER") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
facet_grid(~BURNED)Willow plots: macroplot data
## Data munging
# calculate the average canopy diameter
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(CANOPY_DIAM_AVG = (CANOPY_DIA_1_CM + CANOPY_DIA_2_CM)/2)
### canopy diameter by species
mcro.canopy.diam.sum <- csv.all.lc.mcro.df %>%
group_by(SITE_ID, yr, SPECIES_CODE, FENCED) %>%
summarise(cano_diam_med = median(CANOPY_DIAM_AVG)) csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(timeClass = case_when(yr == 2008 ~ "BL",
yr == 2009 ~ "BL",
TRUE ~ as.character(yr))) %>%
mutate(timeClass = as.factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "2018", "2013", "BL"))## cleaning the LOCATION tab
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(LOCATION = case_when(is.na(LOCATION) & SITE_TYPE == "WK" ~ "Kawuneeche",
TRUE ~ LOCATION))%>%
mutate(LOCATION = str_replace(LOCATION, "_", " ")) %>%
mutate(LOCATION = str_replace(LOCATION, "_", " ")) #**Note: WC5,6,7,8,11,33 are listed as "removed" so are eliminated**
## clean
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
filter(!SITE_ID %in% c("WC05","WC06","WC07","WC08","WC11","WC33"))# lu.removed.plot
# csv.all.lc.mcro.df
# remove all the removed plots
csv.all.lc.mcro.df <- anti_join(csv.all.lc.mcro.df, lu.removed.plot, by="SITE_ID")# ADDRESS MISSING BL KV
# Baseline data for KV were not provided in the initial data transfer.
# The following reads in these missing observations provided 8/21.
# read in the missing KV baseline data
bl.new <- read_csv("./data/EVMP_data/Baseline/KV Baseline_Macro_2011.csv") %>%
clean_names()# Match column names in the 'new' baseline data to those in the
# rest of the data after standardizing names/formats
bl.new <- bl.new %>%
rename(site_type = site_type_wc_core_wnc_non_core) %>%
rename(canopy_dia_1_cm = canopy_diameter_max_cm) %>%
rename(canopy_dia_2_cm = canopy_diameter_perp_cm) %>%
rename(ht_to_tallest_budscar_cm = height_to_tallest_bud_scar_cm) %>%
rename(site_id = unique_site_id) %>%
rename(plant_ht_cm = plant_height_cm) %>%
clean_names(case = "screaming_snake")
bl.new <- bl.new %>%
select(-FENCED) %>% # remove this (all NA) and join in the
mutate(SITE_ID = case_when(SITE_ID == "WK1" ~ "WK01",
SITE_ID == "WK2" ~ "WK02",
SITE_ID == "WK3" ~ "WK03",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK4" ~ "WK04",
SITE_ID == "WK5" ~ "WK05",
SITE_ID == "WK6" ~ "WK06",
SITE_ID == "WK7" ~ "WK07",
SITE_ID == "WK8" ~ "WK08",
SITE_ID == "WK 8" ~ "WK08",
SITE_ID == "WK9" ~ "WK09",
TRUE ~ as.character(SITE_ID))
) %>%
mutate(LOCATION = "Kawuneeche") %>%
mutate(yr = year(anytime::anydate(DATE))) %>%
mutate(mo = month(anytime::anydate(DATE))) %>%
mutate(timeClass = "BL") %>%
mutate(BURNED = "Unburned")## fencing status is not part of the baseline file (it's all NA)
# Create a LU from the site info object (see above) and join to attribute
# these data
lu.kv.f <- site.info.all %>%
filter(RANGE_TYPE == "Kawuneeche Valley") %>%
select(SITE_ID, FENCED) %>%
mutate(FENCED = case_when(FENCED == "Y" ~ "Fenced",
FENCED == "N" ~ "Unfenced"))
bl.new <- bl.new %>%
left_join(.,lu.kv.f)
# visdat::vis_dat(bl.new)
# bl.new %>%
# tabyl(SITE_ID, FENCED)
bl.new <- bl.new %>%
# mutate(zCond = case_when(BURNED == "Burned" & FENCED == "Unfenced" ~ "BG",
# BURNED == "Burned" & FENCED == "Fenced" ~ "BF",
# BURNED == "Unburned" & FENCED == "Unfenced" ~ "UG",
# BURNED == "Unburned" & FENCED == "Fenced" ~ "UF"
# )) %>%
# mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) %>% ## these are the classes used in the weighting scheme in Zeigenfuss 2015
mutate(DATE = anytime::anydate(DATE))
## carry forth the updated csv.all.mcro.df
csv.all.lc.mcro.df <- bind_rows(csv.all.lc.mcro.df, bl.new)# LU to join attributes missing in the 'new' BL
lu.mcro <- csv.all.lc.mcro.df %>%
filter(LOCATION == "Kawuneeche") %>%
select(SITE_ID, zCond, zCond2) %>%
drop_na() %>%
distinct()
# join
bl.new <- bl.new %>%
# select(-c(zCond,zCond2)) %>%
left_join(.,lu.mcro, by = "SITE_ID")csv.all.lc.mcro.df <- bind_rows(csv.all.lc.mcro.df,bl.new) %>%
distinct() Canopy cover
## average the canopy
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(CANOPY_DIA_CM_avg = (CANOPY_DIA_1_CM + CANOPY_DIA_2_CM)/2)
## clean up
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(FENCED = case_when(FENCED == "Y_but_fence_down_since_2013" ~ "Unfenced",
FENCED == "Y" ~ "Fenced",
FENCED == "N" ~ "Unfenced"))
# quick check
# csv.all.lc.mcro.df %>% tabyl(FENCED)
# lots of burned categories. Some don't make sense (e.g., "N Y"). Collapsing to Burned/Unburned
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(BURNED = case_when(BURNED == "Unburned" ~ "Unburned",
BURNED == "N Y" ~ "Burned", # ??
BURNED == "Completely" ~ "Burned",
BURNED == "Moderately" ~ "Burned",
BURNED == "Moderately to Completely" ~ "Burned",
BURNED == "Y" ~ "Burned",
BURNED == "N" ~ "Unburned",
BURNED == "Not burned" ~ "Unburned",
is.na(BURNED) ~ "Unburned",
TRUE ~ BURNED)) %>%
mutate(DATE = ymd(DATE))
## add a species group attribute -- willow/non-willow
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(spp_group = case_when(str_detect(SPECIES_CODE, "^SA") ~ "willow",
TRUE ~ "non-willow"))# Add condition classes from Zeigenfuss 2015 zcond lu
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(zCond = case_when(BURNED == "Burned" & FENCED == "Unfenced" ~ "BG",
BURNED == "Burned" & FENCED == "Fenced" ~ "BF",
BURNED == "Unburned" & FENCED == "Unfenced" ~ "UG",
BURNED == "Unburned" & FENCED == "Fenced" ~ "UF"
)) %>%
mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) ## these are the classes used in the weighting scheme in Zeigenfuss 2015## Key question. What to do with burned plots at baseline? They weren't burned at baseline, so should be "unburned" at that timeclass BUT if the goal is to track that cohort of plots that became burned...
## ensure that no plots are attributed as burned at baseline (fire happened in 2012)
csv.all.lc.mcro.df %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
mutate(timeClass = fct_drop(timeClass)) %>%
tabyl(timeClass, BURNED) %>%
gt()
# moving forward treating them as the second scenario...#### Calculate cover
# prep the percent cover. As character in the raw data. Assume NA 0
## fix issue of data in two columns !!!
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(PERCENT_PLANT_IN_PLOT = as.numeric(PERCENT_PLANT_IN_PLOT)) %>%
mutate(PERCENT_PLANT_IN_PLOT = case_when(is.na(PERCENT_PLANT_IN_PLOT) & !is.na(PERCENT_OF_PLANT_IN_PLOT)~ PERCENT_OF_PLANT_IN_PLOT,
TRUE ~ PERCENT_PLANT_IN_PLOT)) %>%
select(-PERCENT_OF_PLANT_IN_PLOT) #
# csv.all.lc.mcro.df %>%
# # mutate(PERCENT_PLANT_IN_PLOT = as.numeric(PERCENT_PLANT_IN_PLOT)) %>%
# mutate(PERCENT_PLANT_IN_PLOT = replace_na(data = PERCENT_PLANT_IN_PLOT, replace = 0)) %>%
# glimpse()
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(PERCENT_PLANT_IN_PLOT = replace_na(data = PERCENT_PLANT_IN_PLOT, replace = 0))
# mutate(PERCENT_PLANT_IN_PLOT = case_when(is.na(PERCENT_PLANT_IN_PLOT) ~ 1,
# TRUE ~ PERCENT_PLANT_IN_PLOT)) %>% # note: opposite assumption with what to do with NA
## address issue with KV fencing NA's
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>%
mutate(FENCED = case_when(SITE_ID == "WK01" ~ "Fenced",
SITE_ID == "WK02" ~ "Fenced",
SITE_ID == "WK03" ~ "Unfenced",
SITE_ID == "WK04" ~ "Unfenced",
SITE_ID == "WK05" ~ "Fenced",
SITE_ID == "WK06" ~ "Unfenced",
SITE_ID == "WK07" ~ "Unfenced",
SITE_ID == "WK08" ~ "Unfenced",
SITE_ID == "WK09" ~ "Unfenced",
SITE_ID == "WK10" ~ "Fenced",
TRUE ~ FENCED))
canopy.all.spp <- csv.all.lc.mcro.df %>%
mutate(PERCENT_PLANT_IN_PLOT = as.numeric(PERCENT_PLANT_IN_PLOT)/100) %>%
mutate(PERCENT_PLANT_IN_PLOT = case_when(PERCENT_PLANT_IN_PLOT == 1.45 ~ .145,
TRUE ~ PERCENT_PLANT_IN_PLOT)) %>% # correct error in raw data
# mutate(cano.area.m2 = PERCENT_PLANT_IN_PLOT * (CANOPY_DIA_CM_avg/2)^2 * 3.141593 * 0.0001) %>%
mutate(cano.area.m2 = ((((CANOPY_DIA_1_CM/100)*(CANOPY_DIA_2_CM/100)*3.141593)/4) * PERCENT_PLANT_IN_PLOT)) # this is how LZ calculated cover in the SAS 2013 code update. Slightly different estimates than method used in previous. For consistency, using LZ formula ## calculate sum canopy area by species
canopy.all.spp <- canopy.all.spp %>%
mutate(cover.plant = cano.area.m2/16 * 100) %>%
mutate(cover.plant = case_when(cover.plant > 100 ~ 100,
TRUE ~ cover.plant)) %>%
group_by(timeClass, yr, SPECIES_CODE, SITE_ID, SITE_TYPE, BURNED, FENCED) %>%
mutate(cano.area.m2.spp.sum = sum(cano.area.m2)) %>%
ungroup() %>%
mutate(cover.spp = cano.area.m2.spp.sum/16 * 100) %>%
mutate(cover.spp = case_when(cover.spp > 100 ~ 100,
TRUE ~ cover.spp))
### willow cover. Summed across all willows in plot, div plot area
canopy.willow.allspp <- canopy.all.spp %>%
filter(spp_group == "willow") %>%
group_by(timeClass, yr, SITE_ID, SITE_TYPE, BURNED, FENCED) %>%
dplyr::summarize(cano.area.m2.will.sum = sum(cano.area.m2)) %>%
ungroup() %>%
mutate(cover.will = cano.area.m2.will.sum/16 * 100) %>%
mutate(cover.will = case_when(cover.will > 100 ~ 100,
TRUE ~ cover.will)) %>%
mutate(zCond = case_when(BURNED == "Burned" & FENCED == "Unfenced" ~ "BG",
BURNED == "Burned" & FENCED == "Fenced" ~ "BF",
BURNED == "Unburned" & FENCED == "Unfenced" ~ "UG",
BURNED == "Unburned" & FENCED == "Fenced" ~ "UF"
)) %>%
mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) ## add the 'condition' classes used by Zeignfuss etal in their 2015 report# #### Figure 38 revised 2022
# canopy.all.spp %>%
# glimpse()# !!!
canopy.all.spp <- canopy.all.spp %>%
mutate(timeClass = fct_relevel(timeClass, "BL", "2013", "2018"))## requested fig by LZ
# cover by species WC
wilcov.tile.spp.wc <- canopy.all.spp %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(timeClass,SPECIES_CODE, FENCED) %>%
skimr::skim(cover.spp) %>%
select(timeClass, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(timeClass, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Species", fill = "mean canopy cover(%)") +
facet_wrap(~FENCED)
wilcov.tile.spp.wc
## WNC tile
wilcov.tile.spp.wnc <- canopy.all.spp %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WNC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(timeClass,SPECIES_CODE, FENCED) %>%
skimr::skim(cover.spp) %>%
select(timeClass, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(timeClass, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "", fill = "mean canopy cover(%)")
wilcov.tile.spp.wnc
## actual fig 38
wilcov.tile.spp.wc + wilcov.tile.spp.wnc +
plot_annotation(tag_levels = "A") +
plot_layout(widths = c(2,1))
ggsave("./output/figures_202202/Fig38_mean_wilcov_wc_wnc.png", width = 6.5, height = 3.5, dpi = 300)
ggsave("./output/figures_202202/Fig38_mean_wilcov_wc_wnc.pdf", width = 6.5, height = 3.5)#### Fig 42 revised 2022
# Fig 42
# wk
wilcov.tile.spp.wk <- canopy.all.spp %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WK") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE, FENCED) %>%
skimr::skim(cover.spp) %>%
select(yr, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Species", fill = "mean canopy cover(%)") +
facet_wrap(~FENCED)
wilcov.tile.spp.wk
# ggsave("./output/figures_202202/Fig42_willow_cov_wk.pdf", width = 5.5, height = 3.75, dpi=300) # just edited the bl in acrobat #!!!# fig
wilcov.tile.spp.wc + (wilcov.tile.spp.wnc + theme(legend.position = "none")) +
plot_layout(ncol=2, widths = c(.65,.35)) +
# plot_layout(ncol=3, widths = c(.35,.35,.5)) +
plot_annotation(caption = "willow_cov_3panel.png")canopy.all.spp %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WK") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE, FENCED) %>%
skimr::skim(cover.spp) %>%
select(yr, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable()canopy.all.spp %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WK") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE, FENCED) %>%
skimr::skim(cover.spp) %>%
select(yr, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
mutate(across(where(is.numeric), round, 1)) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
geom_text(aes(label = numeric.mean)) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "", fill = "mean cover(%)", title = "Kawuneeche Valley", caption = "willow_cov_wk_lbl.png") +
facet_wrap(~FENCED)
ggsave("./output/figures_202108/willow_cov_wk_lbl.png", width = 7.5, height = 3.75, dpi=300)canopy.all.willow.sum <- canopy.all.spp %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
# mutate(BURNED = case_when(timeClass == "BL" ~ "Unburned",
# TRUE ~ BURNED)) %>% ## Changing bl burned to unburned
# mutate(BURNED = case_when(timeClass == "2013" & BURNED == "Burned" ~ "Burned",
# timeClass == "BL" & BURNED == "Unburned" & timeClass == "2013" & BURNED == "Burned" ~ "Burned",
# TRUE ~ BURNED)) %>% ## Changing bl unburned to burned
group_by(timeClass, yr, SITE_ID, SITE_TYPE, LOCATION, FENCED, BURNED) %>%
dplyr::summarise(cano.sum.m2 = sum(cano.area.m2), cano.mean.m2 = mean(cano.area.m2, na.rm=TRUE)) %>%
mutate(cover.allwillow = cano.sum.m2/16*100) %>%
mutate(cover.allwillow = case_when(cover.allwillow > 100 ~ 100,
TRUE ~ cover.allwillow)) %>%
ungroup() %>%
mutate(zCond = case_when(BURNED == "Burned" & FENCED == "Unfenced" ~ "BG",
BURNED == "Burned" & FENCED == "Fenced" ~ "BF",
BURNED == "Unburned" & FENCED == "Unfenced" ~ "UG",
BURNED == "Unburned" & FENCED == "Fenced" ~ "UF"
)) %>%
mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) ## add the 'condition' classes used by Zeignfuss etal in their 2015 report## write to csv
# canopy.all.willow.sum %>%
# write_csv("./output/exported_data/willow_cover_20200725.csv")
# lu.removed.plot
# remove all the removed plots identified in the site info tab if raw files
canopy.all.willow.sum <- anti_join(canopy.all.willow.sum, lu.removed.plot, by="SITE_ID")
# canopy.all.willow.sum %>%
# tabyl(timeClass,SITE_TYPE)
# !!!
canopy.all.willow.sum %>%
write_csv("./output/exported_data/willow_macroplot_cover_BLto2018b.csv") # re-exported 8Combined WC and WNC
#### All willow species
#### Winter range weighted average
## excluding WK, WC and WNC; non 5 yr sampling
canopy.all.willow.sum <- canopy.all.willow.sum %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
mutate(timeClass = fct_drop(timeClass))
canopy.all.willow.sum %>%
tabyl(timeClass)## timeClass n percent
## BL 82 0.2928571
## 2013 95 0.3392857
## 2018 103 0.3678571##
canopy.all.willow.sum %>%
mutate(cover.allwillow = case_when(is.na(cover.allwillow) ~ 0,
TRUE ~ cover.allwillow)) %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
group_by(SITE_TYPE, LOCATION, timeClass) %>%
summarise(n.loc.tc = n(), mean.cov = mean(cover.allwillow, na.rm = TRUE), sd.cov = sd(cover.allwillow, na.rm = TRUE)) %>%
# summarise(n.loc.tc = n(), mean.cov = mean(cover.allwillow, na.rm = TRUE, mean.cov.mn = mean(cover.allwillow.mn, na.rm = TRUE))) %>%
ungroup() %>%
group_by(SITE_TYPE, timeClass) %>%
mutate(n.tc = sum(n.loc.tc)) %>%
ungroup()## # A tibble: 27 x 7
## SITE_TYPE LOCATION timeClass n.loc.tc mean.cov sd.cov n.tc
## <chr> <chr> <fct> <int> <dbl> <dbl> <int>
## 1 WC Endovalley BL 8 37.0 27.6 42
## 2 WC Endovalley 2013 9 37.0 27.2 63
## 3 WC Endovalley 2018 9 54.5 30.2 62
## 4 WC Horseshoe Park BL 12 30.5 25.9 42
## 5 WC Horseshoe Park 2013 12 44.1 27.3 63
## 6 WC Horseshoe Park 2018 12 58.9 35.7 62
## 7 WC Moraine Park BL 17 4.64 8.95 42
## 8 WC Moraine Park 2013 32 16.2 24.4 63
## 9 WC Moraine Park 2018 33 39.8 37.3 62
## 10 WC Upper Beaver Meadows BL 5 10.1 10.6 42
## # ... with 17 more rowscanopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
group_by(SITE_TYPE, timeClass) %>%
summarise(mean.will.cov = mean(cover.allwillow, na.rm = TRUE),
sd.will.cov = sd(cover.allwillow, na.rm = TRUE),
med.will.cov = median(cover.allwillow, na.rm = TRUE)) %>%
mutate(across(where(is.double), round, 2)) %>%
gt()| timeClass | mean.will.cov | sd.will.cov | med.will.cov |
|---|---|---|---|
| WC | |||
| BL | 21.99 | 23.94 | 17.92 |
| 2013 | 24.27 | 26.78 | 14.38 |
| 2018 | 43.58 | 35.41 | 32.98 |
| WNC | |||
| BL | 36.90 | 28.17 | 30.46 |
| 2013 | 43.00 | 32.31 | 37.28 |
| 2018 | 55.55 | 33.06 | 52.72 |
canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
group_by(SITE_TYPE, timeClass) %>%
summarise(mean.will.cov = mean(cover.allwillow, na.rm = TRUE), sd.will.cov = sd(cover.allwillow, na.rm = TRUE), med.will.cov = median(cover.allwillow, na.rm = TRUE), n.obs = n()) %>%
mutate(across(where(is.double), round, 2)) %>%
gt()| timeClass | mean.will.cov | sd.will.cov | med.will.cov | n.obs |
|---|---|---|---|---|
| WC | ||||
| BL | 21.99 | 23.94 | 17.92 | 42 |
| 2013 | 24.27 | 26.78 | 14.38 | 63 |
| 2018 | 43.58 | 35.41 | 32.98 | 62 |
| WNC | ||||
| BL | 36.90 | 28.17 | 30.46 | 32 |
| 2013 | 43.00 | 32.31 | 37.28 | 32 |
| 2018 | 55.55 | 33.06 | 52.72 | 32 |
# purrr plots
tmp1 <- canopy.all.willow.sum %>%
group_nest(SITE_TYPE) %>%
mutate(plots = map2(.y = SITE_TYPE, .x = data, ~{ggplot(data = .x) +
geom_boxplot(aes(y = cover.allwillow, x = timeClass), fill="Gray80") +
geom_hline(aes(yintercept=31), color="red", lty="dashed") +
# ggtitle(paste0("Willow cover, site: ", .y)) +
labs(title = paste0("Site type: ", .y), x = "", y = "Willow cover (%)") +
theme_minimal()}))
tmp1 %>%
pull(plots)## [[1]]
##
## [[2]]
##
## [[3]]
# purrr plots
canopy.all.willow.sum %>%
group_nest(LOCATION) %>%
mutate(plots = map2(.y = LOCATION, .x = data, ~{ggplot(data = .x) +
geom_boxplot(aes(y = cover.allwillow, x = timeClass), fill="Gray80") +
# ggtitle(paste0("Willow cover, site: ", .y)) +
labs(title = paste0("Location: ", .y), x = "", y = "Willow cover (%)") +
theme_minimal()})) %>%
pull(plots)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
# purrr plots
tmp2 <- canopy.all.willow.sum %>%
group_nest(LOCATION) %>%
mutate(tbls = map(.x = data, .f = datatable)) %>%
mutate(plots = map2(.y = LOCATION, .x = data, ~{ggplot(data = .x) +
geom_boxplot(aes(y = cover.allwillow, x = timeClass), fill="Gray80") +
# ggtitle(paste0("Willow cover, site: ", .y)) +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
labs(title = paste0("Location: ", .y), x = "", y = "Willow cover (%)") +
theme_minimal()}))
tmp2 %>%
pull(plots)## [[1]]
##
## [[2]]
##
## [[3]]
##
## [[4]]
##
## [[5]]
##
## [[6]]
##
## [[7]]
##
## [[8]]
##
## [[9]]
##
## [[10]]
tmp2 %>%
pull(tbls)#### Figure 36 revised 2022
canopy.all.willow.sum <- canopy.all.willow.sum %>%
mutate(timeClass = fct_relevel(timeClass, "BL","2013","2018"))
# !!!
canopy.all.willow.sum <-canopy.all.willow.sum %>%
mutate(site_type2 = case_when(SITE_TYPE == "WC" ~ "core winter range",
SITE_TYPE == "WNC" ~ "noncore winter range",
TRUE ~ SITE_TYPE))wc.cov.pl1 <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# mutate(timeClass = fct_rev(timeClass)) %>%
ggplot(aes(timeClass,cover.allwillow)) +
geom_boxplot(fill = "grey50") +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
labs(x = "Year", y = "Willow canopy cover (%)") +
theme_minimal()
# wc.cov.pl1
# ggsave("./output/figures_202108/All_winter_range_willow_cov_boxplot.png", width = 3.75, height = 3.75)
wc.cov.pl2 <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# mutate(timeClass = fct_rev(timeClass)) %>%
ggplot(aes(timeClass,cover.allwillow)) +
geom_boxplot(aes(fill = site_type2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
labs(fill = "", x = "Year", y ="") +
theme_minimal()
# wc.cov.pl2
# ggsave("./output/figures_202108/All_winter_range_willow_cov_boxplot_b.png", width = 4.5, height = 3.75)
# cowplot::plot_grid(wc.cov.pl1, wc.cov.pl2, labels = "AUTO",rel_widths = c(1, 2))
wc.cov.pl1 + wc.cov.pl2 +
plot_annotation(tag_levels = "A") +
plot_layout(widths = c(1,1.75))
ggsave("./output/figures_202202/Fig36_All_winter_range_willow_cov_boxplot_2panel_revised.png", width = 6.5, height = 3.75, dpi=300)
ggsave("./output/figures_202202/Fig36_All_winter_range_willow_cov_boxplot_2panel_revised.pdf", width = 6.5, height = 3.75)##### summary tables for cover
# pooled across range types, fenced, burned
## Time class FENCED SITE_TYPE
summary.TC <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass) %>%
gt() %>%
tab_header(title = "Willow cover - All species, range types, and fenced/burned status")
summary.TC | Willow cover - All species, range types, and fenced/burned status | ||||||
| Time class | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|
| 2018 | 47.7 | 34.9 | 0.2 | 43.8 | 100 | 94 |
| 2013 | 30.0 | 29.7 | 0.1 | 23.9 | 100 | 88 |
| BL | 29.0 | 26.9 | 0.2 | 21.3 | 100 | 68 |
## Time class FENCED SITE_TYPE
summary.TC.site_type <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, SITE_TYPE) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Willow cover - All species and fenced status")
summary.TC.site_type | Willow cover - All species and fenced status | |||||||
| Time class | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|
| 2018 | WC | 43.6 | 35.4 | 0.2 | 33.0 | 100 | 62 |
| 2018 | WNC | 55.5 | 33.1 | 1.4 | 52.7 | 100 | 32 |
| 2013 | WC | 24.3 | 26.8 | 0.1 | 14.4 | 100 | 61 |
| 2013 | WNC | 43.0 | 32.3 | 2.0 | 37.3 | 100 | 27 |
| BL | WC | 22.0 | 23.9 | 0.2 | 17.9 | 100 | 36 |
| BL | WNC | 36.9 | 28.2 | 2.6 | 30.5 | 100 | 32 |
# summary.TC.site_type %>%
# gt::gtsave(file = "./output/tables/summary_cover_all_willow_TCxSITE_Type.rtf")## Time class FENCED SITE_TYPE
summary.TC.fenced.site_type <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass,FENCED, SITE_TYPE) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, Fenced = FENCED, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Willow cover - All species")
summary.TC.fenced.site_type | Willow cover - All species | ||||||||
| Time class | Fenced | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | WC | 54.9 | 34.6 | 5.0 | 55.8 | 100 | 28 |
| 2018 | Unfenced | WC | 34.2 | 33.8 | 0.2 | 23.2 | 100 | 34 |
| 2018 | Unfenced | WNC | 55.5 | 33.1 | 1.4 | 52.7 | 100 | 32 |
| 2013 | Fenced | WC | 28.6 | 30.4 | 0.1 | 17.5 | 100 | 28 |
| 2013 | Unfenced | WC | 20.6 | 23.2 | 0.2 | 13.7 | 100 | 33 |
| 2013 | Unfenced | WNC | 43.0 | 32.3 | 2.0 | 37.3 | 100 | 27 |
| BL | Fenced | WC | 16.9 | 23.9 | 0.2 | 10.5 | 100 | 17 |
| BL | Unfenced | WC | 26.5 | 23.7 | 0.3 | 23.0 | 100 | 19 |
| BL | Unfenced | WNC | 36.9 | 28.2 | 2.6 | 30.5 | 100 | 32 |
# summary.TC.fenced.site_type %>%
# gt::gtsave(file = "./output/tables/summary_cover_all_willow.rtf")## fenced and burned, all range type
##### summary tables for cover
# pooled across range types, fenced, burned
## Time class FENCED SITE_TYPE
summary.TC.burned.fenced <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, FENCED, BURNED) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, Fenced = FENCED, Burned = BURNED, n = n.valid) %>%
gt() %>%
tab_header(title = "Willow cover - All species, range types, and fenced/burned status")
summary.TC.burned.fenced | Willow cover - All species, range types, and fenced/burned status | ||||||||
| Time class | Fenced | Burned | mean | sd | min | med | max | n |
|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | Burned | 38.6 | 29.2 | 5.0 | 26.1 | 100.0 | 13 |
| 2018 | Fenced | Unburned | 69.1 | 33.4 | 13.7 | 76.0 | 100.0 | 15 |
| 2018 | Unfenced | Burned | 15.1 | 34.4 | 0.3 | 3.0 | 100.0 | 8 |
| 2018 | Unfenced | Unburned | 48.6 | 33.2 | 0.2 | 47.0 | 100.0 | 58 |
| 2013 | Fenced | Burned | 12.0 | 21.3 | 0.1 | 3.9 | 78.5 | 13 |
| 2013 | Fenced | Unburned | 42.9 | 30.2 | 2.1 | 47.6 | 100.0 | 15 |
| 2013 | Unfenced | Burned | 11.1 | 23.2 | 0.7 | 2.2 | 71.7 | 9 |
| 2013 | Unfenced | Unburned | 34.1 | 29.5 | 0.2 | 26.9 | 100.0 | 51 |
| BL | Fenced | Burned | 2.9 | 3.1 | 0.2 | 1.6 | 8.9 | 7 |
| BL | Fenced | Unburned | 26.8 | 27.4 | 1.1 | 19.6 | 100.0 | 10 |
| BL | Unfenced | Burned | 2.8 | NA | 2.8 | 2.8 | 2.8 | 1 |
| BL | Unfenced | Unburned | 33.6 | 26.7 | 0.3 | 26.8 | 100.0 | 50 |
# summary.TC.burned.fenced %>%
# gt::gtsave(file = "./output/tables/summary_cover_allwillow_allRT_fenced_burned.rtf")
# canopy.all.willow.sum %>%
# filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
# filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# mutate(timeClass = fct_drop(timeClass)) %>%
# mutate(timeClass = fct_rev(timeClass)) %>%
# group_by(timeClass, BURNED) %>%
# summarytools::descr(var = cover.allwillow,
# stats = "common") %>%
# tb() %>%
# mutate_if(is.numeric, round,1) %>%
# select(-c(variable,pct.valid)) %>%
# # datatable()
# datatable(.,extensions = 'Buttons',
# options = list(scrollX=TRUE, lengthMenu = c(5,10,15),
# paging = TRUE, searching = TRUE,
# fixedColumns = TRUE, autoWidth = TRUE,
# ordering = TRUE, dom = 'tB',
# buttons = c('copy', 'csv')))## burned and fenced: separated by range type
##### summary tables for cover
# pooled across range types, fenced, burned
## Time class FENCED SITE_TYPE
summary.TC.burned.fenced.rangetype <- canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, SITE_TYPE, FENCED, BURNED) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, Fenced = FENCED, Burned = BURNED, n = n.valid) %>%
gt() %>%
tab_header(title = "Willow cover - All species, grouped by range type, fencing and burning")
summary.TC.burned.fenced.rangetype| Willow cover - All species, grouped by range type, fencing and burning | |||||||||
| Time class | SITE_TYPE | Fenced | Burned | mean | sd | min | med | max | n |
|---|---|---|---|---|---|---|---|---|---|
| 2018 | WC | Fenced | Burned | 38.6 | 29.2 | 5.0 | 26.1 | 100.0 | 13 |
| 2018 | WC | Fenced | Unburned | 69.1 | 33.4 | 13.7 | 76.0 | 100.0 | 15 |
| 2018 | WC | Unfenced | Burned | 15.1 | 34.4 | 0.3 | 3.0 | 100.0 | 8 |
| 2018 | WC | Unfenced | Unburned | 40.1 | 32.0 | 0.2 | 33.0 | 100.0 | 26 |
| 2018 | WNC | Unfenced | Unburned | 55.5 | 33.1 | 1.4 | 52.7 | 100.0 | 32 |
| 2013 | WC | Fenced | Burned | 12.0 | 21.3 | 0.1 | 3.9 | 78.5 | 13 |
| 2013 | WC | Fenced | Unburned | 42.9 | 30.2 | 2.1 | 47.6 | 100.0 | 15 |
| 2013 | WC | Unfenced | Burned | 11.1 | 23.2 | 0.7 | 2.2 | 71.7 | 9 |
| 2013 | WC | Unfenced | Unburned | 24.2 | 22.6 | 0.2 | 24.6 | 100.0 | 24 |
| 2013 | WNC | Unfenced | Unburned | 43.0 | 32.3 | 2.0 | 37.3 | 100.0 | 27 |
| BL | WC | Fenced | Burned | 2.9 | 3.1 | 0.2 | 1.6 | 8.9 | 7 |
| BL | WC | Fenced | Unburned | 26.8 | 27.4 | 1.1 | 19.6 | 100.0 | 10 |
| BL | WC | Unfenced | Burned | 2.8 | NA | 2.8 | 2.8 | 2.8 | 1 |
| BL | WC | Unfenced | Unburned | 27.9 | 23.6 | 0.3 | 24.7 | 100.0 | 18 |
| BL | WNC | Unfenced | Unburned | 36.9 | 28.2 | 2.6 | 30.5 | 100.0 | 32 |
# summary.TC.burned.fenced %>%
# gt::gtsave(file = "./output/tables/summary_cover_allwillow_allRT_fenced_burned.rtf")
# data table
canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, SITE_TYPE, FENCED, BURNED) %>%
summarytools::descr(var = cover.allwillow,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
datatable()## gtsummary
canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
# mutate(timeClass = as.character(timeClass)) %>%
select(timeClass, SITE_TYPE, FENCED, cover.allwillow) %>%
gtsummary::tbl_summary(
by = timeClass,
include = c(timeClass,cover.allwillow)) %>%
add_p()
canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# mutate(timeClass = fct_rev(timeClass)) %>%
mutate(timeClass = as.character(timeClass)) %>%
select(timeClass, SITE_TYPE, FENCED, cover.allwillow) %>%
gtsummary::tbl_summary(
by = timeClass,
statistic = list(all_continuous() ~ "{mean} ({sd})",
all_categorical() ~ "{n} / {N} ({p}%)"))
canopy.all.willow.sum %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# mutate(timeClass = fct_rev(timeClass)) %>%
mutate(timeClass = as.character(timeClass)) %>%
select(timeClass, SITE_TYPE, FENCED, cover.allwillow) %>%
gtsummary::tbl_summary(
by = timeClass,
statistic = list(all_continuous() ~ "{mean} ({sd})",
all_categorical() ~ "{n} / {N} ({p}%)"))#### # check te lz weighting
## exluding WK
canopy.all.willow.sum %>%
mutate(cover.allwillow = case_when(is.na(cover.allwillow) ~ 0,
TRUE ~ cover.allwillow)) %>%
filter(SITE_TYPE == "WC" | SITE_TYPE == "WNC") %>% group_by(BURNED, FENCED, timeClass) %>%
summarise(n.cond.tc = n(), mean.cov = mean(cover.allwillow, na.rm = TRUE)) %>%
ungroup() %>%
group_by(timeClass) %>%
mutate(n.tc = sum(n.cond.tc)) %>%
ungroup() %>%
mutate(weight = n.cond.tc/n.tc) %>%
mutate(mean.cov.wt = weight*mean.cov) %>%
datatable()WC
canopy.all.willow.sum %>%
group_by(timeClass, SITE_TYPE) %>%
descr(cover.allwillow) %>%
summarytools::tb() %>%
datatable(filter = "top")### Fig 37 revised 2022
##
## Filter to just 5 yr resample and WC
canopy.all.willow.sum %>%
# mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
ggplot(aes(timeClass, cover.allwillow)) +
geom_boxplot(fill = "grey50") +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
facet_wrap(~FENCED) +
labs(caption = "WC all willows combined macroplot cover", y = "% cover", x = "") +
theme_minimal()
ggsave("./output/figures_202108/cover_wc_boxplot_TCxF_dfc.png", width = 6.25, height = 3.75, dpi =300)plx1 <- canopy.all.willow.sum %>%
# mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WC") %>%
filter(FENCED == "Fenced") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
ggplot(aes(timeClass, cover.allwillow)) +
geom_boxplot(fill = "grey50") +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
# facet_wrap(~FENCED) +
labs(x="Year", y = "Willow canopy cover (%)") +
theme_minimal()
plx2 <- canopy.all.willow.sum %>%
# mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WC") %>%
filter(FENCED == "Unfenced") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
ggplot(aes(timeClass, cover.allwillow)) +
geom_boxplot(fill = "grey50") +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
# facet_wrap(~FENCED) +
labs(x="Year", y="") +
theme_minimal()
plx1 + plx2 +
plot_annotation(tag_levels = "A")
ggsave("./output/figures_202202/Fig37_cover_wc_boxplot_TCxF_dfc.png", width = 6.25, height = 3.75, dpi =300)
ggsave("./output/figures_202202/Fig37_cover_wc_boxplot_TCxF_dfc.pdf", width = 6.25, height = 3.75)## create summary table
canopy.all.willow.sum %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE, FENCED) %>%
summarytools::descr(cover.allwillow) %>%
summarytools::tb() %>%
mutate(across(where(is.numeric),~round(.x, 1))) %>%
select(1,3,5:13, n.valid) %>%
gt()| timeClass | FENCED | mean | sd | min | q1 | med | q3 | max | mad | iqr | n.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | 54.9 | 34.6 | 5.0 | 22.1 | 55.8 | 96.5 | 100 | 53.3 | 71.5 | 28 |
| 2018 | Unfenced | 34.2 | 33.8 | 0.2 | 4.0 | 23.2 | 64.1 | 100 | 30.4 | 58.8 | 34 |
| 2013 | Fenced | 28.6 | 30.4 | 0.1 | 3.5 | 17.5 | 51.1 | 100 | 24.7 | 46.7 | 28 |
| 2013 | Unfenced | 20.6 | 23.2 | 0.2 | 2.4 | 13.7 | 29.7 | 100 | 18.6 | 27.3 | 33 |
| BL | Fenced | 16.9 | 23.9 | 0.2 | 1.6 | 10.5 | 20.9 | 100 | 14.0 | 19.2 | 17 |
| BL | Unfenced | 26.5 | 23.7 | 0.3 | 11.7 | 23.0 | 33.5 | 100 | 15.5 | 19.8 | 19 |
## WNC
## Filter to just 5 yr resample and WNC
canopy.all.willow.sum %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
ggplot(aes(timeClass, cover.allwillow)) +
geom_boxplot(fill = "grey60") +
geom_hline(aes(yintercept = 31), color = "red", lty = "dashed", size = 1) +
# facet_wrap(~FENCED) +
labs(caption = "WNC all willows combined macroplot cover", y = "% cover", x = "") +
theme_minimal()
# ggsave("./output/figures_202108/cover_wnc_boxplot01_revised.png", width = 3.75, height = 3.75, dpi=300)
# ggsave("./output/figures_202108/cover_wnc_boxplot01.pdf", width = 3.75, height = 3.75)
## create summary table
canopy.all.willow.sum %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(SITE_TYPE == "WNC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, SITE_TYPE, FENCED) %>%
summarytools::descr(cover.allwillow) %>%
summarytools::tb() %>%
mutate(across(where(is.numeric),~round(.x, 1))) %>%
select(1,3,5:13, n.valid) %>%
gt() %>%
tab_header(title = "Non-core range willow cover")| Non-core range willow cover | |||||||||||
| timeClass | FENCED | mean | sd | min | q1 | med | q3 | max | mad | iqr | n.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2018 | Unfenced | 55.5 | 33.1 | 1.4 | 34.8 | 52.7 | 93.4 | 100 | 46.0 | 56.6 | 32 |
| 2013 | Unfenced | 43.0 | 32.3 | 2.0 | 18.4 | 37.3 | 59.9 | 100 | 28.0 | 38.4 | 27 |
| BL | Unfenced | 36.9 | 28.2 | 2.6 | 14.2 | 30.5 | 51.1 | 100 | 27.3 | 36.6 | 32 |
# join cover for spatial export
canopy.all.willow.sum.wide <- canopy.all.willow.sum %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
clean_names() %>%
select(time_class, site_id, site_type, location, cover_allwillow) %>%
pivot_wider(names_from = time_class, names_glue = "cover{time_class}",values_from = cover_allwillow)
cov.willow.sf <- left_join(clean_names(site.info.clean.sf), canopy.all.willow.sum.wide, by = "site_id") %>%
filter(p_type == "willow")
# cov.willow.sf %>%
# st_write("./output/exported_data/spatial/willow_cover_20200907.shp")Management thresholds
Cover thresholds: winter range, TC
#### All willow species
canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
tabyl(time_class, thresh) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC - cover threshold of 31%")| WC+WNC - cover threshold of 31% | |||
| time_class | above | below | perc.above.thresh |
|---|---|---|---|
| BL | 23 | 45 | 33.8 |
| 2013 | 34 | 54 | 38.6 |
| 2018 | 57 | 37 | 60.6 |
Cover thresholds: winter range, TC x Fenced
canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
group_by(time_class, thresh, fenced) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from = thresh, values_from = n) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC - cover threshold of 31%")| WC+WNC - cover threshold of 31% | ||||
| time_class | fenced | above | below | perc.above.thresh |
|---|---|---|---|---|
| BL | Fenced | 1 | 16 | 5.9 |
| BL | Unfenced | 22 | 29 | 43.1 |
| 2013 | Fenced | 11 | 17 | 39.3 |
| 2013 | Unfenced | 23 | 37 | 38.3 |
| 2018 | Fenced | 17 | 11 | 60.7 |
| 2018 | Unfenced | 40 | 26 | 60.6 |
Cover thresholds: winter range, TC x burned
canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
group_by(time_class, thresh, burned) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from = thresh, values_from = n) %>%
replace_na(list(above = 0, below = 0)) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC - cover threshold of 31%")| WC+WNC - cover threshold of 31% | ||||
| time_class | burned | above | below | perc.above.thresh |
|---|---|---|---|---|
| BL | Unburned | 23 | 37 | 38.3 |
| BL | Burned | 0 | 8 | 0.0 |
| 2013 | Burned | 2 | 20 | 9.1 |
| 2013 | Unburned | 32 | 34 | 48.5 |
| 2018 | Burned | 6 | 15 | 28.6 |
| 2018 | Unburned | 51 | 22 | 69.9 |
Cover thresholds: winter range, TC x fenced x burned
canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
group_by(time_class, thresh, fenced, burned) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from = thresh, values_from = n) %>%
replace_na(list(above = 0, below = 0)) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC - cover threshold of 31%")| WC+WNC - cover threshold of 31% | |||||
| time_class | fenced | burned | above | below | perc.above.thresh |
|---|---|---|---|---|---|
| BL | Fenced | Unburned | 1 | 9 | 10.0 |
| BL | Unfenced | Unburned | 22 | 28 | 44.0 |
| BL | Fenced | Burned | 0 | 7 | 0.0 |
| BL | Unfenced | Burned | 0 | 1 | 0.0 |
| 2013 | Fenced | Burned | 1 | 12 | 7.7 |
| 2013 | Fenced | Unburned | 10 | 5 | 66.7 |
| 2013 | Unfenced | Burned | 1 | 8 | 11.1 |
| 2013 | Unfenced | Unburned | 22 | 29 | 43.1 |
| 2018 | Fenced | Burned | 5 | 8 | 38.5 |
| 2018 | Fenced | Unburned | 12 | 3 | 80.0 |
| 2018 | Unfenced | Burned | 1 | 7 | 12.5 |
| 2018 | Unfenced | Unburned | 39 | 19 | 67.2 |
canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
mutate(time_class = fct_rev(time_class)) %>%
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
group_by(time_class, thresh, fenced, burned) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from = thresh, values_from = n) %>%
# replace_na(list(above = 0, below = 0)) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
ggplot(aes(x = fenced, y = burned)) +
geom_tile(aes(fill = perc.above.thresh), color = 'grey80', alpha=0.85) +
# scale_fill_viridis_b() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
geom_text(aes(label = round(perc.above.thresh,1)), color = "grey70", size=.5, alpha = 1) +
theme_minimal() +
labs(x = "", y = "", fill = "% above \n threshold") +
facet_grid(~time_class)
ggsave("./output/figures_202108/WCWNC_willow_percentPlotCovThresh_dfc.png", width = 5.5, height = 2.25)canopy.all.willow.sum %>%
clean_names() %>%
filter(!is.na(cover_allwillow)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
mutate(time_class = fct_rev(time_class)) %>%
filter(site_type != "WK") %>%
mutate(thresh = case_when(cover_allwillow >=31 ~ "above",
cover_allwillow <31 ~ "below")) %>%
group_by(time_class, site_type, thresh, fenced, burned) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from = thresh, values_from = n) %>%
# replace_na(list(above = 0, below = 0)) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
ggplot(aes(x = fenced, y = burned)) +
geom_tile(aes(fill = perc.above.thresh), color = 'grey80', alpha=0.85) +
# scale_fill_viridis_b() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
geom_text(aes(label = round(perc.above.thresh,1)), color = "black", alpha = .85) +
theme_minimal() +
labs(x = "", y = "", fill = "% above \n threshold", caption = "WCxWNC_willow_percentPlotCovThresh_dfc.png") +
facet_grid(site_type~time_class)
ggsave("./output/figures_202108/WCxWNC_willow_percentPlotCovThresh_dfc.png", width = 5.5, height = 2.5)Range-wide weighted summaries
## add condition classes per Zeigenfuss SAS code
## code excerpt
# group=_name_;
# if group='nonwillo' then delete;
# if burn='Y' and fence='N' then cond='BG';
# if burn='Y' and fence='Y' then cond='BF';
# if burn='N' and fence='N' then cond='UG';
# if burn='N' and fence='Y' then cond='UF';
## range wide estimates
# weights from 2013
# if year=2013 and cond='BF' then areawt=0.085;
# if year=2013 and cond='BG' then areawt=0.45;
# if year=2013 and cond='UG' then areawt=0.219;
# if year=2013 and cond='UF' then areawt=0.117;
# if site_type='WNC' then areawt=0.129;
## I can not find in the SAS code where the areawt values are calculated; just applying those in SAS code
## table 8 Zeigenfuss 2015. timeClass x fenced x site type
lz.wt.willow.tb8 <- tribble(
~timeClass, ~site_typeXfenced, ~areawt, ~SITE_TYPE,
"2013", "WC-Fenced", 0.202, "WC",
"2013", "WC-Unfenced", 0.669, "WC",
"2013", "WNC-Unfenced", 0.129, "WNC",
"2018", "WC-Fenced", 0.202, "WC",
"2018", "WC-Unfenced", 0.669, "WC",
"2018", "WNC-Unfenced", 0.129, "WNC",
# "BL", "WC-Fenced", 0.871, "WC",
"BL", "WC-Fenced", 0.202, "WC",
"BL", "WC-Unfenced", 0.669, "WC",
"BL", "WNC-Unfenced", 0.129, "WNC"
)
## Summarized to WC and WNC by timeClass
lz.wt.willow.tb8_sitetype <- lz.wt.willow.tb8 %>%
group_by(timeClass,SITE_TYPE) %>%
summarise(areawt = sum(areawt)) %>%
ungroup()
# lz.wt.willow.tb8_sitetype %>%
# gt()
## table 9 in Zeigenfuss 2015. Burning, fencing, site type
# create a tibble from the area wts in the SAS code above
lz.wt.willow.tbl9 <- tribble(
~timeClass, ~zCond, ~areawt_lz, ~SITE_TYPE,
"2013", "BF", 0.085, "WC",
"2013", "BG", 0.45, "WC",
"2013", "UG", 0.219, "WC",
"2013", "UF", 0.117, "WC",
"2013", "UG", 0.129, "WNC",
"2018", "BF", 0.085, "WC",
"2018", "BG", 0.45, "WC",
"2018", "UG", 0.219, "WC",
"2018", "UF", 0.117, "WC",
"2018", "UG", 0.129, "WNC",
"BL", "UG", 0.871,"WC",
"BL", "UG", 0.129,"WNC"
)
lz.wt.willow.tbl9 <- lz.wt.willow.tbl9 %>%
mutate(zCond2 = paste0(SITE_TYPE,"-",zCond)) %>%
mutate(zCond2_tc = paste0(SITE_TYPE,"-",zCond,"-",timeClass)) %>%
select(zCond2_tc,areawt_lz)
lz.wt.willow.tbl9 %>%
rename(Category=zCond2_tc, Weight = areawt_lz) %>%
gt() %>%
tab_header(title = "Area weights used in Zeigenfuss 2015 Table 9")| Area weights used in Zeigenfuss 2015 Table 9 | |
| Category | Weight |
|---|---|
| WC-BF-2013 | 0.085 |
| WC-BG-2013 | 0.450 |
| WC-UG-2013 | 0.219 |
| WC-UF-2013 | 0.117 |
| WNC-UG-2013 | 0.129 |
| WC-BF-2018 | 0.085 |
| WC-BG-2018 | 0.450 |
| WC-UG-2018 | 0.219 |
| WC-UF-2018 | 0.117 |
| WNC-UG-2018 | 0.129 |
| WC-UG-BL | 0.871 |
| WNC-UG-BL | 0.129 |
#### Table 8 in Zeigenfuss 2015 - update for willow cover variable
# unweighted table 8. Inludes burned sites
tbl8.cov <- canopy.all.willow.sum %>%
# filter(BURNED == "Unburned") %>%
filter(SITE_TYPE != "WK") %>%
mutate(fenceClass_tc = paste0(SITE_TYPE,"-",FENCED,"-",timeClass)) %>%
mutate(site_typeXfenced = paste0(SITE_TYPE,"-", FENCED)) %>%
# mutate(fenceClass_tc = paste0(SITE_TYPE,"-",FENCED,"-",timeClass)) %>%
group_by(timeClass, SITE_TYPE, FENCED, site_typeXfenced) %>%
summarise(n = n(), mean.cov = mean(cover.allwillow, na.rm=TRUE), sd.cov = sd(cover.allwillow, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.cov/sqrt(n)) %>%
mutate(across(where(is.numeric),round,1)) %>%
arrange(timeClass)
##
tbl8.cov <- left_join(tbl8.cov, lz.wt.willow.tb8) %>%
mutate(mean.cov.wt = areawt*mean.cov, se.cov.wt = areawt*se)
## RANGE wide estimate tbl8.cov
tbl8.cov.rangewide <- tbl8.cov %>%
group_by(timeClass) %>%
summarise(mean.cov = sum(mean.cov.wt, na.rm=TRUE), se = sum(se.cov.wt, na.rm=TRUE)) %>%
mutate(across(where(is.numeric),round,0)) %>%
mutate(mean_se = paste0(mean.cov,"(+/-",se,")")) %>%
mutate(site_typeXfenced = "Entire winter range (weighted avg)")
### table 8
tbl8.cov %>%
mutate(mean_se = paste0(mean.cov,"(+/-",se,")")) %>%
bind_rows(.,tbl8.cov.rangewide) %>%
select(timeClass, SITE_TYPE, FENCED, site_typeXfenced, mean_se) %>%
pivot_wider(names_from = timeClass,
# names_glue = "{timeClass}_test_{FENCED}",
values_from = mean_se) %>%
select(-c(FENCED, SITE_TYPE)) %>%
relocate('Winter range zone' = site_typeXfenced, "Baseline" = "BL",'2013','2018') %>%
gt() %>%
tab_header(title = "Willow cover (percent)")| Willow cover (percent) | |||
| Winter range zone | Baseline | 2013 | 2018 |
|---|---|---|---|
| WC-Fenced | 16.9(+/-4) | 28.6(+/-5.4) | 54.9(+/-10.4) |
| WC-Unfenced | 26.5(+/-5.4) | 20.6(+/-3.5) | 34.2(+/-5.9) |
| WNC-Unfenced | 36.9(+/-6.5) | 43(+/-7.6) | 55.5(+/-9.8) |
| Entire winter range (weighted avg) | 26(+/-5) | 25(+/-4) | 41(+/-7) |
### range wide (bottomline of table)
lz.wt.willow.tb8_sitetype## # A tibble: 6 x 3
## timeClass SITE_TYPE areawt
## <chr> <chr> <dbl>
## 1 2013 WC 0.871
## 2 2013 WNC 0.129
## 3 2018 WC 0.871
## 4 2018 WNC 0.129
## 5 BL WC 0.871
## 6 BL WNC 0.129# unweighted table 9
wt.cov.rangewide <- canopy.all.willow.sum %>%
filter(SITE_TYPE != "WK") %>%
group_by(timeClass, SITE_TYPE) %>%
summarise(n = n(), mean.cov = mean(cover.allwillow, na.rm=TRUE), sd.cov = sd(cover.allwillow, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se.cov = mean.cov/sqrt(n))
wt.cov.rangewide <- wt.cov.rangewide %>%
left_join(.,lz.wt.willow.tb8_sitetype) %>%
mutate(mean.cov.wt = areawt*mean.cov, se.cov.wt = areawt*se.cov) %>%
group_by(timeClass) %>%
summarise(mean.cov.wt = sum(mean.cov.wt),se.cov.wt = sum(se.cov.wt)) %>%
ungroup() %>%
mutate(timeClass= as_factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "BL", before="2013")) %>%
arrange(timeClass)
wt.cov.rangewide %>%
mutate(across(where(is.numeric), round, 1)) %>%
gt() %>%
tab_header(title="Entire winter range (weighted average")| Entire winter range (weighted average | ||
| timeClass | mean.cov.wt | se.cov.wt |
|---|---|---|
| BL | 23.9 | 3.8 |
| 2013 | 26.7 | 3.6 |
| 2018 | 45.1 | 6.1 |
# comp to bl:20(2); 2013:24(3); na in zeigenfuss 2015# unweighted table 9
wt.cov <- canopy.all.willow.sum %>%
filter(SITE_TYPE != "WK") %>%
mutate(zCond2_tc = paste0(SITE_TYPE,"-",zCond,"-",timeClass)) %>%
group_by(timeClass, SITE_TYPE, BURNED, FENCED, zCond2,zCond2_tc) %>%
summarise(n = n(), mean.cov = mean(cover.allwillow, na.rm=TRUE), sd.cov = sd(cover.allwillow, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.cov/sqrt(n)) %>%
arrange(timeClass, zCond2)### zcond2
# join in weights from 2015 SAS code
wt.cov.zcond2 <- left_join(wt.cov, lz.wt.willow.tbl9, by="zCond2_tc") %>%
mutate(mean.cov.wt = areawt_lz*mean.cov, se.wt = areawt_lz*se)
## check sum of weights = 1
temp1 <- wt.cov.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass,SITE_TYPE) %>%
summarise(sum.wt.cov = sum(mean.cov.wt, na.rm=TRUE), sum.wt.wt = sum(areawt_lz, na.rm=TRUE)) %>%
ungroup()
temp1## # A tibble: 6 x 4
## timeClass SITE_TYPE sum.wt.cov sum.wt.wt
## <fct> <chr> <dbl> <dbl>
## 1 2018 WC 27.0 0.871
## 2 2018 WNC 7.17 0.129
## 3 2013 WC 16.3 0.871
## 4 2013 WNC 5.55 0.129
## 5 BL WC 24.3 0.871
## 6 BL WNC 4.76 0.129temp1 %>%
group_by(timeClass) %>%
summarise(wt.cov = sum((sum.wt.cov*sum.wt.wt)))## # A tibble: 3 x 2
## timeClass wt.cov
## <fct> <dbl>
## 1 2018 24.4
## 2 2013 15.0
## 3 BL 21.7wt.cov.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
select(timeClass, zCond2, mean.wt) %>%
pivot_wider(names_from = timeClass, values_from = c(mean.wt)) %>%
clean_names() %>%
gt()
wt.cov.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
select(timeClass, zCond2, mean, mean.wt) %>%
pivot_wider(names_from = timeClass, values_from = c(mean.wt)) %>%
clean_names() %>%
gt()
wt.cov.zcond2 %>%
arrange(zCond2) %>%
datatable()canopy.all.willow.sum %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
filter(SITE_TYPE != "WK") %>%
group_by(timeClass)## # A tibble: 263 x 13
## # Groups: timeClass [3]
## timeClass yr SITE_ID SITE_~1 LOCAT~2 FENCED BURNED cano.~3 cano.~4 cover~5
## <fct> <dbl> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 BL 2008 WC01 WC Horses~ Fenced Unbur~ 2.92 0.183 18.3
## 2 BL 2008 WC02 WC Horses~ Fenced Unbur~ 3.34 0.0879 20.9
## 3 BL 2008 WC03 WC Horses~ Fenced Unbur~ 4.91 0.123 30.7
## 4 BL 2008 WC04 WC Horses~ Fenced Unbur~ 4.42 0.632 27.6
## 5 BL 2008 WC09 WC Horses~ Fenced Unbur~ 2.55 0.255 15.9
## 6 BL 2008 WC10 WC Horses~ Fenced Unbur~ 17.1 1.31 100
## 7 BL 2008 WC12 WC Endova~ Unfen~ Unbur~ 7.66 0.957 47.9
## 8 BL 2008 WC13 WC Endova~ Unfen~ Unbur~ 5.36 0.446 33.5
## 9 BL 2008 WC14 WC Endova~ Unfen~ Unbur~ 4.25 0.250 26.5
## 10 BL 2008 WC15 WC Endova~ Unfen~ Unbur~ 4.51 0.451 28.2
## # ... with 253 more rows, 3 more variables: zCond <chr>, zCond2 <chr>,
## # site_type2 <chr>, and abbreviated variable names 1: SITE_TYPE, 2: LOCATION,
## # 3: cano.sum.m2, 4: cano.mean.m2, 5: cover.allwillow## transform
##
# add transform following method in Zeigenfuss
#
canopy.all.willow.sum <- canopy.all.willow.sum %>%
mutate(cover.transformed = cover.allwillow/100) %>%
mutate(cover.transformed = case_when(cover.transformed == 1 ~ 1-0.0883573,
cover.transformed == 0 ~ 0.0883573,
TRUE ~ cover.transformed)) %>%
mutate(cover.transformed = log(cover.transformed/(1-cover.transformed)))Height
All shrubs species
Summary statistics: WC and WNC plots
# All shrub species
# Combined Winter Range combined (-WK)
ht.WCWNC.allShrub.plotsummary <- csv.all.lc.mcro.df %>%
mutate(timeClass = fct_rev(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_TYPE == "WC" |SITE_TYPE == "WNC") %>%
select(timeClass, SITE_ID, PLANT_HT_CM) %>%
group_by(timeClass,SITE_ID) %>%
summarise(PLANT_HT_CM_mean = mean(PLANT_HT_CM, na.rm=TRUE), PLANT_HT_CM_max = max(PLANT_HT_CM),PLANT_HT_CM_median = median(PLANT_HT_CM)) %>%
ungroup()
## median
ht.WCWNC.allShrub.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_median, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
gt() %>%
tab_header(title = "Shrub height (macroplot median, all shrub species)") %>%
fmt_number(
columns = 2:11,
decimals = 1,
suffixing = TRUE
) # %>% gtsave("./output/tables/Mcplot_allshrubHT_median_WCandWNC_TC.rtf")| Shrub height (macroplot median, all shrub species) | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 104.3 | 89.7 | 0.0 | 50.0 | 67.5 | 125.0 | 430.0 | 40.8 | 75.0 | 81.0 |
| 2018 | 106.0 | 85.3 | 10.0 | 50.0 | 80.0 | 137.5 | 530.0 | 51.9 | 83.8 | 103.0 |
| 2013 | 90.2 | 90.6 | 0.0 | 40.0 | 60.0 | 100.0 | 530.0 | 37.1 | 58.8 | 99.0 |
## macroplot mean -- all shrubs
ht.WCWNC.allShrub.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_mean, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
gt() %>%
tab_header(title = "Shrub height (macroplot mean, all shrub species)") %>%
fmt_number(
columns = 2:11,
decimals = 1,
suffixing = TRUE
) # %>% gtsave("./output/tables/Mcplot_allshrubHT_mean_WCandWNC_TC.rtf")| Shrub height (macroplot mean, all shrub species) | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 112.1 | 85.9 | 0.0 | 54.3 | 84.8 | 136.1 | 430.0 | 49.9 | 81.7 | 81.0 |
| 2018 | 115.9 | 78.5 | 13.3 | 59.9 | 90.0 | 157.9 | 513.0 | 59.3 | 97.1 | 103.0 |
| 2013 | 108.5 | 96.7 | 0.0 | 45.0 | 78.5 | 126.2 | 530.0 | 54.4 | 80.2 | 106.0 |
## macroplot max ht -- all shrubs
ht.WCWNC.allShrub.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_max, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
gt() %>%
tab_header(title = "Shrub height (macroplot max, all shrub species)") %>%
fmt_number(
columns = 2:11,
decimals = 1,
suffixing = TRUE
) # %>% gtsave("./output/tables/Mcplot_allshrubHT_max_WCandWNC_TC.rtf")| Shrub height (macroplot max, all shrub species) | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 226.0 | 154.7 | 0.0 | 85.0 | 190.0 | 365.0 | 630.0 | 177.9 | 280.0 | 81.0 |
| 2018 | 262.2 | 154.6 | 25.0 | 130.0 | 240.0 | 370.0 | 810.0 | 185.3 | 235.0 | 103.0 |
| 2013 | 210.6 | 177.8 | 0.0 | 70.0 | 145.0 | 325.0 | 850.0 | 126.0 | 250.0 | 99.0 |
## add in fencing
# Combined Winter Range combined (-WK)
ht.WCWNC.allShrub.fence.plotsummary <- csv.all.lc.mcro.df %>%
mutate(timeClass = fct_rev(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_TYPE == "WC" |SITE_TYPE == "WNC") %>%
select(timeClass, SITE_ID, FENCED, PLANT_HT_CM) %>%
group_by(timeClass,SITE_ID, FENCED) %>%
summarise(PLANT_HT_CM_mean = mean(PLANT_HT_CM, na.rm=TRUE), PLANT_HT_CM_max = max(PLANT_HT_CM),PLANT_HT_CM_median = median(PLANT_HT_CM)) %>%
ungroup()ht.WCWNC.allShrub.fence.plotsummary.tidy <- ht.WCWNC.allShrub.fence.plotsummary %>%
pivot_longer(
cols = starts_with("PLANT"),
names_to = "htvar",
values_to = "value"
)
ht.WCWNC.allShrub.fence.plotsummary.tidy %>%
mutate(htvar = case_when(htvar == "PLANT_HT_CM_max" ~ "max",
htvar == "PLANT_HT_CM_mean" ~ "mean",
htvar == "PLANT_HT_CM_median" ~ "median"
)) %>%
# ggplot(aes(htvar, value)) +
ggplot(aes(value)) +
geom_density(aes(color=htvar, lty = htvar), size=1) +
scale_colour_brewer(palette = "Dark2") +
# geom_boxplot() +
# facet_wrap(~FENCED) +
facet_grid(FENCED~timeClass) +
theme_minimal() +
coord_flip() +
labs(title = "Comparison of shrub height plot level metrics", subtitle="Combined WC & WNC plots, all shrub species", x = "Willow height (cm)", color="",lty = "")
# Mean Combined Winter Range (-WK): Fenced
ht.WCWNC.allShrub.fence.plotsummary %>%
group_by(timeClass, FENCED) %>%
summarytools::descr(var = PLANT_HT_CM_mean, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Shrub height (macroplot mean, all shrub species)") # %>% gtsave("./output/tables/Mcplot_allshrubHT_fencing_mean_WCandWNC_TC.rtf")| Shrub height (macroplot mean, all shrub species) | |||||||||||
| Time class | FENCED | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Fenced | 67.1 | 31.4 | 0.0 | 51.2 | 65.0 | 80.4 | 130.0 | 22.8 | 29.2 | 21 |
| BL | Unfenced | 127.9 | 93.3 | 0.0 | 62.7 | 93.2 | 174.3 | 430.0 | 63.6 | 106.9 | 60 |
| 2018 | Fenced | 107.5 | 49.7 | 39.3 | 78.3 | 91.7 | 134.1 | 230.0 | 31.5 | 55.8 | 29 |
| 2018 | Unfenced | 119.2 | 87.3 | 13.3 | 56.0 | 87.5 | 177.1 | 513.0 | 66.2 | 118.1 | 74 |
| 2013 | Fenced | 76.3 | 67.9 | 0.0 | 39.4 | 60.0 | 88.4 | 361.7 | 37.1 | 48.2 | 31 |
| 2013 | Unfenced | 121.7 | 103.9 | 0.0 | 46.0 | 87.8 | 175.5 | 530.0 | 64.0 | 127.8 | 75 |
# Mean all winter range combined (-WK): Fenced
ht.WCWNC.allShrub.fence.plotsummary %>%
group_by(timeClass, FENCED) %>%
summarytools::descr(var = PLANT_HT_CM_max, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Shrub height (macroplot max, all shrub species)")| Shrub height (macroplot max, all shrub species) | |||||||||||
| Time class | FENCED | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Fenced | 133.3 | 118.8 | 0 | 70.0 | 100.0 | 130 | 520 | 44.5 | 60.0 | 21 |
| BL | Unfenced | 258.5 | 153.5 | 0 | 112.5 | 277.5 | 380 | 630 | 185.3 | 266.2 | 60 |
| 2018 | Fenced | 214.0 | 59.5 | 65 | 175.0 | 220.0 | 260 | 345 | 59.3 | 85.0 | 29 |
| 2018 | Unfenced | 281.1 | 175.3 | 25 | 110.0 | 287.5 | 400 | 810 | 237.2 | 290.0 | 74 |
| 2013 | Fenced | 145.6 | 149.4 | 0 | 70.0 | 110.0 | 185 | 850 | 74.1 | 112.5 | 31 |
| 2013 | Unfenced | 240.2 | 182.8 | 0 | 75.0 | 190.0 | 410 | 750 | 192.7 | 335.0 | 68 |
All willows
# all winter range combined (-WK)
## just willow species
## calculate the mean, max, and median willow height by plot id
## grouped by timeClass and SITE_ID
ht.WCWNC.willow.plotsummary <- csv.all.lc.mcro.df %>%
mutate(timeClass = fct_rev(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_TYPE == "WC" |SITE_TYPE == "WNC") %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
select(timeClass, SITE_ID, PLANT_HT_CM, SITE_TYPE,FENCED,zCond, zCond2) %>%
group_by(timeClass,SITE_ID,SITE_TYPE,FENCED, zCond, zCond2) %>%
summarise(PLANT_HT_CM_mean = mean(PLANT_HT_CM, na.rm=TRUE), PLANT_HT_CM_median = median(PLANT_HT_CM), PLANT_HT_CM_max = max(PLANT_HT_CM)) %>%
ungroup()## summary table: mean ht
ht.WCWNC.willow.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_mean, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Mean plot willow height", subtitle = "All willows, WC & WNC macroplots") #%>%| Mean plot willow height | ||||||||||
| All willows, WC & WNC macroplots | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 119.6 | 90.5 | 15.0 | 56.8 | 87.0 | 159.0 | 430.0 | 61.1 | 101.7 | 74 |
| 2018 | 150.7 | 89.1 | 33.3 | 82.7 | 135.6 | 198.7 | 508.8 | 79.3 | 111.9 | 94 |
| 2013 | 134.0 | 102.0 | 26.7 | 62.5 | 100.6 | 182.5 | 530.0 | 75.4 | 109.8 | 95 |
# gtsave("./output/tables/Mcplot_mean_HT_all_willow_WCandWNC_TC.rtf")
## summary table: max ht
ht.WCWNC.willow.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_max, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Max plot willow height", subtitle = "All willows, WC & WNC macroplots") #%>%| Max plot willow height | ||||||||||
| All willows, WC & WNC macroplots | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 211.5 | 140.9 | 15 | 90.0 | 157.5 | 340.0 | 520 | 137.1 | 250.0 | 74 |
| 2018 | 253.8 | 133.7 | 35 | 160.0 | 245.0 | 350.0 | 710 | 140.8 | 186.2 | 94 |
| 2013 | 201.5 | 141.7 | 35 | 77.5 | 157.5 | 317.5 | 530 | 129.7 | 237.5 | 88 |
#gtsave("./output/tables/Mcplot_max_HT_all_willow_WCandWNC_TC.rtf")
## summary table: median ht
ht.WCWNC.willow.plotsummary %>%
group_by(timeClass) %>%
summarytools::descr(var = PLANT_HT_CM_median, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Median plot willow height", subtitle = "All willows, WC & WNC macroplots") #%>%| Median plot willow height | ||||||||||
| All willows, WC & WNC macroplots | ||||||||||
| Time class | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | 115.1 | 95.4 | 15 | 50.0 | 70.0 | 130.0 | 430 | 44.5 | 79.2 | 74 |
| 2018 | 146.2 | 97.9 | 30 | 75.0 | 128.8 | 200.0 | 555 | 87.1 | 122.5 | 94 |
| 2013 | 119.1 | 99.4 | 15 | 53.8 | 83.8 | 152.5 | 530 | 55.6 | 96.9 | 88 |
# gtsave("./output/tables/Mcplot_median_HT_all_willow_WCandWNC_TC.rtf")## table:
ht.WCWNC.willow.plotsummary %>%
group_by(timeClass, FENCED) %>%
summarytools::descr(var = PLANT_HT_CM_mean, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
gt() %>%
tab_header(title = "Mean plot willow height", subtitle = "All willows, WC & WNC macroplots")| Mean plot willow height | |||||||||||
| All willows, WC & WNC macroplots | |||||||||||
| Time class | FENCED | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Fenced | 66.5 | 33.1 | 15.0 | 45.0 | 58.2 | 86.4 | 130.0 | 24.5 | 40.3 | 18 |
| BL | Unfenced | 136.7 | 96.6 | 28.8 | 62.1 | 92.9 | 202.7 | 430.0 | 74.3 | 138.4 | 56 |
| 2018 | Fenced | 154.4 | 56.8 | 50.2 | 103.6 | 146.2 | 204.3 | 280.0 | 68.4 | 96.4 | 28 |
| 2018 | Unfenced | 149.1 | 100.1 | 33.3 | 67.4 | 131.2 | 185.7 | 508.8 | 93.7 | 117.5 | 66 |
| 2013 | Fenced | 95.7 | 49.5 | 30.7 | 52.5 | 93.0 | 126.6 | 223.3 | 55.6 | 71.2 | 28 |
| 2013 | Unfenced | 150.0 | 113.7 | 26.7 | 63.0 | 104.2 | 228.3 | 530.0 | 82.7 | 162.4 | 67 |
## table adding in location and fencing
ht.WCWNC.willow.plotsummary %>%
group_by(timeClass, SITE_TYPE, FENCED) %>%
summarytools::descr(var = PLANT_HT_CM_mean, stats = "common") %>%
summarytools::tb() %>%
rename(n = n.valid, 'Time class' = timeClass) %>%
mutate(across(where(is.numeric),round,1)) %>%
mutate(variable = paste0("plot mean")) %>%
clean_names() %>%
gt() %>%
tab_header(title = "Mean plot willow height", subtitle = "All willows, WC & WNC macroplots") | Mean plot willow height | ||||||||||
| All willows, WC & WNC macroplots | ||||||||||
| time_class | site_type | fenced | variable | mean | sd | min | med | max | n | pct_valid |
|---|---|---|---|---|---|---|---|---|---|---|
| BL | WC | Fenced | plot mean | 66.5 | 33.1 | 15.0 | 58.2 | 130.0 | 18 | 100 |
| BL | WC | Unfenced | plot mean | 91.6 | 63.4 | 28.8 | 67.5 | 278.3 | 24 | 100 |
| BL | WNC | Unfenced | plot mean | 170.5 | 103.9 | 40.6 | 154.8 | 430.0 | 32 | 100 |
| 2018 | WC | Fenced | plot mean | 154.4 | 56.8 | 50.2 | 146.2 | 280.0 | 28 | 100 |
| 2018 | WC | Unfenced | plot mean | 104.8 | 69.0 | 33.3 | 74.7 | 287.2 | 34 | 100 |
| 2018 | WNC | Unfenced | plot mean | 196.1 | 107.2 | 63.8 | 179.8 | 508.8 | 32 | 100 |
| 2013 | WC | Fenced | plot mean | 95.7 | 49.5 | 30.7 | 93.0 | 223.3 | 28 | 100 |
| 2013 | WC | Unfenced | plot mean | 107.1 | 98.2 | 26.7 | 75.0 | 530.0 | 35 | 100 |
| 2013 | WNC | Unfenced | plot mean | 196.8 | 112.2 | 45.3 | 185.4 | 420.0 | 32 | 100 |
# ht.WCWNC.willow.plotsummaryMean height by willow species
pl.meanht.wcwnc.tile <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
# filter(SITE_TYPE == "WC") %>%
filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Combined Range")
pl.meanht.wc.tile <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Core Range")
pl.meanht.wnc.tile <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WNC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Noncore Range")
pl.meanht.wk.tile <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WK") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
# theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Kawuneeche Valley")
# pl.meanht.wk.tile
pl.meanht.wcwnc.tile + pl.meanht.wc.tile + pl.meanht.wnc.tile +
plot_annotation(caption = "willowht_macroplot_WCWNC_tile_3panel.png")
ggsave("./output/figures_202108/willowht_macroplot_WCWNC_tile_3panel.png", width = 7.25, height = 3.5, dpi = 300)## values labeled
pl.meanht.wcwnc.tile.lbl <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
# filter(SITE_TYPE == "WC") %>%
filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Combined Range")
pl.meanht.wc.tile.lbl <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Core Range")
pl.meanht.wnc.tile.lbl <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WNC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Noncore Range")## KV
pl.meanht.wk.tile.lbl <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WK") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(yr,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(yr, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(yr, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
geom_text(aes(label = round(numeric.mean,1)), size=3, color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
# theme(legend.position = "none") +
labs(x = "Year", y = "Species", fill = "mean height (cm)", title = "Kawuneeche Valley")
pl.meanht.wk.tile.lbl
(pl.meanht.wcwnc.tile.lbl + theme(legend.position = "none")) + (pl.meanht.wc.tile.lbl + theme(legend.position = "none")) + pl.meanht.wnc.tile.lbl +
plot_annotation(caption = "willowht_macroplot_WCWNC_tile_3panel_lbl.png")
ggsave("./output/figures_202108/willowht_macroplot_WCWNC_tile_3panel_lbl.png", width = 7.5, height = 4.25, dpi = 300)#### Fig 32 revised 2022
csv.all.lc.mcro.df <- csv.all.lc.mcro.df %>% #glimpse()
mutate(timeClass = as_factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "BL","2013","2018"))
#
# willow.mcro.all %>%
# filter(yr %in% c("2008","2013","2018")) %>%
# # mutate(yr = as.character(yr)) %>%
# mutate(yr = case_when(yr == "2008" ~ "BL",
# TRUE ~ yr)) %>%
# mutate(yr = as_factor(yr)) %>%
# mutate(yr = fct_relevel(yr, "BL","2013","2018"))pl.meanht.wc.tile.fenced <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(timeClass,SPECIES_CODE, FENCED) %>%
skimr::skim(PLANT_HT_CM) %>%
select(timeClass, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(timeClass, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Species", fill = "mean height (cm)") +
facet_wrap(~FENCED)
# csv.all.lc.mcro.df %>%
# filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
# filter(SITE_TYPE == "WC") %>%
# # filter(SITE_TYPE != "WK") %>%
# mutate(yr = as.character(yr)) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
# group_by(yr,SPECIES_CODE, FENCED) %>%
# skimr::skim(PLANT_HT_CM) %>%
# select(yr, FENCED, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
# select(-skim_type) %>%
# ggplot(aes(yr, SPECIES_CODE)) +
# geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# # geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
# scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# theme_minimal() +
# theme(legend.position = "bottom") +
# labs(x = "Year", y = "Species", fill = "mean height (cm)") +
# facet_wrap(~FENCED)
pl.meanht.wnc.tile <- csv.all.lc.mcro.df %>%
filter(SPECIES_CODE == "SAMO" | SPECIES_CODE == "SAGE" | SPECIES_CODE == "SAPL") %>%
filter(SITE_TYPE == "WNC") %>%
# filter(SITE_TYPE != "WK") %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
group_by(timeClass,SPECIES_CODE) %>%
skimr::skim(PLANT_HT_CM) %>%
select(timeClass, contains("skim"),SPECIES_CODE, contains("c.m"), contains("c.s")) %>%
select(-skim_type) %>%
ggplot(aes(timeClass, SPECIES_CODE)) +
geom_tile(aes(fill = numeric.mean), color="grey80", alpha=0.85) +
# geom_text(aes(label = round(numeric.mean,1)), color = "black", alpha = .85) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "", fill = "mean height (cm)")
pl.meanht.wc.tile.fenced + pl.meanht.wnc.tile +
plot_layout(widths = c(2,1)) +
plot_annotation(tag_levels = "A")
ggsave("./output/figures_202202/Fig32_willowht_macroplot_WCWNCxF_tile_2panel.png", width = 7.5, height = 4.25, dpi = 300)
ggsave("./output/figures_202202/Fig32_willowht_macroplot_WCWNCxF_tile_2panel.pdf", width = 7.5, height = 4.25)# lu.removed.plot
# csv.all.lc.li.df
# # remove all the removed plots identified in the site info tab if raw files
# csv.all.lc.mcro.df <- anti_join(csv.all.lc.mcro.df, lu.removed.plot, by="SITE_ID")
csv.all.lc.mcro.df %>%
tabyl(SITE_TYPE, yr)## write_csv
csv.all.lc.mcro.df %>%
write_csv("./output/exported_data/willow_mcro.csv")## parse out groups of species
allshrub.mcro.all <- csv.all.lc.mcro.df %>%
mutate(yr = as.character(yr)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
clean_names()
nonwillowshrub.mcro.all <- csv.all.lc.mcro.df %>%
mutate(yr = as.character(yr)) %>%
filter(str_detect(SPECIES_CODE, "^SA",negate = TRUE)) %>%
filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
clean_names()
willow.mcro.all <- csv.all.lc.mcro.df %>%
filter(str_detect(SPECIES_CODE, "^SA")) %>%
# filter(SITE_TYPE == "WC") %>%
# filter(SITE_TYPE != "WNC") %>%
mutate(yr = as.character(yr)) %>%
# mutate(yr = as.integer(yr)) %>%
# mutate(yr = as.character(yr)) %>%
# filter(yr == 2013 | yr == 2018) %>%
# filter(yr == 2008 | yr == 2013 | yr == 2018) %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
clean_names()#### Core winter range
allshrub.mcro.all %>%
filter(site_type == "WC") %>%
# filter(SITE_TYPE != "WNC") %>%
ggplot(aes(time_class, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced),outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
ylim(0,320) +
labs(x = "", y = "Shrub height (cm)", fill = "", caption = "macro, WC only, all shrubs")
# ggsave("./output/figures_202108/WC_allshrub_ht_boxplot_dfc.png", width = 5.5, height = 3.5)
nonwillowshrub.mcro.all %>%
filter(site_type == "WC") %>%
# filter(SITE_TYPE != "WNC") %>%
ggplot(aes(time_class, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced),outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
ylim(0,200) +
labs(x = "", y = "Shrub height (cm)", fill = "", caption = "WC only, allnon willow shrubs")
# ### Mean ht in plots, willow species only
# join cover for spatial export
will.ht.mean <- willow.mcro.all %>%
mutate(time_class = forcats::fct_rev(time_class)) %>%
filter(time_class == "BL" | time_class == "2013" | time_class == "2018") %>%
group_by(site_id, time_class) %>%
summarise(plant_ht_cm.mean = mean(plant_ht_cm)) %>%
ungroup() %>%
pivot_wider(names_from = time_class, names_glue = "htmean{time_class}",values_from = plant_ht_cm.mean) %>%
mutate(difBL18 = htmean2018 - htmeanBL) %>%
mutate(difBL13 = htmean2018 - htmeanBL) %>%
mutate(dif1318 = htmean2018 - htmean2013)
## join
will.ht.mean.sf <- left_join(will.ht.mean, clean_names(site.info.clean.sf)) %>%
mutate(range_type = case_when(is.na(range_type) ~ "core winter range",
TRUE ~ range_type)) %>%
st_as_sf(sf_column_name = "geometry")
# will.ht.mean.sf %>%
# st_write("./output/exported_data/spatial/willow_htmean_20200907.shp")Mean willow height - Baseline
will.ht.mean.sf %>%
filter(!is.na(htmeanBL)) %>%
mutate(across(where(is.numeric), round, 2)) %>%
mapview(zcol = "htmeanBL")Mean willow height - 2013
will.ht.mean.sf %>%
filter(!is.na(htmean2013)) %>%
mutate(across(where(is.numeric), round, 2)) %>%
mapview(zcol = "htmean2013")Mean willow height - 2018
will.ht.mean.sf %>%
filter(range_type != "Kawuneeche Valley") %>%
filter(!is.na(htmean2018)) %>%
mutate(across(where(is.numeric), round, 2)) %>%
mapview(zcol = "htmean2018")Individual willow species
# levels(willow.ht.wc.wnc$time_class)
pl.li.samo.density <- willow.ht.wc.wnc %>%
mutate(time_class = fct_drop(f = time_class, only = "2017")) %>%
filter(time_class == "BL" | time_class == "2018" |time_class == "2013") %>%
# filter(site_type != "WK") %>%
filter(species_code == "SAMO") %>%
# filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = plant_ht_cm, y = time_class), alpha = 0.45) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~site_type, ncol = 1) +
labs(x = "Willow height (cm)", y = "Year", title = "SAMO")
# pl.li.samo.density
pl.li.sage.density <- willow.ht.wc.wnc %>%
mutate(time_class = fct_drop(f = time_class, only = "2017")) %>%
filter(time_class == "BL" | time_class == "2018" |time_class == "2013") %>%
filter(site_type != "WK") %>%
filter(species_code == "SAGE") %>%
# filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = plant_ht_cm, y = time_class), alpha = 0.45) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~site_type, ncol = 1) +
labs(x = "Willow height (cm)", y = "Year", title = "SAGE")
pl.li.sapl.density <- willow.ht.wc.wnc %>%
mutate(time_class = fct_drop(f = time_class, only = "2017")) %>%
filter(time_class == "BL" | time_class == "2018" |time_class == "2013") %>%
filter(site_type != "WK") %>%
filter(species_code == "SAPL") %>%
# filter(str_detect(SPECIES_CODE, "^SA")) %>%
ggplot() +
ggridges::geom_density_ridges(aes(x = plant_ht_cm, y = time_class), alpha = 0.45) +
# viridis::scale_fill_viridis(discrete = TRUE, option = "D") +
theme_minimal() +
scale_fill_manual(values = colfunc2(3)) +
facet_wrap(~site_type, ncol = 1) +
labs(x = "Willow height (cm)", y = "Year", title = "SAPL")
pl.li.samo.density + pl.li.sage.density + pl.li.sapl.density + patchwork::plot_layout(ncol=3)
ggsave("./output/figures_202108/WCWNCWK_wilspp_density.png", width = 7.5, height = 4.75, dpi = 300)
# csv.all.lc.li.df %>%
# tabyl(SPECIES_CODE)Height difference from baseline
#### Fig31 revised 2022
# WC and WNC
pl.diff1.wc <- will.ht.mean.sf %>%
as_tibble() %>%
# distinct(range_type)
filter(!is.na(fenced)) %>%
filter(range_type == "core winter range") %>%
ggplot(aes(fenced, difBL18)) +
geom_boxplot(outlier.shape = NA, fill = "grey50") +
geom_hline(yintercept=0, color = "black", size=1, alpha = 0.25) +
ylim(-75,175) +
theme_minimal() +
labs(x = "", y = "Height difference (cm)")
pl.diff1.wnc <- will.ht.mean.sf %>%
as_tibble() %>%
# distinct(range_type)
filter(!is.na(fenced)) %>%
filter(range_type == "non-core winter range") %>%
ggplot(aes(fenced, difBL18)) +
geom_boxplot(outlier.shape = NA, fill = "grey50") +
geom_hline(yintercept=0, color = "black", size=1, alpha = 0.25) +
ylim(-75,175) +
theme_minimal() +
labs(x = "", y = "") +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank()
)
pl.diff1.wc + pl.diff1.wnc +
plot_layout(widths=c(2,1)) +
plot_annotation(tag_levels = "A")
ggsave("./output/figures_202202/Fig31_revised_WC_WNC_HtMeanDiff18BL_TCxfenced_dfc.png", width = 6.5, height = 3.75, dpi = 300)
ggsave("./output/figures_202202/Fig31_revised_WC_WNC_HtMeanDiff18BL_TCxfenced_dfc.pdf", width = 6.5, height = 3.75)## all elk range
will.ht.mean.sf %>%
as_tibble() %>%
filter(!is.na(fenced)) %>%
filter(range_type != "Kawuneeche Valley") %>%
# group_by(fenced, range_type) %>%
descr(difBL18) %>%
tb() %>%
select(-c(skewness, se.skewness, kurtosis)) %>%
gt() %>%
tab_header(title = "Willow ht diff (2018-BL),WC & WNC plots") %>%
fmt_number(
columns = 2:11,
decimals = 1,
suffixing = TRUE
)| Willow ht diff (2018-BL),WC & WNC plots | ||||||||||||
| variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| difBL18 | 32.2 | 72.8 | −138.3 | −4.5 | 26.0 | 70.7 | 310.4 | 53.4 | 72.6 | 2.3 | 71 | 70.29703 |
## all elk range fenced
will.ht.mean.sf %>%
as_tibble() %>%
filter(!is.na(fenced)) %>%
filter(range_type != "Kawuneeche Valley") %>%
group_by(fenced) %>%
descr(difBL18) %>%
tb() %>%
select(-c(skewness, se.skewness, kurtosis)) %>%
gt() %>%
tab_header(title = "Willow ht diff (2018-BL),WC & WNC plots") %>%
fmt_number(
columns = 3:11,
decimals = 1,
suffixing = TRUE
)| Willow ht diff (2018-BL),WC & WNC plots | |||||||||||||
| fenced | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Fenced | difBL18 | 87.1 | 41.5 | 33.8 | 52.9 | 87.9 | 116.5 | 180.0 | 47.7 | 63.6 | 0.4765376 | 17 | 54.83871 |
| Unfenced | difBL18 | 14.9 | 72.1 | −138.3 | −11.7 | 11.5 | 35.4 | 310.4 | 34.9 | 46.2 | 4.8307491 | 54 | 77.14286 |
will.ht.mean.sf %>%
as_tibble() %>%
filter(!is.na(fenced)) %>%
filter(range_type != "Kawuneeche Valley") %>%
group_by(fenced, range_type) %>%
descr(difBL18) %>%
tb() %>%
select(-c(skewness, se.skewness, kurtosis)) %>%
gt() %>%
tab_header(title = "Willow ht diff (2018-BL),WC & WNC plots") %>%
fmt_number(
columns = 4:11,
decimals = 1,
suffixing = TRUE
) # %>% | Willow ht diff (2018-BL),WC & WNC plots | ||||||||||||||
| fenced | range_type | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Fenced | core winter range | difBL18 | 87.1 | 41.5 | 33.8 | 52.9 | 87.9 | 116.5 | 180.0 | 47.7 | 63.61586 | 0.4765376 | 17 | 54.83871 |
| Unfenced | core winter range | difBL18 | −0.6 | 40.3 | −138.3 | −11.7 | 1.7 | 11.4 | 99.0 | 17.8 | 22.66700 | -62.4126789 | 22 | 57.89474 |
| Unfenced | non-core winter range | difBL18 | 25.6 | 86.6 | −136.2 | −10.7 | 23.7 | 65.4 | 310.4 | 58.9 | 68.98599 | 3.3782010 | 32 | 100.00000 |
# gtsave("./output/tables/WillowHtDif_WCplusWNC.rtf")will.ht.mean.sf %>%
as_tibble() %>%
filter(!is.na(burned)) %>%
filter(range_type != "Kawuneeche Valley") %>%
ggplot(aes(burned, difBL18)) +
geom_boxplot(outlier.shape = NA, fill = "grey50") +
geom_hline(yintercept=0, color = "black", size=1, alpha = 0.25) +
ylim(-75,175) +
theme_minimal() +
facet_grid(fenced~range_type) +
labs(x = "", y = "Height difference (cm)", caption = "mean willow height, all willow spp, 2018-BL")
ggsave("./output/figures_202108/revised_WC_WNC_HtMeanDiff18BL_TCxburned_dfc.png", width = 5.5, height = 3.75, dpi = 300)will.ht.mean.sf %>%
as_tibble() %>%
filter(!is.na(fenced)) %>%
filter(range_type != "Kawuneeche Valley") %>%
group_by(burned, range_type) %>%
descr(difBL18) %>%
tb() %>%
select(-c(skewness, se.skewness, kurtosis)) %>%
gt() %>%
# tab_header(title = "Willow Offtake (% leader use) WC & WNC plots") %>%
fmt_number(
columns = 4:11,
decimals = 1,
suffixing = TRUE
)| burned | range_type | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Burned | core winter range | difBL18 | 25.0 | 66.3 | −138.3 | −10.8 | 37.6 | 65.1 | 120.0 | 57.8 | 74.63542 | 2.645387 | 12 | 48.00000 |
| Unburned | core winter range | difBL18 | 43.2 | 57.0 | −34.6 | 0.8 | 15.0 | 99.0 | 180.0 | 36.8 | 92.84780 | 1.320154 | 27 | 61.36364 |
| Unburned | non-core winter range | difBL18 | 25.6 | 86.6 | −136.2 | −10.7 | 23.7 | 65.4 | 310.4 | 58.9 | 68.98599 | 3.378201 | 32 | 100.00000 |
### max to spatial
will.ht.max <- willow.mcro.all %>%
mutate(time_class = forcats::fct_rev(time_class)) %>%
filter(time_class == "BL" | time_class == "2013" | time_class == "2018") %>%
group_by(site_id, time_class) %>%
summarise(plant_ht_cm.max = max(plant_ht_cm)) %>%
ungroup() %>%
pivot_wider(names_from = time_class, names_glue = "htmax{time_class}",values_from = plant_ht_cm.max) %>%
mutate(difBL18 = htmax2018 - htmaxBL) %>%
mutate(difBL13 = htmax2018 - htmaxBL) %>%
mutate(dif1318 = htmax2018 - htmax2013)
## join
will.ht.max.sf <- left_join(will.ht.max, clean_names(site.info.clean.sf)) %>%
st_as_sf(sf_column_name = "geometry")
will.ht.max.sf %>%
filter(!is.na(htmax2018)) %>%
mapview(zcol = "htmax2018")# will.ht.max.sf %>%
# st_write("./output/exported_data/spatial/willow_htmax_20200907.shp")willow.mcro.all %>%
filter(site_type == "WC") %>%
# filter(SITE_TYPE != "WNC") %>%
ggplot(aes(time_class, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced),outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
ylim(0,350) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
labs(x = "", y = "Willow height (cm)", fill = "", caption = "Macroplot, WC only")
# ggsave("./output/figures_202108/WC_willow_ht_boxplot_dfc.png", width = 5.5, height = 3.5)
# ggsave("./output/figures_202108/WC_allnonwillow_ht_boxplot_dfc.png", width = 5.5, height = 3.5)#### Fig28 revised 2022
# !!!
willow.mcro.all <- willow.mcro.all %>%
filter(yr %in% c("2008","2013","2018")) %>%
# mutate(yr = as.character(yr)) %>%
mutate(yr = case_when(yr == "2008" ~ "BL",
TRUE ~ yr)) %>%
mutate(yr = as_factor(yr)) %>%
mutate(yr = fct_relevel(yr, "BL","2013","2018"))
# levels(willow.mcro.all$yr)
# address request for change in fill 2022
willow.mcro.all <- willow.mcro.all %>%
mutate(site_type2 = case_when(site_type == "WC" ~ "core winter range",
site_type == "WNC" ~ "noncore winter range",
TRUE ~ site_type))## two panel revised fig
pl.b.wc <- willow.mcro.all %>%
filter(site_type == "WC") %>%
ggplot(aes(yr, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced),outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
# scale_fill_manual(values = colfunc2(2)) +
ylim(0,350) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Willow height (cm)", fill = "")
pl.b.wnc <- willow.mcro.all %>%
filter(site_type == "WNC") %>%
ggplot(aes(yr, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced),outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
# scale_fill_manual(values = colfunc2(2)) +
ylim(0,350) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "", fill = "")
# pl.b.wnc + pl.b.wc + plot_layout(widths = c(1, 2))
pl.b.wc + pl.b.wnc +
plot_layout(widths = c(2, 1)) +
plot_annotation(tag_levels = 'A')
ggsave("./output/figures_202202/Fig28_wilht_allsp_macro_wc_wnc.png", width = 6.85, height = 3.75, dpi=300)
ggsave("./output/figures_202202/Fig28_wilht_allsp_macro_wc_wnc.pdf", width = 6.85, height = 3.75)##### WC by species
willow.mcro.all %>%
filter(site_type != "WK") %>%
# filter(site_type == "WC") %>%
# filter(SITE_TYPE != "WNC") %>%
ggplot(aes(site_type, plant_ht_cm)) +
# geom_boxplot(aes(fill = fenced), outlier.shape = NA) +
geom_boxplot(fill = "grey50", outlier.shape = NA) +
# scale_fill_manual(values = c("grey80")) +
ylim(0,350) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
labs(x = "", y = "Willow height (cm)", fill = "", caption = "Macroplot, all willow") +
facet_wrap(~time_class)
ggsave("./output/figures_202108/WC_willow_ht_boxplot_site_type_dfc.png", width = 5.5, height = 3.5)### WNC
willow.mcro.all %>%
# filter(site_type == "WC") %>%
filter(site_type == "WNC") %>%
ggplot(aes(time_class, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced), outlier.shape = NA) +
scale_fill_manual(values = c("grey80", "grey40")) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
ylim(0,350) +
theme_minimal() +
labs(x = "", y = "Willow height (cm)", fill = "", caption = "macroplot, WNC only")
# ggsave("./output/figures_202108/WNC_willow_ht_boxplot_dfc.png", width = 5.5, height = 3.5)### WK
willow.mcro.all %>%
filter(site_type == "WK") %>%
# filter(site_type == "WNC") %>%
ggplot(aes(time_class, plant_ht_cm)) +
geom_boxplot(aes(fill = fenced)) +
scale_fill_manual(values = c("grey80", "grey40")) +
geom_hline(aes(yintercept = 110), color = "red", lty = "dashed", size = 1) +
theme_minimal() +
labs(x = "", y = "Willow height (cm)", fill = "")
# ggsave("./output/figures_202108/WK_willow_ht_boxplot_dfc.png", width = 5.5, height = 3.5)Management thresholds
Count of plots above 1.1 m
## thresholds
#### winter range (wc and wnc)
willow.mcro.all %>%
filter(!is.na(plant_ht_cm)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
group_by(time_class, site_id, fenced, site_type) %>%
summarise(ht.mean = mean(plant_ht_cm), ht.max = max(plant_ht_cm)) %>%
ungroup() %>%
mutate(thresh1p1 = case_when(ht.mean >=110 ~ "above",
ht.mean <110 ~ "below")) %>%
tabyl(time_class, thresh1p1) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC")| WC+WNC | |||
| time_class | above | below | perc.above.thresh |
|---|---|---|---|
| 2018 | 56 | 38 | 59.6 |
| 2013 | 42 | 53 | 44.2 |
| BL | 25 | 38 | 39.7 |
### WC & WNC: fenced threholds
willow.mcro.all %>%
filter(!is.na(plant_ht_cm)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
group_by(time_class, site_id, fenced, site_type) %>%
summarise(ht.mean = mean(plant_ht_cm), ht.max = max(plant_ht_cm)) %>%
ungroup() %>%
mutate(thresh1p1 = case_when(ht.mean >=110 ~ "above",
ht.mean <110 ~ "below")) %>%
group_by(time_class, fenced, thresh1p1) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from =thresh1p1, values_from = n) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC: fenced")| WC+WNC: fenced | ||||
| time_class | fenced | above | below | perc.above.thresh |
|---|---|---|---|---|
| 2018 | Fenced | 20 | 8 | 71.4 |
| 2018 | Unfenced | 36 | 30 | 54.5 |
| 2013 | Fenced | 10 | 18 | 35.7 |
| 2013 | Unfenced | 32 | 35 | 47.8 |
| BL | Fenced | 2 | 14 | 12.5 |
| BL | Unfenced | 23 | 24 | 48.9 |
#### Range type x fenced
willow.mcro.all %>%
filter(!is.na(plant_ht_cm)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# filter(site_type != "WK") %>%
group_by(time_class, site_id, fenced, site_type) %>%
summarise(ht.mean = mean(plant_ht_cm), ht.max = max(plant_ht_cm)) %>%
ungroup() %>%
mutate(thresh1p1 = case_when(ht.mean >=110 ~ "above",
ht.mean <110 ~ "below")) %>%
group_by(time_class, site_type, fenced, thresh1p1) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from =thresh1p1, values_from = n) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC: fenced")| WC+WNC: fenced | |||||
| time_class | site_type | fenced | above | below | perc.above.thresh |
|---|---|---|---|---|---|
| 2018 | WC | Fenced | 20 | 8 | 71.4 |
| 2018 | WC | Unfenced | 13 | 21 | 38.2 |
| 2018 | WK | Fenced | 1 | 3 | 25.0 |
| 2018 | WK | Unfenced | NA | 5 | NA |
| 2018 | WNC | Unfenced | 23 | 9 | 71.9 |
| 2013 | WC | Fenced | 10 | 18 | 35.7 |
| 2013 | WC | Unfenced | 11 | 24 | 31.4 |
| 2013 | WNC | Unfenced | 21 | 11 | 65.6 |
| BL | WC | Fenced | 2 | 14 | 12.5 |
| BL | WC | Unfenced | 4 | 11 | 26.7 |
| BL | WNC | Unfenced | 19 | 13 | 59.4 |
#### WC & WNC: burned fenced
willow.mcro.all %>%
filter(!is.na(plant_ht_cm)) %>%
filter(time_class == "BL" | time_class == "2013" |time_class == "2018") %>%
mutate(time_class = fct_drop(time_class)) %>%
# tabyl(species_code)
filter(site_type != "WK") %>%
group_by(time_class, site_id, fenced, burned) %>%
summarise(ht.mean = mean(plant_ht_cm), ht.max = max(plant_ht_cm)) %>%
ungroup() %>%
mutate(thresh1p1 = case_when(ht.mean >=110 ~ "above",
ht.mean <110 ~ "below")) %>%
group_by(time_class, fenced, burned, thresh1p1) %>%
summarise(n = n()) %>%
ungroup() %>%
pivot_wider(names_from =thresh1p1, values_from = n) %>%
mutate(perc.above.thresh = round((above/(above + below)*100),1)) %>%
gt() %>%
tab_header(title = "WC+WNC: fenced burned")| WC+WNC: fenced burned | |||||
| time_class | fenced | burned | above | below | perc.above.thresh |
|---|---|---|---|---|---|
| 2018 | Fenced | Burned | 7 | 6 | 53.8 |
| 2018 | Fenced | Unburned | 13 | 2 | 86.7 |
| 2018 | Unfenced | Burned | 1 | 7 | 12.5 |
| 2018 | Unfenced | Unburned | 35 | 23 | 60.3 |
| 2013 | Fenced | Burned | NA | 13 | NA |
| 2013 | Fenced | Unburned | 10 | 5 | 66.7 |
| 2013 | Unfenced | Burned | NA | 9 | NA |
| 2013 | Unfenced | Unburned | 32 | 26 | 55.2 |
| BL | Fenced | Burned | 1 | 6 | 14.3 |
| BL | Fenced | Unburned | 1 | 8 | 11.1 |
| BL | Unfenced | Burned | NA | 1 | NA |
| BL | Unfenced | Unburned | 23 | 23 | 50.0 |
Range-wide summary
## table 8 Zeigenfuss 2015. timeClass x fenced x site type
lz.wt.willow.tb8 %>%
gt() %>%
tab_header(title = "Area weights used in Zeigenfuss 2015")| Area weights used in Zeigenfuss 2015 | |||
| timeClass | site_typeXfenced | areawt | SITE_TYPE |
|---|---|---|---|
| 2013 | WC-Fenced | 0.202 | WC |
| 2013 | WC-Unfenced | 0.669 | WC |
| 2013 | WNC-Unfenced | 0.129 | WNC |
| 2018 | WC-Fenced | 0.202 | WC |
| 2018 | WC-Unfenced | 0.669 | WC |
| 2018 | WNC-Unfenced | 0.129 | WNC |
| BL | WC-Fenced | 0.202 | WC |
| BL | WC-Unfenced | 0.669 | WC |
| BL | WNC-Unfenced | 0.129 | WNC |
lz.wt.willow.tb8_sitetype %>%
gt() %>%
tab_header(title = "Area weights used in Zeigenfuss 2015")| Area weights used in Zeigenfuss 2015 | ||
| timeClass | SITE_TYPE | areawt |
|---|---|---|
| 2013 | WC | 0.871 |
| 2013 | WNC | 0.129 |
| 2018 | WC | 0.871 |
| 2018 | WNC | 0.129 |
| BL | WC | 0.871 |
| BL | WNC | 0.129 |
lz.wt.willow.tbl9 %>%
rename(Category=zCond2_tc, Weight = areawt_lz) %>%
gt() %>%
tab_header(title = "Area weights used in Zeigenfuss 2015")| Area weights used in Zeigenfuss 2015 | |
| Category | Weight |
|---|---|
| WC-BF-2013 | 0.085 |
| WC-BG-2013 | 0.450 |
| WC-UG-2013 | 0.219 |
| WC-UF-2013 | 0.117 |
| WNC-UG-2013 | 0.129 |
| WC-BF-2018 | 0.085 |
| WC-BG-2018 | 0.450 |
| WC-UG-2018 | 0.219 |
| WC-UF-2018 | 0.117 |
| WNC-UG-2018 | 0.129 |
| WC-UG-BL | 0.871 |
| WNC-UG-BL | 0.129 |
ht.WCWNC.willow.plotsummary <- ht.WCWNC.willow.plotsummary %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(across(where(is.numeric), round, 2))
## join in the weights
ht.WCWNC.willow.plotsummary <- ht.WCWNC.willow.plotsummary %>%
left_join(., lz.wt.willow.tb8_sitetype)
# willow.mcro.all %>%
# filter(!is.na(plant_ht_cm))
ht.WCWNC.willow.plotsummary %>%
left_join(.,lz.wt.willow.tb8) ## # A tibble: 263 x 11
## timeClass SITE_ID SITE_T~1 FENCED zCond zCond2 PLANT~2 PLANT~3 PLANT~4 areawt
## <chr> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 BL WC01 WC Fenced UF WC-UF 59.5 57.5 120 0.871
## 2 BL WC02 WC Fenced UF WC-UF 56.8 55 100 0.871
## 3 BL WC03 WC Fenced UF WC-UF 66.8 60 130 0.871
## 4 BL WC04 WC Fenced UF WC-UF 83.4 70 190 0.871
## 5 BL WC09 WC Fenced UF WC-UF 69.5 57.5 160 0.871
## 6 BL WC10 WC Fenced UF WC-UF 124. 120 200 0.871
## 7 BL WC12 WC Unfen~ UG WC-UG 136. 150 245 0.871
## 8 BL WC13 WC Unfen~ UG WC-UG 93.3 70 255 0.871
## 9 BL WC14 WC Unfen~ UG WC-UG 40.5 40 80 0.871
## 10 BL WC15 WC Unfen~ UG WC-UG 87.5 90 150 0.871
## # ... with 253 more rows, 1 more variable: site_typeXfenced <chr>, and
## # abbreviated variable names 1: SITE_TYPE, 2: PLANT_HT_CM_mean,
## # 3: PLANT_HT_CM_median, 4: PLANT_HT_CM_max#### Table 8 - mean height
ht.WCWNC.willow.plotsummary %>%
left_join(.,lz.wt.willow.tb8) %>%
tabyl(zCond2)## zCond2 n percent
## WC-BF 34 0.12927757
## WC-BG 23 0.08745247
## WC-UF 40 0.15209125
## WC-UG 70 0.26615970
## WNC-UG 96 0.36501901tbl8.ht <- ht.WCWNC.willow.plotsummary %>%
mutate(fenceClass_tc = paste0(SITE_TYPE,"-",FENCED,"-",timeClass)) %>%
mutate(site_typeXfenced = paste0(SITE_TYPE,"-", FENCED)) %>%
# mutate(fenceClass_tc = paste0(SITE_TYPE,"-",FENCED,"-",timeClass)) %>%
group_by(timeClass, SITE_TYPE, FENCED, site_typeXfenced) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_mean, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_mean, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
mutate(across(where(is.numeric),round,1)) %>%
arrange(timeClass)
lz.wt.willow.tb8## # A tibble: 9 x 4
## timeClass site_typeXfenced areawt SITE_TYPE
## <chr> <chr> <dbl> <chr>
## 1 2013 WC-Fenced 0.202 WC
## 2 2013 WC-Unfenced 0.669 WC
## 3 2013 WNC-Unfenced 0.129 WNC
## 4 2018 WC-Fenced 0.202 WC
## 5 2018 WC-Unfenced 0.669 WC
## 6 2018 WNC-Unfenced 0.129 WNC
## 7 BL WC-Fenced 0.202 WC
## 8 BL WC-Unfenced 0.669 WC
## 9 BL WNC-Unfenced 0.129 WNC##
tbl8.ht <- left_join(tbl8.ht, lz.wt.willow.tb8) %>%
mutate(mean.ht.wt = areawt*mean.ht, se.ht.wt = areawt*se)
## RANGE wide estimate tbl8.cov
tbl8.ht.rangewide <- tbl8.ht %>%
group_by(timeClass) %>%
summarise(mean.ht = sum(mean.ht.wt, na.rm=TRUE), se = sum(se.ht.wt, na.rm=TRUE)) %>%
mutate(across(where(is.numeric),round,0)) %>%
mutate(mean_se = paste0(mean.ht,"(+/-",se,")")) %>%
mutate(site_typeXfenced = "Entire winter range (weighted avg)")
### table 8
tbl8.ht %>%
mutate(mean_se = paste0(mean.ht,"(+/-",se,")")) %>%
bind_rows(.,tbl8.ht.rangewide) %>%
select(timeClass, SITE_TYPE, FENCED, site_typeXfenced, mean_se) %>%
pivot_wider(names_from = timeClass,
# names_glue = "{timeClass}_test_{FENCED}",
values_from = mean_se) %>%
select(-c(FENCED, SITE_TYPE)) %>%
relocate('Winter range zone' = site_typeXfenced, "Baseline" = "BL",'2013','2018') %>%
gt() %>%
tab_header(title = "Willow height (cm)")| Willow height (cm) | |||
| Winter range zone | Baseline | 2013 | 2018 |
|---|---|---|---|
| WC-Fenced | 66.5(+/-15.7) | 95.7(+/-18.1) | 154.3(+/-29.2) |
| WC-Unfenced | 91.6(+/-18.7) | 107.1(+/-18.1) | 104.8(+/-18) |
| WNC-Unfenced | 170.5(+/-30.1) | 196.8(+/-34.8) | 196.1(+/-34.7) |
| Entire winter range (weighted avg) | 97(+/-20) | 116(+/-20) | 127(+/-22) |
### range wide (bottomline of table)
lz.wt.willow.tb8_sitetype## # A tibble: 6 x 3
## timeClass SITE_TYPE areawt
## <chr> <chr> <dbl>
## 1 2013 WC 0.871
## 2 2013 WNC 0.129
## 3 2018 WC 0.871
## 4 2018 WNC 0.129
## 5 BL WC 0.871
## 6 BL WNC 0.129# unweighted table 9
wt.ht.rangewide <- ht.WCWNC.willow.plotsummary %>%
group_by(timeClass, SITE_TYPE) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_mean, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_mean, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
left_join(.,lz.wt.willow.tb8_sitetype) %>%
mutate(mean.ht.wt = areawt*mean.ht, se.ht.wt = areawt*se) %>%
group_by(timeClass) %>%
summarise(mean.ht.wt = sum(mean.ht.wt),se.ht.wt = sum(se.ht.wt)) %>%
ungroup() %>%
mutate(timeClass= as_factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "BL", before="2013")) %>%
arrange(timeClass)
wt.ht.rangewide %>%
mutate(across(where(is.numeric), round, 1)) %>%
gt() %>%
tab_header(title="Entire winter range (weighted average")| Entire winter range (weighted average | ||
| timeClass | mean.ht.wt | se.ht.wt |
|---|---|---|
| BL | 92.4 | 14.8 |
| 2013 | 114.3 | 15.7 |
| 2018 | 136.1 | 18.5 |
# comp to bl:20(2); 2013:24(3); na in zeigenfuss 2015# unweighted table 9
wt.ht.mean <- ht.WCWNC.willow.plotsummary %>%
mutate(zCond2_tc = paste0(SITE_TYPE,"-",zCond,"-",timeClass)) %>%
group_by(timeClass, SITE_TYPE, zCond2,zCond2_tc) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_mean, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_mean, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
arrange(timeClass, zCond2)### zcond2
# join in weights from 2015 SAS code
wt.ht.zcond2 <- left_join(wt.ht.mean, lz.wt.willow.tbl9, by="zCond2_tc") %>%
mutate(mean.ht.wt = areawt_lz*mean.ht, se.wt = areawt_lz*se)
## check sum of weights = 1
temp1 <- wt.ht.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass,SITE_TYPE) %>%
summarise(sum.wt.ht = sum(mean.ht.wt, na.rm=TRUE), sum.wt.wt = sum(areawt_lz, na.rm=TRUE)) %>%
ungroup()
temp1## # A tibble: 6 x 4
## timeClass SITE_TYPE sum.wt.ht sum.wt.wt
## <fct> <chr> <dbl> <dbl>
## 1 BL WC 83.6 0.871
## 2 BL WNC 22.0 0.129
## 3 2018 WC 85.4 0.871
## 4 2018 WNC 25.3 0.129
## 5 2013 WC 68.8 0.871
## 6 2013 WNC 25.4 0.129temp1 %>%
group_by(timeClass) %>%
summarise(wt.ht = sum((sum.wt.ht*sum.wt.wt)))## # A tibble: 3 x 2
## timeClass wt.ht
## <fct> <dbl>
## 1 BL 75.7
## 2 2018 77.6
## 3 2013 63.2wt.ht.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
select(timeClass, zCond2, mean.ht.wt) %>%
pivot_wider(names_from = timeClass, values_from = c(mean.ht.wt)) %>%
clean_names() %>%
gt()#### Table 8 - maximum height
ht.WCWNC.willow.plotsummary %>%
left_join(.,lz.wt.willow.tb8) %>%
tabyl(zCond2)## zCond2 n percent
## WC-BF 34 0.12927757
## WC-BG 23 0.08745247
## WC-UF 40 0.15209125
## WC-UG 70 0.26615970
## WNC-UG 96 0.36501901tbl8.ht.max <- ht.WCWNC.willow.plotsummary %>%
mutate(fenceClass_tc = paste0(SITE_TYPE,"-",FENCED,"-",timeClass)) %>%
mutate(site_typeXfenced = paste0(SITE_TYPE,"-", FENCED)) %>%
group_by(timeClass, SITE_TYPE, FENCED, site_typeXfenced) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_max, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_max, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
mutate(across(where(is.numeric),round,1)) %>%
arrange(timeClass)
##
tbl8.ht.max <- left_join(tbl8.ht.max, lz.wt.willow.tb8) %>%
mutate(mean.ht.wt = areawt*mean.ht, se.ht.wt = areawt*se)
## RANGE wide estimate tbl8.cov
tbl8.ht.max.rangewide <- tbl8.ht.max %>%
group_by(timeClass) %>%
summarise(mean.ht = sum(mean.ht.wt, na.rm=TRUE), se = sum(se.ht.wt, na.rm=TRUE)) %>%
mutate(across(where(is.numeric),round,0)) %>%
mutate(mean_se = paste0(mean.ht,"(+/-",se,")"))
### table 8
tbl8.ht.max %>%
mutate(mean_se = paste0(mean.ht,"(+/-",se,")")) %>%
bind_rows(.,tbl8.ht.max.rangewide) %>%
select(timeClass, SITE_TYPE, FENCED, site_typeXfenced, mean_se) %>%
pivot_wider(names_from = timeClass,
# names_glue = "{timeClass}_test_{FENCED}",
values_from = mean_se) %>%
select(-c(FENCED, SITE_TYPE)) %>%
relocate('Winter range zone' = site_typeXfenced, "Baseline" = "BL",'2013','2018') %>%
gt() %>%
tab_header(title = "Maximum willow height (cm)")| Maximum willow height (cm) | |||
| Winter range zone | Baseline | 2013 | 2018 |
|---|---|---|---|
| WC-Fenced | 101.9(+/-24) | 131.6(+/-24.9) | 213.8(+/-40.4) |
| WC-Unfenced | 213.4(+/-43.6) | 194.1(+/-32.8) | 192.8(+/-33.1) |
| WNC-Unfenced | 271.7(+/-48) | 283.1(+/-50.1) | 353.8(+/-62.5) |
| NA | 198(+/-40) | 193(+/-33) | 218(+/-38) |
### range wide (bottomline of table)
lz.wt.willow.tb8_sitetype## # A tibble: 6 x 3
## timeClass SITE_TYPE areawt
## <chr> <chr> <dbl>
## 1 2013 WC 0.871
## 2 2013 WNC 0.129
## 3 2018 WC 0.871
## 4 2018 WNC 0.129
## 5 BL WC 0.871
## 6 BL WNC 0.129# unweighted table 9
wt.ht.max.rangewide <- ht.WCWNC.willow.plotsummary %>%
group_by(timeClass, SITE_TYPE) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_max, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_max, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
left_join(.,lz.wt.willow.tb8_sitetype) %>%
mutate(mean.ht.wt = areawt*mean.ht, se.ht.wt = areawt*se) %>%
group_by(timeClass) %>%
summarise(mean.ht.wt = sum(mean.ht.wt),se.ht.wt = sum(se.ht.wt)) %>%
ungroup() %>%
mutate(timeClass= as_factor(timeClass)) %>%
mutate(timeClass = fct_relevel(timeClass, "BL", before="2013")) %>%
arrange(timeClass)
wt.ht.max.rangewide %>%
mutate(across(where(is.numeric), round, 1)) %>%
gt() %>%
tab_header(title="Entire winter range (weighted average")| Entire winter range (weighted average | ||
| timeClass | mean.ht.wt | se.ht.wt |
|---|---|---|
| BL | 179.3 | 28.5 |
| 2013 | 180.6 | 24.6 |
| 2018 | 221.8 | 30.4 |
# comp to bl:20(2); 2013:24(3); na in zeigenfuss 2015# unweighted table 9
wt.ht.mean <- ht.WCWNC.willow.plotsummary %>%
mutate(zCond2_tc = paste0(SITE_TYPE,"-",zCond,"-",timeClass)) %>%
group_by(timeClass, SITE_TYPE, zCond2,zCond2_tc) %>%
summarise(n = n(), mean.ht = mean(PLANT_HT_CM_mean, na.rm=TRUE), sd.ht = sd(PLANT_HT_CM_mean, na.rm=TRUE)) %>%
ungroup() %>%
mutate(se = mean.ht/sqrt(n)) %>%
arrange(timeClass, zCond2)### zcond2
# join in weights from 2015 SAS code
wt.ht.zcond2 <- left_join(wt.ht.mean, lz.wt.willow.tbl9, by="zCond2_tc") %>%
mutate(mean.ht.wt = areawt_lz*mean.ht, se.wt = areawt_lz*se)
## check sum of weights = 1
temp1 <- wt.ht.zcond2 %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass,SITE_TYPE) %>%
summarise(sum.wt.ht = sum(mean.ht.wt, na.rm=TRUE), sum.wt.wt = sum(areawt_lz, na.rm=TRUE)) %>%
ungroup()
temp1## # A tibble: 6 x 4
## timeClass SITE_TYPE sum.wt.ht sum.wt.wt
## <fct> <chr> <dbl> <dbl>
## 1 BL WC 83.6 0.871
## 2 BL WNC 22.0 0.129
## 3 2018 WC 85.4 0.871
## 4 2018 WNC 25.3 0.129
## 5 2013 WC 68.8 0.871
## 6 2013 WNC 25.4 0.129temp1 %>%
group_by(timeClass) %>%
summarise(wt.ht = sum((sum.wt.ht*sum.wt.wt)))## # A tibble: 3 x 2
## timeClass wt.ht
## <fct> <dbl>
## 1 BL 75.7
## 2 2018 77.6
## 3 2013 63.2Offtake
# **DD2**
#
# "stem-scaled diameter difference method"
#
# **DD2 = (b/b +u) \* (Dp - Dt)/(Db - Dt)**
#
# b, the number of browsed shoots on the stem; u, the number of unbrowsed
# shoots; Dp, shoot diameter at the point of browsing; Dt, the average
# diameter of unbrowsed shoot tips; and Db, the diameter at the base of
# the shoot.#### Baseline
### LZ 2013 baseline
## LZ's 2013 data
# ROMO_elk_vegetation_monitoring_data_willow2013 update.xls
#### Read in the worksheets and create list of df
# each tab is a df in the list object
lz.bl13.wil.sheets <- excel_sheets(path = ("./data/EVMP_data/Baseline/ROMO_elk_vegetation_monitoring_data_willow2013 update.xls"))
## read in all of the tabs as 'data' in list column
lz.bl13.wil <- lz.bl13.wil.sheets %>%
enframe() %>%
rename(sheet = value) %>%
mutate(path = ("./data/EVMP_data/Baseline/ROMO_elk_vegetation_monitoring_data_willow2013 update.xls")) %>%
mutate(data = map2(.x = path,.y = sheet,.f = read_excel,col_types = "text")) %>%
select(-c(name))### BL-2013 spring offtake
lz.bl13.offt.spr <- lz.bl13.wil %>%
filter(str_detect(sheet,pattern = "RMNP_spring")) %>%
unnest(cols = c(data)) %>%
clean_names() %>%
distinct()
### BL-2013 fall offtake
lz.bl13.offt.fall <- lz.bl13.wil %>%
filter(str_detect(sheet,pattern = "RMNP_fall")) %>%
unnest(cols = c(data)) %>%
clean_names() %>%
distinct()
### BL-2013: "twig 2008"
lz.bl13.twig2008 <- lz.bl13.wil %>%
filter(str_detect(sheet,pattern = "twig")) %>%
unnest(cols = c(data)) %>%
clean_names()#### BL twig
### munge the baseline 2013 twig data
lz.bl13.twig2008.clean <- lz.bl13.twig2008 %>%
na_if(".") %>%
clean_names() %>%
mutate(across(.cols = c(shoot_length_cm,shoot_weight_g,date_of_shoot_collection, diameter_at_base_of_shoot_mm, diameter_at_tip_of_shoot_mm),.fns = as.numeric)) %>%
mutate(date = janitor::excel_numeric_to_date(date_of_shoot_collection)) %>%
mutate(yr = year(date))
### remove all records with 'na'
lz.bl13.twig2008.clean <- lz.bl13.twig2008.clean %>%
na.omitSpecies-specific regressions of mass as a function
of:
twig length
twig length + location
# lz.bl13.twig2008.clean %>%
# visdat::vis_dat()
lz.bl13.twig2008.clean %>%
ggplot(aes(shoot_weight_g,shoot_length_cm)) +
geom_point(aes(color=location)) +
geom_smooth(aes(color = location),method = "lm", se = FALSE) +
scale_color_viridis(discrete = TRUE, option = 'A') +
theme_minimal() +
labs(x = "Shoot weight (g)", y = "Shoot length (cm)", caption = "BL 2013 data lz.bl13.twig2008.clean. Pooled willow species")
lz.bl13.twig2008.clean %>%
filter(!is.na(species_code)) %>%
ggplot(aes(shoot_weight_g,shoot_length_cm)) +
geom_point(aes(color=location)) +
geom_smooth(aes(color = location),method = "lm", se = FALSE) +
scale_color_viridis(discrete = TRUE, option = 'A') +
theme_minimal() +
facet_wrap(~species_code) +
labs(x = "Shoot weight (g)", y = "Shoot length (cm)", caption = "BL 2013 data lz.bl13.twig2008.clean")
## regressions
models.twigs <- tibble::tribble(
~model_name, ~ formula,
"wt~length", shoot_weight_g ~ shoot_length_cm,
"wt~length+loc", shoot_weight_g ~ shoot_length_cm + location)
lz.bl13.twig2008.clean %>%
nest_by(species_code) %>%
left_join(models.twigs, by = character()) %>%
rowwise(species_code, model_name) %>%
mutate(model = list(lm(formula, data = data))) %>%
summarise(broom::glance(model)) %>%
gt() %>%
tab_header(title = "Species-specific length ~ mass")| Species-specific length ~ mass | |||||||||||
| r.squared | adj.r.squared | sigma | statistic | p.value | df | logLik | AIC | BIC | deviance | df.residual | nobs |
|---|---|---|---|---|---|---|---|---|---|---|---|
| SAGE - wt~length | |||||||||||
| 0.8965182 | 0.8891266 | 0.11799387 | 121.289472 | 2.791326e-08 | 1 | 12.55920 | -19.11839 | -16.80063 | 0.19491576 | 14 | 16 |
| SAGE - wt~length+loc | |||||||||||
| 0.9550505 | 0.9325758 | 0.09201399 | 42.494381 | 2.032713e-06 | 5 | 19.23005 | -24.46009 | -19.05197 | 0.08466575 | 10 | 16 |
| SAMO - wt~length | |||||||||||
| 0.5560687 | 0.5522417 | 0.18127173 | 145.301683 | 3.448539e-22 | 1 | 35.08928 | -64.17856 | -55.86651 | 3.81169510 | 116 | 118 |
| SAMO - wt~length+loc | |||||||||||
| 0.7004323 | 0.6842395 | 0.15222542 | 43.255659 | 7.136139e-27 | 6 | 58.29572 | -100.59144 | -78.42596 | 2.57215621 | 111 | 118 |
| SAPL - wt~length | |||||||||||
| 0.8667350 | 0.8519278 | 0.08267903 | 58.534609 | 3.156120e-05 | 1 | 12.91605 | -19.83209 | -18.63841 | 0.06152240 | 9 | 11 |
| SAPL - wt~length+loc | |||||||||||
| 0.8975391 | 0.7950781 | 0.09726413 | 8.759817 | 1.629196e-02 | 5 | 14.36177 | -14.72353 | -11.93827 | 0.04730156 | 5 | 11 |
#### BL clean
lz.bl.fall <- lz.bl13.offt.fall %>%
select(c(sheet,year_of_data_collection,
site_type_wc_core_wnc_non_core,
site_number,
unique_site_id,
microplot_location,
species_code,
shoot_ratio,
number_browsed_current_annual_growth_shoots,
number_unbrowsed_current_annual_growth_shoots,
measured_shoot_browsed_b_or_unbrowsed_u,
diameter_at_base_of_shoot_mm,
diameter_at_tip_of_shoot_mm,
shoot_length_cm))
## address the inconsistent year
lz.bl.fall <- lz.bl.fall %>%
rename(yr = year_of_data_collection) %>%
mutate(yr = as.integer(yr))
lz.bl.spring <- lz.bl13.offt.spr %>%
select(c(sheet,date,
site_type_wc_core_wnc_non_core,
site_number,
unique_site_id,
microplot_location,
species_code,
shoot_ratio,
number_browsed_current_annual_growth_shoots,
number_unbrowsed_current_annual_growth_shoots,
measured_shoot_browsed_b_or_unbrowsed_u,
diameter_at_base_of_shoot_mm,
diameter_at_tip_of_shoot_mm,
shoot_length_cm))
lz.bl.spring <- lz.bl.spring %>%
mutate(date = as.numeric(date)) %>%
mutate(date = janitor::excel_numeric_to_date(date)) %>%
mutate(yr = lubridate::year(date)) %>% mutate(yr = as.integer(yr))
# lz.bl.spring %>%
# tabyl(yr)
## add season and concatenate side_id per 10yr update
lz.bl.fall <- lz.bl.fall %>%
mutate(season = "fall") %>%
mutate(site_id = as.character(glue::glue('{site_type_wc_core_wnc_non_core}-{site_number}'))) %>%
rename(site_type = site_type_wc_core_wnc_non_core)
### address the "." encoding
lz.bl.fall <- lz.bl.fall %>%
na_if(".")
lz.bl.spring <- lz.bl.spring %>%
mutate(season = "spring") %>%
mutate(site_id = as.character(glue::glue('{site_type_wc_core_wnc_non_core}-{site_number}'))) %>%
rename(site_type = site_type_wc_core_wnc_non_core)
### address the "." encoding
lz.bl.spring <- lz.bl.spring %>%
select(-date) %>%
na_if(".")## combine fall and spring
lz.bl.fasp <- bind_rows(lz.bl.fall, lz.bl.spring)
lz.bl.fasp <- lz.bl.fasp %>%
mutate(across(.cols = contains("number"),.fns = as.numeric)) %>%
mutate(across(.cols = contains("diam"),.fns = as.numeric)) %>%
mutate(across(.cols = c(shoot_ratio, contains("leng")),.fns = as.numeric))
## clean
lz.bl.fasp <- lz.bl.fasp %>%
filter(species_code != "DEAD")%>%
filter(species_code != "NONE")## qaqc
lz.bl.fasp %>%
visdat::vis_dat() +
coord_flip() +
labs(title = "combined BL spr and fall")
## note that there is no plant ID# remove records for which browsing status is NA
lz.bl.fasp <- lz.bl.fasp %>%
filter(!is.na(measured_shoot_browsed_b_or_unbrowsed_u)) Master excel file: Willow_Offtake_Data_2009_Through_2018.xlsx
| Tabs in workbook |
| name |
|---|
| DIRECTIONS - READ FIRST |
| 2009 Spring Offtake |
| 2010 Spring Offtake |
| willow twig 2010_11 |
| 2011 Spring Offtake |
| willow twig 2011_12 |
| 2012 Spring Offtake |
| willow twig 2012_13 |
| 2013 Spring Offtake |
| 2013 fall shoots |
| 2014 Spring Offtake |
| 2015 Spring Offtake |
| 2016 Spring Offtake |
| 2017 Spring Offtake |
| 2018 Spring Offtake |
## The following was pasted in verbatim from the "DIRECTIONS" tab:
# This willow database (workbook)structure
# Annual willow data collected in support of the Elk-Vegetation Management Plan (EVMP) is accumulated by year and season in this single workbook
#
# The cumulative data set for all years-to-date is contained in the most recent year's subdirectory, e.g., O:…EVMP>Vegetation>Annual Records>FY10, FY11, etc.
#
# Data are collected and entered in a worksheet specific to that year and season as shown on the worksheet tabs.
#
# Willow data in support of the Elk Vegetation Management Plan (EVMP) is collected in 2 stages each year -- A sample of unbrowsed shoots are collected
# each fall, after the growing season. Specific measurements of browsed and unbrowsed shoots in specified plots are taken each spring
# prior to the onset of growth. Comparison of the spring measurements to the previous fall's shoot measurements allows calculation of winter offtake by
# herbivores.
#
# Data security, disaster recovery
# In addition to residing on the O:..>EVMP subdirectory as noted above, the data workbook is backed up on the hard drive (C:) of the field wildlife
# biologist's office computer after each data entry session
#
# Hard copy of spring offtake shoot measurements are held in the supervisory biologist's (T. Johnson) files (originals) and photocopies are kept in the field wildlife
# biologist's files
#
# Fall shoot measurements are conducted in the office, and entered directly into the worksheet, without hard copy
#
# Looking for baseline data?
# Baseline data was collected over 2 seasons: 2008 and 2009.
# The baseline data is located in an Excel spreadsheet at:
# EVMP > Vegetation > Analysis > 5 Year Review > Baseline Data from Linda
#
# Where is the Kawuneeche Baseline data?
# The Kawuneeche Baseline data is in a worksheet in the Baseline.xls workbook as described above.
# The Kawuneeche willow plots (KW 1 thru 8) were established in August/Sept 2011, just prior to the installation of the exclosure near Timber Creek CG.
#
# KEY
#
# SITE_TYPE (WC=Willow core, WNC= Willow noncore, WK= Willow Kawuneeche Valley)
#
# COLOR_OF_STEM_MARKER (BR=brown, G=green, BL=black, Y=yellow, GR=gray, BR-N=brown notched, W=white)
#
# NUMBER_BROWSED_CAG_SHOOTS (# Browsed Current Annual Growth Shoots)
#
# NUMBER_UNBROWSED_CAG_SHOOTS (# Unbrowsed Current Annual Growth Shoots)
#
# BROWSED_OR_UNBROWSED (Measured shoot browsed (B) or unbrowsed (U)?)
#
# ADDITIONAL_SHOOT (Additional shoot 1=yes, 0=no) ## remove the "DIRECTIONS" tab and create new field for season
offt.raw <- offt.raw %>%
filter(str_detect(sheet,pattern = "DIRE",negate = TRUE)) %>%
mutate(season = case_when(str_detect(sheet,pattern = "Spring") ~ "spring",
str_detect(sheet,pattern = "fall") ~ "fall",
TRUE ~ "Oth"))
## extract the year from the sheet name
## 'twig' tabs come out as 'NA'
offt.raw <- offt.raw %>%
mutate(yr = as.integer(str_sub(sheet,1,4)))#### Stem diameter data
## twig data
twig.raw <- offt.raw %>%
filter(str_detect(sheet,pattern = "twig")) %>%
unnest(cols = data) %>%
janitor::clean_names() %>%
mutate(date_of_collection = as.Date(as.numeric(date_of_collection), origin = "1899-12-30")) %>%
mutate(yr = year(date_of_collection))
## type convert
twig.raw <- twig.raw %>%
mutate(across(starts_with("dia"), as.numeric)) %>%
mutate(across(starts_with("shoot"), as.numeric)) offt.raw.spr <- offt.raw %>%
filter(season == "spring")
# unnest
offt.raw.spr.tidy <- offt.raw.spr %>%
unnest(cols = data) %>%
janitor::clean_names()## Distinct
# offt.raw.spr.tidy %>%
# filter(dia_base_of_shoot_mm == "0") %>% View()
## Note: not other measurements for these "0" values, so should be NA
######### DEAL WITH NA #############
## Note
na_strings <- c(".", "na", "NA", "N A", "N / A", "N/A", "N/ A", "Not Available", "NOt available")
#
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
naniar::replace_with_na_all(condition = ~.x %in% na_strings)## type convert
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
# glimpse()
mutate_at(.vars = c('number_browsed_cag_shoots','number_unbrowsed_cag_shoots', 'dia_base_of_shoot_mm','dia_tip_of_shoot_mm','shoot_length_cm','total_stem_count', 'shoot_ratio','calculated_count_of_shoots','additional_shoot'),.funs = as.numeric) %>%
mutate(site_id = case_when(site_id == "WC1" ~ "WC01",
site_id == "WC2" ~ "WC02",
site_id == "WC3" ~ "WC03",
site_id == "WC4" ~ "WC04",
site_id == "WC4" ~ "WC04",
site_id == "WC5" ~ "WC05",
site_id == "WC6" ~ "WC06",
site_id == "WC7" ~ "WC07",
site_id == "WC8" ~ "WC08",
site_id == "WC9" ~ "WC09",
site_id == "WNC1" ~ "WNC01",
site_id == "WNC1" ~ "WNC01",
site_id == "WNC2" ~ "WNC02",
site_id == "WNC3" ~ "WNC03",
site_id == "WNC4" ~ "WNC04",
site_id == "WNC4" ~ "WNC04",
site_id == "WNC5" ~ "WNC05",
site_id == "WNC6" ~ "WNC06",
site_id == "WNC7" ~ "WNC07",
site_id == "WNC8" ~ "WNC08",
site_id == "WNC9" ~ "WNC09",
site_id == "WK1" ~ "WK01",
site_id == "WK2" ~ "WK02",
site_id == "WK3" ~ "WK03",
site_id == "WK4" ~ "WK04",
site_id == "WK4" ~ "WK04",
site_id == "WK5" ~ "WK05",
site_id == "WK6" ~ "WK06",
site_id == "WK7" ~ "WK07",
site_id == "WK8" ~ "WK08",
site_id == "WK 8" ~ "WK08",
site_id == "WNC 32" ~ "WNC32",
site_id == "WK9" ~ "WK09",
TRUE ~ as.character(site_id))
)
## eliminate duplicates across all variables
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
distinct()# qa
# offt.raw.spr.tidy %>%
# visdat::vis_dat()
# all the NA for plant id is in 2009; all the NA for color of stem marker in 2009
offt.raw.spr.tidy %>%
tabyl(plant_id_number, yr)
offt.raw.spr.tidy %>%
tabyl(color_of_stem_marker, yr)## clean plant id
## add a plant id value from stem color (2009 only)
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(plant_id_number = case_when(color_of_stem_marker == "BL" ~ "1",
color_of_stem_marker == "BR" ~ "2",
color_of_stem_marker == "G" ~ "3",
color_of_stem_marker == "GR" ~ "4",
color_of_stem_marker == "NR" ~ "5",
color_of_stem_marker == "Y" ~ "6",
TRUE ~ plant_id_number)) ## these sheets are missing basal diameters
offt.raw.spr.tidy %>%
filter(is.na(dia_base_of_shoot_mm)) %>%
datatable()#### clean up site_id
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(site_id = case_when(
site_id == "WC 39" ~ "WC39",
site_id == "WC 50" ~ "WC50",
TRUE ~ site_id)) ## checking that row names are consistent across yr values
offt.raw.spr.tidy %>%
nest_by(yr) %>%
rowwise(yr) %>%
mutate(l = length(data)) %>%
mutate(names = list(names(data))) %>%
unnest(names) %>%
tabyl(names, yr)### Offtake combine baseline and master
## prep BL for rbind
## rename cols in bl
lz.bl.fasp <- lz.bl.fasp %>%
rename(dia_base_of_shoot_mm = diameter_at_base_of_shoot_mm) %>%
rename(dia_tip_of_shoot_mm = diameter_at_tip_of_shoot_mm) %>%
rename(number_unbrowsed_cag_shoots = number_unbrowsed_current_annual_growth_shoots) %>%
rename(number_browsed_cag_shoots =
number_browsed_current_annual_growth_shoots) %>%
rename(browsed_or_unbrowsed = measured_shoot_browsed_b_or_unbrowsed_u)
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(site_number = as.numeric(site_number))## compare
janitor::compare_df_cols(lz.bl.fasp,offt.raw.spr.tidy) %>%
View()
offt.raw.spr.tidy %>%
visdat::vis_dat()## combine the baseline observations from the separate LZ import (data apparently not in the 10yr review files)
## add columns to track things more easily
lz.bl.fasp <- lz.bl.fasp %>%
mutate(source = "LZBL") ## baseline
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(source = "10yrReview")
## row bind
offt.raw.spr.tidy <- bind_rows(offt.raw.spr.tidy, lz.bl.fasp)## standardize site id
## this is done for the 10yr update-derived object, but not th LZ BL
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(site_id = str_remove(site_id,"-")) %>%
mutate(site_id = case_when(site_id == "WNC1" ~ "WNC01",
site_id == "WNC2" ~ "WNC02",
site_id == "WNC3" ~ "WNC03",
site_id == "WNC4" ~ "WNC04",
site_id == "WNC5" ~ "WNC05",
site_id == "WNC6" ~ "WNC06",
site_id == "WNC7" ~ "WNC07",
site_id == "WNC8" ~ "WNC08",
site_id == "WNC9" ~ "WNC09",
site_id == "WC1" ~ "WC01",
site_id == "WC2" ~ "WC02",
site_id == "WC3" ~ "WC03",
site_id == "WC4" ~ "WC04",
site_id == "WC5" ~ "WC05",
site_id == "WC6" ~ "WC06",
site_id == "WC7" ~ "WC07",
site_id == "WC8" ~ "WC08",
site_id == "WC9" ~ "WC09",
TRUE ~ site_id))
## remove "dead" and "0" species code
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
filter(species_code != "DEAD") %>%
filter(species_code != '0') %>%
mutate(species_code = toupper(.$species_code))
# reclass "SA-" to "SAXX"
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(species_code = case_when(species_code == "SA-" ~ "SAXX",
TRUE ~ species_code))# more cleaning. Many fields are not used (mostly NA) and not used in calcs so removed here
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
select(-c(unique_site_id, color_of_stem_marker, path, calculated_count_of_shoots, contains("number_"))) #### Create unique stem id
## Create unique stem id
## This follows directions in appendix 7 of Zeigenfuss 2011. NOTE: there are many incomplete fields...
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(stid = paste0(site_id,"-",microplot_location,"-",plant_id_number,"-", stem_id_letter))
## adding species code to stid
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(stid.sppcode = paste0(site_id,"-",microplot_location,"-",plant_id_number,"-", stem_id_letter,"-", species_code))
# offt.raw.spr.tidy %>%
# select(yr, site_id, stid, stid.sppcode) %>%
# tabyl(site_id, yr) %>%
# View()
## diagnose and fix issues with b/u
offt.raw.spr.tidy %>%
tabyl(browsed_or_unbrowsed) %>%
# distinct(browsed_or_unbrowsed) %>%
gt() %>%
tab_header("Distinct 'browsed_unbrowsed",subtitle = "need to standardized encoding and deal with NA")| Distinct 'browsed_unbrowsed | |||
| need to standardized encoding and deal with NA | |||
| browsed_or_unbrowsed | n | percent | valid_percent |
|---|---|---|---|
| 0 | 1 | 4.481893e-05 | 4.492767e-05 |
| b | 1 | 4.481893e-05 | 4.492767e-05 |
| B | 8443 | 3.784062e-01 | 3.793243e-01 |
| u | 2 | 8.963786e-05 | 8.985533e-05 |
| U | 13811 | 6.189943e-01 | 6.204960e-01 |
| NA | 54 | 2.420222e-03 | NA |
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(browsed_or_unbrowsed = case_when(
str_detect(browsed_or_unbrowsed,pattern = "u") ~ "U",
str_detect(browsed_or_unbrowsed,pattern = "b") ~ "B",
TRUE ~ browsed_or_unbrowsed))
### clean: 0 browsed doesn't make sense
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
filter(browsed_or_unbrowsed != "0") %>%
filter(!is.na(browsed_or_unbrowsed)) %>%
filter(browsed_or_unbrowsed != "NA") ### Missing plant id
offt.raw.spr.tidy %>%
filter(is.na(plant_id_number)) %>%
select(sheet, yr, plant_id_number) %>%
tabyl(sheet) %>%
gt() %>%
tab_header(title = "No plant id for these records in the orignal data")| No plant id for these records in the orignal data | ||
| sheet | n | percent |
|---|---|---|
| 2009 Spring Offtake | 2 | 0.0006002401 |
| RMNP_fall_willow_offtake | 2096 | 0.6290516206 |
| RMNP_spring_willow_offtake | 1234 | 0.3703481393 |
## based on above, will try another stid with spp
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
mutate(stid.alt = paste0(site_id,"-",microplot_location,"-", species_code))# There is little consistency in the format of data entry between years...
## qc
offt.raw.spr.tidy %>%
visdat::vis_dat()
## qc tables
offt.raw.spr.tidy %>%
tabyl(yr, site_id) %>%
gt()
offt.raw.spr.tidy %>%
tabyl(yr, sheet) %>%
gt()
offt.raw.spr.tidy %>%
tabyl(yr, browsed_or_unbrowsed) %>%
gt()
offt.raw.spr.tidy %>%
tabyl(yr, stid) %>%
gt()#### Tally u and b
offt.raw.spr.tidy %>%
tabyl(yr,season)
## limited fall data### FILTER to only spring data
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
filter(season == "spring")# distinct records across all fields
offt.raw.spr.tidy <- offt.raw.spr.tidy %>%
distinct()
# offt.raw.spr.tidy %>%
# tabyl(yr)
# glimpse()
#### Tally u and b
### new object
offt.cln <- offt.raw.spr.tidy %>%
group_by(site_id, stid, yr, browsed_or_unbrowsed) %>%
mutate(stem.tally = n()) %>%
ungroup()
## replacing NA for 'additional shoot' with 0 as this seems implied
offt.cln <- offt.cln %>%
mutate(additional_shoot = replace_na(additional_shoot, 0))## remove some apparent duplicates
offt.cln <- offt.cln %>%
select(-c(sheet,source)) %>%
distinct()offt.cln %>%
View()#### Multiply the stem tally by shoot ratio
## shoot ratio has problems...
#### Address issues with 'shoot ratio'
# Missing shoot ratio. Making these '1'
# replacing '0' with '1'. Why? As multiplier with count, will be '0' if count is zero.
offt.cln <- offt.cln %>%
mutate(shoot_ratio = replace_na(shoot_ratio, 1)) %>%
mutate(shoot_ratio = case_when(
shoot_ratio == 0 ~ 1,
TRUE ~ shoot_ratio
))
## assume shoot ratio of 33 is 3; reclass
offt.cln <- offt.cln %>%
mutate(shoot_ratio = case_when(
shoot_ratio == 33 ~ 3,
TRUE ~ shoot_ratio
))
## clean records based on comments
offt.cln <- offt.cln %>%
filter(comments != "Shouldn't analyze this plot with offtake - it is fenced")
## list of comments
# offt.cln %>%
# filter(!is.na(comments)) %>%
# select(sheet,site_id,yr, comments) %>%
# datatable()## multiply the stem tally by shoot ratio
offt.cln <- offt.cln %>%
mutate(total_bu_pre_addshoot = stem.tally*shoot_ratio) %>%
mutate(total_bu = total_bu_pre_addshoot + additional_shoot)## join in the site info
site.info.cleannames <- site.info.clean %>%
clean_names()
offt.cln <- left_join(offt.cln, site.info.cleannames, by = "site_id")
##########
### Removed plots have been carried over
site.info.fenced.burned <- site.info.clean %>%
clean_names() %>%
select(site_id, fenced, burned)
offt.cln <- offt.cln %>%
select(-fenced, -burned)
offt.cln <- left_join(offt.cln,site.info.fenced.burned, by = "site_id")###
offt.cln %>%
# filter(!is.na(plant_id_number)) %>%
tabyl(site_id, yr) %>%
gt()
####### need to find 2009! a little 2014 too have missing plant id
offt.cln %>%
visdat::vis_dat()## calc total number of stems (b + u)
offt.cln <- offt.cln %>%
group_by(stid, yr) %>%
mutate(tot_allstems_per_shoot = sum(total_bu)) %>% ungroup()
#qa
# offt.cln %>%
# slice_sample(n = 25) %>%
# gt()
offt.cln <- offt.cln %>% #names()
group_by(stid, yr) %>%
mutate(sum_bu_per_stem = sum(total_bu)) %>%
ungroup()
## calc the % of shoots browsed per STEM (step 2a n Zeigenfuss 2011)
offt.cln <- offt.cln %>%
mutate(percent_bu_per_stem = total_bu/sum_bu_per_stem) %>%
mutate(percent_bu_per_stem = round(percent_bu_per_stem,3)) ## fix species code
## eliminate "DEAD" species
offt.cln <- offt.cln %>%
filter(species_code != "DEAD") %>%
# filter(species_code != "0") %>%
mutate(species_code = case_when(
species_code == "Sabe" ~ "SABE",
species_code == "Sage" ~ "SAGE",
species_code == "Samo" ~ "SAMO",
species_code == "SA-" ~ "SAXX",
TRUE ~ species_code
))# offt.cln %>%
# mutate(time_class = case_when(yr == 2008 ~ "BL",
# yr == 2009 ~ "BL",
# TRUE ~ as.character(yr))) %>%
# mutate(time_class = as.factor(time_class)) %>%
# tabyl(time_class)
# mutate(time_class = fct_relevel(time_class, "2018", "2013", "BL"))
## add timeclass
### summary plots
# select just the browsed stems
offt.percbrowsed <- offt.cln %>%
filter(browsed_or_unbrowsed == "B") %>%
select(c(yr, site_type, site_id, species_code, stid, sum_bu_per_stem, percent_bu_per_stem, fenced, range_type)) %>%
distinct()
offt.percbrowsed %>%
group_by(yr, site_id, fenced, range_type) %>%
summarytools::descr(percent_bu_per_stem) %>%
tb() %>%
datatable()## qc
# offt.cln %>%
# group_by(yr,site_id, stid) %>%
# summarytools::descr(percent_bu_per_stem,
# stats = "common") %>%
# tb() %>%
# gt()
offt.cln %>%
# filter(site_id == "WC12" | yr == 2009) %>%
ggplot(aes(reorder(site_id, percent_bu_per_stem),percent_bu_per_stem)) +
geom_col(aes(fill = browsed_or_unbrowsed), color = "grey50", size=0.5) +
facet_wrap(~yr)
## offtake
offt.percbrowsed %>%
ggplot(aes(x = as_factor(yr), y = percent_bu_per_stem)) +
geom_boxplot(fill = "grey50", outlier.shape = NA) +
labs(x = "Year",y = "% leader use") +
# facet_wrap(~site_type) +
facet_grid(fenced~site_type) +
theme_minimal() +
scale_y_continuous(labels=scales::percent)
offt.percbrowsed %>%
ggplot(aes(x = as_factor(yr), y = percent_bu_per_stem)) +
geom_boxplot(fill = "grey50", outlier.shape = NA) +
labs(x = "Year",y = "% leader use") +
facet_wrap(~site_type) +
theme_minimal() +
scale_y_continuous(labels=scales::percent)
offt.percbrowsed %>%
ggplot(aes(x = percent_bu_per_stem, y = as_factor(yr))) +
ggridges::geom_density_ridges(rel_min_height = 0.005,panel_scaling = TRUE) +
# scale_y_discrete(expand = c(0.01, 0)) +
# scale_x_continuous(expand = c(0.01, 0)) +
theme_minimal() +
labs(x = "% leader use", y = "", caption = "all species") +
# scale_y_continuous(labels=scales::percent) +
facet_wrap(~site_type) +
scale_x_continuous(labels=scales::percent,limits = c(0,1))
# offt.percbrowsed %>%
# ggplot(aes(x = percent_bu_per_stem, y = as_factor(yr))) +
# # ggridges::geom_density_ridges(rel_min_height = 0.005,panel_scaling = TRUE) +
# geom_boxplot() +
# # scale_y_discrete(expand = c(0.01, 0)) +
# # scale_x_continuous(expand = c(0.01, 0)) +
# theme_minimal() +
# labs(x = "% leader use", y = "", caption = "all species") +
# # scale_y_continuous(labels=scales::percent) +
# # facet_wrap(~site_type) +
# facet_grid(site_type~fenced) +
# scale_x_continuous(labels=scales::percent,limits = c(0,1))
#
#
# ggsave("./output/figures_202108/ggridge_percleaderuse_site_type_20200602.png", width = 8.5, height = 6, dpi = 300)
offt.percbrowsed %>%
filter(site_type != "WK") %>%
ggplot(aes(y = percent_bu_per_stem)) +
geom_histogram() +
# theme_minimal() +
theme_minimal() +
labs(y = "% leader use", x = "count", caption = "all species") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# facet_grid(as_factor(yr) ~site_type)
facet_grid(site_type ~ as_factor(yr)) +
scale_y_continuous(labels=scales::percent,limits = c(0,1))
# facet_wrap(~site_type, scales = "free_x")
# ggsave("./output/figures_202108/histo_percleaderuse_wc_wnc_20200602.png", width = 9.5, height = 4.5, dpi = 300)
offt.percbrowsed %>%
ggplot(aes(x = percent_bu_per_stem)) +
# geom_histogram() +
geom_density(aes(color = as_factor(yr))) +
facet_wrap(~site_type) +
theme_minimal() +
labs(x = "% leader use", y = "") +
scale_x_continuous(labels=scales::percent,limits = c(0,1))
# WC density
offt.percbrowsed %>%
filter(site_type == "WC") %>%
ggplot(aes(x = percent_bu_per_stem)) +
# geom_histogram() +
geom_density(aes(color = as_factor(yr))) +
facet_wrap(~site_type) +
theme_minimal() +
labs(x = "% leader use", y = "", color = "") +
scale_x_continuous(labels=scales::percent,limits = c(0,1))
ggsave("./output/figures_202108/desnity_percleaderuse_wc_20200602.png", width = 4.5, height = 3.75, dpi = 300)# WNC density
offt.percbrowsed %>%
filter(site_type == "WNC") %>%
ggplot(aes(x = percent_bu_per_stem)) +
# geom_histogram() +
geom_density(aes(color = as_factor(yr))) +
facet_wrap(~site_type) +
theme_minimal() +
labs(x = "% leader use", y = "", color = "") +
scale_x_continuous(labels=scales::percent,limits = c(0,1))
ggsave("./output/figures_202108/density_percleaderuse_wnc.png", width = 4.5, height = 3.75, dpi = 300)### summary by site
offt.percbrowsed.summary <- offt.percbrowsed %>%
group_by(yr, site_id) %>%
summarytools::descr(var = percent_bu_per_stem, stats = "common") %>%
summarytools::tb() %>%
mutate(across(where(is.numeric), round, 1))
# make plot based
offt.percbrowsed.summary <- offt.percbrowsed %>%
group_by(yr, site_type) %>%
summarytools::descr(var = percent_bu_per_stem, stats = "common") %>%
summarytools::tb() %>%
mutate(across(where(is.numeric), round, 1))
offt.percbrowsed.summary %>%
gt() %>%
tab_header(title = "Willow Offtake (% leader use)") #### Percent browsed
## yr x for combined WC and WNC site type
offt.percbrowsed.summary.allRange <- offt.percbrowsed %>%
mutate(percent_bu_per_stem = percent_bu_per_stem*100) %>%
filter(site_type == "WC" | site_type == "WNC") %>% group_by(yr) %>%
summarytools::descr(var = percent_bu_per_stem, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, Year = yr)
offt.percbrowsed.summary.allRange %>%
gt() %>%
tab_header(title = "Willow Offtake (% leader use) WC & WNC plots") %>%
fmt_number(
columns = 2:11,
decimals = 1,
suffixing = TRUE
) # %>% | Willow Offtake (% leader use) WC & WNC plots | ||||||||||
| Year | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|
| 2009 | 100.0 | NA | 100.0 | 100.0 | 100.0 | 100.0 | 100.0 | 0.0 | 0.0 | 1.0 |
| 2016 | 77.1 | 28.7 | 40.0 | 50.0 | 100.0 | 100.0 | 100.0 | 0.0 | 50.0 | 7.0 |
| 2017 | 75.0 | 43.3 | 25.0 | 25.0 | 100.0 | 100.0 | 100.0 | 0.0 | 37.5 | 3.0 |
| 2018 | 69.8 | 29.7 | 14.3 | 50.0 | 66.7 | 100.0 | 100.0 | 37.1 | 50.0 | 10.0 |
# gtsave("./output/tables/WillowPercOfft_WCplusWNC.rtf")## yr x for combined WC and WNC site type
offt.percbrowsed.summary.allRange.fen <- offt.percbrowsed %>%
mutate(percent_bu_per_stem = percent_bu_per_stem*100) %>%
filter(site_type == "WC" | site_type == "WNC") %>% group_by(yr, fenced) %>%
summarytools::descr(var = percent_bu_per_stem, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, Year = yr)
offt.percbrowsed.summary.allRange.fen %>%
gt() %>%
tab_header(title = "Willow Offtake (% leader use) WC & WNC plots") %>%
fmt_number(
columns = 3:11,
decimals = 1,
suffixing = TRUE
) # %>% | Willow Offtake (% leader use) WC & WNC plots | |||||||||||
| Year | fenced | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2009 | Fenced | 100.0 | NA | 100.0 | 100.0 | 100.0 | 100.0 | 100.0 | 0.0 | 0.0 | 1 |
| 2016 | Unfenced | 77.1 | 28.7 | 40.0 | 50.0 | 100.0 | 100.0 | 100.0 | 0.0 | 50.0 | 7 |
| 2017 | Unfenced | 75.0 | 43.3 | 25.0 | 25.0 | 100.0 | 100.0 | 100.0 | 0.0 | 37.5 | 3 |
| 2018 | Unfenced | 66.4 | 29.4 | 14.3 | 50.0 | 66.7 | 100.0 | 100.0 | 24.8 | 50.0 | 9 |
| 2018 | NA | 100.0 | NA | 100.0 | 100.0 | 100.0 | 100.0 | 100.0 | 0.0 | 0.0 | 1 |
# gtsave("./output/tables/WillowPercOfft_WCplusWNC.rtf")## yr x site type
offt.percbrowsed.summary <- offt.percbrowsed %>%
mutate(percent_bu_per_stem = percent_bu_per_stem*100) %>%
group_by(yr, site_type) %>%
summarytools::descr(var = percent_bu_per_stem, round.digits = 1) %>%
summarytools::tb() %>%
select(-c(variable, se.skewness, kurtosis, pct.valid,cv, skewness)) %>%
rename(n = n.valid, Year = yr, 'Site type' = site_type)
## WC and WNC
offt.percbrowsed.summary %>%
filter(`Site type` == "WC" | `Site type` == "WNC") %>%
gt() %>%
tab_header(title = "Willow Offtake (% leader use)") %>%
fmt_number(
columns = 3:11,
decimals = 1,
suffixing = TRUE
) # %>% | Willow Offtake (% leader use) | |||||||||||
| Year | Site type | mean | sd | min | q1 | med | q3 | max | mad | iqr | n |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2009 | WC | 100.0 | NA | 100.0 | 100.0 | 100.0 | 100.0 | 100.0 | 0.0 | 0.0 | 1 |
| 2016 | WC | 83.3 | 28.9 | 50.0 | 50.0 | 100.0 | 100.0 | 100.0 | 0.0 | 25.0 | 3 |
| 2016 | WNC | 72.5 | 32.0 | 40.0 | 45.0 | 75.0 | 100.0 | 100.0 | 37.1 | 52.5 | 4 |
| 2017 | WC | 100.0 | 0.0 | 100.0 | 100.0 | 100.0 | 100.0 | 100.0 | 0.0 | 0.0 | 2 |
| 2017 | WNC | 25.0 | NA | 25.0 | 25.0 | 25.0 | 25.0 | 25.0 | 0.0 | 0.0 | 1 |
| 2018 | WC | 80.0 | 27.4 | 50.0 | 50.0 | 100.0 | 100.0 | 100.0 | 0.0 | 50.0 | 5 |
| 2018 | WNC | 59.5 | 31.1 | 14.3 | 50.0 | 66.7 | 66.7 | 100.0 | 24.8 | 16.7 | 5 |
# gtsave("./output/tables/WillowPercOfft_WC_WNC_yrxsite_type.rtf")# **Calculate DD1, the avg proportion of shoot consumed per stem (step 3
# in Zeigenfuss 2011)**
#
# DD1 = (Dp - Dt)/(Db -Dt)
#
# Dp = shoot diameter at point of browsing Dt = Avg diam of of unbrowsed
# stems Db = diamter at base of shoot
## Calculate:
## Dp = shoot diameter at point of browsing &
## Db = diamter at base of shoot
offt.cln <- offt.cln %>%
mutate(Db = dia_base_of_shoot_mm) %>%
mutate(Dp = dia_tip_of_shoot_mm)
## calculate Dt - Avg diam of of unbrowsed stems
Dt.table <- offt.cln %>%
filter(browsed_or_unbrowsed == "U") %>%
group_by(stid, yr) %>%
summarise(Dt = mean(Dp, na.rm = TRUE)) %>%
ungroup()
## Dtsite
Dtsite.table <- offt.cln %>%
filter(browsed_or_unbrowsed == "U") %>%
group_by(site_id, species_code, yr) %>%
summarise(Dtsite = mean(Dp, na.rm = TRUE)) %>%
ungroup()
## Dtspecies
Dtspp.table <- offt.cln %>%
filter(browsed_or_unbrowsed == "U") %>%
group_by(species_code, yr) %>%
summarise(Dtspp = mean(Dp, na.rm = TRUE)) %>%
mutate(Dtspp = case_when(
species_code == "SALA" ~ 0.748, # setting to Dt of SAXX, since there are NaN for SALA and SAWO
species_code == "SAWO" ~ 0.748,
TRUE ~ Dtspp
)) %>%
ungroup()
## join in the Dt values
offt.cln.br <- offt.cln %>%
filter(browsed_or_unbrowsed == "B") %>%
left_join(.,Dt.table)
## join Dtsite for BROWSED
offt.cln.br <- offt.cln %>%
filter(browsed_or_unbrowsed == "B") %>%
left_join(.,Dtsite.table)
## join in Dtspp for BROWSED
offt.cln.br <- offt.cln %>%
filter(browsed_or_unbrowsed == "B") %>%
left_join(.,Dtspp.table)
# offt.cln.br %>%
# visdat::vis_dat(warn_large_data = FALSE)# cont below
## IF Dt is NA after sub in Dtsite (if available. Will still be Na, but fewer)
offt.cln.br <- offt.cln.br %>%
mutate(Dtadj = case_when(
is.na(Dt) ~ Dtsite,
TRUE ~ Dt
)
)
## IF Dt is still NA after subbing in Dtsite, replace with Dtspp
offt.cln.br <- offt.cln.br %>%
mutate(Dtadj = case_when(
is.na(Dtadj) ~ Dtspp,
TRUE ~ Dtadj
)
)
## if Dt is negative or greater than zero (part 3 in Zeigenfuss 2011). Where Dt is < Dtspp, replace with Dtspp
offt.cln.br <- offt.cln.br %>%
mutate(Dtadj = case_when(
Dt <= Dtspp ~ Dtspp,
TRUE ~ Dtadj
)
)
## covert values >1 to 1 (can't have more than 100%) -- see Zeigenfuss
offt.cln.br <- offt.cln.br %>%
mutate(Dtadj = case_when(
Dtadj > 1 ~ 1,
TRUE ~ Dtadj
)
)
# offt.cln.br %>%
# summarytools::descr(Dtadj) %>%
# summarytools::tb()# DD1stem >>>
### calc DD1
offt.cln.br %>% names()
offt.cln.br <- offt.cln.br %>%
group_by(stid, yr) %>%
mutate(DD1 = ((Dp - Dtadj)/(Db - Dtadj))) %>%
ungroup()
offt.cln.br %>%
filter(!is.na(DD1)) %>%
summarytools::descr(DD1,na.rm = TRUE)## Notes for above from Ziegenfuus 2011
## There are some cases where no unbrowsed shoots were measured on an individual stem and thus an average unbrowsed tip diameter (Dt) for the stem cannot be calculated. In this case, an average unbrowsed tip diameter for all the stems of a particular species within a site is calculated (Dtsite) and then substituted for Dt. If there were no unbrowsed shoots of a species found within an individual site, then an average unbrowsed shoot tip can be calculated from all shoot measurements of that species (Dtsp) that were collected from other willow-monitoring sites measured within the same year and this average is substituted for Dt.## calc the % of shoots per site and year (step 2b in Z 2011)
offt.cln.site.allwillow <- offt.cln %>%
group_by(site_id, species_code)
## calc the proporation of browsed/unbrowsed stems out of total
offt.cln <- offt.cln %>%
mutate(perc_bu_shoots = total_bu/tot_allstems*100)
browsed_percent <- a.stid.cnt.bu %>%
filter(browsed_or_unbrowsed == "B") %>%
dplyr::select(stid, yr, species_code, browsed_or_unbrowsed, perc_bu_shoots)
offt.cln.spr.tidy <- offt.cln.spr.tidy %>%
filter(is.na(shoot_ratio))
tabyl(shoot_ratio)
## try some cleaning
offt.cln.spr.tidy <- offt.raw.spr.tidy %>%
filter(!is.na(dia_tip_of_shoot_mm)) offt.raw.spr.tidy %>%
names()
##### define function
# dd2 = function(df){
# b = df$number_browsed_cag_stems
# u = df$number_unbrowsed_cag_stems
# Dp = df$
# } # 'number_browsed_cag_shoots','number_unbrowsed_cag_shoots', 'dia_base_of_shoot_mm','dia_tip_of_shoot_mm','shoot_length_cm','total_stem_count'Beaver and Moose Presence
The following plots and tables summarize the beaver and moose presence observations for 2018
#### Observations of beaver presence noted in plots
# How best to use these obserations?
#
# **Variable: BEAVER_PRESENCE**
sinfo.df %>%
mutate(BEAVER_PRESENCE = recode(BEAVER_PRESENCE,
"Absence_" = "Absence",
"Food_cache_cuttings"="Cuttings")) %>%
tabyl(BEAVER_PRESENCE) %>%
gt::gt() %>%
fmt_number(
columns = vars(percent),
decimals = 2
)| BEAVER_PRESENCE | n | percent |
|---|---|---|
| Absence | 118 | 0.96 |
| Cuttings | 5 | 0.04 |
sinfo.df %>%
mutate(BEAVER_PRESENCE = recode(BEAVER_PRESENCE,
"Absence_" = "Absence",
"Food_cache_cuttings"="Cuttings")) %>%
group_by(BEAVER_PRESENCE) %>%
tally()## # A tibble: 2 x 2
## BEAVER_PRESENCE n
## <chr> <int>
## 1 Absence 118
## 2 Cuttings 5bv.tally <- sinfo.df %>%
mutate(LOCATION = case_when(is.na(LOCATION) & SITE_TYPE == "WK" ~ "Kawuneeche",
TRUE ~ LOCATION))%>%
mutate(LOCATION = str_replace(LOCATION, "_", " ")) %>%
mutate(LOCATION = str_replace(LOCATION, "_", " ")) %>%
mutate(BEAVER_PRESENCE = recode(BEAVER_PRESENCE,
"Absence_" = "Absence",
"Food_cache_cuttings"="Cuttings")) %>%
group_by(LOCATION) %>%
mutate(n_site = n()) %>%
ungroup()
bv.tally %>%
group_by(LOCATION, BEAVER_PRESENCE, n_site) %>%
tally() %>%
ggplot(aes(x = reorder(LOCATION, n_site), y = n)) +
geom_col(aes(fill = BEAVER_PRESENCE), color = "grey50", size=0.5) +
coord_flip() +
labs(x = "", y = "Number of plots", fill = "", caption = "2018 Beaver presence") +
scale_fill_manual(values = c("ivory3", "cyan3")) +
theme_minimal()
ggsave("./output/figures_202108/beaver_presence01.png", width = 6.25, height = 3.75, dpi=300)
bv.tally %>%
group_by(LOCATION, BEAVER_PRESENCE, n_site) %>%
tally() %>%
ungroup() %>%
mutate(perc.cut = n/n_site*100) %>%
filter(BEAVER_PRESENCE == "Cuttings")## # A tibble: 4 x 5
## LOCATION BEAVER_PRESENCE n_site n perc.cut
## <chr> <chr> <int> <int> <dbl>
## 1 Horseshoe Park Cuttings 13 1 7.69
## 2 McGraw Ranch Cuttings 8 1 12.5
## 3 Moraine Park Cuttings 42 2 4.76
## 4 Upper Beaver Meadows Cuttings 15 1 6.67bv.mcro <- csv.all.lc.mcro.df %>%
mutate(BEAVER_PRESENCE = recode(BEAVER_PRESENCE,
"Absence_" = "Absence",
"Food_cache_cuttings"="Cuttings"))
bv.mcro.sum <- bv.mcro %>%
select(SITE_ID, timeClass,BEAVER_PRESENCE,LOCATION, SITE_TYPE) %>%
distinct() %>%
group_by(timeClass,BEAVER_PRESENCE, SITE_TYPE) %>%
tally() %>%
ungroup() %>%
filter(!is.na(BEAVER_PRESENCE)) %>%
pivot_wider(names_from = BEAVER_PRESENCE, values_from = n) %>%
mutate(perc.cuttings = 100* Cuttings/(Cuttings + Absence)) %>%
mutate(perc.abs = 100 - perc.cuttings)
bv.mcro.sum %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
arrange(desc(SITE_TYPE)) %>%
gt()| timeClass | SITE_TYPE | Absence | Cuttings | perc.cuttings | perc.abs |
|---|---|---|---|---|---|
| BL | WNC | 33 | 1 | 2.941176 | 97.05882 |
| 2013 | WNC | 33 | 1 | 2.941176 | 97.05882 |
| 2018 | WNC | 33 | 1 | 2.941176 | 97.05882 |
| BL | WC | 45 | 2 | 4.255319 | 95.74468 |
| 2013 | WC | 69 | 3 | 4.166667 | 95.83333 |
| 2018 | WC | 70 | 4 | 5.405405 | 94.59459 |
# sinfo.df %>%
# distinct(MOOSE_PRESENCE)
# inconsistent encoding of MOOSE_PRESENCE
# # A tibble: 10 x 1
# MOOSE_PRESENCE
# <chr>
# 1 Absence_
# 2 Browse
# 3 Browse/Tracks
# 4 Browse_tracks
# 5 Tracks
# 6 Scat_beds_
# 7 Browse_scat_tracks
# 8 Browse_scat
# 9 Scat
# 10 Browse_scat_tracks_sighting
sinfo.df <- sinfo.df %>%
mutate(MOOSE_PRESENCE2 = recode(MOOSE_PRESENCE,
"Absence_" = "Absence",
"Browse_tracks"="Presence",
"Browse/Tracks"="Presence",
"Browse_scat"="Presence",
"Browse_scat_tracks"="Presence",
"Browse_scat_tracks_sighting" = "Presence",
"Scat_beds_" = "Presence"
)) %>%
mutate(MOOSE_PRESENCE = recode(MOOSE_PRESENCE,
"Absence_" = "Absence",
"Browse_tracks"="Browse/tracks",
"Browse/Tracks"="Browse/tracks",
"Browse_scat"="Browse/scat",
"Browse_scat_tracks"="Browse/scat/tracks",
"Browse_scat_tracks_sighting" = "Browse/scat/tracks/sighting",
"Scat_beds_" = "Scat/beds"
))
sinfo.df %>%
tabyl(MOOSE_PRESENCE) %>%
rename('Moose presence' = 'MOOSE_PRESENCE') %>%
gt::gt() %>%
fmt_number(
columns = vars(percent),
decimals = 2
) %>%
tab_header(
title = "Moose presence in 2018"
)| Moose presence in 2018 | ||
| Moose presence | n | percent |
|---|---|---|
| Absence | 42 | 0.34 |
| Browse | 55 | 0.45 |
| Browse/scat | 5 | 0.04 |
| Browse/scat/tracks | 9 | 0.07 |
| Browse/scat/tracks/sighting | 1 | 0.01 |
| Browse/tracks | 6 | 0.05 |
| Scat | 2 | 0.02 |
| Scat/beds | 1 | 0.01 |
| Tracks | 2 | 0.02 |
# sinfo.df %>%
# tabyl(MOOSE_PRESENCE2) %>%
# rename('Moose presence' = 'MOOSE_PRESENCE2') %>%
# gt::gt() %>%
# fmt_number(
# columns = vars(percent),
# decimals = 2
# ) %>%
# tab_header(
# title = "Moose presence in 2018"
# )#### Observations of moose presence noted in plots
# > How best to use these obserations?
# **Variable: MOOSE_PRESENCE**
mcro.moose <- csv.all.lc.mcro.df %>%
mutate(moose = case_when(MOOSE_PRESENCE == "Absence_" ~ "Absent",
MOOSE_PRESENCE != "Absent" ~ "Present",
TRUE ~ MOOSE_PRESENCE))
mcro.moose.tally <- mcro.moose %>%
select(c(SITE_ID, moose, yr, LOCATION, BURNED, FENCED, timeClass)) %>%
distinct() %>%
group_by(timeClass, LOCATION) %>%
mutate(n_plots_in_loc = n()) %>%
ungroup()
mcro.moose.tally <- mcro.moose.tally %>%
filter(!is.na(LOCATION)) %>%
group_by(timeClass, moose, LOCATION, n_plots_in_loc) %>%
# mutate(n_plots_in_loc_sign = n()) %>%
tally() %>%
ungroup() %>%
mutate(perc_moose = n/n_plots_in_loc * 100)
mcro.moose.tally.n <- mcro.moose.tally %>%
group_by(timeClass, moose, LOCATION) %>%
tally() %>%
ungroup()## moose plotting
mcro.moose.tally %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LOCATION != "Kawuneeche") %>%
mutate(timeClass = forcats::fct_rev(timeClass)) %>%
ggplot(aes(x = timeClass, y = perc_moose, color="grey80")) +
geom_col(aes(fill = moose), width = .7, color = "grey50", size=0.5) +
facet_wrap(~LOCATION, ncol = 3) +
theme_minimal() +
labs(x = "", y = "% plots", fill = "") +
scale_fill_manual(values = c("grey90", "grey40")) 
# scale_fill_manual(values = colfunc3(2))
# scale_fill_manual(values = c("ivory3", "cyan3"))
ggsave("./output/figures_202108/moose_presence_absence01.png", width = 6.25, height = 3.75, dpi=300)
# mcro.moose.tally %>%
# filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
# filter(LOCATION != "Kawuneeche") %>%
# filter(moose =="Present") %>%
# mutate(timeClass = forcats::fct_rev(timeClass))%>%
# ggplot(aes(x = timeClass, y = perc_moose)) +
# geom_col(aes(fill = moose), width = 0.7, color = "grey80") +
# facet_wrap(~LOCATION, ncol = 3) +
# theme_minimal() +
# labs(x = "", y = "% plots", fill = "") +
# scale_fill_manual(values = colfunc2(2)) +
# # scale_fill_manual(values = c("ivory4", "blue")) +
# theme(legend.position = "none")
#
# ggsave("./output/figures_202108/moose_presence01.png", width = 6.25, height = 3.75, dpi=300)
mcro.moose.tally %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable()csv.all.lc.mcro.df %>%
group_by(SITE_ID, MOOSE_PRESENCE, yr) %>%
filter(MOOSE_PRESENCE != "Absence_") %>%
tally() %>%
dplyr::select(-n) %>%
datatable()Aspen data
Master excel file:
Aspen_Data_Baseline_through_2018.xlsx
The excel datafile provided by RMNP
(Aspen_Data_Baseline_Through_2018.xlsx) includes 10
tabs.
## **Data import**
asp <- readxl::excel_sheets("./data/EVMP_data/TenYearReview/Aspen_Data_Baseline_Through_2018.xlsx")
path <- ("data/EVMP_data/TenYearReview/Aspen_Data_Baseline_Through_2018.xlsx")
#### Read in the worksheets and create list of df
# each tab is a df in the list object
asp.d <- path %>%
excel_sheets() %>%
set_names() %>%
map(read_excel, path = path, na = "NA") ######
## site info tabs. read and clean
asp.siteinfo2018 <- asp.d$'Aspen 2018 Site Info'
# standardize use of SITE_ID (i.e., plot)
asp.siteinfo2018 <- asp.siteinfo2018 %>%
mutate(SITE_ID = case_when(SITE_ID == "AC1" ~ "AC01",
SITE_ID == "AC2" ~ "AC02",
SITE_ID == "AC3" ~ "AC03",
SITE_ID == "AC4" ~ "AC04",
SITE_ID == "AC4" ~ "AC04",
SITE_ID == "AC5" ~ "AC05",
SITE_ID == "AC6" ~ "AC06",
SITE_ID == "AC7" ~ "AC07",
SITE_ID == "AC8" ~ "AC08",
SITE_ID == "AC9" ~ "AC09",
SITE_ID == "ANC1" ~ "ANC01",
SITE_ID == "ANC1" ~ "ANC01",
SITE_ID == "ANC2" ~ "ANC02",
SITE_ID == "ANC3" ~ "ANC03",
SITE_ID == "ANC4" ~ "ANC04",
SITE_ID == "ANC4" ~ "ANC04",
SITE_ID == "ANC5" ~ "ANC05",
SITE_ID == "ANC6" ~ "ANC06",
SITE_ID == "ANC7" ~ "ANC07",
SITE_ID == "ANC8" ~ "ANC08",
SITE_ID == "ANC9" ~ "ANC09",
SITE_ID == "AK1" ~ "AK01",
SITE_ID == "AK2" ~ "AK02",
SITE_ID == "AK3" ~ "AK03",
SITE_ID == "AK4" ~ "AK04",
SITE_ID == "AK4" ~ "AK04",
SITE_ID == "AK5" ~ "AK05",
SITE_ID == "AK6" ~ "AK06",
SITE_ID == "AK7" ~ "AK07",
SITE_ID == "AK8" ~ "AK08",
SITE_ID == "AK9" ~ "AK09",
TRUE ~ as.character(SITE_ID))
)
asp.siteinfo2018 %>%
datatable()asp.siteinfo_baseline <- asp.d$'Aspen Baseline Site Info'
asp.siteinfo_baseline <- asp.siteinfo_baseline
# write_csv(asp.siteinfo_baseline, "./data/EVMP_derived/asp_siteinfoBaseline.csv")######
## select the tabs with tally data
asp.d.sel <- asp.d[c(3,4,5,6,8,10)]
## combine
asp.tally.all <- bind_rows(asp.d.sel, .id = "tab")
## fix inconsistent labels
asp.tally.all <-
asp.tally.all %>%
mutate(SITE_ID = case_when(SITE_ID == "AC1" ~ "AC01",
SITE_ID == "AC2" ~ "AC02",
SITE_ID == "AC3" ~ "AC03",
SITE_ID == "AC4" ~ "AC04",
SITE_ID == "AC4" ~ "AC04",
SITE_ID == "AC5" ~ "AC05",
SITE_ID == "AC6" ~ "AC06",
SITE_ID == "AC7" ~ "AC07",
SITE_ID == "AC8" ~ "AC08",
SITE_ID == "AC9" ~ "AC09",
SITE_ID == "ANC1" ~ "ANC01",
SITE_ID == "ANC1" ~ "ANC01",
SITE_ID == "ANC2" ~ "ANC02",
SITE_ID == "ANC3" ~ "ANC03",
SITE_ID == "ANC4" ~ "ANC04",
SITE_ID == "ANC4" ~ "ANC04",
SITE_ID == "ANC5" ~ "ANC05",
SITE_ID == "ANC6" ~ "ANC06",
SITE_ID == "ANC7" ~ "ANC07",
SITE_ID == "ANC8" ~ "ANC08",
SITE_ID == "ANC9" ~ "ANC09",
SITE_ID == "AK1" ~ "AK01",
SITE_ID == "AK2" ~ "AK02",
SITE_ID == "AK3" ~ "AK03",
SITE_ID == "AK4" ~ "AK04",
SITE_ID == "AK4" ~ "AK04",
SITE_ID == "AK5" ~ "AK05",
SITE_ID == "AK6" ~ "AK06",
SITE_ID == "AK7" ~ "AK07",
SITE_ID == "AK8" ~ "AK08",
SITE_ID == "AK9" ~ "AK09",
TRUE ~ as.character(SITE_ID))
)asp.tally.all %>%
group_by(BURNED, FENCED) %>%
tally()%>%
gt::gt()
# aspen combined variable names
asp.tally.all %>%
names() %>%
enframe() %>%
gt::gt()asp.tally.all %>%
janitor::tabyl(tab,SITE_TYPE) %>%
gt::gt()Tally of records by year and core, non-core, and Kawuneeche Valley sites
asp.tally.all %>%
janitor::tabyl(YEAR,SITE_TYPE) %>%
gt::gt()| YEAR | AC | AK | ANC |
|---|---|---|---|
| 2006 | 30 | 0 | 4 |
| 2007 | 16 | 16 | 26 |
| 2008 | 6 | 0 | 10 |
| 2009 | 38 | 0 | 0 |
| 2013 | 96 | 16 | 42 |
| 2015 | 28 | 0 | 0 |
| 2016 | 28 | 0 | 0 |
| 2017 | 28 | 0 | 0 |
| 2018 | 92 | 16 | 42 |
## join in site info
asp.tally.all <- left_join(asp.tally.all, site.info.clean, by = "SITE_ID")
## make the 'NA' for the 'SITE_TYPE' field 'N' instead
asp.tally.all <- asp.tally.all %>%
mutate(FENCED = case_when(FENCED == "NA_" ~ "N",
is.na(FENCED) ~ "N",
FENCED == "N" ~ "Unfenced",
TRUE ~ as.character(FENCED))
)
## tidy height and dbh classes
## tidy the dbh
asp.tally.dbh.tidy <- asp.tally.all %>%
pivot_longer(
cols = starts_with("DBH"),
names_to = "DBHclass",
values_to = "DBHval"
)
# asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
# select(-contains("HT_"))
## tidy the height
asp.tally.ht.tidy <- asp.tally.all %>%
pivot_longer(
cols = starts_with("HT_"),
names_to = "HTclass",
values_to = "HTval"
)
# asp.tally.all
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
select(-contains("DBH"))## clean up BURNED: 'NA' to 'N'
asp.tally.all <-
asp.tally.all %>%
mutate(BURNED = case_when(is.na(BURNED) ~ 'Unburned',
TRUE ~ as.character(BURNED)))
### write table
# write_csv(asp.tally.all, "./data/EVMP_derived/asp_tally_all.csv")## mod the dbh factor levels
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
mutate(DBHclassFact = as_factor(DBHclass)) %>%
mutate(FENCED = case_when(FENCED == "N" ~ "Unfenced",
TRUE ~ FENCED))
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
mutate(timeClass = case_when(YEAR == 2006 ~ "BL",
YEAR == 2007 ~ "BL",
YEAR == 2008 ~ "BL",
YEAR == 2009 ~ "BL",
TRUE ~ as.character(YEAR))) %>%
mutate(timeClass = factor(timeClass, levels = c("BL", "2013","2015","2016","2017","2018"))) # set as factor, set levels
## set the dbh factor levels
# levels(asp.tally.dbh.tidy$)
## Convert stem counts to density
## 4046.86 m2 = 1 acre conversion
## plot is 25m2
## scaler is: 161.8744
## i.e., 1 stem/m2 = 161.8744 stems/acre
# rename stemTally for DBH class to something more sensible
asp.tally.dbh.tidy <-
asp.tally.dbh.tidy %>%
rename(stemTally = DBHval)
## Create a new field to combine the 2cm dbh bands into smaller number of classes.
# write a table to use as look-up
# asp.tally.tidy %>%
# distinct(DBHclassFact) %>%
# write_csv('./data/EVMP_derived/DBHclassFact_lu.csv')
# read in the lu
dbh.lu <- read_csv('./data/EVMP_derived/DBHclassFact_lu.csv')
asp.tally.dbh.tidy <- left_join(asp.tally.dbh.tidy, dbh.lu, by = "DBHclassFact")
## set the factor levels for the DBH classes
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
mutate(DBHclGp01 = as_factor(DBHclGp01))
## fix issue of missing "RANGE TYPE" attributes
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
mutate(RANGE_TYPE = case_when(is.na(RANGE_TYPE) & SITE_TYPE == "AC" ~ "core winter range",
is.na(RANGE_TYPE) & SITE_TYPE == "ANC" ~ "non-core winter range",
is.na(RANGE_TYPE) & SITE_TYPE == "AK" ~ "Kawuneeche Valley",
TRUE ~ RANGE_TYPE))
## collapse the counts by DBHclGp01
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
group_by(SITE_ID, timeClass, SITE_TYPE, REMOVED, BURNED, FENCED, VALLEY, RANGE_TYPE, LIVE_DEAD, DBHclGp01) %>%
summarise(stemTally = sum(stemTally), mean.tally = mean(stemTally, na.rm = TRUE)) %>%
ungroup() %>%
mutate(stemDen.ha = stemTally *400) %>% # converts stems/2m2 plot to stems/ha
mutate(stemDen.ac = stemTally *161.8744) # converts stems/2m2 plot to stems/acre### ALL stem diameters
## mod the ht
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
mutate(timeClass = case_when(YEAR == 2006 ~ "BL",
YEAR == 2007 ~ "BL",
YEAR == 2008 ~ "BL",
YEAR == 2009 ~ "BL",
TRUE ~ as.character(YEAR))) %>%
mutate(timeClass = factor(timeClass, levels = c("BL", "2013","2015","2016","2017","2018"))) # set as factor, set levels
### rename the HTval to something more easily interpreted then convert to stem density/ha
asp.tally.ht.tidy <-
asp.tally.ht.tidy %>%
rename(stemTally = HTval) %>%
mutate(stemDen.ha = stemTally *400) %>% # converts stems/25m2 plot to stems/ha
mutate(stemDen.ac = stemTally *161.8744) # converts stems/25m2 plot to stems/acre
# asp.tally.ht.tidy %>%
# datatable()Stem count by diameter
## add stem density calc for following plots
# 1 stem in plot = 161.8744 stems/acre### Core winter range
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
ggplot(aes(timeClass, DBHclGp01), color="grey80", alpha = .8) +
geom_tile(aes(fill = FENCED), color = "grey80") +
# geom_text(aes(label = stemTally), size = 3) +
scale_fill_manual(values = colfunc3(2)) +
facet_wrap(~SITE_ID, ncol=8) +
theme_minimal() +
labs(fill = "", x = "", y = "", title = "Aspen live stem counts", subtitle = "Core winter range") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
group_by(timeClass,DBHclGp01, FENCED,VALLEY) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5, alpha = .8) +
# geom_text(aes(label = mean.tally), size = 3) +
facet_grid(FENCED~VALLEY) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_gradient2(low="#0095AF",high="#FCFFDD") +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen live stem counts", caption = "Core winter range plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Mean aspen stem count
## make site_type as factor, sort
asp.tally.dbh.tidy <- asp.tally.dbh.tidy %>%
mutate(SITE_TYPE = as_factor(SITE_TYPE)) %>%
mutate(SITE_TYPE = fct_relevel(SITE_TYPE, "AK", after = Inf))
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
group_by(timeClass,DBHclGp01, FENCED,SITE_TYPE) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean.tally), size = 3) +
facet_grid(FENCED~SITE_TYPE) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen live stem counts", caption = "all aspen plots") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
### Non-core winter range
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "non-core winter range") %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
group_by(timeClass,DBHclGp01, FENCED,VALLEY) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5, alpha = .2) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
geom_text(aes(label = mean.tally), size = 3) +
facet_grid(FENCED~VALLEY) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen live stem counts", caption = "Non-core winter range plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
### Kawuneeche Valley
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(SITE_TYPE == "AK") %>%
filter(timeClass == "BL" | timeClass == "2013" |timeClass == "2018") %>%
group_by(timeClass,DBHclGp01, FENCED,VALLEY) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5, alpha = .2) +
# geom_tile(fill = "grey90", color = "grey80", alpha = .2) +
geom_text(aes(label = mean.tally), size = 3) +
facet_grid(FENCED~VALLEY) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen live stem counts", caption = "Kawuneeche Valley plots only") +
# facet_grid(SITE_ID ~ timeClass) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Live stem density - All stem diameters
### Core winter range
asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_ID != "AC01") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC68") %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.35) +
geom_tile(aes(color = FENCED), size = 0.8, fill=NA) +
scale_color_manual(values = c("grey10","grey80")) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey80", size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density - all diameters", subtitle = "Core winter range", fill = "Stems/acre", y = "DBH class", color="", caption = "AC_ht_stemsAc_tile_allTreeDiam.png") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_ht_stemsAc_tile_allTreeDiam.png", width = 9.75, height = 10.5)asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_ID != "AC01") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC68") %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_col(aes(fill = stemDen.ac), color = "grey70", size=.35) +
# geom_tile(aes(color = FENCED), size = 0.8, fill=NA) +
scale_color_manual(values = c("grey10","grey80")) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density - all diameters", subtitle = "Core winter range", fill = "Stems/acre", y = "DBH class", color="") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
### Core winter range
asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_ID != "AC01") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC68") %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
geom_tile(aes(color = FENCED), size=2, fill=NA) +
scale_color_manual(values = c("#9ADCBB","grey80")) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density - all diameters", subtitle = "Core winter range", fill = "Stems/acre", y = "DBH class", color="", caption = "AC_ht_stemsAc_tile_allTreeDiam.png") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_ht_stemsAc_tile_allTreeDiam.png", width = 9.75, height = 10.5, dpi=300)## summary table
## Time class FENCED SITE_TYPE
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, SITE_TYPE) %>%
summarytools::descr(var = stemDen.ha,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Aspen stem density") #%>% | Aspen stem density | |||||||
| Time class | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|
| 2018 | AC | 908.7 | 2596.4 | 0 | 0 | 16400 | 184 |
| 2018 | ANC | 319.0 | 979.4 | 0 | 0 | 8400 | 84 |
| 2018 | AK | 275.0 | 470.4 | 0 | 0 | 2000 | 32 |
| 2013 | AC | 425.5 | 1261.9 | 0 | 0 | 10400 | 188 |
| 2013 | ANC | 285.7 | 781.9 | 0 | 0 | 6000 | 84 |
| 2013 | AK | 312.5 | 525.3 | 0 | 0 | 2400 | 32 |
| BL | AC | 200.0 | 417.5 | 0 | 0 | 2800 | 180 |
| BL | ANC | 270.0 | 851.0 | 0 | 0 | 7200 | 80 |
| BL | AK | 375.0 | 688.6 | 0 | 0 | 2400 | 32 |
# gt::gtsave(file = "./output/tables/summary_asp_den_tc_sitetype.rtf")
### add fencing
asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, FENCED, SITE_TYPE) %>%
summarytools::descr(var = stemDen.ha,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Aspen stem density") #%>% | Aspen stem density | ||||||||
| Time class | FENCED | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | AC | 2371.4 | 3787.7 | 0 | 600 | 14000 | 56 |
| 2018 | Unfenced | AC | 268.8 | 1464.4 | 0 | 0 | 16400 | 128 |
| 2018 | Unfenced | ANC | 319.0 | 979.4 | 0 | 0 | 8400 | 84 |
| 2018 | Unfenced | AK | 275.0 | 470.4 | 0 | 0 | 2000 | 32 |
| 2013 | Fenced | AC | 1092.9 | 2141.9 | 0 | 0 | 10400 | 56 |
| 2013 | Unfenced | AC | 142.4 | 275.8 | 0 | 0 | 1200 | 132 |
| 2013 | Unfenced | ANC | 285.7 | 781.9 | 0 | 0 | 6000 | 84 |
| 2013 | Unfenced | AK | 312.5 | 525.3 | 0 | 0 | 2400 | 32 |
| BL | Fenced | AC | 291.7 | 599.2 | 0 | 0 | 2800 | 48 |
| BL | Unfenced | AC | 166.7 | 324.3 | 0 | 0 | 1600 | 132 |
| BL | Unfenced | ANC | 270.0 | 851.0 | 0 | 0 | 7200 | 80 |
| BL | Unfenced | AK | 375.0 | 688.6 | 0 | 0 | 2400 | 32 |
# gt::gtsave(file = "./output/tables/summary_asp_den_tc_sitetype_fencing.rtf")
## add burned
asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, BURNED, SITE_TYPE) %>%
summarytools::descr(var = stemDen.ha,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Aspen stem density") #%>% | Aspen stem density | ||||||||
| Time class | BURNED | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|---|
| 2018 | Burned | AC | 1785.7 | 4166.2 | 0 | 0 | 16400 | 28 |
| 2018 | Burned | ANC | 100.0 | 200.0 | 0 | 0 | 400 | 4 |
| 2018 | Unburned | AC | 751.3 | 2184.4 | 0 | 0 | 14000 | 156 |
| 2018 | Unburned | ANC | 330.0 | 1001.8 | 0 | 0 | 8400 | 80 |
| 2018 | Unburned | AK | 275.0 | 470.4 | 0 | 0 | 2000 | 32 |
| 2013 | Burned | AC | 114.3 | 341.8 | 0 | 0 | 1600 | 28 |
| 2013 | Burned | ANC | 300.0 | 600.0 | 0 | 0 | 1200 | 4 |
| 2013 | Unburned | AC | 505.3 | 1384.7 | 0 | 0 | 10400 | 152 |
| 2013 | Unburned | ANC | 285.0 | 792.9 | 0 | 0 | 6000 | 80 |
| 2013 | Unburned | AK | 312.5 | 525.3 | 0 | 0 | 2400 | 32 |
| 2013 | NA | AC | 0.0 | 0.0 | 0 | 0 | 0 | 8 |
| BL | Burned | AC | 300.0 | 486.2 | 0 | 0 | 1600 | 12 |
| BL | Burned | ANC | 300.0 | 383.0 | 0 | 200 | 800 | 4 |
| BL | Unburned | AC | 210.8 | 431.3 | 0 | 0 | 2800 | 148 |
| BL | Unburned | ANC | 268.4 | 870.0 | 0 | 0 | 7200 | 76 |
| BL | Unburned | AK | 375.0 | 688.6 | 0 | 0 | 2400 | 32 |
| BL | NA | AC | 60.0 | 195.7 | 0 | 0 | 800 | 20 |
# gt::gtsave(file = "./output/tables/summary_asp_den_tc_sitetype_burn.rtf")
## add burned
asp.tally.dbh.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, FENCED, BURNED, SITE_TYPE) %>%
summarytools::descr(var = stemDen.ha,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Aspen stem density") #%>% | Aspen stem density | |||||||||
| Time class | FENCED | BURNED | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | Burned | AC | 2666.7 | 4285.6 | 0 | 1000 | 12000 | 12 |
| 2018 | Fenced | Unburned | AC | 2290.9 | 3690.7 | 0 | 400 | 14000 | 44 |
| 2018 | Unfenced | Burned | AC | 1125.0 | 4085.0 | 0 | 0 | 16400 | 16 |
| 2018 | Unfenced | Burned | ANC | 100.0 | 200.0 | 0 | 0 | 400 | 4 |
| 2018 | Unfenced | Unburned | AC | 146.4 | 279.0 | 0 | 0 | 800 | 112 |
| 2018 | Unfenced | Unburned | ANC | 330.0 | 1001.8 | 0 | 0 | 8400 | 80 |
| 2018 | Unfenced | Unburned | AK | 275.0 | 470.4 | 0 | 0 | 2000 | 32 |
| 2013 | Fenced | Burned | AC | 200.0 | 497.3 | 0 | 0 | 1600 | 12 |
| 2013 | Fenced | Unburned | AC | 1336.4 | 2349.8 | 0 | 400 | 10400 | 44 |
| 2013 | Unfenced | Burned | AC | 50.0 | 136.6 | 0 | 0 | 400 | 16 |
| 2013 | Unfenced | Burned | ANC | 300.0 | 600.0 | 0 | 0 | 1200 | 4 |
| 2013 | Unfenced | Unburned | AC | 166.7 | 295.1 | 0 | 0 | 1200 | 108 |
| 2013 | Unfenced | Unburned | ANC | 285.0 | 792.9 | 0 | 0 | 6000 | 80 |
| 2013 | Unfenced | Unburned | AK | 312.5 | 525.3 | 0 | 0 | 2400 | 32 |
| 2013 | Unfenced | NA | AC | 0.0 | 0.0 | 0 | 0 | 0 | 8 |
| BL | Fenced | Burned | AC | 350.0 | 583.1 | 0 | 0 | 1600 | 8 |
| BL | Fenced | Unburned | AC | 280.0 | 609.0 | 0 | 0 | 2800 | 40 |
| BL | Unfenced | Burned | AC | 200.0 | 230.9 | 0 | 200 | 400 | 4 |
| BL | Unfenced | Burned | ANC | 300.0 | 383.0 | 0 | 200 | 800 | 4 |
| BL | Unfenced | Unburned | AC | 185.2 | 343.4 | 0 | 0 | 1600 | 108 |
| BL | Unfenced | Unburned | ANC | 268.4 | 870.0 | 0 | 0 | 7200 | 76 |
| BL | Unfenced | Unburned | AK | 375.0 | 688.6 | 0 | 0 | 2400 | 32 |
| BL | Unfenced | NA | AC | 60.0 | 195.7 | 0 | 0 | 800 | 20 |
# gt::gtsave(file = "./output/tables/summary_asp_den_tc_sitetype_fenceXburn.rtf")Burned plots
## add just burned plots
asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
geom_text(aes(label = mean.tally), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen count in burned plots", caption = "Plots burned in 2012, AC, live stems only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.burn.count.ac.f <- asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean.tally), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen count in burned plots", caption = "Plots burned in 2012, AC, live stems only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.burn.count.ac.f
ggsave("./output/figures_202108/AC_burned_live_only_TCxF_mean.png", width = 6, height = 3.75)## add just burned plots
asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme(legend.position = "bottom") +
theme_minimal() +
labs(x = "", y = "", fill = "Stems/acre", title = "Mean tree density in burned plots", caption = "Plots burned in 2012, AC, live trees only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "bottom")
ggsave("./output/figures_202108/AC_burned_live_DBH_only_TCxF_meanDenl.png", width = 6, height = 3.75)
asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme(legend.position = "bottom") +
theme_minimal() +
labs(x = "", y = "", fill = "Stems/acre", title = "Mean tree density in burned plots", caption = "Plots burned in 2012, AC, live trees only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
mutate(shortTall = case_when(HTclass == 'HT_0_50_CM' ~ "Short",
HTclass == 'HT_51_100_CM' ~ "Short",
HTclass == 'HT_101_150_CM' ~ "Short",
HTclass == 'HT_151_200_CM' ~ "Tall",
HTclass == 'HT_201_250_CM' ~ "Tall")
) %>%
mutate(HTclass.lbl = case_when(HTclass == "HT_0_50_CM" ~ "0-50 cm",
HTclass == "HT_51_100_CM" ~ "51-100 cm",
HTclass == "HT_101_150_CM" ~ "101-150 cm",
HTclass == "HT_151_200_CM" ~ "151-200 cm",
HTclass == "HT_201_250_CM" ~ "201+ cm",
TRUE ~ "other")) %>%
mutate(HTclass.lbl =as_factor(HTclass.lbl))
asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,shortTall, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0))## # A tibble: 24 x 11
## timeCl~1 short~2 FENCED varia~3 mean sd min med max n.valid pct.v~4
## <fct> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 BL Short Fenced stemDe~ 1592 2077 0 567 4371 6 100
## 2 BL Short Unfen~ stemDe~ 108 93 0 162 162 3 100
## 3 BL Tall Fenced stemDe~ 0 0 0 0 0 4 100
## 4 BL Tall Unfen~ stemDe~ 81 114 0 81 162 2 100
## 5 2013 Short Fenced stemDe~ 2626 1956 0 3076 5342 9 100
## 6 2013 Short Unfen~ stemDe~ 11830 14741 0 4532 43059 12 100
## 7 2013 Tall Fenced stemDe~ 0 0 0 0 0 6 100
## 8 2013 Tall Unfen~ stemDe~ 20 57 0 0 162 8 100
## 9 2015 Short Fenced stemDe~ 791 645 0 809 2104 9 100
## 10 2015 Short Unfen~ stemDe~ 5126 6286 0 3561 19911 12 100
## # ... with 14 more rows, and abbreviated variable names 1: timeClass,
## # 2: shortTall, 3: variable, 4: pct.validasp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,shortTall, FENCED) %>%
summarytools::descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, mean)) +
geom_col(aes(fill=FENCED), position='dodge', color = "grey50", size=0.5) +
facet_wrap(~shortTall) +
theme_minimal() +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
labs(fill="", x="", y="Stems/acre", caption = "AC burned plots only, live stems \n AC_burned_live_sapHt_only_TCxF_meanDen_bar.png") 
ggsave("./output/figures_202108/AC_burned_live_sapHt_only_TCxF_meanDen_bar.png", width = 7.5, height = 4.75)
asp.tally.ht.tidy %>%
# filter(SITE_TYPE == "AC") %>%
filter(timeClass %in% c("BL", "2013","2018")) %>%
filter(SITE_TYPE != "AK") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,shortTall, FENCED, SITE_TYPE) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, mean)) +
geom_col(aes(fill=FENCED), position='dodge', color = "grey50", size=0.5) +
facet_grid(shortTall~SITE_TYPE) +
theme_minimal() +
theme(legend.position = "bottom") +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_grey(start = 0.2, end = 0.8) +
scale_fill_manual(values = c("grey90", "grey40")) +
labs(fill="", x="", y="Stems/acre", title = "Short and tall sapling density in burned plots", caption = "ACANC_burned_live_sapHt_only_TCxF_meanDen_bar.png") 
ggsave("./output/figures_202108/ACANC_burned_live_sapHt_only_TCxF_meanDen_bar.png", width = 6.75, height = 5.75)asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,shortTall, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, shortTall)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Stems/acre", title = "Tall and short sapling density in burned plots", caption = "Plots burned in 2012, AC, live trees only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_burned_live_sapHt_only_TCxF_meanDen_lbl.png", width = 6, height = 3.75)asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,shortTall, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, shortTall)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Stems/acre", title = "Tall and short sapling density in burned plots", caption = "Plots burned in 2012, AC, live trees only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_burned_live_sapHt_only_TCxF_meanDen_nolbl.png", width = 6, height = 2.75)## list of plot lacking a value for "RANGE_TYPE"
## on inspection, these have been dropped
## e.g., AC41 was washed away in 2013 floods (see E. Ertl 2018 notes)
## AC01 - near Grand Lake
## None of these have data for 2018
# asp.tally.ht.tidy %>%
# filter(is.na(RANGE_TYPE)) %>%
# distinct(SITE_ID)
# View()
# # A tibble: 5 x 1
# SITE_ID
# <chr>
# 1 AC01
# 2 AC21
# 3 AC41
# 4 AC12
# 5 AC14
## CLEAN
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
filter(!is.na(valley_full)) %>% ## drop the 4 plots
filter(is.na(REMOVED))
### create a better 'HTclass' for plotting
asp.tally.ht.tidy <-
asp.tally.ht.tidy %>%
mutate(HTclass2 = case_when(HTclass == "HT_0_50_CM" ~ "0-50 cm",
HTclass == "HT_51_100_CM" ~ "51-100 cm",
HTclass == "HT_101_150_CM" ~ "101-150 cm",
HTclass == "HT_151_200_CM" ~ "151-200 cm",
HTclass == "HT_201_250_CM" ~ "201-250 cm")
)
# set as factor, set levels
asp.tally.ht.tidy <-
asp.tally.ht.tidy %>%
mutate(HTclass2 = factor(HTclass2, levels = c("0-50 cm", "51-100 cm","101-150 cm","151-200 cm","201-250 cm")))#### Fig 16 revised 2022
asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,HTclass2, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, HTclass2)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
# labs(x = "Year", y = "Height class", fill = "Stems/acre", title = "Tall and short sapling density in burned plots", caption = "Plots burned in 2012, AC, live trees only") + +
labs(x = "Year", y = "Height class", fill = "Stems/acre") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202202/Fig16_AC_burned_live_sapHt2_only_TCxF_meanDen_lbl.png", width = 6.25, height = 3.75, dpi=300)
ggsave("./output/figures_202202/Fig16_AC_burned_live_sapHt2_only_TCxF_meanDen_lbl.pdf", width = 6.25, height = 3.75)asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,HTclass2, FENCED) %>%
descr(stemDen.ac, stats="common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 0)) %>%
ggplot(aes(timeClass, HTclass2)) +
geom_tile(aes(fill = mean), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Stems/acre", title = "Tall and short sapling density in burned plots", caption = "Plots burned in 2012, AC, live trees only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_burned_live_sapHt2_only_TCxF_meanDen_nolbl.png", width = 5.5, height = 3.75)pl.burn.count.ac.f <- asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(BURNED == "Burned") %>%
filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean.tally), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~FENCED) +
theme_minimal() +
labs(x = "", y = "", fill = "Mean tally", title = "Mean aspen count in burned plots", caption = "Plots burned in 2012, AC, live stems only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.burn.count.ac.f
ggsave("./output/figures_202108/AC_burned_live_only_TCxF_mean.png", width = 6, height = 3.75)asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
mutate(timeClass = fct_drop(timeClass)) %>%
mutate(timeClass = fct_rev(timeClass)) %>%
group_by(timeClass, FENCED, BURNED, SITE_TYPE) %>%
summarytools::descr(var = stemDen.ha,
stats = "common") %>%
tb() %>%
mutate_if(is.numeric, round,1) %>%
select(-c(variable,pct.valid)) %>%
rename("Time class" = timeClass, 'Site type' = SITE_TYPE) %>%
gt() %>%
tab_header(title = "Aspen stem density") #%>% | Aspen stem density | |||||||||
| Time class | FENCED | BURNED | Site type | mean | sd | min | med | max | n.valid |
|---|---|---|---|---|---|---|---|---|---|
| 2018 | Fenced | Burned | AC | 2666.7 | 4285.6 | 0 | 1000 | 12000 | 12 |
| 2018 | Fenced | Unburned | AC | 2290.9 | 3690.7 | 0 | 400 | 14000 | 44 |
| 2018 | Unfenced | Burned | AC | 1125.0 | 4085.0 | 0 | 0 | 16400 | 16 |
| 2018 | Unfenced | Burned | ANC | 100.0 | 200.0 | 0 | 0 | 400 | 4 |
| 2018 | Unfenced | Unburned | AC | 146.4 | 279.0 | 0 | 0 | 800 | 112 |
| 2018 | Unfenced | Unburned | ANC | 330.0 | 1001.8 | 0 | 0 | 8400 | 80 |
| 2018 | Unfenced | Unburned | AK | 275.0 | 470.4 | 0 | 0 | 2000 | 32 |
| 2017 | Fenced | Burned | AC | 2166.7 | 4234.8 | 0 | 400 | 14000 | 12 |
| 2017 | Fenced | Unburned | AC | 366.7 | 648.5 | 0 | 0 | 2000 | 12 |
| 2017 | Unfenced | Burned | AC | 425.0 | 1700.0 | 0 | 0 | 6800 | 16 |
| 2017 | Unfenced | Unburned | AC | 425.0 | 371.5 | 0 | 400 | 800 | 16 |
| 2016 | Fenced | Burned | AC | 2133.3 | 5546.1 | 0 | 200 | 19600 | 12 |
| 2016 | Fenced | Unburned | AC | 400.0 | 660.6 | 0 | 0 | 2000 | 12 |
| 2016 | Unfenced | Burned | AC | 75.0 | 217.6 | 0 | 0 | 800 | 16 |
| 2016 | Unfenced | Unburned | AC | 450.0 | 435.1 | 0 | 600 | 1200 | 16 |
| 2015 | Fenced | Burned | AC | 533.3 | 1257.2 | 0 | 0 | 4400 | 12 |
| 2015 | Fenced | Unburned | AC | 400.0 | 565.7 | 0 | 0 | 1600 | 12 |
| 2015 | Unfenced | Burned | AC | 50.0 | 136.6 | 0 | 0 | 400 | 16 |
| 2015 | Unfenced | Unburned | AC | 375.0 | 425.0 | 0 | 200 | 1200 | 16 |
| 2013 | Fenced | Burned | AC | 200.0 | 497.3 | 0 | 0 | 1600 | 12 |
| 2013 | Fenced | Unburned | AC | 1336.4 | 2349.8 | 0 | 400 | 10400 | 44 |
| 2013 | Unfenced | Burned | AC | 50.0 | 136.6 | 0 | 0 | 400 | 16 |
| 2013 | Unfenced | Burned | ANC | 300.0 | 600.0 | 0 | 0 | 1200 | 4 |
| 2013 | Unfenced | Unburned | AC | 166.7 | 295.1 | 0 | 0 | 1200 | 108 |
| 2013 | Unfenced | Unburned | ANC | 285.0 | 792.9 | 0 | 0 | 6000 | 80 |
| 2013 | Unfenced | Unburned | AK | 312.5 | 525.3 | 0 | 0 | 2400 | 32 |
| 2013 | Unfenced | NA | AC | 0.0 | 0.0 | 0 | 0 | 0 | 8 |
| BL | Fenced | Burned | AC | 350.0 | 583.1 | 0 | 0 | 1600 | 8 |
| BL | Fenced | Unburned | AC | 280.0 | 609.0 | 0 | 0 | 2800 | 40 |
| BL | Unfenced | Burned | AC | 200.0 | 230.9 | 0 | 200 | 400 | 4 |
| BL | Unfenced | Burned | ANC | 300.0 | 383.0 | 0 | 200 | 800 | 4 |
| BL | Unfenced | Unburned | AC | 185.2 | 343.4 | 0 | 0 | 1600 | 108 |
| BL | Unfenced | Unburned | ANC | 268.4 | 870.0 | 0 | 0 | 7200 | 76 |
| BL | Unfenced | Unburned | AK | 375.0 | 688.6 | 0 | 0 | 2400 | 32 |
| BL | Unfenced | NA | AC | 60.0 | 195.7 | 0 | 0 | 800 | 20 |
# gt::gtsave(file = "./output/tables/summary_asp_den_tc_sitetype_fenceXburn.rtf")#### Fig 18 revised 2022
## add just burned plots, live vs dead
asp.tally.dbh.tidy %>%
filter(BURNED == "Burned") %>%
# filter(LIVE_DEAD == 'LIVE') %>%
# filter(RANGE_TYPE == "core winter range") %>%
group_by(timeClass,DBHclGp01, FENCED, LIVE_DEAD) %>%
summarise(mean.tally = round(mean(stemTally, na.rm=TRUE),1)) %>%
ungroup() %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = mean.tally), color = "grey70", size=.5) +
# geom_tile(fill = "grey90", color = "grey70", size=.5, alpha = .2) +
# geom_text(aes(label = mean.tally), size = 3) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# facet_wrap(~FENCED) +
facet_grid(LIVE_DEAD~FENCED) +
theme_minimal() +
labs(x = "Year", y = "DBH class", fill = "Mean tree count") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# ggsave("./output/figures_202108/asp_burned_only_TCxF_LiveXdead_meanCnt.png", width = 7, height = 5)
ggsave("./output/figures_202202/Fig18_asp_burned_only_TCxF_LiveXdead_meanCnt.png", width = 6.5, height = 3.75, dpi=300)
ggsave("./output/figures_202202/Fig18_asp_burned_only_TCxF_LiveXdead_meanCnt.pdf", width = 6.5, height = 3.75)asp.tally.dbh.tidy %>%
mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5, alpha = .52) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
geom_text(aes(label = round(stemDen.ac,0)),size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density", subtitle = "Core winter range", fill = "Stems/acre", y = "DBH class", caption = "AC_diam_stemsAc_tile_rev.png") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_diam_stemsAc_tile_rev.png", width = 8.75, height = 7.75)### Non-core winter range
asp.tally.dbh.tidy %>%
mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "non-core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 4) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density", subtitle = "Non-core winter range", fill = "Stems/acre", y = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/ANC_diam_stemsAc_tile_rev.png", width = 7.5, height = 5.5)#### Kawuneeche Valley
pl.hm.stemsac.ak <- asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "Kawuneeche Valley") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 4) +
theme_minimal() +
labs(x = "", y = "", title = "Aspen live stem density", subtitle = "Kawuneeche Valley", fill = "Stems/acre", y = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.hm.stemsac.ak
ggsave("./output/figures_202108/AK_diam_stemsAc_tile_revised.png", width = 5.5, height = 3.5)pl.hm.stemsac.ac.f <- asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
mutate(timeClass = fct_drop(timeClass)) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(SITE_TYPE == "AC") %>%
filter(FENCED == "Fenced") %>%
# filter(RANGE_TYPE == "Kawuneeche Valley") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
theme(legend.position = "none") +
# theme(legend.position = "bottom") +
labs(x = "", y = "", title = "Core range", subtitle = "Fenced plots", fill = "Stems/acre", y = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.hm.stemsac.ac.f
ggsave("./output/figures_202108/diam_stemsAc_tile_ac_f.png", width = 7.5, height = 5.5)
pl.hm.stemsac.ac.uf <- asp.tally.dbh.tidy %>%
filter(is.na(REMOVED)) %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
mutate(timeClass = fct_drop(timeClass)) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(SITE_TYPE == "AC") %>%
filter(FENCED == "Unfenced") %>%
# filter(RANGE_TYPE == "Kawuneeche Valley") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "", y = "", subtitle = "Unfenced", fill = "Stems/acre", y = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.hm.stemsac.ac.uf
# ggsave("./output/figures_202108/diam_stemsAc_tile_ac_uf.png", width = 7.5, height = 8.5)pl.hm.stemsac.ac.f + pl.hm.stemsac.ac.uf + plot_layout(ncol=1, heights = c(1,2.8))
ggsave("./output/figures_202108/diam_stemsAc_tile_ac_f_vs_uf.png", width = 8.75, height = 11.5, dpi=300)#### Aspen: live stem density summary table
asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
group_by(timeClass, RANGE_TYPE, FENCED) %>%
descr() %>%
tb() %>%
mutate(across(where(is.numeric), round,2)) %>%
datatable()## Calculate the percent stems in DBH/classes
dbh.perc <- asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == "LIVE") %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
group_by(SITE_ID, timeClass, DBHclGp01) %>%
mutate(percentTot = stemTally/sumStem)%>%
filter(SITE_ID != "AC01") %>% # removed plots
filter(SITE_ID != "AC12") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC41") %>%
filter(SITE_ID != "AC21")Core winter range
## prep for revised stacked order barplot 2021-02-09
dbh.perc.clean <- dbh.perc %>%
clean_names %>%
rename(dbh_class = db_hcl_gp01)
## manual sort based on the 2015 fig requested
dbh.sort.lu <- read_csv("./data/EVMP_derived/AC_dbh_sort.csv")
dbh.sort.lu <- dbh.sort.lu %>%
select(SITE_ID, FactorLevel_DBH_sort) %>%
clean_names()
dbh.joined <- left_join(dbh.perc.clean,dbh.sort.lu)
## add "no aspen" category
dbh.joined <- dbh.joined %>%
filter(is.na(removed)) %>%
mutate(dbh_class = as.character(dbh_class)) %>%
mutate(dbh_class = case_when(is.nan(percent_tot) ~ "no aspen",
TRUE ~ dbh_class)) %>%
mutate(percent_tot = case_when(is.nan(percent_tot) ~ .25,
TRUE ~ percent_tot))
## reorder factor
dbh.joined <- dbh.joined %>%
mutate(dbh_class = as_factor(dbh_class)) %>%
mutate(dbh_class = fct_relevel(dbh_class, "10-20 cm", after=2))#### Fig 15 revised 2022
### revised plots 2021-02-09
# stacked sorted boxplot
## create color gradient
# colorspace::sequential_hcl(4, "Teal")
dbhclass.gradient <- c("#26185F", "#0095AF", "#9ADCBB", "#FCFFDD", "grey50")
# ACx F
plot.percTot.dbh.AC.F <- dbh.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "AC" & fenced == "Fenced") %>%
ggplot(aes(reorder(site_id, factor_level_dbh_sort), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
#labs(y = "% of total stems", x = "Plot ID", fill = "DBH class", title = "", subtitle = "Fenced plots") +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) +
theme(legend.position = "right")
# ACxUf
plot.percTot.dbh.AC.UF <- dbh.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "AC" & fenced == "Unfenced") %>%
ggplot(aes(reorder(site_id, factor_level_dbh_sort), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
theme_minimal() +
# labs(y = "% of total stems", x = "Plot ID", fill = "DBH class", subtitle = "Unfenced plots") +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent)
# library(patchwork)
### custom layout
layout.f14 <- "
AAAA#
BBBBB
"
## with title
# plot.percTot.dbh.AC.F / plot.percTot.dbh.AC.UF +
# #plot_layout(widths = c(1, 2.2)) +
# plot_layout(design = layout.f14) +
# plot_annotation(tag_levels = 'A',
# title = 'Proportion of Live Aspen Stems by DBH Class')
plot.percTot.dbh.AC.F / plot.percTot.dbh.AC.UF +
#plot_layout(widths = c(1, 2.2)) +
plot_layout(design = layout.f14) +
plot_annotation(tag_levels = 'A')
# ggsave("./output/figures_202108/AspPercTotXdbh_ac_FxUf.png", width = 10.5, height = 5, dpi=300)
# ggsave("./output/figures_202108/AsppercTotXdbh_ac_FxUf.pdf", width = 10, height = 5)
ggsave("./output/figures_202202/Fig14_AspPercTotXdbh_ac_FxUf.png", width = 7, height = 8, dpi=300)
ggsave("./output/figures_202202/Fig14_AspPercTotXdbh_ac_FxUf.pdf", width = 6.5, height = 7)### revised plots 2021-02-09 !!! supplanted by above
# stacked sorted boxplot
## create color gradient
# colorspace::sequential_hcl(4, "Teal")
dbhclass.gradient <- c("#26185F", "#0095AF", "#9ADCBB", "#FCFFDD", "grey50")
# ACx F
plot.percTot.dbh.AC.F <- dbh.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "AC" & fenced == "Fenced") %>%
ggplot(aes(reorder(site_id, factor_level_dbh_sort), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "", fill = "DBH class", title = "Proportion of Live Aspen Stems by DBH Class", subtitle = "Fenced plots") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) +
theme(legend.position = "none")
# ACxUf
plot.percTot.dbh.AC.UF <- dbh.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "AC" & fenced == "Unfenced") %>%
ggplot(aes(reorder(site_id, factor_level_dbh_sort), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
theme_minimal() +
labs(y = "", x = "", fill = "DBH class", subtitle = "Unfenced plots") +
theme(legend.position = "bottom") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent)
# library(patchwork)
plot.percTot.dbh.AC.F + plot.percTot.dbh.AC.UF +
plot_layout(widths = c(1, 2.2))
# ggsave("./output/figures_202108/AspPercTotXdbh_ac_FxUf.png", width = 10.5, height = 5, dpi=300)
# ggsave("./output/figures_202108/AsppercTotXdbh_ac_FxUf.pdf", width = 10, height = 5)DBH classes: Fenced plots
## DBH
dbh.perc.f <- asp.tally.dbh.tidy %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(FENCED == "Fenced") %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem)
## heatmap
dbh.perc.f %>%
filter(!is.nan(percentTot)) %>%
# filter()
ggplot(aes(DBHclGp01, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'grey80', alpha=.8) +
facet_grid(.~timeClass) +
# scale_fill_viridis_c(begin = .01, end = .9, direction = -1) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
theme(legend.position = "bottom") +
theme_minimal() +
labs(x = "DBH class", y = "", fill = "", title = "Proportion of Live Aspen Stems by DBH Class", subtitle = "Fenced Plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_Live_Fenced_Unburned_PropDBH_heatmap.png", width = 7, height = 5, dpi = 300)
dbh.perc.f %>%
filter(SITE_ID != "AC67") %>%
filter(!is.nan(percentTot)) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, percentTot)) +
# geom_col(aes(fill = DBHclGp01), color = "darkgray") +
geom_col(aes(fill = DBHclGp01), color = "grey50", size=0.5) +
facet_wrap(~SITE_ID, ncol = 5) +
scale_fill_grey() +
theme_minimal() +
labs(y = "% total stems", x = "", fill = "DBH class", title = "Proportion of Live Aspen Stems by DBH Class", caption = "Fenced plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# theme(legend.position = "top") +
scale_y_continuous(labels=scales::percent)
# ggsave("./output/figures_202108/AC_Live_Fenced_PropDBH_bw.png", width = 8, height = 6, dpi = 300)Non-core winter range
DBH classes: Non-fenced plots
## prep for revised stacked order barplot 2021-02-09
dbh.anc.ak.lu <- dbh.perc.clean %>%
filter(site_type != "AC") %>%
select(time_class, site_id, site_type, dbh_class, percent_tot) %>%
pivot_wider(names_from = dbh_class, values_from = percent_tot) %>%
clean_names() %>%
arrange(time_class, site_type, desc(x2_10_cm), desc(x10_20_cm)) %>%
rownames_to_column()
# dbh.anc.ak.lu %>%
# write_csv("./data/EVMP_derived/dbh_sort_ANC_AK_lu.csv")
dbh.anc.ak.lu <- dbh.anc.ak.lu %>%
ungroup() %>%
rename(sort.dbh = rowname) %>%
filter(time_class == "BL") %>%
select(site_id, sort.dbh, -time_class) %>%
mutate(sort.dbh = as.integer(sort.dbh))
## manual sort based on the 2015 fig requested
dbh.anc.ak.joined <- left_join(dbh.perc.clean, dbh.anc.ak.lu)
## add "no aspen" category
dbh.anc.ak.joined <- dbh.anc.ak.joined %>%
filter(is.na(removed)) %>%
mutate(dbh_class = as.character(dbh_class)) %>%
mutate(dbh_class = case_when(is.nan(percent_tot) ~ "no aspen",
TRUE ~ dbh_class)) %>%
mutate(percent_tot = case_when(is.nan(percent_tot) ~ .25,
TRUE ~ percent_tot))
## reorder factor
dbh.anc.ak.joined <- dbh.anc.ak.joined %>%
mutate(dbh_class = as_factor(dbh_class)) %>%
mutate(dbh_class = fct_relevel(dbh_class, "10-20 cm", after=2))#### Fig15 revised 202202
### revised plots 2021-02-09
# stacked sorted boxplot
## create color gradient
dbhclass.gradient <- c("#26185F", "#0095AF", "#9ADCBB", "#FCFFDD", "grey50")
# ANC
dbh.anc.ak.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "ANC") %>%
ggplot(aes(reorder(site_id, sort.dbh), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class", title = "Proportion of Live Aspen Stems by DBH Class", subtitle = "Fenced plots") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) 
dbh.anc.ak.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "ANC") %>%
ggplot(aes(reorder(site_id, sort.dbh), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
# geom_point(data = subset(., burned == "Burned"), y= 0.5) +
# geom_point(y=0.5, aes(color = burned)) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class", title = "Proportion of Live Aspen Stems by DBH Class", caption = "ANC") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) 
ggsave("./output/figures_202108/AspPercTotXdbh_anc.png", width = 7, height = 5, dpi=300)
# ggsave("./output/figures_202108/AsppercTotXdbh_anc.pdf", width = 7, height = 5)## revised 2022
dbh.anc.ak.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "ANC") %>%
ggplot(aes(reorder(site_id, sort.dbh), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50", size=.5) +
# geom_point(data = subset(., burned == "Burned"), y= 0.5) +
# geom_point(y=0.5, aes(color = burned)) +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
theme(legend.position = "bottom") +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) 
ggsave("./output/figures_202202/Fig15_AspPercTotXdbh_anc_botleg.png", width = 7, height = 5, dpi=300)
ggsave("./output/figures_202202/Fig15_AspPercTotXdbh_anc_botleg.pdf", width = 7, height = 5)Kawuneeche Valley
#### Fig 20 revised 2022
### revised plots 2021-02-09
# stacked sorted boxplot
## create color gradient
# colorspace::sequential_hcl(4, "Teal")
# colorspace::sequential_hcl(4, "Greens")
# colorspace::sequential_hcl(4, "YlGnBu")
dbhclass.gradient <- c("#26185F", "#0095AF", "#9ADCBB", "#FCFFDD", "grey50")
# AK
dbh.anc.ak.joined %>%
filter(time_class %in% c("BL","2013","2018")) %>%
filter(site_type == "AK") %>%
ggplot(aes(reorder(site_id, sort.dbh), percent_tot)) +
geom_col(aes(fill = dbh_class), color="grey50") +
facet_wrap(~time_class, ncol = 1) +
scale_fill_manual(values = dbhclass.gradient) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "DBH class") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) 
ggsave("./output/figures_202202/Fig20_AspPercTotXdbh_ak.png", width = 5, height = 4.25, dpi=300)
ggsave("./output/figures_202202/Fig20_AspPercTotXdbh_ak.pdf", width = 5, height = 4.25)Proportion of plots with regeneration above threshold
asp.tally.dbh.tidy %>%
filter(is.na(REMOVED)) %>%
filter(LIVE_DEAD == "LIVE") %>%
group_by(SITE_ID, timeClass, FENCED, BURNED) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
group_by(SITE_TYPE, FENCED, BURNED) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
select(-variable) %>%
gt() %>%
tab_header(title = "Summary stats: Live stem density/acre")| Summary stats: Live stem density/acre | |||||||||
| SITE_TYPE | FENCED | BURNED | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|
| AC | Fenced | Burned | 566.6 | 1422.6 | 0 | 0 | 7931.8 | 68 | 100 |
| AC | Fenced | Unburned | 456.0 | 982.3 | 0 | 0 | 5665.6 | 164 | 100 |
| AC | Unfenced | Burned | 136.8 | 780.8 | 0 | 0 | 6636.9 | 84 | 100 |
| AC | Unfenced | Unburned | 80.1 | 133.7 | 0 | 0 | 647.5 | 376 | 100 |
| AC | Unfenced | NA | 17.3 | 67.4 | 0 | 0 | 323.7 | 28 | 100 |
| ANC | Unfenced | Burned | 94.4 | 161.3 | 0 | 0 | 485.6 | 12 | 100 |
| ANC | Unfenced | Unburned | 119.3 | 359.9 | 0 | 0 | 3399.4 | 236 | 100 |
| AK | Unfenced | Unburned | 129.8 | 228.5 | 0 | 0 | 971.2 | 96 | 100 |
asp.tally.dbh.tidy %>%
filter(is.na(REMOVED)) %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(SITE_TYPE != "AK") %>%
group_by(SITE_ID, timeClass, FENCED, BURNED) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
# group_by(BURNED, FENCED) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
select(-variable) %>%
gt() %>%
tab_header(title = "Summary stats: Live stem density/acre", subtitle = "Combined AC and ANC plots")| Summary stats: Live stem density/acre | ||||||
| Combined AC and ANC plots | ||||||
| mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|
| 190.8 | 650.5 | 0 | 0 | 7931.8 | 968 | 100 |
asp.tally.dbh.tidy %>%
filter(is.na(REMOVED)) %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(SITE_TYPE != "AK") %>%
group_by(SITE_ID, timeClass, FENCED, BURNED) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
group_by(BURNED, FENCED) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
select(-variable) %>%
gt() %>%
tab_header(title = "Summary stats: Live stem density/acre", subtitle = "Combined AC and ANC plots")| Summary stats: Live stem density/acre | ||||||||
| Combined AC and ANC plots | ||||||||
| BURNED | FENCED | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|
| Burned | Fenced | 566.6 | 1422.6 | 0 | 0 | 7931.8 | 68 | 100 |
| Burned | Unfenced | 131.5 | 732.0 | 0 | 0 | 6636.9 | 96 | 100 |
| Unburned | Fenced | 456.0 | 982.3 | 0 | 0 | 5665.6 | 164 | 100 |
| Unburned | Unfenced | 95.2 | 247.3 | 0 | 0 | 3399.4 | 612 | 100 |
| NA | Unfenced | 17.3 | 67.4 | 0 | 0 | 323.7 | 28 | 100 |
Suckering by height class
### Add Short/Tall stem field
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
mutate(FENCED = case_when(FENCED == "Y" ~ "Fenced",
FENCED == "N" ~ "Unfenced",
TRUE ~ FENCED)) %>%
mutate(shortTall = case_when(HTclass == 'HT_0_50_CM' ~ "short",
HTclass == 'HT_51_100_CM' ~ "short",
HTclass == 'HT_101_150_CM' ~ "short",
HTclass == 'HT_151_200_CM' ~ "tall",
HTclass == 'HT_201_250_CM' ~ "tall")
)
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
mutate(HTclass.lbl = case_when(HTclass == "HT_0_50_CM" ~ "0-50 cm",
HTclass == "HT_51_100_CM" ~ "51-100 cm",
HTclass == "HT_101_150_CM" ~ "101-150 cm",
HTclass == "HT_151_200_CM" ~ "151-200 cm",
HTclass == "HT_201_250_CM" ~ "201+ cm",
TRUE ~ "other")) %>%
mutate(HTclass.lbl =as_factor(HTclass.lbl))asp.tally.ht.tidy %>%
group_by(SITE_TYPE, HTclass.lbl, timeClass) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable()Summary by Range Type
asp.tally.ht.tidy %>%
group_by(SITE_TYPE, HTclass.lbl, timeClass) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable(caption = "All plots", filter = "bottom")Summary by Burned and Fenced - Combined Winter Range
asp.tally.ht.tidy %>%
filter(SITE_TYPE != "AK") %>%
group_by(SITE_TYPE, HTclass.lbl, timeClass, BURNED, FENCED) %>%
descr(stemDen.ac, stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable(caption = "All plots", filter = "bottom")Small Trees (0-10cm DBH))
### Core winter range
asp.tally.dbh.tidy %>%
filter(DBHclGp01 == "0-2 cm" | DBHclGp01 == "2-10 cm") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_ID != "AC01") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC68") %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
geom_tile(aes(color = FENCED), size=2, fill=NA) +
scale_color_manual(values = c("red","grey80")) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", subtitle = "Aspen live stem density - 0-10cm DBH", title = "Core winter range", fill = "Stems/acre", y = "DBH class", color="", caption = "AC_ht_stemsAc_tile_0to10cm.png") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_ht_stemsAc_tile_0to10cm.png", width = 7.75, height = 5.5)Small Trees (10+ cm DBH))
### Core winter range
asp.tally.dbh.tidy %>%
filter(DBHclGp01 != "0-2 cm" & DBHclGp01 != "2-10 cm") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(SITE_ID != "AC01") %>%
filter(SITE_ID != "AC14") %>%
filter(SITE_ID != "AC68") %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}({FENCED})')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, DBHclGp01)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
geom_tile(aes(color = FENCED), size = 0.7, fill=NA) +
scale_color_manual(values = c("grey10","grey80")) +
# scale_fill_viridis_c() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# geom_text(aes(label = round(stemDen.ac,0)),color = "grey70", size=.5, size = 2.7) +
facet_wrap(~SITE_ID, ncol = 6) +
theme_minimal() +
labs(x = "", y = "", subtitle = "Aspen live stem density - 10+cm DBH", title = "Core winter range", fill = "Stems/acre", y = "DBH class", color="", caption = "AC_ht_stemsAc_tile_dbh10pluscm.png") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_ht_stemsAc_tile_dbh10pluscm.png", width = 7.75, height = 5.5)## join in dbh with height classes
asp.dbh2join <- asp.tally.dbh.tidy %>%
select(c(SITE_ID, timeClass, DBHclGp01))
ht.dbh.class <- left_join(asp.tally.ht.tidy, asp.dbh2join) %>%
filter(LIVE_DEAD != "DEAD") %>%
select(c(SITE_TYPE, SITE_ID, timeClass, stemTally, stemDen.ac, BURNED, FENCED, RANGE_TYPE, VALLEY, DBHclGp01, HTclass, shortTall))
ht.dbh.class <- ht.dbh.class %>%
mutate(RANGE_TYPE = case_when(grepl("AC", SITE_ID) & is.na(RANGE_TYPE) ~ "core winter range",
TRUE ~ RANGE_TYPE))
## factor levels
ht.dbh.class <- ht.dbh.class %>%
mutate(HTclass = as_factor(HTclass))
# levels(ht.dbh.class$HTclass.lbl)
# create a labeling field for height class
ht.dbh.class <- ht.dbh.class %>%
mutate(HTclass.lbl = case_when(HTclass == "HT_0_50_CM" ~ "0-50 cm",
HTclass == "HT_51_100_CM" ~ "51-100 cm",
HTclass == "HT_101_150_CM" ~ "101-150 cm",
HTclass == "HT_151_200_CM" ~ "151-200 cm",
HTclass == "HT_201_250_CM" ~ "201+ cm",
TRUE ~ "other")) %>%
mutate(HTclass.lbl =as_factor(HTclass.lbl))# All stem diameters
suckering.vtype <- ht.dbh.class %>%
# filter(HTclass == "HT_151_200_CM" |HTclass == "HT_201_250_CM") %>%
group_by(SITE_ID, RANGE_TYPE, FENCED, timeClass) %>%
summarise(stemTally.all_dbh = sum(stemTally)) %>%
mutate(stemDen.ac = stemTally.all_dbh *161.8744) %>% # converts stems/2m2 plot to stems/acre) %>%
# mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor (<1,700 stems/acre)",
# stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate (1,700-4,500 stems/acre)",
# stemDen.ac >=4500 ~ "High (>4500 stems/acre)")) %>%
mutate(stemDen.ha = stemTally.all_dbh *400) %>%
mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor",
stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate",
stemDen.ac >=4500 ~ "High")) %>%
ungroup()###Tall saplings (1.5-2.5m tall)
### suckering classes: by range type
# the following combines the tally for stems between 1.5 and 2.5 m
suckering.vtype.tallsap <- ht.dbh.class %>%
filter(HTclass == "HT_151_200_CM" |HTclass == "HT_201_250_CM") %>%
group_by(SITE_ID, RANGE_TYPE, FENCED, timeClass) %>%
summarise(stemTally.1p5to2m = sum(stemTally)) %>%
mutate(stemDen.ac = stemTally.1p5to2m *161.8744) %>% # converts stems/2m2 plot to stems/acre) %>%
# mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor (<1,700 stems/acre)",
# stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate (1,700-4,500 stems/acre)",
# stemDen.ac >=4500 ~ "High (>4500 stems/acre)")) %>%
mutate(stemDen.ha = stemTally.1p5to2m *400) %>%
mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor",
stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate",
stemDen.ac >=4500 ~ "High")) %>%
ungroup()#### Fig 11 revised 2022
## need to address the factor levels 2022-02
suckering.vtype.tallsap <- suckering.vtype.tallsap %>%
mutate(timeClass = fct_relevel(timeClass, "2018", "2013", "BL"))pl.tallsap.wc.f <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
filter(FENCED == "Fenced") %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "bottom") +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "bottom") +
labs(x = "", y = "Site ID", fill = "") +
facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(title = "Core range")
pl.tallsap.wc.uf <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(FENCED == "Unfenced") %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "bottom") +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "none") +
labs(x = "", y = "Site ID", fill = "") +
facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(title = "Core range")
# wnc
pl.tallsap.wnc <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "non-core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "bottom") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "", y = "Site ID", fill = "") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(title = "Noncore range")pl.tallsap.wc.uf / (pl.tallsap.wc.f + pl.tallsap.wnc) +
# plot_layout(ncol = 1)
plot_layout(ncol=1) 
# plot_annotation(title="Tall saplings (1.5-2.5m tall)", caption = "ACANC_tallsap_1p5_2p5m_3panel.png")
# ggsave("./output/figures_202108/ACANC_tallsap_1p5_2p5m_3panel.png", width = 8.25, height = 5)
ggsave("./output/figures_202108/ACANC_tallsap_1p5_2p5m_3panel.png", width = 8.25, height = 5)pl.tallsap.wc.f <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
filter(FENCED == "Fenced") %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "bottom") +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "right") +
labs(y = "Plot ID", x = "Year", fill = "") +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(x="Plot ID")
pl.tallsap.wc.f
pl.tallsap.wc.uf <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(FENCED == "Unfenced") %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "bottom") +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "none") +
labs(y = "Plot ID", x = "Year", fill = "") +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(x="Plot ID")
pl.tallsap.wc.uf
# wnc
pl.tallsap.wnc <- suckering.vtype.tallsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "non-core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(legend.position = "none") +
labs(y = "Plot ID", x = "Year", fill = "") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip() +
labs(x="Plot ID")
pl.tallsap.wnc
pl.tallsap.wc.uf / pl.tallsap.wc.f / pl.tallsap.wnc +
# plot_layout(ncol = 1)
plot_layout(ncol=1) +
# plot_annotation(title="Tall saplings (1.5-2.5m tall)") +
plot_annotation(tag_levels = 'A')
## this is the fig I've sent out 202202
### ### custom layout
layout.f11 <- "
AAAAAAAA#
#BBBBBB##
CCCCCCCCC
"
pl.tallsap.wc.uf / pl.tallsap.wc.f / pl.tallsap.wnc +
#plot_layout(widths = c(1, 2.2)) +
plot_layout(design = layout.f11) +
plot_annotation(tag_levels = 'A')
ggsave("./output/figures_202202/Fig11_ACANC_tallsap_1p5_2p5m_3panel.png", width = 7.25, height = 5, dpi=300)
ggsave("./output/figures_202202/Fig11_ACANC_tallsap_1p5_2p5m_3panel.pdf", width = 7.25, height = 5)Short saplings (<1.5m tall)
### suckering classes: by range type
# the following combines the tally for stems between 1.5 and 2.5 m
suckering.vtype.shortsap <- ht.dbh.class %>%
filter(HTclass != "HT_151_200_CM" & HTclass != "HT_201_250_CM") %>%
group_by(SITE_ID, RANGE_TYPE, FENCED, timeClass) %>%
summarise(stemTally.1p5to2m = sum(stemTally)) %>%
mutate(stemDen.ac = stemTally.1p5to2m *161.8744) %>% # converts stems/2m2 plot to stems/acre) %>%
# mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor (<1,700 stems/acre)",
# stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate (1,700-4,500 stems/acre)",
# stemDen.ac >=4500 ~ "High (>4500 stems/acre)")) %>%
mutate(stemDen.ha = stemTally.1p5to2m *400) %>%
mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor",
stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate",
stemDen.ac >=4500 ~ "High")) %>%
ungroup()## need to address the factor levels 2022-02
suckering.vtype.shortsap <- suckering.vtype.shortsap %>%
mutate(timeClass = fct_relevel(timeClass, "2018", "2013", "BL"))pl.shortsap.wc.f <- suckering.vtype.shortsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
filter(FENCED == "Fenced") %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
theme(legend.position = "right") +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "Year", y = "Plot ID", fill = "") +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip()
pl.shortsap.wc.uf <- suckering.vtype.shortsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(FENCED == "Unfenced") %>%
filter(RANGE_TYPE == "core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
# scale_fill_grey() +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "none") +
labs(x = "Year", y = "Plot ID", fill = "") +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip()
# wnc
pl.shortsap.wnc <- suckering.vtype.shortsap %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "non-core winter range") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "Year", y = "Plot ID", fill = "") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# facet_wrap(~FENCED, scales = "free_y") +
coord_flip() # original, revised vbelow 2022
pl.shortsap.wc.uf / (pl.shortsap.wc.f + pl.shortsap.wnc) +
# plot_layout(ncol = 1)
plot_layout(ncol=1) +
plot_annotation(title="Short saplings (<1.5m tall)", caption = "ACANC_shortsap_0_1p5m_3panel.png")
ggsave("./output/figures_202108/ACANC_shortsap_0_1p5m_3panel.png", width = 8.25, height = 5)#### Fig 12 revised 2022-04-24
## this is the fig I've sent out 202202
### ### custom layout
layout.f12 <- "
AAAAAAAA#
#BBBBBB##
CCCCCCCCC
"
pl.shortsap.wc.uf / pl.shortsap.wc.f / pl.shortsap.wnc +
#plot_layout(widths = c(1, 2.2)) +
plot_layout(design = layout.f12) +
plot_annotation(tag_levels = 'A')
# ggsave("./output/figures_202202/Fig11_ACANC_tallsap_1p5_2p5m_3panel.png", width = 7.25, height = 5)
ggsave("./output/figures_202202/Fig12_ACANC_shortsap_3panel.pdf", width = 7.25, height = 5)
ggsave("./output/figures_202202/Fig12_ACANC_shortsap_3panel.png", width = 7.25, height = 5, dpi=300)Trees only: core vs. non-core winter range
### TREES ONLY: core vs. non-core winter range
## fenced and unfenced
suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
# filter(suckering_class == "")
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
scale_fill_manual(values = colfunc2(3)) +
# scale_fill_grey() +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "", y = "Site ID", fill = "", caption = "Stem density 1.5-2.5 m in ht. All plots") +
facet_wrap(~RANGE_TYPE, scales = "free_y")
# ggsave("./output/figures_202108/AC_suck_1p5to2p5m.png", width = 6.5, height = 6)
## create summary of above
suckering.vtype %>%
# filter(!is.na(RANGE_TYPE)) %>%
# mutate(timeClass = as.character(timeClass)) %>%
filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
mutate(timeClass = fct_drop(timeClass)) %>%
# group_by(RANGE_TYPE, timeClass, suckering_class) %>%
tabyl(timeClass, suckering_class) %>%
rowwise() %>%
mutate(sum = sum(c_across(High:Poor))) %>%
mutate(perc.high = High/sum*100) %>%
mutate(perc.mod = Moderate/sum*100) %>%
mutate(perc.poor = Poor/sum*100) %>%
mutate(across(contains("perc"),round,1)) %>%
gt()| timeClass | High | Moderate | Poor | sum | perc.high | perc.mod | perc.poor |
|---|---|---|---|---|---|---|---|
| BL | 48 | 8 | 4 | 60 | 80.0 | 13.3 | 6.7 |
| 2013 | 60 | 5 | 1 | 66 | 90.9 | 7.6 | 1.5 |
| 2018 | 61 | 4 | 2 | 67 | 91.0 | 6.0 | 3.0 |
suckering.vtype %>%
mutate(timeClass = as.character(timeClass)) %>%
filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
# mutate(timeClass = fct_drop(timeClass, only = "2018")) %>%
# group_by(RANGE_TYPE, timeClass, suckering_class) %>%
tabyl(timeClass, suckering_class) %>%
rowwise() %>%
mutate(sum = sum(c_across(High:Poor))) %>%
mutate(perc.high = High/sum) %>%
mutate(perc.mod = Moderate/sum) %>%
mutate(perc.poor = Poor/sum) %>%
pivot_longer(cols = contains("perc."),names_to = "perc_class") %>%
mutate(perc_class = case_when(perc_class == "perc.high" ~ "High",
perc_class == "perc.mod" ~ "Moderate",
perc_class == "perc.poor" ~ "Poor")) %>%
mutate(timeClass = fct_relevel(timeClass, "BL")) %>%
ggplot(aes(timeClass, value)) +
geom_col(aes(fill = perc_class),color="grey50", size=.5) +
theme_minimal() +
# scale_fill_manual(values = colfunc2alt(3)) +
scale_fill_grey(start = 0.2, end = 0.8) +
# scale_fill_grey() +
labs(x="", y = "Percent of plots in condition class", fill = "", caption = "Suckering condition class, combined AC and ANC plots \n AspPercTotXsuckeringClass_ac_anc.png") +
scale_y_continuous(labels=scales::percent)
ggsave("./output/figures_202108/AspPercTotXsuckeringClass_ac_anc.png", width = 5, height = 5, dpi=300)
suckering.vtype %>%
mutate(timeClass = as.character(timeClass)) %>%
filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
# mutate(timeClass = fct_drop(timeClass, only = "2018")) %>%
# group_by(RANGE_TYPE, timeClass, suckering_class) %>%
tabyl(timeClass, suckering_class) %>%
rowwise() %>%
mutate(sum = sum(c_across(High:Poor))) %>%
mutate(perc.high = High/sum) %>%
mutate(perc.mod = Moderate/sum) %>%
mutate(perc.poor = Poor/sum) %>%
pivot_longer(cols = contains("perc."),names_to = "perc_class") %>%
mutate(perc_class = case_when(perc_class == "perc.high" ~ "High",
perc_class == "perc.mod" ~ "Moderate",
perc_class == "perc.poor" ~ "Poor")) %>%
mutate(timeClass = fct_relevel(timeClass, "BL")) %>%
ggplot(aes(timeClass, value)) +
geom_col(aes(fill = perc_class),color="grey50", size=.5) +
theme_minimal() +
scale_fill_manual(values = colfunc3(3)) +
# scale_fill_grey() +
labs(x="", y = "Percent of plots in condition class", fill = "", caption = "Suckering condition class, combined AC and ANC plots \n AspPercTotXsuckeringClass_ac_anc_alt.png") +
scale_y_continuous(labels=scales::percent)
ggsave("./output/figures_202108/AspPercTotXsuckeringClass_ac_anc_alt.png", width = 5, height = 5, dpi=300)### All stems: core winter range
suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
arrange(-stemDen.ac) %>%
datatable(rownames = FALSE, caption = "stemDen.ac aspen suckering 1.5 m to 2.5 m", filter = "top")## broken out by fenced, just for AC
asp.pl.ac <- suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "core winter range") %>%
# filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
scale_fill_grey() +
theme_minimal() +
theme(legend.position = "none") +
labs(x = "", y = "Site ID", fill = "", title = "Core winter range") +
# labs(x = "", y = "Site ID", fill = "", caption = "Suckering: Stem density 1.5 m to 2.5 m in ht. AC plots only") +
# facet_grid(FENCED~RANGE_TYPE)
facet_wrap(~FENCED, scales = "free_y")
# asp.pl.ac
# ggsave("./output/figures_202108/AC_suckering_1p5to2p5m_fenced.png", width = 5.5, height = 5)
asp.pl.anc <- suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "non-core winter range") %>%
# filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
scale_fill_grey() +
theme_minimal() +
# theme(legend.position = "top") +
# labs(x = "", y = "Site ID", fill = "", caption = "Suckering: Stem density 1.5 m to 2.5 m in ht. AC plots only") +
labs(x = "", y = "Site ID",title = "Non-core range", fill = "") +
# facet_grid(FENCED~RANGE_TYPE)
facet_wrap(~FENCED, scales = "free_y")
# asp.pl.anc
## combine
library(patchwork)
asp.pl.ac + asp.pl.anc + plot_layout(ncol=2,widths=c(2,1))
## save revised figure
ggsave("./output/figures_202108AC_ANC_suckering_1p5to2p5m_fenced.png", width = 7.5, height = 5)### All stems: non-core winter range
## broken out by fenced, just for AC
suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(RANGE_TYPE == "non-core winter range") %>%
# filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
scale_fill_grey() +
theme_minimal() +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "", caption = "Suckering: Stem density 1.5 m to 2.5 m in ht. AC plots only") +
# facet_grid(FENCED~RANGE_TYPE)
facet_wrap(~FENCED, scales = "free_y")
# ggsave("./output/figures_202108/ANC_suckering_1p5to2p5m_fenced.png", width = 5.5, height = 5)### All stems: response to burning
suckering.vtype.burned.allHt <- ht.dbh.class %>%
distinct() %>%
# filter(HTclass == "HT_151_200_CM" |HTclass == "HT_201_250_CM") %>%
group_by(SITE_ID, HTclass.lbl, DBHclGp01, RANGE_TYPE, FENCED, BURNED, timeClass) %>%
summarise(count = n(), stemTally.htclass = sum(stemTally), mean.tally = mean(stemTally, na.rm=TRUE)) %>%
ungroup() %>%
mutate(stemDen.ac = stemTally.htclass *161.8744) %>%
mutate(stemDen.ha = round((stemTally.htclass*400),0)) # convert to ha
####### burned ha
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Burned") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ha), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
# scale_fill_viridis(trans = "log") +
# scale_fill_viridis() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "stems/ha", caption = "Suckering: Stem density ha AC - BURNED \n AC_suck_burned_ht_class_den_ha_bw.png") +
facet_wrap(~HTclass.lbl, ncol = 5)
ggsave("./output/figures_202108/AC_suck_burned_ht_class_den_ha_bw.png", width = 7.5, height = 3.25)
# ggsave("./output/figures_202108/AC_suck_burned_ht_class_den_ha.png", width = 7.5, height = 3.25)
####### burned acre
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Burned") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
# scale_fill_viridis(trans = "log") +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_viridis() +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "stems/acre", caption = "Suckering: Stem density acre AC - BURNED") +
facet_wrap(~HTclass.lbl, ncol = 5)
ggsave("./output/figures_202108/AC_suck_burned_ht_class_den_acre.png", width = 4.5, height = 3.25)
## ha
# suckering.vtype.burned.allHt %>%
# filter(!is.na(RANGE_TYPE)) %>%
# filter(BURNED == "Burned") %>%
# filter(RANGE_TYPE == "core winter range" ) %>%
# filter(timeClass %in% c("BL","2013","2018")) %>%
# ggplot(aes(timeClass, SITE_ID)) +
# # geom_tile(aes(fill = stemDen.ha), color = "grey70", size=.5) +
# geom_text(aes(label = stemDen.ha),angle=45) +
# theme_minimal() +
# scale_fill_viridis() +
# # theme(legend.position = "top") +
# labs(x = "", y = "Site ID", fill = "stems/ha", caption = "Suckering: Stem density ha AC - BURNED") +
# facet_wrap(~HTclass.lbl, scales = "free_y", ncol = 5)
####### burned acre
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Burned") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
# scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "stems/acre", caption = "Suckering: Stem density acre AC - BURNED")
ggsave("./output/figures_202108/AC_suck_burned_ht_class_den_acre.png", width = 7.5, height = 3.25)
### unburned ha
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Unburned") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ha), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
# scale_fill_viridis() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "bottom") +
labs(x = "", y = "Site ID", fill = "stems/ha", caption = "Suckering: Stem density ha AC - UNBURNED") +
facet_wrap(~HTclass.lbl, ncol = 5)
ggsave("./output/figures_202108/AC_suck_unburned_ht_class_den_ha.png", width = 7.5, height = 7.25)
### unburned acre
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Unburned") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
# scale_fill_viridis() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "stems/acre", caption = "Suckering: Stem density acre AC - UNBURNED") +
facet_wrap(~HTclass.lbl, ncol = 5)
ggsave("./output/figures_202108/AC_suck_unburned_ht_class_den_acre.png", width = 7.5, height = 7.25)### unburned acre
suckering.vtype.burned.allHt %>%
filter(!is.na(RANGE_TYPE)) %>%
filter(BURNED == "Unburned") %>%
# filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = stemDen.ac), color = "grey70", size=.5) +
# geom_tile(aes(color = FENCED, fill = stemDen.ha)) + # scale_fill_grey() +
theme_minimal() +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_viridis() +
# scale_fill_gradient(low = "black", high = "grey") +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "stems/acre", caption = "Suckering: Stem density acre AC - UNBURNED") +
facet_grid()
# facet_wrap(~HTclass.lbl, ncol = 5)#### Tall stems (>1.5 m height)
### just the stems >1.5 m
suckering.vtype.burned <- ht.dbh.class %>%
filter(HTclass == "HT_151_200_CM" |HTclass == "HT_201_250_CM") %>%
group_by(SITE_ID, RANGE_TYPE, FENCED, BURNED, timeClass) %>%
summarise(stemTally.1p5to2m = sum(stemTally)) %>%
mutate(stemDen.ac = stemTally.1p5to2m *161.8744) %>% # converts stems/2m2 plot to stems/acre) %>%
# mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor (<1,700 stems/acre)",
# stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate (1,700-4,500 stems/acre)",
# stemDen.ac >=4500 ~ "High (>4500 stems/acre)")) %>%
mutate(suckering_class = case_when(stemDen.ac < 1700 ~ "Poor",
stemDen.ac >=1700 & stemDen.ac <4500 ~ "Moderate",
stemDen.ac >=4500 ~ "High")) %>%
ungroup()
## Burned vs unburned AC
suckering.vtype.burned %>%
filter(!is.na(RANGE_TYPE)) %>%
# distinct(RANGE_TYPE)
# filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(RANGE_TYPE == "core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
scale_fill_grey() +
# scale_fill_manual(values = colfunc2(3)) +
theme_minimal() +
# theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "", caption = "Suckering: Stem density 1.5-2.5 m in ht. AC") +
facet_wrap(~BURNED, scales = "free_y")
# ggsave("./output/figures_202108/AC_suck_1p5to2p5m_AC_burned_bw.png", width = 4.5, height = 5.5)
#########
## Burned vs unburned ANC
suckering.vtype.burned %>%
filter(!is.na(RANGE_TYPE)) %>%
# distinct(RANGE_TYPE)
# filter(RANGE_TYPE != "Kawuneeche Valley") %>%
filter(RANGE_TYPE == "non-core winter range" ) %>%
filter(timeClass %in% c("BL","2013","2018")) %>%
ggplot(aes(timeClass, SITE_ID)) +
geom_tile(aes(fill = suckering_class), color = "grey70", size=.5) +
scale_fill_grey() +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
theme_minimal() +
theme(legend.position = "top") +
labs(x = "", y = "Site ID", fill = "", caption = "Suckering: Stem density 1.5-2.5 m in ht. ANC") +
facet_wrap(~BURNED, scales = "free_y")
# ggsave("./output/figures_202108/suck_1p5to2p5m_ANC_burned_bw.png", width = 4.5, height = 5.5)### calculate the percent of plots in different suckering classes for all factors and site types
suck.class.summary <- suckering.vtype.burned %>%
group_by(RANGE_TYPE, BURNED, FENCED, timeClass) %>%
mutate(n_denom = n()) %>%
ungroup() %>%
group_by(RANGE_TYPE, BURNED, FENCED, timeClass,suckering_class, n_denom) %>%
tally() %>%
mutate(perc_in_class = (round((n/n_denom*100),1))) %>%
ungroup()
suck.class.summary %>%
datatable()## AC
suck.class.summary %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass,perc_in_class)) +
geom_col(aes(fill = suckering_class), color = "grey50", size=0.5) +
scale_fill_grey() +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
theme_minimal() +
# theme(legend.position = "top") +
labs(x = "", y = "% of plots in class", fill = "", caption = "Suckering: Stem density 1.5-2.5 m in ht. AC") +
# geom_text(aes(label = perc_in_class)) +
facet_wrap(~BURNED, scales = "free_y") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
facet_grid(BURNED ~ FENCED)
# ggsave("./output/figures_202108/suck_class_AC_burned_fenced_bw.png", width = 5.5, height = 3.75)
## alt text AC
suck.class.summary %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass,suckering_class)) +
# geom_tile(aes(fill = BURNED), color = "grey70", size=.5) +
# geom_col(aes(fill = suckering_class)) +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
theme_minimal() +
# theme(legend.position = "top") +
labs(x = "", y = "", fill = "", caption = "Suckering: Stem density 1.5-2.5 m in ht.") +
geom_text(aes(label = perc_in_class)) +
facet_wrap(BURNED~FENCED, scales = "free_y") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# ggsave("./output/figures_202108/suck_class_AC_burned_fenced_text.png", width = 5.5, height = 3.75)
## ANC
suck.class.summary %>%
filter(RANGE_TYPE == "non-core winter range") %>%
ggplot(aes(timeClass,perc_in_class)) +
geom_col(aes(fill = suckering_class), color = "grey50", size=0.5) +
scale_fill_grey() +
# scale_fill_manual(values = c("darkgreen","green","grey90")) +
theme_minimal() +
# theme(legend.position = "top") +
labs(x = "", y = "% of plots in class", fill = "", caption = "Suckering: Stem density 1.5-2.5 m in ht. ANC") +
# geom_text(aes(label = perc_in_class)) +
facet_wrap(~BURNED, scales = "free_y") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
facet_grid(BURNED ~ FENCED)
# ggsave("./output/figures_202108/suck_class_ANC_burned_fenced_bw.png", width = 5.5, height = 3.75)# prop func
prop.fun <- function(x, cnt){
x = x/cnt
x
}
# suckering.vtype.tabyl %>%
# # glimpse()
# # mutate(n = sum(`High (>4500 stems/acre)`,`Moderate (1,700-4,500 stems/acre)`,`Poor (<1,700 stems/acre)`)) %>%
# # mutate_if(.predicate = is.numeric, prop.fun())
# gt()
# suckering.vtype %>% distinct(SITE_ID)
suckering.vtype <- suckering.vtype %>%
mutate(RANGE_TYPE = case_when(grepl("AC", SITE_ID) & is.na(RANGE_TYPE) ~ "core winter range",
TRUE ~ RANGE_TYPE))
#### calc the percent
percent_suckering_class <- suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
mutate(timeClass = as.character(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, RANGE_TYPE, suckering_class) %>%
summarise(sum_class = n()) %>%
ungroup() %>%
# tally()
group_by(timeClass, RANGE_TYPE) %>%
mutate(n_allTimes = sum(sum_class)) %>%
ungroup() %>%
mutate(percent_in_class = 100*(sum_class/n_allTimes)) %>%
mutate(percent_in_class = round(percent_in_class, 1)) %>%
arrange(timeClass, suckering_class)
percent_suckering_class %>%
gt()| timeClass | RANGE_TYPE | suckering_class | sum_class | n_allTimes | percent_in_class |
|---|---|---|---|---|---|
| 2013 | core winter range | High | 43 | 45 | 95.6 |
| 2013 | Kawuneeche Valley | High | 7 | 8 | 87.5 |
| 2013 | non-core winter range | High | 17 | 21 | 81.0 |
| 2013 | core winter range | Moderate | 1 | 45 | 2.2 |
| 2013 | Kawuneeche Valley | Moderate | 1 | 8 | 12.5 |
| 2013 | non-core winter range | Moderate | 4 | 21 | 19.0 |
| 2013 | core winter range | Poor | 1 | 45 | 2.2 |
| 2018 | core winter range | High | 41 | 46 | 89.1 |
| 2018 | Kawuneeche Valley | High | 6 | 8 | 75.0 |
| 2018 | non-core winter range | High | 20 | 21 | 95.2 |
| 2018 | core winter range | Moderate | 3 | 46 | 6.5 |
| 2018 | Kawuneeche Valley | Moderate | 1 | 8 | 12.5 |
| 2018 | non-core winter range | Moderate | 1 | 21 | 4.8 |
| 2018 | core winter range | Poor | 2 | 46 | 4.3 |
| 2018 | Kawuneeche Valley | Poor | 1 | 8 | 12.5 |
| BL | core winter range | High | 33 | 40 | 82.5 |
| BL | Kawuneeche Valley | High | 7 | 8 | 87.5 |
| BL | non-core winter range | High | 15 | 20 | 75.0 |
| BL | core winter range | Moderate | 4 | 40 | 10.0 |
| BL | Kawuneeche Valley | Moderate | 1 | 8 | 12.5 |
| BL | non-core winter range | Moderate | 4 | 20 | 20.0 |
| BL | core winter range | Poor | 3 | 40 | 7.5 |
| BL | non-core winter range | Poor | 1 | 20 | 5.0 |
# fig for report
percent_suckering_class %>%
mutate(timeClass = as_factor(timeClass)) %>%
mutate(timeClass = relevel(timeClass, "BL")) %>%
ggplot(aes(timeClass, percent_in_class)) +
geom_col(aes(fill = suckering_class), color = "grey50", size=0.5) +
theme_minimal() +
# scale_fill_manual(values = c("darkgreen","lightgreen","ivory3")) +
scale_fill_grey() +
labs(x = "", y = "Percent of plots", fill = "") +
facet_wrap(~RANGE_TYPE)# teme(legend.position = "top")
# ggsave("./output/figures_202108/suckering_proportion_all_plots_ht_class_bw2.png", width = 6.75, height = 3.95)#### calc the percent
percent_suckering_class.vtype <- suckering.vtype %>%
filter(!is.na(RANGE_TYPE)) %>%
mutate(timeClass = as.character(timeClass)) %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
group_by(timeClass, suckering_class, RANGE_TYPE) %>%
summarise(sum_class = n()) %>%
ungroup() %>%
group_by(timeClass, RANGE_TYPE) %>%
mutate(n_allTimes = sum(sum_class)) %>%
ungroup() %>%
mutate(percent_in_class = 100*sum_class/n_allTimes) %>%
mutate(percent_in_class = round(percent_in_class, 1))
percent_suckering_class.vtype %>%
datatable()#### Fig for report
percent_suckering_class.vtype %>%
mutate(timeClass = as_factor(timeClass)) %>%
mutate(timeClass = relevel(timeClass, "BL")) %>%
mutate(RANGE_TYPE = as_factor(RANGE_TYPE)) %>%
mutate(RANGE_TYPE = relevel(RANGE_TYPE, "core winter range","non-core winter range")) %>%
ggplot(aes(timeClass, percent_in_class)) +
geom_col(aes(fill = suckering_class)) +
# geom_text(aes(label = percent_in_class)) +
theme_minimal() +
scale_fill_grey() +
# scale_fill_manual(values = c("darkgreen","lightgreen","ivory3")) +
labs(x = "", y = "Percent of sites", fill = "") +
facet_wrap(~RANGE_TYPE)
# ggsave("./output/figures_202108/suckering_proportion_all_plots_ht_class_rangety_bw3.png", width = 8, height = 3.85)ht.dbh.class %>%
group_by(RANGE_TYPE, timeClass, BURNED, FENCED, DBHclGp01, HTclass) %>%
descr(round.digits = 1, stats = "common") %>%
tb() %>%
datatable(filter = "bottom")### Suckering: live unburned
ht.dbh.class.ub <- ht.dbh.class %>%
filter(BURNED == "Unburned")## MP specific
asp.tally.ht.tidy %>%
# group_by(VALLEY) %>% tally()
filter(VALLEY == "MP") %>%
ggplot(aes(HTclass2, stemTally)) +
geom_col(aes(fill = LIVE_DEAD), color = "grey50", size=0.5) +
theme_minimal() +
scale_fill_manual(values = colfunc3(2)) +
labs(x = "Height class", y = "Stem tally", fill = "", caption = "Moraine Park, all plots - Live/Dead") +
facet_grid(SITE_ID ~ timeClass, as.table = FALSE) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# ggsave(./output/figures_202108/MP_aspHt_stemTally.png, width = 6, height = 7.7, dpi = 300)
asp.tally.ht.tidy %>%
# group_by(VALLEY) %>% tally()
filter(FENCED == "Fenced") %>%
# filter(SITE_ID == "AC65") %>%
filter(VALLEY == "MP") %>%
ggplot(aes(HTclass2, stemTally)) +
geom_col(aes(fill = LIVE_DEAD)) +
labs(x = "Height class", y = "Stem tally", fill = "", caption = "Moraine Park, Fenced plots only - Live/Dead") +
theme_minimal() +
scale_fill_manual(values = colfunc3(2)) +
facet_grid(SITE_ID ~ timeClass, as.table = FALSE) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/MP_aspHt_stemTally_fenced_only.png", width = 7.5, height = 4.7, dpi = 300)
## unfenced
asp.tally.ht.tidy %>%
# group_by(VALLEY) %>% tally()
filter(FENCED == "Unfenced") %>%
# filter(SITE_ID == "AC65") %>%
filter(VALLEY == "MP") %>%
ggplot(aes(HTclass2, stemTally)) +
geom_col(aes(fill = LIVE_DEAD), color = "grey50", size=0.5) +
labs(x = "Height class", y = "Stem tally", fill = "", caption = "Moraine Park, Unfenced plots only - Live/Dead") +
theme_minimal() +
scale_fill_manual(values = colfunc3(2)) +
facet_grid(SITE_ID ~ timeClass, as.table = FALSE) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/MP_aspHt_stemTally_fenced_only.png", width = 6, height = 7.7, dpi = 300)AC dead trees (>2.5m)
By Fencing and Burning
### AC dead stems -- by fencing
asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == "DEAD") %>%
group_by(FENCED, BURNED, timeClass) %>%
summarise(median.tally = median(stemTally, na.rm = TRUE),mean.tally = mean(stemTally, na.rm=TRUE), sum.tally = sum(stemTally), iqr.tally = IQR(stemTally, na.rm=TRUE)) %>%
ungroup() %>%
ggplot(aes(timeClass, mean.tally)) +
geom_col(aes(fill = FENCED), position = "dodge", color = "grey50", size=0.5) +
theme_minimal() +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_grey(start = 0.2, end = 0.8) +
labs(x = "", y = "Stem tally", fill = "", title = "Core winter range", caption = "AC plots - Sum of Dead Stems across all plots") +
facet_wrap(~BURNED)
ggsave("./output/figures_202108/AC_sum_dead.png", width = 3.75, height = 3.5)### AC dead stems -- by fencing
pl.bar.dead.ac <- asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == "DEAD") %>%
group_by(FENCED, BURNED, timeClass) %>%
summarise(median.tally = median(stemTally, na.rm = TRUE), sum.tally = sum(stemTally), iqr.tally = IQR(stemTally, na.rm=TRUE),mean.tally = mean(stemTally, na.rm=TRUE)) %>%
ungroup() %>%
ggplot(aes(timeClass, mean.tally)) +
geom_col(aes(fill = BURNED), position = "dodge", color = "grey50", size=0.5) +
theme_minimal() +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
# scale_fill_grey() +
theme(legend.position = "none") +
labs(x = "", y = "Stem count", fill = "", title = "Core range") +
facet_wrap(~FENCED)pl.bar.dead.anc <- asp.tally.ht.tidy %>%
filter(SITE_TYPE == "ANC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == "DEAD") %>%
group_by(BURNED, timeClass) %>%
summarise(median.tally = median(stemTally, na.rm = TRUE), sum.tally = sum(stemTally), iqr.tally = IQR(stemTally, na.rm=TRUE),mean.tally = mean(stemTally, na.rm=TRUE)) %>%
ungroup() %>%
ggplot(aes(timeClass, mean.tally)) +
geom_col(aes(fill = BURNED), position = "dodge", color = "grey50", size=0.5) +
theme_minimal() +
# scale_fill_manual(values = colfunc3(2)) +
# scale_fill_manual() +
scale_fill_manual(values = c("grey90", "grey40")) +
theme(legend.position = "bottom") +
labs(x = "", y = "Stem count", fill = "", title = "Noncore Range")
pl.bar.dead.ac + pl.bar.dead.anc + plot_layout(widths = c(1.75, 1))
ggsave("./output/figures_202108/AC_mean_dead_fenced_burned_combo.png", width = 6.75, height = 3.75)asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
filter(LIVE_DEAD == "DEAD") %>%
group_by(FENCED, BURNED, timeClass) %>%
summarise(median.tally = median(stemTally, na.rm = TRUE), sum.tally = sum(stemTally), iqr.tally = IQR(stemTally, na.rm=TRUE),mean.tally = mean(stemTally, na.rm=TRUE),) %>%
ungroup() %>%
group_by(FENCED, BURNED, timeClass) %>%
descr(mean.tally) %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
datatable()# MP
asp.tally.ht.tidy %>%
filter(FENCED == "Fenced") %>%
filter(VALLEY == "MP") %>%
filter(timeClass %in% c("BL", "2013", "2018")) %>%
ggplot(aes(timeClass, stemTally)) +
geom_col(aes(fill = LIVE_DEAD), color = "grey50", size=0.5) +
facet_grid(SITE_ID ~ HTclass2, as.table = FALSE) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
# scale_fill_manual(values = c("red", "blue")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "", y = "Stem count", fill = "", caption = "Moraine Park")
## median by valley - AC
med.cnt.dbh.fenced.ac <- asp.tally.ht.tidy %>%
filter(timeClass == "BL" |timeClass == "2013" |timeClass == "2018") %>%
filter(SITE_TYPE == "AC") %>%
group_by(timeClass, FENCED, VALLEY, HTclass2) %>%
summarise(med.tally = median(stemTally, na.rm = TRUE)) %>%
ungroup()
med.cnt.dbh.fenced.ac %>%
pivot_wider(names_from = c(FENCED,timeClass), values_from = med.tally) %>%
gt()| VALLEY | HTclass2 | Fenced_BL | Unfenced_BL | Fenced_2013 | Unfenced_2013 | Fenced_2018 | Unfenced_2018 |
|---|---|---|---|---|---|---|---|
| HSP | 0-50 cm | 2.0 | 1.5 | 1.0 | 3.5 | 0.0 | 4.5 |
| HSP | 51-100 cm | 0.0 | 0.0 | 1.0 | 1.5 | 1.5 | 2.0 |
| HSP | 101-150 cm | 0.0 | 0.0 | 1.0 | 0.0 | 1.5 | 0.0 |
| HSP | 151-200 cm | 0.0 | 0.0 | 0.0 | 0.0 | 0.5 | 0.0 |
| HSP | 201-250 cm | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 |
| MP | 0-50 cm | 3.0 | 0.0 | 1.5 | 0.0 | 0.0 | 0.5 |
| MP | 51-100 cm | 0.0 | 0.0 | 11.0 | 1.0 | 2.5 | 1.0 |
| MP | 101-150 cm | 0.0 | 0.0 | 0.0 | 0.0 | 3.5 | 0.0 |
| MP | 151-200 cm | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 |
| MP | 201-250 cm | 0.0 | 0.0 | 0.0 | 0.0 | 0.5 | 0.0 |
| UBM | 0-50 cm | 2.5 | 18.0 | 0.0 | 17.0 | 0.5 | 6.5 |
| UBM | 51-100 cm | 0.0 | 11.5 | 2.5 | 14.0 | 1.0 | 20.0 |
| UBM | 101-150 cm | 0.0 | 0.0 | 3.5 | 0.5 | 3.0 | 12.5 |
| UBM | 151-200 cm | 0.0 | 0.0 | 0.0 | 0.0 | 2.5 | 0.0 |
| UBM | 201-250 cm | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 |
| BME | 0-50 cm | NA | 5.0 | NA | 9.5 | NA | 1.5 |
| BME | 51-100 cm | NA | 9.0 | NA | 15.0 | NA | 22.0 |
| BME | 101-150 cm | NA | 0.0 | NA | 0.0 | NA | 19.0 |
| BME | 151-200 cm | NA | 0.0 | NA | 0.0 | NA | 6.5 |
| BME | 201-250 cm | NA | 0.0 | NA | 0.0 | NA | 1.0 |
| EV | 0-50 cm | NA | 3.5 | NA | 3.0 | NA | 2.5 |
| EV | 51-100 cm | NA | 0.0 | NA | 1.0 | NA | 11.0 |
| EV | 101-150 cm | NA | 0.0 | NA | 0.0 | NA | 0.0 |
| EV | 151-200 cm | NA | 0.0 | NA | 0.0 | NA | 0.0 |
| EV | 201-250 cm | NA | 0.0 | NA | 0.0 | NA | 0.0 |
# med.cnt.dbh.fenced.ac %>%
# ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = med.tally), color = "grey70", size=.5) +
# geom_text(aes(label = med.tally), color = "grey90") +
# facet_grid(VALLEY~FENCED, as.table = FALSE) +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# theme_minimal() +
# scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# # scale_fill_viridis() +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# labs(x = "", y = "Height class", fill = "Stem count", caption = "AC plots only - Median stem count")
#
# ggsave("./output/figures_202108/AC_fenced_medTally_alt.png", width = 4.75, height = 6.35, dpi = 300)
# for caption
# asp.tally.ht.tidy %>%
# select(VALLEY, valley_full) %>%
# distinct() %>%
# mutate(txt = glue::glue("{VALLEY}: {valley_full}")) %>%
# select(txt)
# c("c("HSP: Horseshoe Park", "UBM: Upper Beaver Meadows", "MP: Moraine Park", "BME: Beaver Meadows Entrance", "EV: EndoValley", "KV: Kawuneeche Valley", "HV: Hidden Valley", "DM: Deer Mountain", "RR: Roaring River", "CC: Cow Creek", "HLWP: Hollowell Park")")# number pl by valley
asp.tally.ht.tidy %>%
group_by(VALLEY) %>%
tally() %>%
gt()## Moraine park
asp.tally.ht.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(VALLEY == "MP") %>%
ggplot(aes(HTclass2, timeClass)) +
geom_tile(aes(fill = stemTally), color = "grey70", size=.5) +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
# scale_fill_viridis_c() +
facet_wrap(~SITE_ID, ncol=6) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Moraine Park plots", x = "Height class", y = "", fill = "n stems")
## median by valley - ANC
med.cnt.dbh.fenced.anc <- asp.tally.ht.tidy %>%
filter(timeClass == "BL" |timeClass == "2013" |timeClass == "2018") %>%
filter(SITE_TYPE == "ANC") %>%
group_by(timeClass, FENCED, VALLEY, HTclass2) %>%
summarise(med.tally = median(stemTally, na.rm = TRUE)) %>%
ungroup()
med.cnt.dbh.fenced.anc %>%
pivot_wider(names_from = c(FENCED,timeClass), values_from = med.tally) %>%
gt()| VALLEY | HTclass2 | Unfenced_BL | Unfenced_2013 | Unfenced_2018 |
|---|---|---|---|---|
| CC | 0-50 cm | 3.5 | 2.0 | 0.0 |
| CC | 51-100 cm | 0.0 | 1.5 | 2.0 |
| CC | 101-150 cm | 0.0 | 0.0 | 0.0 |
| CC | 151-200 cm | 0.0 | 0.0 | 0.0 |
| CC | 201-250 cm | 0.0 | 0.0 | 0.0 |
| DM | 0-50 cm | 1.5 | 0.5 | 1.0 |
| DM | 51-100 cm | 0.5 | 1.5 | 2.0 |
| DM | 101-150 cm | 0.0 | 0.0 | 0.5 |
| DM | 151-200 cm | 0.0 | 0.0 | 0.0 |
| DM | 201-250 cm | 0.0 | 0.0 | 0.0 |
| HLWP | 0-50 cm | 2.5 | 0.0 | 2.0 |
| HLWP | 51-100 cm | 0.5 | 1.5 | 1.0 |
| HLWP | 101-150 cm | 0.0 | 0.0 | 1.0 |
| HLWP | 151-200 cm | 0.0 | 0.0 | 1.0 |
| HLWP | 201-250 cm | 0.0 | 0.0 | 0.0 |
| HSP | 0-50 cm | 0.0 | 3.5 | 3.0 |
| HSP | 51-100 cm | 0.0 | 0.0 | 2.5 |
| HSP | 101-150 cm | 0.0 | 0.0 | 0.0 |
| HSP | 151-200 cm | 0.0 | 0.0 | 0.0 |
| HSP | 201-250 cm | 0.0 | 0.0 | 0.0 |
| HV | 0-50 cm | 7.5 | 2.0 | 8.0 |
| HV | 51-100 cm | 4.5 | 3.5 | 8.0 |
| HV | 101-150 cm | 0.5 | 6.0 | 6.0 |
| HV | 151-200 cm | 0.0 | 1.0 | 1.0 |
| HV | 201-250 cm | 0.0 | 0.5 | 0.5 |
| MP | 0-50 cm | 1.5 | 0.5 | 2.5 |
| MP | 51-100 cm | 0.0 | 1.0 | 6.5 |
| MP | 101-150 cm | 0.0 | 0.0 | 3.5 |
| MP | 151-200 cm | 0.0 | 0.0 | 0.0 |
| MP | 201-250 cm | 0.0 | 0.0 | 0.0 |
| RR | 0-50 cm | 7.5 | 6.0 | 4.5 |
| RR | 51-100 cm | 7.0 | 7.5 | 15.0 |
| RR | 101-150 cm | 4.0 | 4.5 | 4.5 |
| RR | 151-200 cm | 4.0 | 8.0 | 6.0 |
| RR | 201-250 cm | 3.5 | 0.0 | 2.0 |
| UBM | 0-50 cm | 1.0 | 1.0 | 0.5 |
| UBM | 51-100 cm | 0.0 | 0.0 | 4.5 |
| UBM | 101-150 cm | 0.0 | 0.0 | 0.0 |
| UBM | 151-200 cm | 0.0 | 0.0 | 0.0 |
| UBM | 201-250 cm | 0.0 | 0.0 | 0.0 |
# med.cnt.dbh.fenced.anc %>%
# ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = med.tally), color = "grey70", size=.5) +
# geom_text(aes(label = med.tally), color = "grey80") +
# # facet_grid(valley_full ~ FENCED, as.table = FALSE) +
# facet_grid(VALLEY~FENCED, as.table = FALSE) +
# # facet_grid(FENCED~VALLEY, as.table = FALSE) +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# theme_minimal() +
# scale_fill_viridis() +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# labs(x = "", y = "Height class", fill = "Stem count", caption = "ANC plots only - Median stem count")
# ggsave("./output/figures_202108/ANC_fenced_medTally_alt.png", width = 4.5, height = 7.5, dpi = 300)
####
# med.cnt.dbh.fenced.anc %>%
# ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = med.tally), color = "grey80") +
# # facet_grid(valley_full ~ FENCED, as.table = FALSE) +
#
# facet_grid(FENCED~VALLEY, as.table = FALSE) +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# theme_minimal() +
# scale_fill_viridis() +
# theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
# # theme(legend.position = "top") +
# labs(x = "", y = "Height class", fill = "Stem count", caption = "ANC plots only - Median stem count")med.cnt.dbh.fenced.ak <- asp.tally.ht.tidy %>%
filter(timeClass == "BL" |timeClass == "2013" |timeClass == "2018") %>%
filter(SITE_TYPE == "AK") %>%
group_by(timeClass, FENCED, VALLEY, HTclass2) %>%
summarise(med.tally = median(stemTally, na.rm = TRUE)) %>%
ungroup()
med.cnt.dbh.fenced.ak %>%
pivot_wider(names_from = c(FENCED,timeClass), values_from = med.tally) %>%
gt() %>%
tab_header(title = "median tally AK")| median tally AK | ||||
| VALLEY | HTclass2 | Unfenced_BL | Unfenced_2013 | Unfenced_2018 |
|---|---|---|---|---|
| KV | 0-50 cm | 1.5 | 1.5 | 2.5 |
| KV | 51-100 cm | 0.0 | 0.0 | 0.0 |
| KV | 101-150 cm | 0.0 | 0.0 | 0.0 |
| KV | 151-200 cm | 0.0 | 0.0 | 0.0 |
| KV | 201-250 cm | 0.0 | 0.0 | 0.0 |
### Live stem tally: core winter range
### Core winter range: Aspen Stem counts
## tally of core winter range - LIVE
asp.tally.ht.tidy %>%
filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
mutate(SITE_ID = glue::glue('{SITE_ID}-{FENCED}')) %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "core winter range") %>%
ggplot(aes(timeClass, HTclass2)) +
geom_tile(aes(fill = stemTally), color = "grey70", size=.5, alpha = .5) +
geom_text(aes(label = stemTally), size = 3) +
facet_wrap(~SITE_ID) +
theme_minimal() +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
labs(x = "", y = "", title = "Core winter range: Aspen live stem counts", fill = "n stems") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/asp_AC_liveTally_revised.png", width = 8.75, height = 8.5, dpi = 300)
# ANC
## tally of NON-core winter range - LIVE
asp.tally.ht.tidy %>% # distinct(RANGE_TYPE)
filter(LIVE_DEAD == 'LIVE') %>%
# distinct(RANGE_TYPE)
filter(RANGE_TYPE == "non-core winter range") %>%
filter(SITE_ID != "ANC24") %>%
ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = FENCED), color = "grey80", alpha = .2) +
geom_tile(aes(fill = stemTally), color = "grey70", size=.5) +
# geom_text(aes(label = stemTally), size = 3) +
# scale_fill_viridis_c() +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~SITE_ID) +
theme_minimal() +
labs(x = "", y = "", title = "Non-core winter range: Aspen live stem counts", fill = "n stems") +
# facet_grid(SITE_ID ~ timeClass) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/asp_ANC_liveTally.png", width = 7.125, height = 5.75, dpi = 300)## tally of core winter range - DEAD
# asp.tally.ht.tidy %>%
# filter(LIVE_DEAD == 'DEAD') %>%
# filter(RANGE_TYPE == "core winter range") %>%
# ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = FENCED), color = "grey80", alpha = .2) +
# geom_text(aes(label = stemTally), size = 3) +
# facet_wrap(~SITE_ID) +
# theme_minimal() +
# labs(x = "", y = "", title = "Moraine Park: Aspen dead stem counts") +
# # facet_grid(SITE_ID ~ timeClass) +
# theme(axis.text.x = element_text(angle = 45, hjust = 1))## tally of KV - LIVE
asp.tally.ht.tidy %>% # distinct(RANGE_TYPE)
filter(LIVE_DEAD == 'LIVE') %>%
filter(RANGE_TYPE == "Kawuneeche Valley") %>%
# filter(SITE_ID != "ANC24") %>%
ggplot(aes(timeClass, HTclass2)) +
# geom_tile(aes(fill = FENCED), color = "grey70", size=.5, alpha = .2) +
geom_tile(aes(fill = stemTally), color = "grey70", size=.5) +
# geom_text(aes(label = stemTally), size = 3) +
# scale_fill_viridis_c() +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
scale_fill_gradientn(colors = c("#0095AF","#9ADCBB", "#FCFFDD")) +
facet_wrap(~SITE_ID, ncol = 4) +
theme_minimal() +
labs(x = "", y = "", title = "Kawuneeche Valley: Aspen live stem counts", fill = "n stems") +
# facet_grid(SITE_ID ~ timeClass) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/asp_KV_liveTallyx.png", width = 6.5, height = 4, dpi = 300)## tally of MP - LIVE
asp.tally.ht.tidy %>%
filter(LIVE_DEAD == 'LIVE') %>%
filter(VALLEY == "MP") %>%
# filter(VALLEY == "EV") %>%
ggplot(aes(timeClass, HTclass2)) +
geom_tile(aes(fill = FENCED), color = "grey70", size=.5, alpha = .2) +
geom_text(aes(label = stemTally), size = 3) +
facet_wrap(~SITE_ID) +
theme_minimal() +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
labs(fill="", x = "", y = "", title = "Moraine Park: Aspen live stem counts") +
# facet_grid(SITE_ID ~ timeClass) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/asp_MP_liveTally_dbh.png", width = 9.5, height = 7, dpi = 300)## tally of MP - DEAD
asp.tally.ht.tidy %>%
filter(LIVE_DEAD == 'DEAD') %>%
filter(VALLEY == "MP") %>%
ggplot(aes(timeClass, HTclass2)) +
geom_tile(aes(fill = FENCED), color = "grey70", size=.5, alpha = .2) +
geom_text(aes(label = stemTally), size = 3) +
# scale_fill_manual(values = colfunc3(2)) +
scale_fill_manual(values = c("grey90", "grey40")) +
facet_wrap(~SITE_ID) +
theme_minimal() +
labs(x = "", y = "", title = "Moraine Park: Aspen dead stem counts", fill="") +
# facet_grid(SITE_ID ~ timeClass) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/asp_MP_deadTally_dbh.png", width = 9.5, height = 7, dpi = 300)## calc percentage in height classes
asp.tally.ht.tidy <- asp.tally.ht.tidy %>%
filter(is.na(REMOVED)) %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(timeClass %in% c('BL','2013','2018')) %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) #%>%
# mutate(percentTot = 100*round(percentTot,1))
ht.perc01 <- asp.tally.ht.tidy# Proportion of Live Aspen Stems by Height Class
## heatmap:
f.plot1 <- ht.perc01 %>%
filter(SITE_TYPE != "AK") %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Fenced") %>%
filter(SITE_ID != "AC33") %>%
filter(SITE_ID != "AC67") %>%
filter(!is.nan(percentTot)) %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}-{FENCED}')) %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'white', alpha = .8) +
# geom_text(aes(label = percentTot), size = 3) +
facet_wrap(~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
# labs(x = "Height class", y = "", fill = "% total stems", caption = "Proportion of Live Aspen Stems by Height Class - Fenced plots only") +
# theme(axis.title.x=element_blank(),
# axis.text.x=element_blank(),
# axis.ticks.x=element_blank()) +
scale_x_discrete(labels = NULL, breaks = NULL) +
labs(x = "", y = "", fill = "% total stems", title="Fenced") +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# ht.perc01 %>% distinct(SITE_TYPE)
uf.plot1 <- ht.perc01 %>%
filter(SITE_TYPE != "AK") %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Unfenced") %>%
filter(SITE_ID != "AC33") %>%
filter(SITE_ID != "AC67") %>%
filter(!is.nan(percentTot)) %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}-{FENCED}')) %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'white', alpha = .8) +
# geom_text(aes(label = percentTot), size = 3) +
facet_wrap(~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
# theme_bw() +
theme_minimal() +
theme(legend.position = "bottom") +
labs(x = "Height class", y = "", fill = "% total stems", title="Unfenced", caption = "acanc_prop_height_raw_revised.png")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
combo.acanc <- f.plot1 + uf.plot1 + plot_layout(ncol = 1, heights = c(1, 3.3))
combo.acanc
# save plot
ggsave("./output/figures_202108/acanc_prop_height_raw_revised.png", width = 7.5, height = 12, dpi= 300)ht.perc01 %>%
filter(SITE_TYPE != "AK") %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Fenced") %>%
filter(SITE_ID != "AC33") %>%
filter(SITE_ID != "AC67") %>%
filter(!is.nan(percentTot)) %>%
# mutate(SITE_ID = glue::glue('{SITE_ID}-{FENCED}')) %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'white', alpha = .8) +
# geom_text(aes(label = percentTot), size = 2.75) +
# facet_grid(.~timeClass) +
facet_wrap(~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
# theme_bw() +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", caption = "AC_prop_height_raw_revised.png")+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "bottom") +
coord_flip()
#
ggsave("./output/figures_202108/AC_prop_height_raw_revised.png", width = 7.5, height = 4.25, dpi= 300)### Heatmaps - Trees, Fenced/Unfenced
## heatmap: fenced
ht.perc01 %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Fenced") %>%
filter(SITE_ID != "AC33") %>%
filter(SITE_ID != "AC67") %>%
filter(!is.nan(percentTot)) %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'white', alpha = .8) +
# geom_text(aes(label = percentTot), size = 3) +
# facet_grid(.~timeClass) +
facet_wrap(~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", caption = "AC_Live_Fenced_heightClass_heatmap3b.png")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_Live_Fenced_heightClass_heatmap3b.png", width = 8.5, height = 4, dpi = 300)## heatmap: unfenced
pl.hmap.ac.uf <- ht.perc01 %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Unfenced") %>%
# filter() %>% # live dead
filter(SITE_ID != "AC07") %>%
filter(SITE_ID != "AC68") %>%
filter(!is.nan(percentTot)) %>%
filter(SITE_TYPE == "AC") %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'grey80', alpha = 1) +
# geom_text(aes(label = percentTot), size = 3) +
facet_grid(.~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", title = "Core range", subtitle = "Unfenced plots", caption = "AC_unfenced_Live_HTclassXSiteID_heatmap_nolbl.png") +
theme(legend.position = "bottom") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.hmap.ac.uf
ggsave("./output/figures_202108/AC_unfenced_Live_HTclassXSiteID_heatmap_nolbl.png", width = 8.5, height = 6, dpi = 300)pl.hmap.ac.f <- ht.perc01 %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Fenced") %>%
# filter() %>% # live dead
filter(SITE_ID != "AC07") %>%
filter(SITE_ID != "AC68") %>%
filter(!is.nan(percentTot)) %>%
filter(SITE_TYPE == "AC") %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'grey80', alpha = 1) +
# geom_text(aes(label = percentTot), size = 3) +
facet_grid(.~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", title = "Core range", subtitle = "Fenced plots")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
pl.hmap.ac.f
ggsave("./output/figures_202108/AC_fenced_Live_HTclassXSiteID_heatmap.png", width = 8.5, height = 6, dpi = 300)
pl.hmap.ac.uf <- ht.perc01 %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(FENCED == "Unfenced") %>%
# filter() %>% # live dead
filter(SITE_ID != "AC07") %>%
filter(SITE_ID != "AC68") %>%
filter(!is.nan(percentTot)) %>%
filter(SITE_TYPE == "AC") %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'grey80', alpha = 1) +
# geom_text(aes(label = percentTot), size = 3) +
facet_grid(.~timeClass) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", caption = "Core range", subtitle = "Unfenced plots")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/AC_fenced_Live_HTclassXSiteID_heatmap_lbl.png", width = 8.5, height = 6, dpi = 300)pl.hmap.ac.f + (pl.hmap.ac.uf + theme(legend.position = "none")) + plot_layout(ncol=1) +
plot_annotation(caption = "AC_F_UF2panel.png")
ggsave("./output/figures_202108/AC_F_UF2panel.png", width = 6.5, height = 8, dpi = 300)asp.tally.ht.tidy %>%
distinct(timeClass)## # A tibble: 3 x 1
## timeClass
## <fct>
## 1 2018
## 2 2013
## 3 BL## heatmap: KV
asp.tally.ht.tidy %>%
filter(is.na(REMOVED)) %>%
filter(BURNED == "Unburned") %>%
filter(LIVE_DEAD == "LIVE") %>%
# filter(timeClass %in% c('BL','2013','2018')) %>%
group_by(SITE_ID, YEAR) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
mutate(percentTot = 100*round(percentTot,1)) %>%
filter(RANGE_TYPE == "Kawuneeche Valley") %>%
filter(!is.nan(percentTot)) %>%
ggplot(aes(HTclass2, SITE_ID)) +
geom_tile(aes(fill = percentTot), color = 'white', alpha = .8) +
geom_text(aes(label = percentTot), size = 3) +
facet_grid(.~YEAR) +
scale_fill_gradientn(colours = c("#FCFFDD","#0095AF")) +
# scale_fill_viridis_c(begin = .4, end = .95, direction = -1, option = "B") +
theme_minimal() +
labs(x = "Height class", y = "", fill = "% total stems", title = "Proportion of Live Aspen Stems by Height Class", caption = "All plots \n KV_Live_unFenced_Unburned_heightClass_heatmap3b.png")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggsave("./output/figures_202108/KV_Live_unFenced_Unburned_heightClass_heatmap3b.png", width = 8.5, height = 6, dpi = 300)Percent of total stems in height class
# REVISED 2022
# export fig10 here
### Revised figures for manuscript
## Generate lu for boxplot sorting on %stems in 0-50cm height class
sort.ht2join <- ht.perc01 %>%
filter(timeClass == "BL") %>%
arrange(timeClass, HTclass) %>%
group_by(timeClass, HTclass, SITE_TYPE) %>%
dplyr::mutate(rank_HtClass_BL = rank(percentTot, ties.method = "first")) %>%
ungroup() %>%
filter(timeClass == "BL") %>%
select(SITE_TYPE, SITE_ID, HTclass, rank_HtClass_BL) %>%
distinct() %>%
arrange(SITE_TYPE, HTclass, rank_HtClass_BL, SITE_ID) %>%
pivot_wider(names_from = HTclass,
names_glue = "sort_{HTclass}",
values_from = rank_HtClass_BL) %>%
arrange(SITE_TYPE, desc(sort_HT_0_50_CM), SITE_ID) %>%
select(2:5) %>%
distinct()
# AC
plot.percTot.AC.F <- full_join(ht.perc01,sort.ht2join) %>%
filter(SITE_TYPE == "AC" & FENCED == "Fenced") %>%
ggplot(aes(reorder(SITE_ID, -sort_HT_0_50_CM), percentTot)) +
geom_col(aes(fill = HTclass2), color = "grey50", size=0.5) +
facet_wrap(~timeClass, ncol = 1) +
scale_fill_manual(values = colfunc2(5)) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "Height class", subtitle = "Fenced plots") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_y_continuous(labels=scales::percent) +
theme(legend.position = "right")
plot.percTot.AC.UF <- full_join(ht.perc01,sort.ht2join) %>%
filter(SITE_TYPE == "AC" & FENCED == "Unfenced") %>%
ggplot(aes(reorder(SITE_ID, -sort_HT_0_50_CM), percentTot)) +
geom_col(aes(fill = HTclass2), color = "grey50", size=0.5) +
facet_wrap(~timeClass, ncol = 1) +
scale_fill_manual(values = colfunc2(5)) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "Height class", title = "", subtitle = "Unfenced plots") +
# labs(y = "% of total stems", x = "", fill = "Height class", title = "Proportion of Live Aspen Stems by Height Class", subtitle = "Unfenced plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "none") +
scale_y_continuous(labels=scales::percent)#### FIGURE 9 revised
# library(patchwork)
plot.ac.fence2panel <- plot.percTot.AC.F + plot.percTot.AC.UF +
plot_layout(widths = c(1, 2.2))
plot.ac.fence2panel
ggsave("./output/figures_202108/AspPercTotXhtclass_ac_FxUf.png", width = 11.25, height = 5, dpi=300)# alt
# plot.percTot.AC.F / plot.percTot.AC.UF +
# plot_layout(widths = c(1, 2.5)) +
# plot_annotation(caption = 'AspPercTotXhtclass_ac_FxUfalt.png')
# ggsave("./output/figures_202108/AspPercTotXhtclass_ac_FxUfalt.png", width = 6.5, height = 8.75, dpi=300)
### custom layout
layout.f09 <- "
AAAAA#
BBBBBB
"
plot.percTot.AC.F / plot.percTot.AC.UF +
#plot_layout(widths = c(1, 2.2)) +
plot_layout(design = layout.f09) +
plot_annotation(tag_levels = 'A')
ggsave("./output/figures_202202/Fig09_AspPercTotXhtclass_ac_FxUfalt.png", width = 6.5, height = 7.75, dpi=300)
ggsave("./output/figures_202202/Fig09_AspPercTotXhtclass_ac_FxUfalt.pdf", width = 6.5, height = 7.75)# Fig 10 revised 2022
## ANC
plot.percTot.ANC <- full_join(ht.perc01,sort.ht2join) %>%
filter(SITE_TYPE == "ANC") %>%
ggplot(aes(reorder(SITE_ID, -sort_HT_0_50_CM), percentTot)) +
geom_col(aes(fill = HTclass2), color = "grey50", size=0.5) +
facet_wrap(~timeClass, ncol = 1) +
scale_fill_manual(values = colfunc2(5)) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
labs(y = "% of total stems", x = "Plot ID", fill = "Height class") +
# labs(y = "% of total stems", x = "", fill = "Height class", title = "Proportion of Live Aspen Stems by Height Class", subtitle = "Unfenced plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "bottom") +
scale_y_continuous(labels=scales::percent)
plot.percTot.ANC
# ggsave("./output/figures_202108/AspPercTotXhtclass_anc_FxUf.png", width = 7, height = 5, dpi=300)
ggsave("./output/figures_202202/Fig10_AspPercTotXhtclass_anc_FxUf.png", width = 7, height = 5, dpi=300)
ggsave("./output/figures_202202/Fig10_AspPercTotXhtclass_anc_FxUf.pdf", width = 7, height = 5)# Fig 19 revised 2022
## AK
plot.percTot.AK <- full_join(ht.perc01,sort.ht2join) %>%
filter(SITE_TYPE == "AK") %>%
ggplot(aes(reorder(SITE_ID, -sort_HT_0_50_CM), percentTot)) +
geom_col(aes(fill = HTclass2), color = "grey50", size=0.5) +
facet_wrap(~timeClass, ncol = 1) +
scale_fill_manual(values = colfunc2(5)) +
# scale_fill_viridis(discrete=TRUE) +
theme_minimal() +
# labs(y = "% of total stems", x = "Plot ID", fill = "Height class", title = "Kawuneeche Valley") +
labs(y = "% of total stems", x = "Plot ID", fill = "Height class") +
# labs(y = "% of total stems", x = "", fill = "Height class", title = "Proportion of Live Aspen Stems by Height Class", subtitle = "Unfenced plots only") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(legend.position = "bottom") +
scale_y_continuous(labels=scales::percent)
plot.percTot.AK
ggsave("./output/figures_202202/Fig19_AspPercTotXhtclass_ak.png", width = 6, height = 4.5, dpi=300)
ggsave("./output/figures_202202/Fig19_AspPercTotXhtclass_ak.pdf", width = 6, height = 4.5)# panel plot
(plot.ac.fence2panel + theme(legend.position = "none")) + (plot.percTot.ANC + theme(legend.position = "none"))
# alt
plot.percTot.AC.F + plot.percTot.AC.UF + plot.percTot.ANC + plot.percTot.AK +
plot_annotation(caption = "AspPercTotXhtclass_panel.png")
ggsave("./output/figures_202108/AspPercTotXhtclass_panel.png", width = 7, height = 7.5, dpi=300)# panel plot
(plot.ac.fence2panel + theme(legend.position = "none")) + (plot.percTot.ANC + theme(legend.position = "none")) + plot.percTot.AK
# alt
plot.percTot.AC.F + plot.percTot.AC.UF + plot.percTot.ANC + plot.percTot.AK +
plot_annotation(caption = "AspPercTotXhtclass_panel.png")
ggsave("./output/figures_202108/AspPercTotXhtclass_panel.png", width = 8, height = 8, dpi=300)Aspen management goals
Targets from Ziegenfuss and Johnson 2015:
1.Progressive increase in aspen regeneration above the baseline level of 13 percent to at least 45 percent of winter range stands (presence of stems less than 2 cm dbh reaching 1.5–2.5 m tall).
# ht.perc01 %>%
# group_by(RANGE_TYPE, FENCED, pType) %>%
# summarise(mean.stemDen.ac = mean(stemDen.ac),n = n())
asp.tally.dbh.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(LIVE_DEAD == "LIVE") %>%
# filter(FENCED == "Fenced") %>%
# filter(timeClass %in% c('BL','2013','2018')) %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
group_by(timeClass, BURNED, FENCED) %>%
descr(stemDen.ac) %>%
tb() %>%
gt() %>%
tab_header(title = "Combined Winter Range Live Tree Density: tcxburnedxfenced")| Combined Winter Range Live Tree Density: tcxburnedxfenced | ||||||||||||||||||
| timeClass | BURNED | FENCED | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | skewness | se.skewness | kurtosis | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Burned | Fenced | stemDen.ac | 141.64010 | 235.97046 | 0 | 0 | 0.0000 | 242.8116 | 647.4976 | 0.0000 | 202.3430 | 1.6659863 | 1.1538324 | 0.7521014 | -0.2345913 | 8 | 100 |
| BL | Burned | Unfenced | stemDen.ac | 80.93720 | 93.45823 | 0 | 0 | 80.9372 | 161.8744 | 161.8744 | 119.9975 | 161.8744 | 1.1547005 | 0.0000000 | 1.0141851 | -2.4375000 | 4 | 100 |
| BL | Unburned | Fenced | stemDen.ac | 113.31208 | 246.45072 | 0 | 0 | 0.0000 | 80.9372 | 1133.1208 | 0.0000 | 40.4686 | 2.1749730 | 2.4117087 | 0.3737834 | 5.7540844 | 40 | 100 |
| BL | Unburned | Unfenced | stemDen.ac | 74.94185 | 138.96078 | 0 | 0 | 0.0000 | 161.8744 | 647.4976 | 0.0000 | 161.8744 | 1.8542480 | 1.8700452 | 0.2325154 | 2.9167887 | 108 | 100 |
| BL | NA | Unfenced | stemDen.ac | 24.28116 | 79.21493 | 0 | 0 | 0.0000 | 0.0000 | 323.7488 | 0.0000 | 0.0000 | 3.2624032 | 2.9375634 | 0.5121033 | 7.6757870 | 20 | 100 |
| 2013 | Burned | Fenced | stemDen.ac | 80.93720 | 201.23628 | 0 | 0 | 0.0000 | 0.0000 | 647.4976 | 0.0000 | 0.0000 | 2.4863262 | 1.9518521 | 0.6373020 | 2.4341840 | 12 | 100 |
| 2013 | Burned | Unfenced | stemDen.ac | 20.23430 | 55.29063 | 0 | 0 | 0.0000 | 0.0000 | 161.8744 | 0.0000 | 0.0000 | 2.7325202 | 2.0585392 | 0.5643077 | 2.3989955 | 16 | 100 |
| 2013 | Unburned | Fenced | stemDen.ac | 540.80765 | 950.92062 | 0 | 0 | 161.8744 | 566.5604 | 4208.7344 | 239.9950 | 526.0918 | 1.7583343 | 2.4379307 | 0.3574838 | 5.3260080 | 44 | 100 |
| 2013 | Unburned | Unfenced | stemDen.ac | 67.44767 | 119.43572 | 0 | 0 | 0.0000 | 161.8744 | 485.6232 | 0.0000 | 161.8744 | 1.7707910 | 1.5300744 | 0.2325154 | 1.0754141 | 108 | 100 |
| 2013 | NA | Unfenced | stemDen.ac | 0.00000 | 0.00000 | 0 | 0 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | NaN | NaN | 0.7521014 | NaN | 8 | 100 |
| 2015 | Burned | Fenced | stemDen.ac | 215.83253 | 508.77997 | 0 | 0 | 0.0000 | 242.8116 | 1780.6184 | 0.0000 | 202.3430 | 2.3572904 | 2.3749365 | 0.6373020 | 4.4781528 | 12 | 100 |
| 2015 | Burned | Unfenced | stemDen.ac | 20.23430 | 55.29063 | 0 | 0 | 0.0000 | 0.0000 | 161.8744 | 0.0000 | 0.0000 | 2.7325202 | 2.0585392 | 0.5643077 | 2.3989955 | 16 | 100 |
| 2015 | Unburned | Fenced | stemDen.ac | 161.87440 | 228.92497 | 0 | 0 | 0.0000 | 323.7488 | 647.4976 | 0.0000 | 323.7488 | 1.4142136 | 0.8838835 | 0.6373020 | -0.7916667 | 12 | 100 |
| 2015 | Unburned | Unfenced | stemDen.ac | 151.75725 | 172.01139 | 0 | 0 | 80.9372 | 323.7488 | 485.6232 | 119.9975 | 323.7488 | 1.1334640 | 0.4260687 | 0.5643077 | -1.4976820 | 16 | 100 |
| 2016 | Burned | Fenced | stemDen.ac | 863.33013 | 2244.41307 | 0 | 0 | 80.9372 | 566.5604 | 7931.8456 | 119.9975 | 526.0918 | 2.5997159 | 2.5704935 | 0.6373020 | 5.2103303 | 12 | 100 |
| 2016 | Burned | Unfenced | stemDen.ac | 30.35145 | 88.04440 | 0 | 0 | 0.0000 | 0.0000 | 323.7488 | 0.0000 | 0.0000 | 2.9008300 | 2.4853256 | 0.5643077 | 5.0308075 | 16 | 100 |
| 2016 | Unburned | Fenced | stemDen.ac | 161.87440 | 267.32677 | 0 | 0 | 0.0000 | 323.7488 | 809.3720 | 0.0000 | 323.7488 | 1.6514456 | 1.2211523 | 0.6373020 | 0.1594444 | 12 | 100 |
| 2016 | Unburned | Unfenced | stemDen.ac | 182.10870 | 176.08879 | 0 | 0 | 242.8116 | 323.7488 | 485.6232 | 239.9950 | 323.7488 | 0.9669433 | 0.0637263 | 0.5643077 | -1.7647191 | 16 | 100 |
| 2017 | Burned | Fenced | stemDen.ac | 876.81967 | 1713.75483 | 0 | 0 | 161.8744 | 809.3720 | 5665.6040 | 239.9950 | 566.5604 | 1.9545123 | 1.8518279 | 0.6373020 | 2.2374602 | 12 | 100 |
| 2017 | Burned | Unfenced | stemDen.ac | 171.99155 | 687.96620 | 0 | 0 | 0.0000 | 0.0000 | 2751.8648 | 0.0000 | 0.0000 | 4.0000000 | 3.2812500 | 0.5643077 | 9.3632812 | 16 | 100 |
| 2017 | Unburned | Fenced | stemDen.ac | 148.38487 | 262.45566 | 0 | 0 | 0.0000 | 242.8116 | 809.3720 | 0.0000 | 202.3430 | 1.7687495 | 1.4123417 | 0.6373020 | 0.6643771 | 12 | 100 |
| 2017 | Unburned | Unfenced | stemDen.ac | 171.99155 | 150.33418 | 0 | 0 | 161.8744 | 323.7488 | 323.7488 | 239.9950 | 323.7488 | 0.8740789 | -0.1115533 | 0.5643077 | -1.9032594 | 16 | 100 |
| 2018 | Burned | Fenced | stemDen.ac | 1079.16267 | 1734.30784 | 0 | 0 | 404.6860 | 971.2464 | 4856.2320 | 599.9875 | 890.3092 | 1.6070866 | 1.4074547 | 0.6373020 | 0.2513842 | 12 | 100 |
| 2018 | Burned | Unfenced | stemDen.ac | 455.27175 | 1653.14768 | 0 | 0 | 0.0000 | 0.0000 | 6636.8504 | 0.0000 | 0.0000 | 3.6311229 | 3.2503884 | 0.5643077 | 9.2236048 | 16 | 100 |
| 2018 | Unburned | Fenced | stemDen.ac | 927.09884 | 1493.57705 | 0 | 0 | 161.8744 | 1375.9324 | 5665.6040 | 239.9950 | 1254.5266 | 1.6110225 | 1.7655728 | 0.3574838 | 2.1870893 | 44 | 100 |
| 2018 | Unburned | Unfenced | stemDen.ac | 59.25759 | 112.89577 | 0 | 0 | 0.0000 | 0.0000 | 323.7488 | 0.0000 | 0.0000 | 1.9051696 | 1.5847684 | 0.2284345 | 0.9025237 | 112 | 100 |
## short samplings
asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(shortTall == "short") %>%
# filter(is.na(REMOVED)) %>%
# filter(BURNED == "Unburned") %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(FENCED == "Fenced") %>%
# filter(SITE_TYPE == "AC") %>%
# filter(timeClass %in% c('BL','2013','2018')) %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
group_by(timeClass, BURNED, FENCED) %>%
descr(stemDen.ac) %>%
tb() %>%
gt() %>%
tab_header(title = "AC live density, short saplings (<1.5m): tcxburnedxfenced")| AC live density, short saplings (<1.5m): tcxburnedxfenced | ||||||||||||||||||
| timeClass | BURNED | FENCED | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | skewness | se.skewness | kurtosis | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Burned | Fenced | stemDen.ac | 1591.7649 | 2076.5821 | 0 | 0.0000 | 566.5604 | 4046.8600 | 4370.609 | 839.9824 | 3318.4252 | 1.3045784 | 0.44782279 | 0.8451543 | -1.966901 | 6 | 100 |
| BL | Unburned | Fenced | stemDen.ac | 2401.1369 | 4784.6440 | 0 | 0.0000 | 809.3720 | 1942.4928 | 21529.295 | 1199.9749 | 1780.6184 | 1.9926577 | 2.83582908 | 0.4268924 | 7.568623 | 30 | 100 |
| 2013 | Burned | Fenced | stemDen.ac | 2625.9625 | 1955.5636 | 0 | 647.4976 | 3075.6136 | 3884.9856 | 5341.855 | 1679.9649 | 3237.4880 | 0.7447036 | -0.24593233 | 0.7171372 | -1.669622 | 9 | 100 |
| 2013 | Unburned | Fenced | stemDen.ac | 1309.7111 | 2357.0532 | 0 | 161.8744 | 485.6232 | 1294.9952 | 12302.454 | 719.9850 | 1133.1208 | 1.7996742 | 3.22604665 | 0.4086354 | 11.688084 | 33 | 100 |
| 2018 | Burned | Fenced | stemDen.ac | 683.4697 | 535.5192 | 0 | 323.7488 | 647.4976 | 1133.1208 | 1456.870 | 719.9850 | 809.3720 | 0.7835303 | 0.06607366 | 0.7171372 | -1.657829 | 9 | 100 |
| 2018 | Unburned | Fenced | stemDen.ac | 431.6651 | 590.1574 | 0 | 0.0000 | 161.8744 | 647.4976 | 2751.865 | 239.9950 | 647.4976 | 1.3671652 | 2.13588690 | 0.4086354 | 5.063576 | 33 | 100 |
asp.tally.ht.tidy %>%
filter(SITE_TYPE == "AC") %>%
filter(shortTall == "tall") %>%
# filter(is.na(REMOVED)) %>%
# filter(BURNED == "Unburned") %>%
filter(LIVE_DEAD == "LIVE") %>%
filter(FENCED == "Fenced") %>%
# filter(SITE_TYPE == "AC") %>%
# filter(timeClass %in% c('BL','2013','2018')) %>%
group_by(SITE_ID, timeClass) %>%
mutate(sumStem = sum(stemTally)) %>%
ungroup() %>%
mutate(percentTot = stemTally/sumStem) %>%
group_by(timeClass, BURNED, FENCED) %>%
descr(stemDen.ac) %>%
tb() %>%
gt() %>%
tab_header(title = "AC live density, tall saplings (1.5-2.5m): tcxburnedxfenced")| AC live density, tall saplings (1.5-2.5m): tcxburnedxfenced | ||||||||||||||||||
| timeClass | BURNED | FENCED | variable | mean | sd | min | q1 | med | q3 | max | mad | iqr | cv | skewness | se.skewness | kurtosis | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| BL | Burned | Fenced | stemDen.ac | 0.00000 | 0.00000 | 0.0000 | 0.0000 | 0.0000 | 0.000 | 0.0000 | 0.000 | 0.000 | NaN | NaN | 1.0141851 | NaN | 4 | 100 |
| BL | Unburned | Fenced | stemDen.ac | 16.18744 | 49.82389 | 0.0000 | 0.0000 | 0.0000 | 0.000 | 161.8744 | 0.000 | 0.000 | 3.0779351 | 2.46918790 | 0.5121033 | 4.3202778 | 20 | 100 |
| 2013 | Burned | Fenced | stemDen.ac | 0.00000 | 0.00000 | 0.0000 | 0.0000 | 0.0000 | 0.000 | 0.0000 | 0.000 | 0.000 | NaN | NaN | 0.8451543 | NaN | 6 | 100 |
| 2013 | Unburned | Fenced | stemDen.ac | 1162.55251 | 1410.86674 | 0.0000 | 0.0000 | 728.4348 | 1456.870 | 4694.3576 | 1079.977 | 1416.401 | 1.2135940 | 1.27924401 | 0.4909618 | 0.5559957 | 22 | 100 |
| 2018 | Burned | Fenced | stemDen.ac | 1079.16267 | 770.67629 | 161.8744 | 323.7488 | 1052.1836 | 1780.618 | 2104.3672 | 1079.977 | 1133.121 | 0.7141428 | 0.07962377 | 0.8451543 | -1.8752884 | 6 | 100 |
| 2018 | Unburned | Fenced | stemDen.ac | 654.85553 | 917.71068 | 0.0000 | 0.0000 | 323.7488 | 1133.121 | 3723.1112 | 479.990 | 1011.715 | 1.4013941 | 1.81977338 | 0.4909618 | 3.0933311 | 22 | 100 |
###### WRITE to disk for statistical analysis
asp.tally.dbh.tidy %>%
write_csv("./output/exported_data/asp_dbh_perc1_20210601.csv")
# asp.tally.ht.tidy %>%
# write_csv("./output/exported_data/asp_ht_perc1_20200309.csv")*Increase in aspen regeneration above the baseline level of 13 percent to at least 45 percent of winter range stands (presence of stems less than 2 cm dbh reaching 1.5–2.5 m tall).
*Progressive shift in the distribution of stem sizes toward the desired future condition of 75 percent small-diameter stems, 20 percent medium-diameter stems, and 5 percent large-diameter stems.
## identify the "in desired future condition" plots
ht.perc01 <- ht.perc01 %>%
mutate(inDesFC = case_when(
stemDen.ha >= 400 & HTclass2 == "151-200cm" ~ "in_dfc",
stemDen.ha >= 400 & HTclass2 == "201-250cm" ~ "in_dfc",
TRUE ~ "out_dfc"))
# ht.perc01 %>%
# View()
ht.perc01 %>% distinct(RANGE_TYPE)## # A tibble: 3 x 1
## RANGE_TYPE
## <chr>
## 1 core winter range
## 2 Kawuneeche Valley
## 3 non-core winter range## in DFC summary
asp_inDFC_summary <- ht.perc01 %>%
group_by(RANGE_TYPE, FENCED, timeClass, inDesFC) %>%
summarise(n_dfc = n()) %>%
ungroup() %>%
group_by(RANGE_TYPE, FENCED, timeClass) %>%
mutate(n_tot = sum(n_dfc)) %>%
ungroup() %>%
mutate(perc_inDFC = n_dfc/n_tot * 100) %>%
mutate(perc_inDFC = round(perc_inDFC, 1))
asp_inDFC_summary %>%
filter(inDesFC == "in_dfc") %>%
gt() %>%
tab_header(title = "percent plots in DFC")| percent plots in DFC | ||||||
| RANGE_TYPE | FENCED | timeClass | inDesFC | n_dfc | n_tot | perc_inDFC |
|---|---|---|---|---|---|---|
asp_inDFC_summary %>%
filter(inDesFC == "in_dfc") %>%
gt() %>%
tab_header(title = "percent plots in DFC")| percent plots in DFC | ||||||
| RANGE_TYPE | FENCED | timeClass | inDesFC | n_dfc | n_tot | perc_inDFC |
|---|---|---|---|---|---|---|
## in DFC summary
asp_inDFC_summary2 <- ht.perc01 %>%
filter(SITE_TYPE == "AC" | SITE_TYPE == "ANC") %>%
group_by(FENCED, timeClass, inDesFC) %>%
summarise(n_dfc = n()) %>%
ungroup() %>%
group_by(FENCED, timeClass) %>%
mutate(n_tot = sum(n_dfc)) %>%
ungroup() %>%
mutate(perc_inDFC = n_dfc/n_tot * 100) %>%
mutate(perc_inDFC = round(perc_inDFC, 1))
asp_inDFC_summary2 %>%
filter(inDesFC == "in_dfc") %>%
gt() %>%
tab_header(title = "percent plots in DFC")| percent plots in DFC | |||||
| FENCED | timeClass | inDesFC | n_dfc | n_tot | perc_inDFC |
|---|---|---|---|---|---|
# asp1 <- read_excel("data/EVMP_data/TenYearReview/Aspen_Data_Baseline_through_2018.xlsx")
# View(Aspen_Data_Baseline_through_2018)Animal signs
## distinct animal species codes
asp.siteinfo2018 %>%
filter(!is.na(ANIMAL_SIGN_TYPE)) %>%
clean_names("screaming_snake") %>%
distinct(ANIMAL_SIGN_SPECIES) %>%
mutate(deer = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "D")) %>%
mutate(elk = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "E")) %>%
mutate(moose = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "M")) %>%
mutate(elk = case_when(ANIMAL_SIGN_SPECIES == "NONE" ~ FALSE,
TRUE ~ elk))## # A tibble: 9 x 4
## ANIMAL_SIGN_SPECIES deer elk moose
## <chr> <lgl> <lgl> <lgl>
## 1 M_E FALSE TRUE TRUE
## 2 E FALSE TRUE FALSE
## 3 E_D_M TRUE TRUE TRUE
## 4 D TRUE FALSE FALSE
## 5 NONE FALSE FALSE FALSE
## 6 E_M FALSE TRUE TRUE
## 7 M FALSE FALSE TRUE
## 8 E_D TRUE TRUE FALSE
## 9 D_E TRUE TRUE FALSEasp.siteinfo2018 <- asp.siteinfo2018 %>%
mutate(SITE_TYPE = as_factor(SITE_TYPE)) %>%
mutate(SITE_TYPE = fct_relevel(SITE_TYPE, "AK", after = Inf)) %>%
mutate(BURNED = case_when(BURNED == "Y" ~ "Burned",
BURNED == "N" ~ "Unburned"))
## attribute the animal type
asp.animal.sign <- asp.siteinfo2018 %>%
filter(!is.na(ANIMAL_SIGN_TYPE)) %>%
clean_names("screaming_snake") %>%
select(c(SITE_TYPE,SITE_ID, BURNED, STAND_TYPE, BARK_SCARRING_CLASS, DATE, contains("ANIM"))) %>%
mutate(DATE = date(DATE)) %>%
mutate(yr = as.integer(year(DATE))) %>%
mutate(deer = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "D")) %>%
mutate(elk = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "E")) %>%
mutate(moose = str_detect(string = ANIMAL_SIGN_SPECIES,pattern = "M")) %>%
mutate(elk = case_when(ANIMAL_SIGN_SPECIES == "NONE" ~ FALSE,
TRUE ~ elk))
## tally and calculate the proportion of plots with sign
asp.sign.summary <- asp.animal.sign %>%
pivot_longer(cols = c(deer, elk, moose),
names_to = "animal",
values_to = "present") %>%
group_by(yr, SITE_TYPE, animal, present) %>%
tally() %>%
ungroup() %>%
group_by(yr, SITE_TYPE, animal) %>%
mutate(tot_pa = sum(n)) %>%
ungroup() %>%
mutate(perc_plots = round(n/tot_pa,2)) %>%
mutate(present = case_when(present == TRUE ~ "present",
present == FALSE ~ "absent"))asp.sign.summary %>%
# filter(SITE_TYPE== "AK") %>%
ggplot(aes(animal, perc_plots)) +
geom_col(aes(fill=present), color = "grey50", size=0.5) +
theme_minimal() +
facet_wrap(~SITE_TYPE) +
scale_y_continuous(labels=scales::percent) +
scale_fill_grey(start = 0.2, end = 0.8) +
# scale_fill_manual(values = c("grey90", "grey40")) +
# scale_fill_manual(values = colfunc3(2)) +
labs(x="", y = "Percent of plots", fill = "") 
ggsave("./output/figures_202108/asp_animal_presence_2018.png", width=6, height = 5, dpi=300)
## plot - animal presence by species and site type
pl.animal.ak <- asp.sign.summary %>%
filter(SITE_TYPE== "AK") %>%
ggplot(aes(animal, perc_plots)) +
geom_col(aes(fill=present), color = "grey50", size=0.5) +
theme_minimal() +
# facet_wrap(~SITE_TYPE) +
scale_y_continuous(labels=scales::percent) +
# scale_fill_manual(values = c("grey20", "grey70")) +
# scale_fill_manual(values = colfunc3(2)) +
# scale_fill_manual(values = c("grey90", "grey40")) +
scale_fill_grey(start = 0.2, end = 0.8) +
theme(legend.position = "none") +
labs(title= "Kawuneeche Valley", x="", y = "Percent of plots", fill = "")
# pl.animal.ak
## incorporating burned 2012
asp.sign.summary.b <- asp.animal.sign %>%
pivot_longer(cols = c(deer, elk, moose),
names_to = "animal",
values_to = "present") %>%
group_by(yr, SITE_TYPE, BURNED, animal, present) %>%
tally() %>%
ungroup() %>%
group_by(yr, SITE_TYPE, BURNED, animal) %>%
mutate(tot_pa = sum(n)) %>%
ungroup() %>%
mutate(perc_plots = round(n/tot_pa,2)) %>%
mutate(present = case_when(present == TRUE ~ "present",
present == FALSE ~ "absent"))
## plot - animal presence by species and site type
pl.animal.acanc.burn <- asp.sign.summary.b %>%
filter(SITE_TYPE != "AK") %>%
ggplot(aes(animal, perc_plots)) +
geom_col(aes(fill=present), color = "grey50", size=0.5) +
# geom_text(aes(label = n, group = present),
# position = position_stack(vjust = .5), color = "grey70", size=.5) +
theme_minimal() +
facet_grid(BURNED~SITE_TYPE) +
scale_y_continuous(labels=scales::percent) +
# scale_fill_manual(values = c()) +
# scale_fill_manual(values = colfunc3(2)) +
# scale_fill_manual(values = c("grey90", "grey40")) +
scale_fill_grey(start = 0.2, end = 0.8) +
theme(legend.position = "bottom") +
labs(x="", y = "Percent of plots", fill = "", title="Winter Range")
# pl.animal.acanc.burn
# ggsave("./output/figures_202108/asp_animal_presence_2018_burned.png", width=6.5, height = 5, dpi=300)
# ggsave("./output/figures_202108/asp_animal_presence_2018_burned.pdf", width=6.5, height = 5)
pl.animal.acanc.burn + pl.animal.ak + plot_layout(widths = c(2,1)) +plot_annotation(caption = "asp_animal_presence_2018_3_panel_burned.png")
ggsave("./output/figures_202108/asp_animal_presence_2018_3_panel_burned.png", width=6.5, height = 3.75, dpi=300)asp.sign.summary.b %>%
select(-yr) %>%
arrange(SITE_TYPE, animal, present) %>%
filter(SITE_TYPE != "AK") %>%
gt() %>%
tab_header(title = "Summary animal observations in aspen plots", subtitle = "2018 data, 2012 burned status")| Summary animal observations in aspen plots | ||||||
| 2018 data, 2012 burned status | ||||||
| SITE_TYPE | BURNED | animal | present | n | tot_pa | perc_plots |
|---|---|---|---|---|---|---|
| AC | Burned | deer | absent | 7 | 7 | 1.00 |
| AC | Unburned | deer | absent | 33 | 39 | 0.85 |
| AC | Unburned | deer | present | 6 | 39 | 0.15 |
| AC | Burned | elk | absent | 4 | 7 | 0.57 |
| AC | Unburned | elk | absent | 19 | 39 | 0.49 |
| AC | Burned | elk | present | 3 | 7 | 0.43 |
| AC | Unburned | elk | present | 20 | 39 | 0.51 |
| AC | Burned | moose | absent | 6 | 7 | 0.86 |
| AC | Unburned | moose | absent | 25 | 39 | 0.64 |
| AC | Burned | moose | present | 1 | 7 | 0.14 |
| AC | Unburned | moose | present | 14 | 39 | 0.36 |
| ANC | Burned | deer | absent | 1 | 1 | 1.00 |
| ANC | Unburned | deer | absent | 17 | 20 | 0.85 |
| ANC | Unburned | deer | present | 3 | 20 | 0.15 |
| ANC | Unburned | elk | absent | 6 | 20 | 0.30 |
| ANC | Burned | elk | present | 1 | 1 | 1.00 |
| ANC | Unburned | elk | present | 14 | 20 | 0.70 |
| ANC | Unburned | moose | absent | 11 | 20 | 0.55 |
| ANC | Burned | moose | present | 1 | 1 | 1.00 |
| ANC | Unburned | moose | present | 9 | 20 | 0.45 |
Upland line intercept
## Data munging
# Data import
## all sheets
uli <- readxl::excel_sheets("data/EVMP_data/TenYearReview/Upland_Line_Intercept_2007_2013_2018.xlsx")
## 2007
b2007 <- readxl::read_excel("data/EVMP_data/TenYearReview/Upland_Line_Intercept_2007_2013_2018.xlsx",sheet = 2) %>%
mutate(yr = 2007)
b2013 <- readxl::read_excel("data/EVMP_data/TenYearReview/Upland_Line_Intercept_2007_2013_2018.xlsx",sheet = 3) %>%
mutate(yr = 2013)
b2018 <- readxl::read_excel("data/EVMP_data/TenYearReview/Upland_Line_Intercept_2007_2013_2018.xlsx",sheet = 4) %>%
mutate(yr = 2018) %>%
mutate(SHRUB_HEIGHT_CM = as.character(SHRUB_HEIGHT_CM))
# combine 07 and 13
upl.li <- bind_rows(b2007,b2013)
## bring in the 2018
upl.li <- upl.li %>%
bind_rows(., b2018)
# janitor::excel_numeric_to_date()
######### DEAL WITH NA #############
na_strings <- c("NA", "N A", "N / A", "N/A", "N/ A", "Not Available", "NOt available")
upl.li <- upl.li %>%
naniar::replace_with_na_all(condition = ~.x %in% na_strings) %>%
mutate(DATE = as.numeric(DATE))
upl.li <- upl.li %>%
clean_names()## expand site type
upl.li <- upl.li %>%
mutate(site_type = case_when(site_type == "UC" ~ "core range",
site_type == "UNC" ~ "non-core range",
TRUE ~ site_type))
### clean
upl.li <- upl.li %>%
mutate(site_id = case_when(site_id == "UC1" ~ "UC01",
site_id == "UC2" ~ "UC02",
site_id == "UC3" ~ "UC03",
site_id == "UC5" ~ "UC05",
site_id == "UC8" ~ "UC08",
site_id == "UC9" ~ "UC09",
site_id == "UNC2" ~ "UNC02",
site_id == "UNC4" ~ "UNC04",
site_id == "UNC5" ~ "UNC05",
site_id == "UNC6" ~ "UNC06",
site_id == "UNC8" ~ "UNC08",
site_id == "UNC9" ~ "UNC09",
TRUE ~ site_id))
# upl.li %>%
# filter(str_detect(string = site_id,pattern = "UNC")) %>%
# tabyl(site_id)
#
# upl.li %>%
# distinct(yr, site_id, site_type) %>%
# tabyl(yr, site_type)
#
# upl.li %>%
# distinct(yr, site_type, shrub_species) %>%
# tabyl(yr, site_type, shrub_species)
upl.li <- upl.li %>%
mutate(shrub_height_cm = as.numeric(shrub_height_cm)) %>%
mutate(yr = as_factor(yr)) %>%
mutate(shrub_species = toupper(shrub_species))
upl.li <- upl.li %>%
mutate(shrub_species = case_when(shrub_species == "ROSA" ~ "ROWO",
TRUE ~ shrub_species))
upl.li <- upl.li %>%
group_by(yr, shrub_species) %>%
mutate(n_spp = n()) %>%
ungroup### Shrub cover
upl.ht.sel <- upl.li %>%
select(
date,
site_id,
site_number,
site_type,
shrub_species,
shrub_height_cm,
line_intercept_length_m,
yr
) %>%
distinct()
## calculate the cover for all shrub species pooled together
upl.allspp.cover <- upl.ht.sel %>%
group_by(site_id, yr, site_type) %>%
summarise(tot_intercept_m = sum(line_intercept_length_m)) %>%
ungroup() %>%
mutate(perc_cover = tot_intercept_m/30*100) %>%
filter(!is.na(perc_cover)) %>%
filter(perc_cover > 0)
## calculate the cover for shrubd BY species
upl.spp.cover <- upl.ht.sel %>%
group_by(site_id, yr, site_type, shrub_species) %>%
summarise(tot_intercept_m = sum(line_intercept_length_m)) %>%
ungroup() %>%
mutate(perc_cover = tot_intercept_m/30*100) %>%
filter(!is.na(perc_cover)) %>%
filter(perc_cover > 0)
### write to disk
# write_csv(upl.allspp.cover, path = "./output/exported_data/upland_LI_allShrubsPooled_20200814.csv")
# write_csv(upl.spp.cover, path = "./output/exported_data/upland_LI_byShrubSpp_20200814.csv")#!!!
## address factor levels
upl.allspp.cover <- upl.allspp.cover %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = case_when(yr == "2007" ~ "BL",
TRUE ~ yr)) %>%
mutate(yr = fct_relevel(yr, "BL","2013","2018"))
# address request for change in fill 2022
upl.allspp.cover <- upl.allspp.cover %>%
mutate(site_type = case_when(site_type == "core range" ~ "core winter range",
site_type == "non-core range" ~ "noncore winter range",
TRUE ~ site_type))### All shrub species: site type
## boxplot
upl.cova <- upl.allspp.cover %>%
ggplot(aes(yr, perc_cover)) +
geom_boxplot(fill="grey50") +
# scale_fill_manual(values = c("ivory", "ivory4")) +
# scale_fill_manual(values = c("grey90")) +
theme_minimal() +
labs(x = "Year", y = "Shrub canopy cover (%)", fill = "")
# labs(x = "", y = "% cover", fill = "", caption = "Upland cover, all shrubs spp and UC UNC sites combined")
upl.cova
# ggsave("./output/figures_202108/upland_species_cover_allspp_sites_combined.png", width = 4.5, height = 3.75, dpi = 300)### All shrub species: by site type
## boxplot
upl.covb <- upl.allspp.cover %>%
ggplot(aes(yr, perc_cover)) +
geom_boxplot(aes(fill = site_type), position = "dodge") +
# scale_fill_manual(values = c("ivory", "ivory4")) +
scale_fill_manual(values = c("grey90","grey50")) +
theme_minimal() +
labs(x = "Year", y = "Shrub canopy cover (%)", fill = "")
upl.covb
# ggsave("./output/figures_202108/upland_species_cover_allspp.png", width = 4.5, height = 3.75, dpi = 300)
## combine plots
#cowplot::plot_grid(upl.cova, upl.covb, labels = "AUTO",rel_widths = c(1, 2))
# ggsave("./output/figures_202108/upland_species_cover_allspp_2panel.png", width = 5.75, height = 3.75, dpi = 300)# Fig 22 revised 2022
## combine plots
cowplot::plot_grid(upl.cova, upl.covb, labels = "AUTO",rel_widths = c(1, 2))
ggsave("./output/figures_202202/Fig22_upland_species_cover_allspp_2panel.png", width = 6, height = 3.75, dpi = 300)
ggsave("./output/figures_202202/Fig22_upland_species_cover_allspp_2panel.pdf", width = 6, height = 3.75)## summary table
upl.allspp.cover %>%
group_by(yr, site_type) %>%
# filter(timeClass == "BL" | timeClass == "2013" | timeClass == "2018") %>%
descr(perc_cover, stats = "common") %>%
summarytools::tb() %>%
mutate(across(c('mean','sd','min','med','max','pct.valid'), ~round(.,digits = 1))) %>%
gt() %>%
tab_header(title = "Upland LI, Cover", subtitle = "All shrub species, all site types")| Upland LI, Cover | |||||||||
| All shrub species, all site types | |||||||||
| yr | site_type | variable | mean | sd | min | med | max | n.valid | pct.valid |
|---|---|---|---|---|---|---|---|---|---|
| BL | core winter range | perc_cover | 13.3 | 8.8 | 2.0 | 11.0 | 31.0 | 21 | 100 |
| BL | noncore winter range | perc_cover | 21.2 | 15.0 | 1.3 | 19.5 | 47.3 | 20 | 100 |
| 2013 | core winter range | perc_cover | 10.8 | 8.1 | 0.3 | 8.8 | 24.3 | 20 | 100 |
| 2013 | noncore winter range | perc_cover | 24.3 | 19.7 | 1.7 | 19.0 | 66.3 | 22 | 100 |
| 2018 | core winter range | perc_cover | 13.6 | 8.0 | 1.7 | 12.7 | 34.3 | 18 | 100 |
| 2018 | noncore winter range | perc_cover | 20.1 | 15.1 | 0.3 | 18.7 | 56.7 | 22 | 100 |
upl.allspp.cover %>%
group_by(yr, site_type) %>%
summarytools::descr() %>%
summarytools::tb() %>%
filter(variable == "perc_cover") %>%
select(yr,
contains("me"),
contains("site"),
contains("sd"),
contains("q")) ## # A tibble: 6 x 8
## yr mean med site_type sd q1 q3 iqr
## <fct> <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 BL 13.3 11 core winter range 8.76 6.67 17 10.3
## 2 BL 21.2 19.5 noncore winter range 15.0 6.83 33.7 25.6
## 3 2013 10.8 8.83 core winter range 8.11 4.33 19.2 13.9
## 4 2013 24.3 19 noncore winter range 19.7 6 36 28.3
## 5 2018 13.6 12.7 core winter range 8.04 7.33 17.7 9.08
## 6 2018 20.1 18.7 noncore winter range 15.1 9.33 30.7 21.2# upl.allspp.cover.summary %>%
# gt()upl.spp.cover %>%
group_by(yr, site_type, shrub_species) %>%
summarytools::descr() %>%
summarytools::tb() %>%
filter(variable == "perc_cover") %>%
datatable(filter = "top")# Fig 23 revised 2022
## Height
### select upland species
#!!!
## address factor levels
upl.li <- upl.li %>%
mutate(yr = as.character(yr)) %>%
mutate(yr = case_when(yr == "2007" ~ "BL",
TRUE ~ yr)) %>%
mutate(yr = fct_relevel(yr, "BL","2013","2018")) %>%
mutate(site_type = case_when(site_type == "core range" ~ "core winter range",
site_type == "non-core range" ~ "noncore winter range",
TRUE ~ site_type))
upl.li %>%
# baseline %>%
filter(n_spp >30) %>%
ggplot(aes(yr, shrub_height_cm)) +
geom_boxplot(aes(fill = site_type)) +
theme_minimal() +
# scale_fill_manual(values = c("ivory1","ivory4")) +
scale_fill_manual(values = c("grey90","grey40")) +
facet_wrap(~shrub_species, scale = 'free_y') +
theme(legend.position = "bottom") +
labs(x = "Year", y = "Maximum shrub height (cm)", fill = "")
ggsave("./output/figures_202202/Fig23_upland_species_max_ht.png", width = 6.5, height = 4.25, dpi = 300)
ggsave("./output/figures_202202/Fig23_upland_species_max_ht.pdf", width = 6.5, height = 4.25)Wild Basin Comparisons
wbasin <- read_csv("./data/wild_basin/Wild Basin willow data survey 2018.csv")
wbasin <- wbasin %>%
janitor::clean_names()
wbasin.sel <- wbasin %>%
rename(plant_ht_cm = max_ht_cm) %>%
mutate(yr = 2018) %>%
mutate(fenced = "N") %>%
mutate(site_type = "WB") %>%
mutate(site_id = paste0("WB",point)) %>%
dplyr::select(c(yr, site_type, site_id, plant_ht_cm, species, fenced, location)) %>%
distinct()# exp lu
csv.all.lc.mcro.df.cln <- csv.all.lc.mcro.df %>%
clean_names()
willow.mcro.evmp <- csv.all.lc.mcro.df.cln %>%
rename(species = species_code) %>%
dplyr::select(yr, site_type, species, site_id, plant_ht_cm, fenced, location) %>%
distinct()
willow.mcro.evmp18 <- willow.mcro.evmp %>%
filter(yr == 2018)
#### bind wb with 2018 evmp
wb.evmp18 <- bind_rows(wbasin.sel, willow.mcro.evmp18) %>%
distinct()### Willow height comparison among Wild Basin and EVMP plots
## compare WILLOW height
wb.evmp18 %>%
filter(str_detect(species, "^S")) %>%
ggplot() +
geom_density(aes(fill = site_type, color = site_type, lty = site_type, x = plant_ht_cm), size=1, alpha = .2) +
theme_minimal() +
scale_fill_manual(values = colfunc3_RdBu(4)) +
scale_color_manual(values = colfunc3_RdBu(4)) +
labs(x = "Willow height (cm)", y = "Density", lty= "Site type", color = "Site type", fill = "Site type", caption = "willow height, WB + EVMP, Salix only \n WB_EVMP_willow_height.png")
ggsave("./output/figures_202108/WB_EVMP_willow_height.png", dpi = 300, width = 4.75, height = 3.75)wb.evmp18 <- wb.evmp18 %>%
mutate(site_type.lbl = case_when(site_type == "WB" ~ "Wild Basin",
site_type == "WC" ~ "Core winter range",
site_type == "WNC" ~ "Noncore winter range",
site_type == "WK" ~ "Kawuneeche Valley",
TRUE ~ "other")) %>%
mutate(fenced = case_when(fenced == "N" ~ "Unfenced",
fenced == "Y" ~ "Fenced",
TRUE ~ fenced)) %>%
mutate(site.type.fenced = paste0(site_type.lbl,"\n",fenced))
# wb.evmp18 %>% distinct(site.type.fenced)
wb.evmp18.willows <- wb.evmp18 %>%
filter(str_detect(species, "^S"))wb.evmp18 %>%
filter(str_detect(species, "^S")) %>%
ggplot(aes(x=reorder(site.type.fenced, plant_ht_cm), plant_ht_cm)) +
geom_boxplot(aes(fill=site_type)) +
# geom_density(aes(fill = site_type, color = site_type, lty = site_type, x = plant_ht_cm), alpha = 0.05) +
theme_minimal() +
# scale_fill_manual(values = colfunc2alt(4)) +
scale_fill_grey(start=0.2, end = 0.8) +
# scale_color_manual(values = colfunc2(4)) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 35, hjust = 1)) +
labs(x = "", y = "Height (cm)", lty= "Site type", color = "Site type", fill = "Site type", caption = "willow height, WB + EVMP, Salix only \n WB_EVMP_willow_height_boxplot.png")
ggsave("./output/figures_202108/WB_EVMP_willow_height_boxplot.png", dpi = 300, width = 5.75, height = 4.75)
# 2 panel
pl.boxht.wc.f <- wb.evmp18 %>%
filter(str_detect(species, "^S")) %>%
filter(site_type == "WC" & fenced == "Fenced") %>%
ggplot(aes(x=reorder(site.type.fenced, plant_ht_cm), plant_ht_cm)) +
geom_boxplot(aes(fill=site_type)) +
# geom_density(aes(fill = site_type, color = site_type, lty = site_type, x = plant_ht_cm), alpha = 0.05) +
theme_minimal() +
# scale_fill_manual(values = colfunc2(5)) +
scale_fill_manual(values = colfunc2alt(5)) +
# scale_color_manual(values = colfunc2(5)) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "", y = "Height (cm)", lty= "Site type", color = "Site type", fill = "Site type", caption = "willow height, all willow spp") +
ylim(0,600) +
facet_wrap(~fenced, scales = "free_x")
pl.boxht.uf.all <- wb.evmp18 %>%
filter(str_detect(species, "^S")) %>%
filter(fenced == "Unfenced") %>%
ggplot(aes(x=reorder(site.type.fenced, plant_ht_cm), plant_ht_cm)) +
geom_boxplot(aes(fill=site_type)) +
# geom_density(aes(fill = site_type, color = site_type, lty = site_type, x = plant_ht_cm), alpha = 0.05) +
theme_minimal() +
scale_fill_manual(values = colfunc2(4)) +
scale_color_manual(values = colfunc2(4)) +
theme(legend.position = "none") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = "", y = "", lty= "Site type", color = "Site type", fill = "Site type") +
ylim(0,600) +
facet_wrap(~fenced, scales = "free_x")
pl.boxht.wc.f + pl.boxht.uf.all + plot_layout(widths = c(.5,2))
ggsave("./output/figures_202108/WB_EVMP_willow_height_boxplot2.png", dpi = 300, width = 6.75, height = 4.75)wb.evmp18 %>%
group_by(site.type.fenced, fenced) %>%
descr(plant_ht_cm) %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
arrange(-mean) %>%
datatable(caption = "All willow species combined")wb.evmp18 %>%
group_by(site.type.fenced, species) %>%
descr(plant_ht_cm) %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
arrange(-mean) %>%
datatable(caption = "By willow species")wb.evmp18.willows.loc <- wb.evmp18.willows %>%
select(-yr) %>%
group_by(site_id,location) %>%
summarytools::descr(stats = "common") %>%
tb() %>%
select(c(location,mean)) %>%
group_by(location) %>%
descr(mean,stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
select(-pct.valid)
# wb.evmp18.willows.loc %>%
# gt() %>%
# gt::gtsave(filename = "./output/tables/WB_vs_EVMP_willowHt_loc.rtf")
#### range type
wb.evmp18.willows.rt <- wb.evmp18.willows %>%
select(-yr) %>%
group_by(site_id,site_type) %>%
summarytools::descr(stats = "common") %>%
tb() %>%
select(c(site_type,mean)) %>%
group_by(site_type) %>%
descr(mean,stats = "common") %>%
tb() %>%
mutate(across(where(is.numeric), round, 1)) %>%
select(-pct.valid)
# wb.evmp18.willows.rt %>%
# arrange(-mean) %>%
# select(-variable) %>%
# gt() %>%
# gt::gtsave(filename = "./output/tables/WB_vs_EVMP_willowHt_site_type.rtf")## write the combined WB18 and winter range/KV plots
wb.evmp18.willows %>%
write_csv("./data/EVMP_derived/wildbasin_evmp2018.csv")Session info
R version 4.0.3 (2020-10-10)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19041) Updated:
2022 December 12
Notes on raw data from E. Ertl
The following are notes from E. Ertl recorded in an describing EVMP vegetation data collection, as recorded in 2018.
Aspen
Plots lost: AC41 (plot was washed away in the 2013 flood)
Plots added: AC68 to replace AC41
Plots that had been treated with fuels management work that has not been noted before: ANC5, ANC7, ANC8, ANC19 (I think?) these areas were thinned of most large trees opening up the canopy substantially and the area was also pile burned; none of the plots appeared to be directly in the pile burn scars but a few came very close; these treatments could alter data in the future (working on getting a GIS layer for this)
Formatted 2015 – 2018 data. 2015-2017 data only consisted of burn plot sampling; no burn plot data collected in 2014
Upland
Plots lost: UC09 (this plot was most likely lost in the 2013 flood), UC14 & UC24 (plots were lost to waterline construction that occurred from 2015-2018)
Plots added: UC37, UC38, UC39 to replace the three plots that were lost
Plots have been treated by prescribed fire in the past; Prescribed fire occurred from 9/17 – 10/2 of 2008; First round of data collected for upland sites occurred in 2007 (working on getting recent GIS layers to account for any other treatments)
Prescribed burning is planned for this coming October 2018 as well, which will potentially burn several upland plots in the Beaver Meadows area
Formatted 2018 shrub data
Willow
Plots lost: WK03; this plot hasn’t been found since 2012 and we looked several times in 2018
Plots added: WK09 to replace WK03 (updated measurement schedule in the protocol), WK10 added late season after talking with Linda Z. – she suggested there be 4 fenced plots in the KV to make the data collected from this area more robust. We weren’t aware of this when we installed WK09, so there will be nine total west side plots (4 fenced and 5 unfenced).
Removed the microplot stem counts from the macroplot sampling in the protocol per Linda Z. early summer
Formatted 2015 – 2018 cumulative willow data 2015-2017 data only consisted of burn plot sampling; there is no burn data for 2014 In 2015 it appears they were only measuring willow in the macroplots, not all shrubs like they should have been.
Fixed unit and rounding issues in data. In 2016 the crew measured additional burned sites that are not on the burn survey list (WC32, WC34, WC78, WC84, and WC85). For some plots they only measured willow instead of measuring all shrubs. Fixed unit and rounding issues in data.
There is only west side data for 2016 and 2017; Nick B. said they weren’t aware that west side plots were supposed to be measured every year back in 2014/2015. Burn survey and west side data are currently combined by year measured
Formatted 2015 – 2018 offtake data (2014 was already added and analyzed in the 2013 review) 2015 offtake notes: Crew didn’t sample WC9, WC78, WC79 (plots are in fences) and sampled extra plots that are not on the protocol list for offtake including WC34, WC35, WC52, WC54, WC56, WK6, WK7, and WK8 (none of these are in fences)
2016 offtake notes: Crew didn’t sample WC79 (fenced), WC85 (fenced), WK3 (lost), WNC30 (couldn’t find plot) and sampled extra plots that are not on the protocol list for offtake including WC34, WC35, WC37 (fenced), WC50 (fenced), WC57, WC69, WC70, WC71, WC76 (fenced), WC81, WC82, WC83, WC86 (fenced)
2017 offtake notes: Crew didn’t sample WC76 (fenced), WC85 (fenced), WNC30 (couldn’t find plot), WK3 (lost), WK6 (river probably too high to access) and no extra plots were sampled
2018 offtake notes: Crew didn’t sample WC33 (removed 2014), WC76 (fenced), WC77 (fenced), WK3 (lost and removed from list in 2018, replaced with WK9 at end of season), WK6 (river too high to access plot)
There were discrepancies between the protocol and the willow master database on what sites to sample for offtake (added by C. Piper). Linda and I updated this schedule in the protocol for future years because the old schedule included plots that were no longer there and plots that have since been fenced.
Burn Surveys 2015-2019 – spoke with Linda Z. and she doesn’t think these need to be measured again in 2019 unless the data is showing something interesting.
Willow stake restoration sites – have these been cross referenced with willow monitoring sites? Were willow stakes planted in some plots? I did find notes that there were willow stakes being measured in WC76 over the years, which would need to be analyzed separately I’m assuming.
Other notes
Kept all of Linda’s original data for the last 5-year review under EVMP’s “analysis” folder
Created new (2018) versions of data for 10-year review analysis but did not delete out any data from previous years where plots were lost this year; also kept old components in the data (i.e. willow shoot measurements, microplot stem counts)
All formatted data for 2018 can be found under EVMPVegetationAnalysis10 Year Review
Blank datasheets have been updated for 2018
Protocols are currently being updated for 2018 and master databases have been updated for 2018.
Added a “Fuels Treatment Post Establishment” and “Treatment Year” column that could be queried by type (i.e. prescribed fire, mechanical treatments, etc.)
Created new shapefiles for all veg plots; trying to find shapefiles for treatment areas in the park and will put them in the EVMP_Veg_Data_2018 geodatabase Located under EVMPVegetationGISEVMP_Veg_Data_2018.gdb OR ShapefilesMaster_Veg_Sites_Shp2018
Created new veg maps. Located under EVMPVegetationLogisticsMapsEVMP vegetation plot maps2018 Veg Site MapsPlot Maps
Wild Basin Willow Data – I created a folder with all of the data collected at Wild Basin this fall. It is located under EVMPVegetationAnnual RecordsFY18Wild Basin – Willow Data
Uploaded all 4 iPads with new electronic datasheets for willow and upland, photo points and plot diagrams from 2018, willow ID keys, updated protocol from 2018, and new vegetation site maps.
# Data collection and management
# Streamlining data collection and data management can facilitate easier updates to the EVMP. Strategies such as the use of tablet-based field data collection apps that incorporate data integrity checks can reduce or eliminate errors that must be corrected when compiling data. Creation and maintenance of machine-readable, non-binary files (e.g., comma-separated value) as opposed to complicated spreadsheets can aid import and analysis and is often a requirement for online data depositories. One common mistake when entering data is to rely on context such as spatial layout or color to encode information. Such information can be easily lost when reading in data into other programs for analysis. Other principles can minimize friction in analysis. For example, it is generally best to put all variables in columns and put each observation or measurement into its row. Merging cells can cause problems down the road and should be avoided. Whatever approach is used for entering data, expect some degree of data wrangling and quality assurance. References
Zeigenfuss, Linda C., and Therese L. Johnson. 2015. “Monitoring of
Vegetation Response to Elk Population and Habitat Management in Rocky
Mountain National Park, 200814.” Reston, VA. https://doi.org/10.3133/ofr20151216.
Zeigenfuss, Linda C, Therese L Johnson, and Zachary Wiebe. 2011.
“Monitoring Plan for Vegetation Responses to Elk Management in
Rocky Mountain National Park.”