## ----setup-1, include=FALSE----------------------------------------------------- library("tidyverse") library("ggplot2") library("tidypaleo") library("patchwork") options(width = 76) theme_set(theme_paleo(9) + theme(plot.background = element_blank())) if (knitr::is_latex_output()) { knitr::opts_chunk$set(dev = "cairo_pdf") } else { knitr::opts_chunk$set(dpi = 300) } # knitr::opts_chunk$set(fig.path = "Figures/") ## ----fig-ex-data, fig.height = 3.5, fig.width = 6, fig.cap = c("Geochemical measurements from Kellys Lake, Nova Scotia, Canada.", "Microfossil zooplankton (Cladocera) relative abundances from Kellys Lake, Nova Socita, Canada.")---- library("tidypaleo") data("kellys_lake_geochem", package = "tidypaleo") data("kellys_lake_cladocera", package = "tidypaleo") # Figure 1 kellys_geochem_plot <- ggplot( kellys_lake_geochem, aes(x = value, y = depth) ) + geom_lineh() + geom_point() + scale_y_reverse() + facet_geochem_gridh(vars(param)) + labs(y = "Depth (cm)", x = NULL) kellys_geochem_plot # Figure 2 kellys_abund_plot <- ggplot( kellys_lake_cladocera, aes(x = rel_abund, y = depth) ) + geom_col_segsh() + scale_y_reverse() + facet_abundanceh(vars(taxon)) + labs(y = "Depth (cm)") kellys_abund_plot ## ----------------------------------------------------------------------------- kellys_lake_geochem ## ---- include = FALSE, eval = FALSE------------------------------------------- ## # Code to generate kellys_lake_geochem.xlsx ## kellys_lake_geochem_wide_err <- kellys_lake_geochem %>% ## select(location, param, depth, error) %>% ## mutate(param = paste0(param, "_sd")) %>% ## pivot_wider(names_from = "param", values_from = error) ## ## kellys_lake_geochem_wide <- kellys_lake_geochem %>% ## select(location, param, depth, age_ad, value) %>% ## pivot_wider(names_from = "param", values_from = value) %>% ## left_join(kellys_lake_geochem_wide_err, by = c("location", "depth")) %>% ## select( ## location, depth, age_ad, ## C, C_sd, `C/N`, `C/N_sd`, d13C, d13C_sd, ## d15N, d15N_sd, K, K_sd, Pb, Pb_sd ## ) %>% ## arrange(location, depth) ## ## writexl::write_xlsx(kellys_lake_geochem_wide, "kellys_lake_geochem.xlsx") ## ----------------------------------------------------------------------------- kellys_lake_geochem_wide <- readxl::read_excel("kellys_lake_geochem.xlsx") kellys_lake_geochem_error <- kellys_lake_geochem_wide %>% select(location, depth, ends_with("_sd")) %>% pivot_longer( -c(location, depth), names_to = "param", values_to = "error" ) %>% mutate(param = str_remove(param, "_sd")) kellys_lake_geochem_long <- kellys_lake_geochem_wide %>% select(-ends_with("sd")) %>% pivot_longer( -c(location, depth, age_ad), names_to = "param", values_to = "value" ) %>% filter(!is.na(value)) %>% left_join( kellys_lake_geochem_error, by = c("location", "depth", "param") ) ## ----------------------------------------------------------------------------- kellys_lake_cladocera_wide <- readxl::read_excel( "kellys_lake_cladocera.xlsx" ) kellys_lake_cladocera_long <- kellys_lake_cladocera_wide %>% pivot_longer( -taxon, names_to = "sample_id", values_to = "count" ) %>% separate( sample_id, into = c("location", "depth"), sep = " " ) %>% separate( depth, into = c("depth_start", "depth_end"), sep = "-", convert = TRUE ) %>% mutate(depth_mid = (depth_start + depth_end) / 2) %>% select(location, starts_with("depth"), taxon, count) ## ----------------------------------------------------------------------------- kellys_lake_cladocera_long %>% group_by(location, depth_mid) %>% mutate(relative_abundance = count / sum(count) * 100) %>% ungroup() ## ----fig-scales-age-depth, fig.height = 3.5, fig.width = 6, message=FALSE, ## fig.cap = "Age-depth transformation and scales applied to a stratigraphic ## plot of geochemical measurements."---- # Figure 3 data("kellys_lake_ages", package = "tidypaleo") kellys_adm <- age_depth_model( depth = kellys_lake_ages$depth, age = kellys_lake_ages$age_ad ) kellys_geochem_plot + scale_y_depth_age(kellys_adm, age_name = "Year CE") ## ----fig-exaggerate, message = FALSE, fig.height = 3.5, fig.width = 6, ## fig.cap = "Exaggerated line and area geometries for highlighting relative ## change of parameters with a large change in magnitude."---- # Setup for Figure 4 and Figure 5 kellys_demo_base <- kellys_lake_cladocera %>% filter(taxon == "Acantholeberis curvirostris") %>% ggplot(aes(x = rel_abund, y = depth)) + scale_y_reverse() + facet_abundanceh(vars(taxon)) + scale_x_abundance(breaks = waiver(), expand = expansion(add = c(0, 1))) + labs(x = "Rel. Abundance (%)", y = "Depth (cm)") # Figure 4 patchwork::wrap_plots( kellys_demo_base + geom_lineh() + geom_lineh_exaggerate(exaggerate_x = 2, col = "grey80"), kellys_demo_base + geom_areah_exaggerate(exaggerate_x = 2, fill = "grey80") + geom_areah(), nrow = 1 ) ## ----fig-geoms, fig.height = 3.5, fig.width = 6, fig.cap = "Column segment, line, area, and combinations commonly used to represent relative abundance values on stratigraphic diagrams."---- # Figure 5 patchwork::wrap_plots( kellys_demo_base + geom_col_segsh(), kellys_demo_base + geom_lineh(), kellys_demo_base + geom_col_segsh() + geom_lineh(), kellys_demo_base + geom_areah(), nrow = 1 ) ## ----fig-error-bars, warning = FALSE, fig.height=3.5, fig.width = 6, fig.cap = "Communicating error in a stratigraphic diagram using error bars."---- # Figure 6 kellys_lake_geochem %>% filter(depth <= 5, param %in% c("K", "Pb")) %>% ggplot(aes(value, depth)) + geom_lineh() + geom_point() + geom_errorbarh( aes(xmin = value - error, xmax = value + error), height = 0.1 ) + facet_geochem_wraph(vars(param)) + scale_y_reverse() + labs(y = "Depth (cm)", x = NULL) ## ----fig-labeller, fig.height = 3.5, fig.width = 6, fig.cap = "Adding units to multi-parameter plots using the geochemistry labeller."---- # Figure 7 kellys_geochem_plot + facet_geochem_gridh( vars(param), units = c( "C" = "%", "C/N" = NA, "d13C" = "‰", "d15N" = "‰", "Pb" = "ppm", "K" = "ppm" ) ) ## ----------------------------------------------------------------------------- keji_lakes_prcomp <- keji_lakes_plottable %>% group_by(location) %>% nested_data( qualifiers = depth, key = taxon, value = rel_abund, trans = sqrt ) %>% nested_prcomp() ## ----------------------------------------------------------------------------- keji_lakes_prcomp %>% select(location, qualifiers, data, scores) keji_lakes_prcomp %>% select(location, model, variance, loadings) keji_lakes_prcomp %>% unnested_data(qualifiers, scores) ## ----------------------------------------------------------------------------- keji_plot <- ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + geom_areah_exaggerate(exaggerate_x = 5, alpha = 0.2) + geom_areah() + scale_y_reverse() + facet_abundanceh( vars(taxon), grouping = vars(location), scales = "free" ) + labs(x = "Relative abundance (%)", y = "Depth (cm)") ## ---- fig.width=6, fig.height=6, echo=FALSE----------------------------------- keji_coniss <- keji_lakes_plottable %>% group_by(location) %>% nested_data( qualifiers = depth, key = taxon, value = rel_abund, trans = sqrt ) %>% nested_chclust_coniss() ## ----------------------------------------------------------------------------- keji_coniss %>% unnested_data(broken_stick) %>% group_by(location) %>% slice(1:4) ## ----------------------------------------------------------------------------- dendro_plot <- ggplot() + layer_dendrogram(keji_coniss, aes(y = depth), label = "CONISS") + scale_y_reverse() + facet_grid(vars(location), vars(label), scales = "free_y") + labs(y = NULL, x = "Dispersion") ## ----fig-keji, fig.height = 6, fig.width = 6, fig.cap="Relative abundances and cluster analysis of microfossil diatom relative abundance from two lakes in Kejimkujik National Park, Nova Scotia, Canada."---- # Figure 8 wrap_plots( keji_plot + theme( strip.background = element_blank(), strip.text.y = element_blank() ), dendro_plot + theme( axis.text.y.left = element_blank(), axis.ticks.y.left = element_blank() ) + labs(y = NULL), nrow = 1, widths = c(6, 1) )