Chapter 7 Summarizing DSP Projects
The following scripts demonstrate a possible workflow for summarizing the vegetation data from a Dynamic Soil Properties (DSP) project. It assumes that all your data are in NASIS and that you have a all the ecological sites and community phases appropriately populated in the site and site observation tables.
7.0.1 Tabular Summaries
The goal of these tabular summaries is to compare the vegetation structure and composition of contrasting land uses.
#remotes::install_github("ncss-tech/soilDB", dependencies = FALSE) #install latest version of SoilDB package
#remotes::install_github("phytoclast/vegnasis", dependencies = FALSE) #install latest version of vegnasis package
library(soilDB)
library(vegnasis)
#Create conditional rounding functions
condRound10 <- function(x){
x <- ifelse(x < 0.05, 0, ifelse(x < 10, round(x, 1), round(x,0)))
x <- as.character(x)
return(x)
}
condRound1 <- function(x){
x <- ifelse(x < 0.05, 0, ifelse(x < 1, round(x, 1), round(x,0)))
x <- as.character(x)
return(x)
}
#Load Demo Data
siteass <- vegnasis::siteass20250414
sites <- vegnasis::sites20250414
veg.raw <- vegnasis::veg.raw20250414
vegplot <- vegnasis::vegplot20250414
vegground <- vegnasis::vegground20250414
#To use your own data, remove # below
# siteass <- get_site_association_from_NASIS(SS=F)
# sites <- get_site_data_from_NASIS_db(SS=F)
# veg.raw <- soilDB::get_vegplot_species_from_NASIS_db(SS=F)
# vegplot <- soilDB::get_vegplot_from_NASIS_db(SS=F)
# vegground <- get_vegplot_groundsurface_from_NASIS_db(SS=F)
#narrow to a project (user site association id)
thesesites <- subset(siteass, usiteassocid %in% 'DSP-F094AB019MI-2024')
sites <- subset(sites, usiteid %in% thesesites$usiteid)
landuse <- data.frame(siteobsiid=sites$siteobsiid, landuse = sites$commphasename)
landuse <- landuse |> left_join(data.frame(siteobsiid=vegplot$siteobsiid, plot = vegplot$vegplotid)) |> subset(!is.na(plot) & !is.na(landuse))
veg <- clean.veg(veg.raw)|> subset(!is.na(taxon))
veg <- veg |> inner_join(landuse)
veg <- veg |> mutate(type=NA) |> fill.type.df() |> fill.hts.df()
veg <- veg |> mutate(taxon = harmonize.taxa(veg$taxon, fix = TRUE, sensu = "usda"))
#Get vegetation Structure ----
veg.str <- veg |> get.structure(simple = TRUE)
veg.str <- veg.str |> inner_join(landuse)
veg.str.long <- tidyr::pivot_longer(veg.str, c(tree,shrub,herb,moss,ht.max))
veg.str.summary <- veg.str.long |> group_by(landuse, name) |> summarise(Low = round(quantile(value,0.05),1),
RV = round(mean(value),1),
High = round(quantile(value,0.95),1))
veg.str.wide <- tidyr::pivot_wider(veg.str.summary, names_from = landuse, values_from = c(Low,RV,High)) |> as.data.frame()
#kableextra ----
library(knitr)
library(kableExtra)
df2 <- veg.str.summary |> group_by(landuse) |> arrange()
df2$name <- factor(df2$name, levels = c('ht.max','tree','shrub','herb','moss'))
df2 <- df2[order(df2$landuse,df2$name),]
df2 |>
knitr::kable(row.names = FALSE, digits = c(0,0,0,0)) |>
remove_column(1) |>
kableExtra::group_rows(index = table(df2$landuse)) |>
# kableExtra::kable_paper("hover", full_width = F)
kable_classic(full_width = F, html_font = "Cambria")| name | Low | RV | High |
|---|---|---|---|
| Early Successional Thicket | |||
| ht.max | 4 | 7 | 11 |
| tree | 0 | 2 | 4 |
| shrub | 90 | 93 | 96 |
| herb | 29 | 44 | 65 |
| moss | 0 | 0 | 0 |
| Late Successional Forest | |||
| ht.max | 18 | 19 | 20 |
| tree | 38 | 42 | 47 |
| shrub | 28 | 53 | 74 |
| herb | 7 | 8 | 8 |
| moss | 38 | 51 | 67 |
| Young Jack Pine Plantation | |||
| ht.max | 7 | 9 | 10 |
| tree | 28 | 47 | 64 |
| shrub | 28 | 47 | 58 |
| herb | 14 | 21 | 30 |
| moss | 16 | 48 | 68 |
#flextable ----
library(flextable)
pcolors <- palette.colors(length(unique(veg.str$landuse))+1, palette = "ggplot2")
pcolors <- pcolors[2:length(pcolors)]
pcolors <- c('white',pcolors,pcolors,pcolors)
thcols <- 1:length(unique(veg.str$landuse))
thcols <- 3*thcols+1
df2 <- veg.str.wide
df2$name <- factor(df2$name, levels = c('ht.max','tree','shrub','herb','moss'))
df2 <- df2[order(df2$name),]
df2$name <- c('Maximum Height (m)','Tree (%)','Shrub (%)','Herb (%)','Moss (%)')
repnames <- colnames(df2)
repnames <- stringr::str_split_fixed(repnames, '_', 2)
repnamesA <- repnames[,2]
repnamesB <- repnames[,1]
repdf <- data.frame(A=repnamesA, B=repnamesB, C=pcolors)
repdf <- repdf |> mutate(seq = 1:nrow(repdf))
repdf <- repdf |> arrange(A)
repnames <- paste0(repnames[,2],'_',repnames[,1])
colnames(df2) <- repnames
df2 <- df2[,repdf$seq]
colnames(df2)[1]<-'Variable'
theme_design <- function(x) {
x <- border_remove(x)
std_border <- fp_border_default(width = 0.5, color = "black")
thk_border <- fp_border_default(width = 2, color = "black")
x <- fontsize(x, size = 10, part = "all")
x <- font(x, fontname = "Cambria", part = "all")
x <- align(x, align = "center", part = "all")
x <- bold(x, bold = TRUE, part = "all")
x <- bg(x, bg = "white", part = "body")
x <- bg(x, bg = repdf$C, part = "header")
x <- bg(x, bg = "white", part = "footer")
x <- color(x, color = "black", part = "all")
x <- padding(x, padding = 1, part = "all")
x <- border_outer(x, part="all", border = thk_border )
x <- border_inner_h(x, border = std_border, part="all")
x <- border_inner_v(x, border = std_border, part="all")
x <- vline(x, j = c(1,thcols), border = thk_border, part = "all")
x <- set_table_properties(x, layout = "fixed")
x
}
df2 |>
flextable() |>
separate_header() |>
autofit() |> theme_design()Variable | Early Successional Thicket | Late Successional Forest | Young Jack Pine Plantation | ||||||
|---|---|---|---|---|---|---|---|---|---|
Low | RV | High | Low | RV | High | Low | RV | High | |
Maximum Height (m) | 4.1 | 7.0 | 11.3 | 18.1 | 19.0 | 19.9 | 7.2 | 8.7 | 9.9 |
Tree (%) | 0.0 | 1.7 | 4.5 | 38.0 | 42.1 | 46.9 | 27.5 | 46.7 | 63.5 |
Shrub (%) | 90.3 | 93.4 | 96.0 | 28.3 | 53.0 | 73.6 | 28.5 | 46.6 | 57.7 |
Herb (%) | 28.8 | 44.2 | 64.9 | 7.0 | 7.7 | 8.5 | 14.1 | 21.4 | 29.7 |
Moss (%) | 0.0 | 0.1 | 0.4 | 37.6 | 51.0 | 67.2 | 16.3 | 48.4 | 67.5 |
#Species_Composition
taxon.fill <- merge(data.frame(group = unique(veg$landuse)), data.frame(taxon = unique(veg$taxon), Low = 0, RV = 0, High = 0)) |> mutate(type = vegnasis::fill.type(taxon)) |> unique()
taxon.fill <- taxon.fill[,c('group','taxon', 'type', 'Low', 'RV', 'High')]
veg.comp.summary <- veg |> summary.ESIS(group='landuse', breaks = c(5), normalize = F,
lowerQ = 0, upperQ = 1) |> ungroup()
veg.comp.summary <- veg.comp.summary |> mutate(Low = cover.Low, RV=cover.mean, High=cover.High)
overstory <- veg.comp.summary |> subset(Top > 5, select = c("group","taxon", "type","Low","RV","High"))
#add missing rows
o2 <- subset(taxon.fill, taxon %in% overstory$taxon)
o2 <- subset(o2, !paste(taxon,group) %in% paste(overstory$taxon,overstory$group) )
overstory <- overstory |> rbind(o2)
allplots <- overstory |> group_by(taxon, type) |> summarise(group = "All Landuses", Low = min(Low), RV = mean(RV), High = max(High)) |> arrange(-RV )
factorgroup <- unique(overstory$group)
factortaxon <- allplots$taxon
overstory <- rbind(overstory, allplots)
overstory$taxon <- factor(overstory$taxon, levels = factortaxon)
overstory$group <- factor(overstory$group, levels = c(factorgroup,"All Landuses"))
overstory <- overstory |> arrange(group, taxon)
overstory |>
knitr::kable(row.names = FALSE, digits = c(1,1,1,1,1)) %>%
remove_column(1) |> column_spec(1,italic=T) |>
kableExtra::group_rows(index = table(overstory$group)) |>
kable_classic(full_width = F, html_font = "Cambria")| taxon | type | Low | RV | High |
|---|---|---|---|---|
| Late Successional Forest | ||||
| Pinus banksiana | tree | 21 | 28.7 | 37.6 |
| Pinus resinosa | tree | 0 | 11.1 | 20.2 |
| Quercus velutina | tree | 0 | 5.3 | 16.0 |
| Quercus ellipsoidalis | tree | 0 | 1.7 | 5.0 |
| Abies balsamea | tree | 0 | 0.7 | 2.0 |
| Pinus strobus | tree | 0 | 0.3 | 0.8 |
| Early Successional Thicket | ||||
| Pinus banksiana | tree | 0 | 1.7 | 5.0 |
| Pinus resinosa | tree | 0 | 0.0 | 0.0 |
| Quercus velutina | tree | 0 | 0.0 | 0.0 |
| Quercus ellipsoidalis | tree | 0 | 0.0 | 0.0 |
| Abies balsamea | tree | 0 | 0.0 | 0.0 |
| Pinus strobus | tree | 0 | 0.0 | 0.0 |
| Young Jack Pine Plantation | ||||
| Pinus banksiana | tree | 25 | 46.7 | 65.0 |
| Pinus resinosa | tree | 0 | 0.0 | 0.0 |
| Quercus velutina | tree | 0 | 0.0 | 0.0 |
| Quercus ellipsoidalis | tree | 0 | 0.0 | 0.1 |
| Abies balsamea | tree | 0 | 0.0 | 0.0 |
| Pinus strobus | tree | 0 | 0.0 | 0.0 |
| All Landuses | ||||
| Pinus banksiana | tree | 0 | 25.7 | 65.0 |
| Pinus resinosa | tree | 0 | 3.7 | 20.2 |
| Quercus velutina | tree | 0 | 1.8 | 16.0 |
| Quercus ellipsoidalis | tree | 0 | 0.6 | 5.0 |
| Abies balsamea | tree | 0 | 0.2 | 2.0 |
| Pinus strobus | tree | 0 | 0.1 | 0.8 |
#Flextable ----
overstory.wide <- overstory |> mutate(Low = condRound1(Low), RV = condRound1(RV), High = condRound1(High)) |> tidyr::pivot_wider(names_from = group, values_from = c(Low,RV,High)) |> as.data.frame()
ngroups <- length(unique(overstory$group))
pcolors <- palette.colors(ngroups+1, palette = "ggplot2")
pcolors <- pcolors[2:length(pcolors)]
pcolors <- c('white','white',pcolors,pcolors,pcolors)
thcols <- 1:ngroups
thcols <- 3*thcols+2
df2 <- overstory.wide
repnames <- colnames(df2)
repnames <- stringr::str_split_fixed(repnames, '_', 2)
repnamesA <- repnames[,2]
repnamesB <- repnames[,1]
repdf <- data.frame(A=repnamesA, B=repnamesB, C=pcolors)
repdf <- repdf |> mutate(seq = 1:nrow(repdf),
seq2 = c(1:2,(1:ngroups)+2,(1:ngroups)+2,(1:ngroups)+2))
repdf <- repdf |> arrange(seq2)
repnames <- paste0(repnames[,2],'_',repnames[,1])
colnames(df2) <- repnames
df2 <- df2[,repdf$seq]
colnames(df2)[1:2]<- c('Taxon','Habit')
theme_design <- function(x) {
x <- border_remove(x)
std_border <- fp_border_default(width = 0.5, color = "black")
thk_border <- fp_border_default(width = 2, color = "black")
x <- fontsize(x, size = 10, part = "all")
x <- font(x, fontname = "Cambria", part = "all")
x <- italic(x, j=1, part = "body")
x <- align(x, align = "center", part = "all")
x <- align(x, align = "center", part = "header")
x <- align(x, align = "left", part = "body", j=1)
x <- align(x, align = "center", part = "body", j=2)
x <- bold(x, bold = TRUE, part = "all")
x <- bg(x, bg = "white", part = "body")
x <- bg(x, bg = repdf$C, part = "header")
x <- bg(x, bg = "white", part = "footer")
x <- color(x, color = "black", part = "all")
x <- padding(x, padding = 1, part = "all")
x <- border_outer(x, part="all", border = thk_border )
x <- border_inner_h(x, border = std_border, part="all")
x <- border_inner_v(x, border = std_border, part="all")
x <- vline(x, j = c(2,thcols), border = thk_border, part = "all")
x <- set_table_properties(x, layout = "fixed")
x
}
df2 |>
flextable() |>
separate_header() |>
autofit() |> theme_design()Taxon | Habit | Late Successional Forest | Early Successional Thicket | Young Jack Pine Plantation | All Landuses | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Low | RV | High | Low | RV | High | Low | RV | High | Low | RV | High | ||
Pinus banksiana | tree | 21 | 29 | 38 | 0 | 2 | 5 | 25 | 47 | 65 | 0 | 26 | 65 |
Pinus resinosa | tree | 0 | 11 | 20 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 4 | 20 |
Quercus velutina | tree | 0 | 5 | 16 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2 | 16 |
Quercus ellipsoidalis | tree | 0 | 2 | 5 | 0 | 0 | 0 | 0 | 0 | 0.1 | 0 | 0.6 | 5 |
Abies balsamea | tree | 0 | 0.7 | 2 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0.2 | 2 |
Pinus strobus | tree | 0 | 0.3 | 0.8 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0.1 | 0.8 |
#understory ----
understory <- veg.comp.summary |> subset(Top <= 5, select = c("group","taxon", "type", "Low","RV","High"))
u2 <- subset(taxon.fill, taxon %in% understory$taxon)
u2 <- subset(u2, !paste(taxon,group) %in% paste(understory$taxon,understory$group))
understory <- understory |> rbind(u2)
allplots <- understory |> group_by(taxon, type) |> summarise(group = "All Landuses", Low = min(Low), RV = mean(RV), High = max(High)) |> arrange(-RV )
keeptaxa <- subset(allplots, High >= 10)$taxon
factorgroup <- unique(understory$group)
factortaxon <- allplots$taxon
understory <- rbind(understory, allplots)
understory$taxon <- factor(understory$taxon, levels = factortaxon)
understory$group <- factor(understory$group, levels = c(factorgroup,"All Landuses"))
understory <- understory |> arrange(group, taxon) |> subset(taxon %in% keeptaxa)
options(knitr.kable.NA = '-')
understory |> #mutate(Low = condRound1(Low), RV = condRound1(RV), High = condRound1(High)) |>
knitr::kable(row.names = FALSE, digits = c(1,1,1,1,1)) %>%
remove_column(1) |> column_spec(1,italic=T) |>
kableExtra::group_rows(index = table(understory$group)) |>
kable_classic(full_width = F, html_font = "Cambria")| taxon | type | Low | RV | High |
|---|---|---|---|---|
| Late Successional Forest | ||||
| Vaccinium angustifolium | shrub/vine | 20.0 | 34.7 | 49.0 |
| Carex pensylvanica | grass/grasslike | 5.0 | 6.0 | 7.0 |
| Quercus ellipsoidalis | tree | 0.0 | 21.9 | 60.3 |
| Pleurozium schreberi | moss | 20.0 | 33.3 | 60.0 |
| Dicranum polysetum | moss | 15.0 | 21.7 | 30.0 |
| Cladina rangiferina | lichen | 1.0 | 5.3 | 10.0 |
| Pinus banksiana | tree | 0.1 | 0.9 | 2.3 |
| Pteridium aquilinum | forb | 0.0 | 0.8 | 2.0 |
| Comptonia peregrina | shrub/vine | 0.1 | 0.5 | 1.2 |
| Arctostaphylos uva-ursi | shrub/vine | 0.0 | 0.4 | 1.0 |
| Polytrichum | moss | 0.0 | 0.0 | 0.0 |
| Melampyrum lineare | forb | 0.1 | 0.3 | 0.6 |
| Prunus pumila | shrub/vine | 0.0 | 0.1 | 0.2 |
| Quercus velutina | tree | 0.0 | 1.6 | 4.9 |
| Gaultheria procumbens | shrub/vine | 0.0 | 4.0 | 11.0 |
| Early Successional Thicket | ||||
| Vaccinium angustifolium | shrub/vine | 72.0 | 83.0 | 90.0 |
| Carex pensylvanica | grass/grasslike | 6.0 | 23.7 | 50.0 |
| Quercus ellipsoidalis | tree | 0.2 | 15.8 | 33.2 |
| Pleurozium schreberi | moss | 0.0 | 0.0 | 0.0 |
| Dicranum polysetum | moss | 0.0 | 0.0 | 0.0 |
| Cladina rangiferina | lichen | 0.0 | 0.1 | 0.2 |
| Pinus banksiana | tree | 16.5 | 25.3 | 42.0 |
| Pteridium aquilinum | forb | 0.0 | 15.0 | 23.0 |
| Comptonia peregrina | shrub/vine | 6.0 | 13.7 | 29.0 |
| Arctostaphylos uva-ursi | shrub/vine | 0.0 | 8.8 | 26.0 |
| Polytrichum | moss | 0.0 | 0.1 | 0.2 |
| Melampyrum lineare | forb | 0.0 | 10.8 | 32.0 |
| Prunus pumila | shrub/vine | 0.3 | 9.8 | 23.0 |
| Quercus velutina | tree | 0.0 | 0.0 | 0.0 |
| Gaultheria procumbens | shrub/vine | 0.0 | 1.0 | 3.0 |
| Young Jack Pine Plantation | ||||
| Vaccinium angustifolium | shrub/vine | 7.0 | 32.3 | 48.0 |
| Carex pensylvanica | grass/grasslike | 6.0 | 15.0 | 20.0 |
| Quercus ellipsoidalis | tree | 0.0 | 4.6 | 7.0 |
| Pleurozium schreberi | moss | 0.0 | 6.7 | 15.0 |
| Dicranum polysetum | moss | 5.0 | 16.7 | 35.0 |
| Cladina rangiferina | lichen | 1.0 | 27.0 | 40.0 |
| Pinus banksiana | tree | 0.2 | 0.5 | 1.0 |
| Pteridium aquilinum | forb | 0.0 | 2.7 | 6.0 |
| Comptonia peregrina | shrub/vine | 0.7 | 3.9 | 6.0 |
| Arctostaphylos uva-ursi | shrub/vine | 0.2 | 5.7 | 14.0 |
| Polytrichum | moss | 0.0 | 13.4 | 40.0 |
| Melampyrum lineare | forb | 0.1 | 0.8 | 2.0 |
| Prunus pumila | shrub/vine | 0.2 | 0.5 | 1.0 |
| Quercus velutina | tree | 0.0 | 5.4 | 16.2 |
| Gaultheria procumbens | shrub/vine | 0.0 | 0.0 | 0.1 |
| All Landuses | ||||
| Vaccinium angustifolium | shrub/vine | 7.0 | 50.0 | 90.0 |
| Carex pensylvanica | grass/grasslike | 5.0 | 14.9 | 50.0 |
| Quercus ellipsoidalis | tree | 0.0 | 14.1 | 60.3 |
| Pleurozium schreberi | moss | 0.0 | 13.3 | 60.0 |
| Dicranum polysetum | moss | 0.0 | 12.8 | 35.0 |
| Cladina rangiferina | lichen | 0.0 | 10.8 | 40.0 |
| Pinus banksiana | tree | 0.1 | 8.9 | 42.0 |
| Pteridium aquilinum | forb | 0.0 | 6.2 | 23.0 |
| Comptonia peregrina | shrub/vine | 0.1 | 6.0 | 29.0 |
| Arctostaphylos uva-ursi | shrub/vine | 0.0 | 5.0 | 26.0 |
| Polytrichum | moss | 0.0 | 4.5 | 40.0 |
| Melampyrum lineare | forb | 0.0 | 4.0 | 32.0 |
| Prunus pumila | shrub/vine | 0.0 | 3.5 | 23.0 |
| Quercus velutina | tree | 0.0 | 2.3 | 16.2 |
| Gaultheria procumbens | shrub/vine | 0.0 | 1.7 | 11.0 |
#understory flextable ----
understory.wide <- understory |> mutate(Low = condRound1(Low), RV = condRound1(RV), High = condRound1(High)) |> tidyr::pivot_wider(names_from = group, values_from = c(Low,RV,High)) |> as.data.frame()
ngroups <- length(unique(understory$group))
pcolors <- palette.colors(ngroups+1, palette = "ggplot2")
pcolors <- pcolors[2:length(pcolors)]
pcolors <- c('white','white',pcolors,pcolors,pcolors)
thcols <- 1:ngroups
thcols <- 3*thcols+2
df2 <- understory.wide
repnames <- colnames(df2)
repnames <- stringr::str_split_fixed(repnames, '_', 2)
repnamesA <- repnames[,2]
repnamesB <- repnames[,1]
repdf <- data.frame(A=repnamesA, B=repnamesB, C=pcolors)
repdf <- repdf |> mutate(seq = 1:nrow(repdf),
seq2 = c(1:2,(1:ngroups)+2,(1:ngroups)+2,(1:ngroups)+2))
repdf <- repdf |> arrange(seq2)
repnames <- paste0(repnames[,2],'_',repnames[,1])
colnames(df2) <- repnames
df2 <- df2[,repdf$seq]
colnames(df2)[1:2]<- c('Taxon','Habit')
theme_design <- function(x) {
x <- border_remove(x)
std_border <- fp_border_default(width = 0.5, color = "black")
thk_border <- fp_border_default(width = 2, color = "black")
x <- fontsize(x, size = 10, part = "all")
x <- font(x, fontname = "Cambria", part = "all")
x <- italic(x, j=1, part = "body")
x <- align(x, align = "center", part = "all")
x <- align(x, align = "center", part = "header")
x <- align(x, align = "left", part = "body", j=1)
x <- align(x, align = "center", part = "body", j=2)
x <- bold(x, bold = TRUE, part = "all")
x <- bg(x, bg = "white", part = "body")
x <- bg(x, bg = repdf$C, part = "header")
x <- bg(x, bg = "white", part = "footer")
x <- color(x, color = "black", part = "all")
x <- padding(x, padding = 1, part = "all")
x <- border_outer(x, part="all", border = thk_border )
x <- border_inner_h(x, border = std_border, part="all")
x <- border_inner_v(x, border = std_border, part="all")
x <- vline(x, j = c(2,thcols), border = thk_border, part = "all")
x <- set_table_properties(x, layout = "fixed")
x
}
df2 |>
flextable() |>
separate_header() |>
autofit() |> theme_design()Taxon | Habit | Late Successional Forest | Early Successional Thicket | Young Jack Pine Plantation | All Landuses | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Low | RV | High | Low | RV | High | Low | RV | High | Low | RV | High | ||
Vaccinium angustifolium | shrub/vine | 20 | 35 | 49 | 72 | 83 | 90 | 7 | 32 | 48 | 7 | 50 | 90 |
Carex pensylvanica | grass/grasslike | 5 | 6 | 7 | 6 | 24 | 50 | 6 | 15 | 20 | 5 | 15 | 50 |
Quercus ellipsoidalis | tree | 0 | 22 | 60 | 0.2 | 16 | 33 | 0 | 5 | 7 | 0 | 14 | 60 |
Pleurozium schreberi | moss | 20 | 33 | 60 | 0 | 0 | 0 | 0 | 7 | 15 | 0 | 13 | 60 |
Dicranum polysetum | moss | 15 | 22 | 30 | 0 | 0 | 0 | 5 | 17 | 35 | 0 | 13 | 35 |
Cladina rangiferina | lichen | 1 | 5 | 10 | 0 | 0.1 | 0.2 | 1 | 27 | 40 | 0 | 11 | 40 |
Pinus banksiana | tree | 0.1 | 0.9 | 2 | 16 | 25 | 42 | 0.2 | 0.5 | 1 | 0.1 | 9 | 42 |
Pteridium aquilinum | forb | 0 | 0.8 | 2 | 0 | 15 | 23 | 0 | 3 | 6 | 0 | 6 | 23 |
Comptonia peregrina | shrub/vine | 0.1 | 0.5 | 1 | 6 | 14 | 29 | 0.7 | 4 | 6 | 0.1 | 6 | 29 |
Arctostaphylos uva-ursi | shrub/vine | 0 | 0.4 | 1 | 0 | 9 | 26 | 0.2 | 6 | 14 | 0 | 5 | 26 |
Polytrichum | moss | 0 | 0 | 0 | 0 | 0.1 | 0.2 | 0 | 13 | 40 | 0 | 4 | 40 |
Melampyrum lineare | forb | 0.1 | 0.3 | 0.6 | 0 | 11 | 32 | 0.1 | 0.8 | 2 | 0 | 4 | 32 |
Prunus pumila | shrub/vine | 0 | 0.1 | 0.2 | 0.3 | 10 | 23 | 0.2 | 0.5 | 1 | 0 | 3 | 23 |
Quercus velutina | tree | 0 | 2 | 5 | 0 | 0 | 0 | 0 | 5 | 16 | 0 | 2 | 16 |
Gaultheria procumbens | shrub/vine | 0 | 4 | 11 | 0 | 1 | 3 | 0 | 0 | 0.1 | 0 | 2 | 11 |
7.0.2 Ground Surface Cover
This analysis summarizes the contents of the NASIS ground surface cover transect. It assumes that lichen hits are coded as “biological crust”, while bryophytes of any type are populated as “moss”. Coarse woody debris are colloquially labeled as “logs”, fine woody debris are referred to as “sticks”. Large surface fragments like cobbles are here just called “rocks”.
library(ggplot2)
#Transect
#narrow to a project (user site association id)
thesesites <- subset(siteass, usiteassocid %in% 'DSP-F094AB019MI-2024')
gsite <- subset(sites, usiteid %in% thesesites$usiteid, select=c(siteiid, site_id, commphasename))|> unique()
gsurf <- vegground |> subset(!is.na(groundsurfcovtype) & siteiid %in% gsite$siteiid) |> left_join(gsite,relationship = "many-to-many") |> mutate(cover = round(ifelse(!is.na(totalpointssampledcount) & !is.na(groundcoverptcount), groundcoverptcount/totalpointssampledcount*100, groundcoverptpct), 1))
gsurf <- gsurf |> mutate(gt = groundsurfcovtype,
gtype = case_when(gt %in% c("litter","embedded litter") ~ 'Litter',
gt %in% c("downed wood, coarse-large","downed wood, coarse-small","tree snags, hard","tree snags, soft") ~ 'Logs',
gt %in% c("downed wood, fine-large","downed wood, fine-medium","downed wood, fine-small") ~ 'Sticks',
gt %in% c("nonvascular plant") ~ 'Moss',
gt %in% c("forb","tree", "grass or grasslike", "shrub or vine or liana") ~ 'Plant Bases',
gt %in% c("biological crust") ~ 'Lichen',
gt %in% c("bare ground") ~ 'Soil',
gt %in% c("water") ~ 'Water',
gt %in% c("bedrock") ~ 'Bedrock',
gt %in% c("surface fragments, small") ~ 'Gravel',
gt %in% c("surface fragments, large") ~ 'Rocks'),
plot = vegplotid)
gsurf$gtype <- factor(gsurf$gtype, levels = c('Water', 'Bedrock', 'Soil', 'Gravel', 'Rocks', 'Litter', 'Sticks', 'Logs', 'Lichen', 'Moss', 'Plant Bases'))
gcolors <- c('lightcyan', 'gray30', 'lightyellow', 'lightgray', 'darkgray', 'burlywood1', 'burlywood3', 'burlywood4', 'palegreen', 'forestgreen', 'lawngreen')
gsurf2 <- subset(gsurf, !is.na(cover)) |> group_by(vegplotid, commphasename, vegplotname) |> mutate(totalcover = sum(cover)) |> ungroup() |> group_by(vegplotid, commphasename, vegplotname, gtype) |>
# group_by(gtype) |>
summarise(Cover = sum(cover/totalcover*100))
# pie(x = gsurf2$Cover, labels = gsurf2$gtype, col=gcolors)
ggplot(gsurf2)+
geom_col(aes(x=vegplotname, y=Cover, fill=gtype))+
scale_fill_manual(breaks = levels(gsurf2$gtype), values = gcolors)+
scale_x_discrete(name = 'Plot')+
scale_y_continuous(expand = c(0,0))
7.0.3 Structural Triangle
The structural triangle is the vegetation equivalent of the soil textural triangle. It requires that you install the ggtern package, which is similar in syntax as the ggplot2 plotting package, except that it uses a triangle coordinate system instead of a Cartesian coordinate system. Although the triangle plot has 3 dimensions, it actuality it is mainly a function of total tree cover and total woody plant cover, which by process of arithmetic can be rendered to effective shrub cover and none-of-the-above cover to represent the non-woody component of cover (actual herb cover may be less than 100% of this component).
library(ggtern)
thesesites <- subset(siteass, usiteassocid %in% 'DSP-F094AB019MI-2024')
sites <- subset(sites, usiteid %in% thesesites$usiteid)
landuse <- data.frame(siteobsiid=sites$siteobsiid, landuse = sites$commphasename)
landuse <- landuse |> left_join(data.frame(siteobsiid=vegplot$siteobsiid, plot = vegplot$vegplotid)) |> subset(!is.na(plot) & !is.na(landuse))
veg <- clean.veg(veg.raw)|> subset(!is.na(taxon))
veg <- veg |> inner_join(landuse)
veg <- veg |> mutate(type=NA) |> fill.type.df() |> fill.hts.df()
veg <- veg |> mutate(taxon = harmonize.taxa(veg$taxon, fix = TRUE, sensu = "usda"))
#Get vegetation Structure ----
veg <- veg |> mutate(tree = ifelse(type %in% c('tree', 'shrub/vine') & ht.max > 5,cover,0),
woody = ifelse(type %in% c('tree', 'shrub/vine'),cover,0))
veg.tern <- veg |> group_by(plot, label) |> summarise(tree = cover.agg(tree), woody = cover.agg(woody), shrub = woody - tree, open = 100 - woody)
veg.tern <- veg.tern |> left_join(landuse)
s1 <- data.frame(open = c(35,0,0),
tree = c(65,100,65),
shrub = c(0,0,35), group="1 forest")
s2 <- data.frame(open = c(25,25,0,0),
tree = c(10,65,65,10),
shrub = c(65,10,35,90), group="2 dense scrubby woodland")
s3 <- data.frame(open = c(80,25,25),
tree = c(10,65,10),
shrub = c(10,10,65), group="3 open scrubby woodland")
s4 <- data.frame(open = c(90,35,25,80),
tree = c(10,65,65,10),
shrub = c(0,0,10,10), group="4 open woodland/savanna")
s5 <- data.frame(open = c(25,25,0,0),
tree = c(0,10,10,0),
shrub = c(75,65,90,100), group="5 shrub thicket")
s6 <- data.frame(open = c(90,80,25,25),
tree = c(0,10,10,0),
shrub = c(10,10,65,75), group="6 open shrubland")
s7 <- data.frame(open = c(100,90,80,90),
tree = c(0,10,10,0),
shrub = c(0,0,10,10), group="7 open grassland")
str.polys = rbind(s1,s2,s3,s4,s5,s6,s7)
gp <- ggtern() +
geom_polygon(data=str.polys, aes(fill=group, x=open, y=tree, z=shrub),alpha=0.25, linewidth=0.1, color='black') +
geom_point(data=veg.tern, aes(x=open, y=tree, z=shrub, shape = landuse), size=3)+
geom_text(data=veg.tern, aes(x=open, y=tree, z=shrub, label=label), vjust=-1, hjust=1, size=2)+
scale_shape_manual(values=c(17, 16, 8)) +
scale_fill_manual(values=c('darkcyan','darkgreen','green','yellowgreen','red','orange','yellow')) +
theme(legend.position=c(0,1),legend.justification=c(0,1)) +theme_nomask()+
labs(fill="Vegetation Structure")
gp
7.0.4 Structural Profile
Similar to the soil properties graphs along a soil profile, this script shows how to generated a stratum profile of differnt plant functional groups.
#Create slices through the crowns
veg.str <- summary.crown.thickness(veg, breaks = c(c(-1:9)/10,c(2:100)/2)) |> structure.fill.zero() |> subset(type %in% c('tree', 'shrub/vine', 'grass/grasslike', 'forb'))
veg.str <- veg.str |> left_join(landuse)
veg.str.pct <- veg.str |> group_by(landuse, type, stratum, stratum.label, bottom, top) |>
summarise(X25 = quantile(Cover, 0.05),
X50 = quantile(Cover, 0.5),
X75 = quantile(Cover, 0.95))
ggplot(veg.str.pct, aes(x = top, y = X50, col=type)) +
# plot median
geom_line() +
# plot quantiles
geom_ribbon(aes(ymin = X25, ymax = X75, x = top, fill=type), alpha = 0.2) +
coord_flip() +
theme(legend.position = "left")+
scale_fill_manual(name='Plant Habit', values = c('red', 'orange', 'darkgreen', 'blue'))+
scale_color_manual(name='Plant Habit', values = c('red', 'orange', 'darkgreen', 'blue'))+
scale_x_continuous(name='height (m)', breaks=c(0,0.1,0.5,c(1:4),c(1:100)*5), minor_breaks = NULL, limits = c(0,25), expand = c(0,0), trans = 'sqrt')+
scale_y_continuous(name='cover', breaks=c((0:5)*20), limits = c(0,100))+
facet_wrap(~ landuse, nrow=1)