--- title: "Validation" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Validation} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r, echo=FALSE, message=FALSE} # Plotting Packages library(dplyr) library(tidyr) library(ggplot2) library(ggpubr) library(ggpmisc) library(yardstick) library(gt) ``` How do we know if Real Twig returns accurate volume estimates? We rigorously tested our method against a high quality reference data set that were both laser scanner and destructively sampled. The laser scanning was done in leaf-off conditions with a Riegl VZ-400. The destructive sampling contains total branch and main stem dry mass, and also basic density for both the main stem and the branches. We used different versions of TreeQSM with the same input parameters per tree to test our model. ## TreeQSM v2.4.1 Below are the mass estimates and statistics using TreeQSM v2.4.1 with its built in tapering and Real Twig applied to the same QSMs. ```{r, echo=FALSE, results='hide', message=FALSE, warning=FALSE} # Import Data file <- system.file("extdata/validation.csv", package = "rTwig") all_biomass <- read.csv(file) %>% rename(Version = version) # Distinct colors factors <- distinct(all_biomass, Version) cbPalette <- c("#009E73", "#CC79A7", "#56B4E9", "#999999", "#E69F00", "#009E73", "#F0E442", "#0072B2", "#D55E00") cbPalette <- cbPalette[1:nrow(factors)] factors <- bind_cols(factors, cbPalette) %>% rename(colors = 2) # Filter Data all_biomass <- all_biomass %>% left_join(factors, by = join_by(Version)) %>% filter(Version %in% c("TreeQSM v2.4.1", "Real Twig (TreeQSM v2.4.1)")) %>% mutate(id = paste0(SpCode, Tree)) # Total Biomass p1 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = Mt.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name), ) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "TLS Biomass (kg)", title = "Total", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass p2 <- ggplot(data = all_biomass, aes(x = Md.DS, y = Md.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Main Stem", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass p3 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = Mb.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Branch", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Total Biomass % Error p4 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "% TLS Biomass Error", title = "Total % Error", shape = "Speces", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass % Error p5 <- ggplot(data = all_biomass, aes(x = Md.DS, y = sperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Main Stem % Error", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass % Error p6 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Branch % Error", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) ``` ```{r, echo=FALSE, fig.width=7, fig.height=4, fig.align='center', warning=FALSE} ggarrange(p1, p4, common.legend = TRUE, legend = "bottom") ggarrange(p2, p5, common.legend = TRUE, legend = "bottom") ggarrange(p3, p6, common.legend = TRUE, legend = "bottom") ``` ```{r, echo=FALSE, warning=FALSE} ### TOTALS ##################################################################### total_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(tperr), RMSE.kg = sqrt(mean(tdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mt.DS) * 100 ) CCC_total <- all_biomass %>% group_by(Version) %>% ccc(Mt.TLS, Mt.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) total_stats <- left_join(total_stats, CCC_total, by = "Version") %>% mutate(type = "total") ### MAIN STEM ################################################################## stem_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(sperr), RMSE.kg = sqrt(mean(sdif^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Md.DS) * 100 ) CCC_stem <- all_biomass %>% group_by(Version) %>% ccc(Md.TLS, Md.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) stem_stats <- left_join(stem_stats, CCC_stem, by = "Version") %>% mutate(type = "stem") ### BRANCHES ################################################################### branch_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(bperr), RMSE.kg = sqrt(mean(bdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mb.DS) * 100 ) CCC_branch <- all_biomass %>% group_by(Version) %>% ccc(Mb.TLS, Mb.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) branch_stats <- left_join(branch_stats, CCC_branch, by = "Version") %>% mutate(type = "branch") all_stats <- bind_rows(total_stats, stem_stats, branch_stats) ### TABLES ################################################################### data <- all_stats %>% mutate_if(is.numeric, round, 3) %>% rename( "Mean Relative Error (%)" = MRE.pct, "RMSE (kg)" = RMSE.kg, "Relative RMSE (%)" = RRMSE.pct ) %>% pivot_longer(cols = 2:5, names_to = "metric", values_to = "value") %>% pivot_wider(names_from = type, values_from = value) %>% group_by(Version) %>% group_split() tables <- vector(mode = "list", length(data)) data[[2]] %>% gt() %>% tab_header(title = "TreeQSM v2.4.1") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) data[[1]] %>% gt() %>% tab_header(title = "Real Twig (TreeQSM v2.4.1)") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) ``` ## TreeQSM v2.3.0 Below are the mass estimates and statistics using TreeQSM v2.3.0 with its built in tapering and Real Twig applied to the same QSMs. ```{r, echo=FALSE, results='hide', message=FALSE, warning=FALSE} # Import Data file <- system.file("extdata/validation.csv", package = "rTwig") all_biomass <- read.csv(file) %>% rename(Version = version) # Distinct colors factors <- distinct(all_biomass, Version) cbPalette <- c("#009E73", "#CC79A7", "#56B4E9", "#999999", "#E69F00", "#009E73", "#F0E442", "#0072B2", "#D55E00") cbPalette <- cbPalette[1:nrow(factors)] factors <- bind_cols(factors, cbPalette) %>% rename(colors = 2) # Filter Data all_biomass <- all_biomass %>% left_join(factors, by = join_by(Version)) %>% filter(Version %in% c("TreeQSM v2.3.0", "Real Twig (TreeQSM v2.3.0)")) %>% mutate(id = paste0(SpCode, Tree)) # Total Biomass p1 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = Mt.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name), ) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "TLS Biomass (kg)", title = "Total", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass p2 <- ggplot(data = all_biomass, aes(x = Md.DS, y = Md.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Main Stem", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass p3 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = Mb.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Branch", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Total Biomass % Error p4 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "% TLS Biomass Error", title = "Total % Error", shape = "Speces", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass % Error p5 <- ggplot(data = all_biomass, aes(x = Md.DS, y = sperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Main Stem % Error", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass % Error p6 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Branch % Error", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) ``` ```{r, echo=FALSE, fig.width=7, fig.height=4, fig.align='center', warning=FALSE, message=FALSE} ggarrange(p1, p4, common.legend = TRUE, legend = "bottom") ggarrange(p2, p5, common.legend = TRUE, legend = "bottom") ggarrange(p3, p6, common.legend = TRUE, legend = "bottom") ``` ```{r, echo=FALSE, message=FALSE, warning=FALSE} ### TOTALS ##################################################################### total_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(tperr), RMSE.kg = sqrt(mean(tdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mt.DS) * 100 ) CCC_total <- all_biomass %>% group_by(Version) %>% ccc(Mt.TLS, Mt.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) total_stats <- left_join(total_stats, CCC_total, by = "Version") %>% mutate(type = "total") ### MAIN STEM ################################################################## stem_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(sperr), RMSE.kg = sqrt(mean(sdif^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Md.DS) * 100 ) CCC_stem <- all_biomass %>% group_by(Version) %>% ccc(Md.TLS, Md.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) stem_stats <- left_join(stem_stats, CCC_stem, by = "Version") %>% mutate(type = "stem") ### BRANCHES ################################################################### branch_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(bperr), RMSE.kg = sqrt(mean(bdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mb.DS) * 100 ) CCC_branch <- all_biomass %>% group_by(Version) %>% ccc(Mb.TLS, Mb.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) branch_stats <- left_join(branch_stats, CCC_branch, by = "Version") %>% mutate(type = "branch") all_stats <- bind_rows(total_stats, stem_stats, branch_stats) ### TABLES ################################################################### data <- all_stats %>% mutate_if(is.numeric, round, 3) %>% rename( "Mean Relative Error (%)" = MRE.pct, "RMSE (kg)" = RMSE.kg, "Relative RMSE (%)" = RRMSE.pct ) %>% pivot_longer(cols = 2:5, names_to = "metric", values_to = "value") %>% pivot_wider(names_from = type, values_from = value) %>% group_by(Version) %>% group_split() tables <- vector(mode = "list", length(data)) data[[2]] %>% gt() %>% tab_header(title = "TreeQSM v2.3.0") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) data[[1]] %>% gt() %>% tab_header(title = "Real Twig (TreeQSM v2.3.0)") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) ``` ## SimpleForest It is important to note that Real Twig was not tested with SimpleForest during its development. While Real Twig does improve volume estimates for SimpleForest versus its built in allometric corrections, there are still improvements to be made, as SimpleForest QSM cylinders are generally much more overestimated than TreeQSM cylinders, making the identification of "good" cylinders difficult. Below are the mass estimates and statistics using SimpleForest v5.3.2 with its built in vessel volume correction, and Real Twig applied to the same QSMs. ```{r, echo=FALSE, results='hide', message=FALSE, warning=FALSE} # Import Data file <- system.file("extdata/validation.csv", package = "rTwig") all_biomass <- read.csv(file) %>% rename(Version = version) # Distinct colors factors <- distinct(all_biomass, Version) cbPalette <- c("#009E73", "#CC79A7", "#56B4E9", "#999999", "#E69F00", "#009E73", "#F0E442", "#0072B2", "#D55E00") cbPalette <- cbPalette[1:nrow(factors)] factors <- bind_cols(factors, cbPalette) %>% rename(colors = 2) # Filter Data all_biomass <- all_biomass %>% left_join(factors, by = join_by(Version)) %>% filter(Version %in% c("SimpleForest", "Real Twig (SimpleForest)")) %>% mutate(id = paste0(SpCode, Tree)) # Total Biomass p1 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = Mt.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name), ) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "TLS Biomass (kg)", title = "Total", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass p2 <- ggplot(data = all_biomass, aes(x = Md.DS, y = Md.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Main Stem", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass p3 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = Mb.TLS, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_abline() + stat_poly_eq(aes( label = paste(after_stat(eq.label), after_stat(rr.label), sep = "~~~") )) + labs( x = "", # "Reference Biomass (kg)", y = "", # "TLS Biomass (kg)", title = "Branch", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Total Biomass % Error p4 <- ggplot(data = all_biomass, aes(x = Mt.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "% TLS Biomass Error", title = "Total % Error", shape = "Speces", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Main Stem Biomass % Error p5 <- ggplot(data = all_biomass, aes(x = Md.DS, y = sperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Main Stem % Error", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) # Branch Biomass % Error p6 <- ggplot(data = all_biomass, aes(x = Mb.DS, y = tperr, color = Version, fill = Version)) + geom_point(aes(shape = scientific.name)) + geom_smooth(method = "lm", formula = y ~ x) + geom_hline(yintercept = 0) + labs( x = "", # "Reference Biomass (kg)", y = "", # "% TLS Biomass Error", title = "Branch % Error", shape = "Species", color = "Method", fill = "Method" ) + theme_classic() + scale_color_manual(values = unique(all_biomass$colors)) + scale_fill_manual(values = unique(all_biomass$colors)) ``` ```{r, echo=FALSE, fig.width=7, fig.height=4, fig.align='center', warning=FALSE, message=FALSE} ggarrange(p1, p4, common.legend = TRUE, legend = "bottom") ggarrange(p2, p5, common.legend = TRUE, legend = "bottom") ggarrange(p3, p6, common.legend = TRUE, legend = "bottom") ``` ```{r, echo=FALSE, warning=FALSE, message=FALSE} ### TOTALS ##################################################################### total_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(tperr), RMSE.kg = sqrt(mean(tdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mt.DS) * 100 ) CCC_total <- all_biomass %>% group_by(Version) %>% ccc(Mt.TLS, Mt.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) total_stats <- left_join(total_stats, CCC_total, by = "Version") %>% mutate(type = "total") ### MAIN STEM ################################################################## stem_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(sperr), RMSE.kg = sqrt(mean(sdif^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Md.DS) * 100 ) CCC_stem <- all_biomass %>% group_by(Version) %>% ccc(Md.TLS, Md.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) stem_stats <- left_join(stem_stats, CCC_stem, by = "Version") %>% mutate(type = "stem") ### BRANCHES ################################################################### branch_stats <- all_biomass %>% group_by(Version) %>% summarize( MRE.pct = mean(bperr), RMSE.kg = sqrt(mean(bdiff^2, na.rm = TRUE)), RRMSE.pct = RMSE.kg / mean(Mb.DS) * 100 ) CCC_branch <- all_biomass %>% group_by(Version) %>% ccc(Mb.TLS, Mb.DS) %>% select(Version, .estimate) %>% rename(CCC = 2) branch_stats <- left_join(branch_stats, CCC_branch, by = "Version") %>% mutate(type = "branch") all_stats <- bind_rows(total_stats, stem_stats, branch_stats) ### TABLES ################################################################### data <- all_stats %>% mutate_if(is.numeric, round, 3) %>% rename( "Mean Relative Error (%)" = MRE.pct, "RMSE (kg)" = RMSE.kg, "Relative RMSE (%)" = RRMSE.pct ) %>% pivot_longer(cols = 2:5, names_to = "metric", values_to = "value") %>% pivot_wider(names_from = type, values_from = value) %>% group_by(Version) %>% group_split() tables <- vector(mode = "list", length(data)) data[[2]] %>% gt() %>% tab_header(title = "SimpleForest") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) data[[1]] %>% gt() %>% tab_header(title = "Real Twig (SimpleForest)") %>% cols_hide(Version) %>% cols_label( metric = "Metric", total = "Total Woody AGB", stem = "Main Stem Biomass", branch = "Branch Biomass" ) %>% cols_align( align = "center", columns = everything() ) %>% tab_options( table.border.top.style = "hidden", table.border.bottom.style = "hidden", table_body.hlines.color = "white", table.font.color = "black", heading.border.bottom.color = "black", column_labels.border.bottom.color = "black", table_body.border.bottom.color = "black" ) ``` ```{r, echo=FALSE, warning=FALSE, message=FALSE} # Future Package Cleanup future::plan("sequential") ```