├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── test-coverage.yaml ├── codecov.yml ├── tests ├── testthat │ ├── .gitignore │ ├── test-data_eval.R │ ├── test-nested_prcomp.R │ ├── _snaps │ │ └── ggstrat │ │ │ ├── adm-null-xaxis-depth-age.svg │ │ │ ├── adm-null-xaxis-age-depth.svg │ │ │ ├── adm-null-yaxis-depth-age.svg │ │ │ ├── adm-null-yaxis-age-depth.svg │ │ │ ├── adm-null-rev-xaxis-age-depth.svg │ │ │ ├── adm-null-rev-yaxis-age-depth.svg │ │ │ ├── adm-yaxis-age-depth.svg │ │ │ ├── adm-rev-yaxis-depth-age.svg │ │ │ ├── adm-xaxis-age-depth.svg │ │ │ ├── adm-rev-xaxis-depth-age.svg │ │ │ ├── horizontal-col-segs.svg │ │ │ ├── vertical-col-segs.svg │ │ │ ├── horizontal-ribbon.svg │ │ │ └── horizontal-area.svg │ └── test-ggstrat-plot_addons.R └── testthat.R ├── LICENSE ├── data-raw ├── kellys_lake.mudata │ ├── datasets.csv │ ├── _mudata.csv │ ├── locations.csv │ ├── columns.csv │ └── params.csv ├── neotoma_ginn_nova_scotia.rds ├── long_lake.R ├── alta_lake.R ├── AL-GC2_30_ages.txt ├── kellys.R ├── LL-PC2_43_ages.txt └── nova_scotia_diatoms.R ├── .gitignore ├── data ├── kellys_lake_ages.rda ├── alta_lake_14C_ages.rda ├── alta_lake_geochem.rda ├── kellys_lake_geochem.rda ├── long_lake_14C_ages.rda ├── long_lake_plottable.rda ├── alta_lake_210Pb_ages.rda ├── alta_lake_bacon_ages.rda ├── keji_lakes_plottable.rda ├── kellys_lake_cladocera.rda ├── long_lake_bacon_ages.rda └── halifax_lakes_plottable.rda ├── man ├── figures │ └── README-keji-strat-1.png ├── theme_paleo.Rd ├── geom_lineh.Rd ├── kellys_lake.Rd ├── as_trans_factory.Rd ├── keji_lakes_plottable.Rd ├── plot.age_depth_model.Rd ├── rotated_facet_labels.Rd ├── predict.age_depth_model.Rd ├── halifax_lakes_plottable.Rd ├── age_depth_as_sec_axis.Rd ├── sequential_layer_facets.Rd ├── nested_analysis.Rd ├── label_species.Rd ├── tidypaleo-package.Rd ├── nested_prcomp.Rd ├── age_depth_interpolate.Rd ├── reexports.Rd ├── label_geochem.Rd ├── scale_x_abundance.Rd ├── geom_ribbonh.Rd ├── plot.nested_analysis.Rd ├── age_depth_model.Rd ├── stat_nested_hclust.Rd ├── layer_dendrogram.Rd ├── geom_col_segsh.Rd ├── layer_scores.Rd ├── scale_y_depth_age.Rd ├── long_lake_14C_ages.Rd ├── nested_data.Rd ├── geom_point_exaggerate.Rd ├── alta_lake_210Pb_ages.Rd ├── nested_hclust.Rd └── facet_abundanceh.Rd ├── cran-comments.md ├── R ├── tidypaleo-package.R ├── zzz.R ├── data_eval.R ├── nested_prcomp.R ├── ggstrat-scales.R ├── data.R └── ggstrat-labels.R ├── .Rbuildignore ├── tidypaleo.Rproj ├── NEWS.md ├── inst └── CITATION ├── LICENSE.md ├── _pkgdown.yml ├── DESCRIPTION ├── README.md ├── README.Rmd ├── vignettes ├── nested_analysis.Rmd └── age_depth.Rmd └── NAMESPACE /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | -------------------------------------------------------------------------------- /tests/testthat/.gitignore: -------------------------------------------------------------------------------- 1 | Rplots.pdf 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: tidypaleo authors 3 | -------------------------------------------------------------------------------- /data-raw/kellys_lake.mudata/datasets.csv: -------------------------------------------------------------------------------- 1 | dataset 2 | cbrm_2017 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .DS_Store 5 | inst/doc 6 | docs/ 7 | -------------------------------------------------------------------------------- /data-raw/kellys_lake.mudata/_mudata.csv: -------------------------------------------------------------------------------- 1 | x_columns,mudata_version 2 | "[""depth""]",R.1.1.0 3 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tidypaleo) 3 | 4 | test_check("tidypaleo") 5 | -------------------------------------------------------------------------------- /data/kellys_lake_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/kellys_lake_ages.rda -------------------------------------------------------------------------------- /data/alta_lake_14C_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/alta_lake_14C_ages.rda -------------------------------------------------------------------------------- /data/alta_lake_geochem.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/alta_lake_geochem.rda -------------------------------------------------------------------------------- /data/kellys_lake_geochem.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/kellys_lake_geochem.rda -------------------------------------------------------------------------------- /data/long_lake_14C_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/long_lake_14C_ages.rda -------------------------------------------------------------------------------- /data/long_lake_plottable.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/long_lake_plottable.rda -------------------------------------------------------------------------------- /data/alta_lake_210Pb_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/alta_lake_210Pb_ages.rda -------------------------------------------------------------------------------- /data/alta_lake_bacon_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/alta_lake_bacon_ages.rda -------------------------------------------------------------------------------- /data/keji_lakes_plottable.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/keji_lakes_plottable.rda -------------------------------------------------------------------------------- /data/kellys_lake_cladocera.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/kellys_lake_cladocera.rda -------------------------------------------------------------------------------- /data/long_lake_bacon_ages.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/long_lake_bacon_ages.rda -------------------------------------------------------------------------------- /data/halifax_lakes_plottable.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data/halifax_lakes_plottable.rda -------------------------------------------------------------------------------- /man/figures/README-keji-strat-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/man/figures/README-keji-strat-1.png -------------------------------------------------------------------------------- /data-raw/neotoma_ginn_nova_scotia.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/paleolimbot/tidypaleo/HEAD/data-raw/neotoma_ginn_nova_scotia.rds -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | 2 | This release prepares tidypaleo for the forthcoming release of dplyr. 3 | 4 | ## R CMD check results 5 | 6 | 0 errors | 0 warnings | 0 notes 7 | -------------------------------------------------------------------------------- /data-raw/kellys_lake.mudata/locations.csv: -------------------------------------------------------------------------------- 1 | dataset,location,collected,lake_name,water_depth_m,alias,longitude,latitude,core_internal_diam 2 | cbrm_2017,KLY17-2,2017-05-23,Kellys Lake,4.5,kly2,-60.019238,45.930774,6.3 3 | -------------------------------------------------------------------------------- /R/tidypaleo-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | # The following block is used by usethis to automatically manage 5 | # roxygen namespace tags. Modify with care! 6 | ## usethis namespace: start 7 | ## usethis namespace: end 8 | NULL 9 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.png$ 5 | ^\.travis\.yml$ 6 | ^codecov\.yml$ 7 | ^data-raw$ 8 | ^_pkgdown\.yml$ 9 | ^docs$ 10 | ^pkgdown$ 11 | ^\.github$ 12 | ^LICENSE\.md$ 13 | ^cran-comments\.md$ 14 | ^CRAN-RELEASE$ 15 | ^CRAN-SUBMISSION$ 16 | -------------------------------------------------------------------------------- /tidypaleo.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | 2 | .onLoad <- function(...) { 3 | vctrs::s3_register("dplyr::filter", "nested_data") 4 | vctrs::s3_register("dplyr::filter", "nested_analysis") 5 | vctrs::s3_register("dplyr::slice", "nested_data") 6 | vctrs::s3_register("dplyr::slice", "nested_analysis") 7 | vctrs::s3_register("dplyr::arrange", "nested_data") 8 | vctrs::s3_register("dplyr::arrange", "nested_analysis") 9 | vctrs::s3_register("dplyr::mutate", "nested_data") 10 | vctrs::s3_register("dplyr::mutate", "nested_analysis") 11 | } 12 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tidypaleo 0.1.4 2 | 3 | * Fixes for S3 method consistency in ggplot2 4.0.0 4 | * Fixes for deprecated arguments `sec_axis(trans = ...)` and `size` for 5 | where `linewidth` is the reccomended usage. 6 | 7 | # tidypaleo 0.1.3 8 | 9 | * Fixes for the forthcoming dplyr 1.1.0. 10 | * Fix deprecated usage of tidyselect. 11 | 12 | # tidypaleo 0.1.2 13 | 14 | * Add CITATION file and Journal of Statistical Software 15 | article DOI to Description. 16 | 17 | # tidypaleo 0.1.1 18 | 19 | * Fixed a test that was failing on M1 Mac. 20 | * Added a `NEWS.md` file to track changes to the package. 21 | -------------------------------------------------------------------------------- /man/theme_paleo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-themes.R 3 | \name{theme_paleo} 4 | \alias{theme_paleo} 5 | \title{A Paleo-friendly ggplot2 theme} 6 | \usage{ 7 | theme_paleo(...) 8 | } 9 | \arguments{ 10 | \item{...}{Passed to \code{\link[ggplot2:ggtheme]{ggplot2::theme_bw()}}} 11 | } 12 | \value{ 13 | A complete \code{\link[ggplot2:theme]{ggplot2::theme()}} 14 | } 15 | \description{ 16 | Essentially, this is \code{\link[ggplot2:ggtheme]{ggplot2::theme_bw()}} with a few modifications 17 | } 18 | \examples{ 19 | library(ggplot2) 20 | 21 | ggplot(mpg, aes(cty, hwy)) + 22 | geom_point() + 23 | theme_paleo() 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/geom_lineh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-geoms.R 3 | \name{geom_lineh} 4 | \alias{geom_lineh} 5 | \title{Connect observations in the vertical direction} 6 | \usage{ 7 | geom_lineh( 8 | mapping = NULL, 9 | data = NULL, 10 | stat = "identity", 11 | position = "identity", 12 | na.rm = FALSE, 13 | show.legend = NA, 14 | inherit.aes = TRUE, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...}{See 20 | \link[ggplot2:geom_path]{geom_line}.} 21 | } 22 | \value{ 23 | A ggplot2 layer. 24 | } 25 | \description{ 26 | Connect observations in the vertical direction 27 | } 28 | -------------------------------------------------------------------------------- /R/data_eval.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create tibbles from user objects and/or user data 3 | #' 4 | #' @param data A data.frame/tibble, or NULL 5 | #' @param ... Arguments are passed to [transmute][dplyr::transmute] if `data` is 6 | #' present, and [tibble][tibble::tibble] if it is not. 7 | #' 8 | #' @return A [tibble][tibble::tibble] with the results of ... 9 | #' @noRd 10 | #' @importFrom rlang !!! 11 | #' 12 | data_eval <- function(.data = NULL, ...) { 13 | args <- rlang::quos(...) 14 | # discard NULLs, which tibble doesn't accept and transmute complains about 15 | args <- args[!vapply(args, identical, FUN.VALUE = logical(1), rlang::quo(NULL))] 16 | 17 | if(is.null(.data)) { 18 | tibble::tibble(!!!args) 19 | } else { 20 | tibble::as_tibble(dplyr::transmute(.data, !!!args)) 21 | } 22 | } 23 | 24 | 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /data-raw/kellys_lake.mudata/columns.csv: -------------------------------------------------------------------------------- 1 | dataset,table,column,type 2 | cbrm_2017,data,dataset,character 3 | cbrm_2017,data,location,character 4 | cbrm_2017,data,param,character 5 | cbrm_2017,data,depth,double 6 | cbrm_2017,data,value,double 7 | cbrm_2017,data,error,double 8 | cbrm_2017,data,error_type,character 9 | cbrm_2017,data,n_detect,integer 10 | cbrm_2017,data,n,integer 11 | cbrm_2017,locations,dataset,character 12 | cbrm_2017,locations,location,character 13 | cbrm_2017,locations,collected,date 14 | cbrm_2017,locations,lake_name,character 15 | cbrm_2017,locations,water_depth_m,double 16 | cbrm_2017,locations,alias,character 17 | cbrm_2017,locations,longitude,double 18 | cbrm_2017,locations,latitude,double 19 | cbrm_2017,locations,core_internal_diam,double 20 | cbrm_2017,params,dataset,character 21 | cbrm_2017,params,param,character 22 | cbrm_2017,datasets,dataset,character 23 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry(bibtype = "Article", 2 | title = "{tidypaleo}: Visualizing Paleoenvironmental Archives Using {ggplot2}", 3 | author = c(person(given = c("Dewey", "W."), 4 | family = "Dunnington", 5 | email = "dewey.dunnington@dal.ca"), 6 | person(given = "Nell", 7 | family = "Libera"), 8 | person(given = "Joshua", 9 | family = "Kurek"), 10 | person(given = c("Ian", "S."), 11 | family = "Spooner"), 12 | person(given = c("Graham", "A."), 13 | family = "Gagnon")), 14 | journal = "Journal of Statistical Software", 15 | year = "2022", 16 | volume = "101", 17 | number = "7", 18 | pages = "1--20", 19 | doi = "10.18637/jss.v101.i07", 20 | header = "To cite tidypaleo in publications use:" 21 | ) 22 | 23 | -------------------------------------------------------------------------------- /man/kellys_lake.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{kellys_lake_cladocera} 5 | \alias{kellys_lake_cladocera} 6 | \alias{kellys_lake_geochem} 7 | \alias{kellys_lake_ages} 8 | \title{Kellys Lake Data} 9 | \format{ 10 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 300 rows and 5 columns. 11 | 12 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 305 rows and 9 columns. 13 | 14 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 14 rows and 5 columns. 15 | } 16 | \usage{ 17 | kellys_lake_cladocera 18 | 19 | kellys_lake_geochem 20 | 21 | kellys_lake_ages 22 | } 23 | \description{ 24 | Geochemistry measurements and Cladocera counts from Kellys Lake, 25 | Cape Breton Island, Nova Scotia, Canada. 26 | } 27 | \references{ 28 | Joshua Kurek, Ian Spooner, and Dewey Dunnington (unpublished data). 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /man/as_trans_factory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{as_trans_factory} 4 | \alias{as_trans_factory} 5 | \alias{validate_trans_factory} 6 | \alias{validate_trans} 7 | \title{Coerce and validate transforms and functions that produce them} 8 | \usage{ 9 | as_trans_factory(factory, env = parent.frame()) 10 | 11 | validate_trans_factory(factory, x = 1:3, y = 1:3) 12 | 13 | validate_trans(trans, x = 1:3, y = 1:3) 14 | } 15 | \arguments{ 16 | \item{factory}{A function that produces a transform object} 17 | 18 | \item{env}{The calling environment, for transform factories that are calls or 19 | rlang lambda-style functions.} 20 | 21 | \item{x}{The test x data} 22 | 23 | \item{y}{The test y data} 24 | 25 | \item{trans}{A transform object} 26 | } 27 | \value{ 28 | The input, invisibly. 29 | } 30 | \description{ 31 | Coerce and validate transforms and functions that produce them 32 | } 33 | \examples{ 34 | as_trans_factory(age_depth_interpolate) 35 | 36 | } 37 | -------------------------------------------------------------------------------- /man/keji_lakes_plottable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{keji_lakes_plottable} 5 | \alias{keji_lakes_plottable} 6 | \title{Keji lakes core diatom counts} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 202 rows and 5 columns. 9 | } 10 | \source{ 11 | Neotoma paleoecology database (\url{https://www.neotomadb.org}) 12 | } 13 | \usage{ 14 | keji_lakes_plottable 15 | } 16 | \description{ 17 | A subset of well-labeled, clean diatom count data for 3 Keji-area (Nova 18 | Scotia) lakes, which form part of the analysis in Ginn et al. (2007). 19 | } 20 | \examples{ 21 | keji_lakes_plottable 22 | 23 | } 24 | \references{ 25 | Ginn, Brian K., Brian F. Cumming, and John P. Smol. "Long-Term 26 | Lake Acidification Trends in High- and Low-Sulphate Deposition Regions from 27 | Nova Scotia, Canada." Hydrobiologia 586, no. 1 (July 1, 2007): 261-75. 28 | \doi{10.1007/s10750-007-0644-3}. 29 | } 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::rcmdcheck 27 | needs: check 28 | 29 | - name: Check 30 | env: 31 | VDIFFR_RUN_TESTS: false 32 | run: | 33 | options(crayon.enabled = TRUE) 34 | rcmdcheck::rcmdcheck(args = "--no-manual") 35 | shell: Rscript {0} 36 | -------------------------------------------------------------------------------- /man/plot.age_depth_model.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{plot.age_depth_model} 4 | \alias{plot.age_depth_model} 5 | \title{Plot an age depth model using base graphics} 6 | \usage{ 7 | \method{plot}{age_depth_model}( 8 | x, 9 | xlab = "depth", 10 | ylab = "age", 11 | xlim = NULL, 12 | ylim = NULL, 13 | add = FALSE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{x}{An \link{age_depth_model}} 19 | 20 | \item{xlab, ylab}{Axis labels} 21 | 22 | \item{xlim, ylim}{Axis limits} 23 | 24 | \item{add}{Pass TRUE to skip creating a new plot} 25 | 26 | \item{...}{Passed to \link[graphics:points]{points} to customize points display} 27 | } 28 | \value{ 29 | The input, invisibly 30 | } 31 | \description{ 32 | Plot an age depth model using base graphics 33 | } 34 | \examples{ 35 | adm <- age_depth_model( 36 | alta_lake_210Pb_ages, 37 | depth = depth_cm, age = age_year_ad, 38 | age_max = age_year_ad + age_error_yr, 39 | age_min = age_year_ad - age_error_yr 40 | ) 41 | 42 | plot(adm) 43 | 44 | } 45 | -------------------------------------------------------------------------------- /man/rotated_facet_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-themes.R 3 | \name{rotated_facet_labels} 4 | \alias{rotated_facet_labels} 5 | \alias{rotated_axis_labels} 6 | \title{Common plot modifications for stratigraphic plots} 7 | \usage{ 8 | rotated_facet_labels( 9 | angle = 45, 10 | direction = "x", 11 | remove_label_background = TRUE 12 | ) 13 | 14 | rotated_axis_labels(angle = 90, direction = "x") 15 | } 16 | \arguments{ 17 | \item{angle}{The angle at which labels should be rotated} 18 | 19 | \item{direction}{The axes along which the operations should be performed} 20 | 21 | \item{remove_label_background}{Whether or not label backgrounds should be removed along 22 | rotated label axes} 23 | } 24 | \value{ 25 | An object or list of objects that can be added to a \link[ggplot2:ggplot]{ggplot} 26 | } 27 | \description{ 28 | Common plot modifications for stratigraphic plots 29 | } 30 | \examples{ 31 | library(ggplot2) 32 | 33 | ggplot(mpg, aes(cty, hwy)) + 34 | geom_point() + 35 | facet_wrap(vars(class)) + 36 | rotated_facet_labels(45, "x") 37 | 38 | } 39 | -------------------------------------------------------------------------------- /man/predict.age_depth_model.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{predict.age_depth_model} 4 | \alias{predict.age_depth_model} 5 | \alias{predict_depth} 6 | \alias{predict_age} 7 | \title{Predict age and depth values} 8 | \usage{ 9 | \method{predict}{age_depth_model}(object, .data = NULL, depth = NULL, age = NULL, ...) 10 | 11 | predict_depth(object, age) 12 | 13 | predict_age(object, depth) 14 | } 15 | \arguments{ 16 | \item{object}{An \link{age_depth_model} object} 17 | 18 | \item{.data}{Optional input data frame} 19 | 20 | \item{depth, age}{Specify exactly one of these to predict the other.} 21 | 22 | \item{...}{Unused} 23 | } 24 | \value{ 25 | A data frame with the same number of observations as the input age or 26 | depth vector. 27 | } 28 | \description{ 29 | Predict age and depth values 30 | } 31 | \examples{ 32 | adm <- age_depth_model( 33 | alta_lake_210Pb_ages, 34 | depth = depth_cm, age = age_year_ad, 35 | age_max = age_year_ad + age_error_yr, 36 | age_min = age_year_ad - age_error_yr 37 | ) 38 | 39 | predict(adm, depth = 1:5) 40 | 41 | } 42 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 tidypaleo authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/halifax_lakes_plottable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{halifax_lakes_plottable} 5 | \alias{halifax_lakes_plottable} 6 | \title{Halifax lakes water chemistry and top/bottom diatom counts} 7 | \format{ 8 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 114 rows and 5 columns. 9 | } 10 | \source{ 11 | Neotoma paleoecology database (\url{https://www.neotomadb.org}) 12 | } 13 | \usage{ 14 | halifax_lakes_plottable 15 | } 16 | \description{ 17 | A subset of well-labeled, clean diatom count data for 44 Halifax-area (Nova Scotia) lakes, 18 | an analysis of which has been published by Ginn et al. (2015). 19 | } 20 | \examples{ 21 | halifax_lakes_plottable 22 | 23 | } 24 | \references{ 25 | Ginn, Brian K., Thiyake Rajaratnam, Brian F. Cumming, and John P. 26 | Smol. "Establishing Realistic Management Objectives for Urban Lakes Using 27 | Paleolimnological Techniques: An Example from Halifax Region (Nova Scotia, 28 | Canada)." Lake and Reservoir Management 31, no. 2 (April 3, 2015): 92-108. 29 | \doi{10.1080/10402381.2015.1013648}. 30 | } 31 | \keyword{datasets} 32 | -------------------------------------------------------------------------------- /man/age_depth_as_sec_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{age_depth_as_sec_axis} 4 | \alias{age_depth_as_sec_axis} 5 | \title{Use an age depth model as a second ggplot axis} 6 | \usage{ 7 | age_depth_as_sec_axis(x, primary = c("depth", "age"), ...) 8 | } 9 | \arguments{ 10 | \item{x}{An \link{age_depth_model}} 11 | 12 | \item{primary}{Specify the primary axis as 'age' or 'depth'} 13 | 14 | \item{...}{Passed to \link[ggplot2:sec_axis]{sec_axis}} 15 | } 16 | \value{ 17 | A ggplot2 \link[ggplot2:sec_axis]{sec_axis} for use in \link[ggplot2:scale_continuous]{scale_x_continuous}, 18 | \link[ggplot2:scale_continuous]{scale_y_continuous}, or their reverse variants. 19 | } 20 | \description{ 21 | Use an age depth model as a second ggplot axis 22 | } 23 | \examples{ 24 | library(ggplot2) 25 | alta_lake_adm <- age_depth_model( 26 | alta_lake_210Pb_ages, 27 | depth = depth_cm, 28 | age = age_year_ad 29 | ) 30 | 31 | ggplot(alta_lake_210Pb_ages, aes(y = depth_cm, x = age_year_ad)) + 32 | geom_path() + 33 | geom_point() + 34 | scale_y_reverse(sec.axis = age_depth_as_sec_axis(alta_lake_adm)) 35 | 36 | } 37 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | development: 2 | mode: auto 3 | 4 | reference: 5 | - title: Stratigraphic diagrams 6 | desc: Helpers for ggplot2-based stratigraphic diagrams. 7 | contents: 8 | - starts_with("geom_") 9 | - starts_with("stat_") 10 | - starts_with("scale_") 11 | - starts_with("facet_") 12 | - starts_with("layer_") 13 | - starts_with("rotated_") 14 | - starts_with("label_") 15 | - starts_with("theme_") 16 | - sequential_layer_facets 17 | 18 | - title: Age-depth models 19 | desc: Functions to interpolate/extrapolate ages and depths given a set of paired age/depth values. 20 | contents: 21 | - age_depth_model 22 | - predict.age_depth_model 23 | - predict_age 24 | - predict_depth 25 | - starts_with("age_depth_") 26 | - contains("age_depth_model") 27 | - as_trans_factory 28 | 29 | - title: Nested analyses 30 | desc: Helpers for clustering and ordination of stratigraphic data. 31 | contents: 32 | - starts_with("nested_") 33 | - plot.nested_analysis 34 | 35 | - title: Example data 36 | desc: Real data sets to test and document this package. 37 | contents: 38 | - starts_with("alta_") 39 | - starts_with("halifax_") 40 | - starts_with("keji_") 41 | - starts_with("long_lake_") 42 | - starts_with("kellys_") 43 | -------------------------------------------------------------------------------- /man/sequential_layer_facets.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-plot_addons.R 3 | \name{sequential_layer_facets} 4 | \alias{sequential_layer_facets} 5 | \title{Change facet ordering behaviour} 6 | \usage{ 7 | sequential_layer_facets(reverse = FALSE) 8 | } 9 | \arguments{ 10 | \item{reverse}{Use TRUE to process layers in reverse order} 11 | } 12 | \value{ 13 | An object that can be added to a \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} 14 | } 15 | \description{ 16 | Normally, facets are ordered using \link[base:factor]{as.factor} on all values that occur 17 | within layer data, which means that when adding additional layers, any ordering 18 | is not preserved unless the factor levels are identical on all factors. This function 19 | changes this behaviour such that facet levels are combined in layer order. This is 20 | useful when adding standalone layers to a plot without disturbing the existing order. 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | 25 | p <- ggplot(mapping = aes(x, y)) + 26 | geom_point(data = data.frame(x = 1:5, y = 1:5, facet = "b")) + 27 | geom_point(data = data.frame(x = 1:5, y = 1:5, facet = "a")) + 28 | facet_wrap(vars(facet)) 29 | 30 | p 31 | p + sequential_layer_facets() 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/nested_analysis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_data_matrix.R 3 | \name{nested_analysis} 4 | \alias{nested_analysis} 5 | \title{Perform an analysis on a nested data matrix} 6 | \usage{ 7 | nested_analysis( 8 | .data, 9 | .fun, 10 | ..., 11 | .output_column = "model", 12 | .reserved_names = NULL, 13 | .env = parent.frame() 14 | ) 15 | } 16 | \arguments{ 17 | \item{.data}{A data frame with a list column of data frames, possibly created using 18 | \link{nested_data}.} 19 | 20 | \item{.fun}{A model function} 21 | 22 | \item{...}{Passed to fun} 23 | 24 | \item{.output_column}{A column name in which the output of .fun should be stored.} 25 | 26 | \item{.reserved_names}{Names that should not be allowed as columns in any 27 | data frame within this object} 28 | 29 | \item{.env}{Passed to \link[rlang:as_function]{as_function}} 30 | } 31 | \value{ 32 | .data with an additional list column of fun output 33 | } 34 | \description{ 35 | Perform an analysis on a nested data matrix 36 | } 37 | \examples{ 38 | nd <- nested_data( 39 | alta_lake_geochem, 40 | qualifiers = c(age, depth, zone), 41 | key = param, 42 | value = value, 43 | trans = scale 44 | ) 45 | 46 | na <- nested_analysis(nd, vegan::rda, X = data) 47 | plot(na) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/label_species.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-labels.R 3 | \name{label_species} 4 | \alias{label_species} 5 | \title{Species facet labellers} 6 | \usage{ 7 | label_species( 8 | labels, 9 | dont_italicize = c("\\\\(.*?\\\\)", "spp?\\\\.", "-complex", "[Oo]ther"), 10 | species_facet = 1, 11 | multi_line = TRUE 12 | ) 13 | } 14 | \arguments{ 15 | \item{labels}{A data.frame of facet label values} 16 | 17 | \item{dont_italicize}{Regular expressions that should not be italicized} 18 | 19 | \item{species_facet}{Which facet(s) contain species values} 20 | 21 | \item{multi_line}{See \link[ggplot2:labellers]{label_parsed}} 22 | } 23 | \value{ 24 | A \code{\link[ggplot2:labeller]{ggplot2::labeller()}} 25 | } 26 | \description{ 27 | Use these to label species with partial italic formatting. See \link[ggplot2:labellers]{label_parsed}. 28 | } 29 | \examples{ 30 | 31 | library(ggplot2) 32 | 33 | ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 34 | geom_col_segsh() + 35 | scale_y_reverse() + 36 | facet_grid( 37 | cols = vars(taxon), 38 | rows = vars(location), 39 | scales = "free_x", 40 | space = "free_x", 41 | labeller = purrr::partial(label_species, species_facet = "taxon") 42 | ) + 43 | labs(y = "Depth (cm)") 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/tidypaleo-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tidypaleo-package.R 3 | \docType{package} 4 | \name{tidypaleo-package} 5 | \alias{tidypaleo} 6 | \alias{tidypaleo-package} 7 | \title{tidypaleo: Tidy Tools for Paleoenvironmental Archives} 8 | \description{ 9 | Provides a set of functions with a common framework for age-depth model management, stratigraphic visualization, and common statistical transformations. The focus of the package is stratigraphic visualization, for which 'ggplot2' components are provided to reproduce the scales, geometries, facets, and theme elements commonly used in publication-quality stratigraphic diagrams. Helpers are also provided to reproduce the exploratory statistical summaries that are frequently included on stratigraphic diagrams. See Dunnington et al. (2021) \doi{10.18637/jss.v101.i07}. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://paleolimbot.github.io/tidypaleo/} 15 | \item \url{https://github.com/paleolimbot/tidypaleo} 16 | \item Report bugs at \url{https://github.com/paleolimbot/tidypaleo/issues} 17 | } 18 | 19 | } 20 | \author{ 21 | \strong{Maintainer}: Dewey Dunnington \email{dewey@fishandwhistle.net} (\href{https://orcid.org/0000-0002-9415-4582}{ORCID}) [copyright holder] 22 | 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /data-raw/long_lake.R: -------------------------------------------------------------------------------- 1 | 2 | library(tidyverse) 3 | library(mudata2) 4 | 5 | long_lake_plottable <- long_lake %>% 6 | tbl_data() %>% 7 | filter(param %in% c("C/N", "d13C", "d15N")) %>% 8 | select(-min_value, -max_value) 9 | 10 | # from Dunnington et al. 2017 / doi:10.1139/facets-2017-0004 11 | # and White 2012 / 12 | # http://openarchive.acadiau.ca/cdm/singleitem/collection/Theses/id/645/rec/80 13 | 14 | long_lake_14C_ages <- long_lake %>% 15 | select_params(`14C_age`) %>% 16 | tbl_data() %>% 17 | arrange(depth) %>% 18 | mutate(core = "Dunnington et al. 2017 / LL-PC2", 19 | type = c("twig fragment", "plant", "wood fragment", "wood", "wood fragment")) %>% 20 | mutate(type = paste0("Carbon-14 age / ", type)) %>% 21 | select(core, depth_cm = depth, age_14C = value, age_error_14C = sd, type) 22 | 23 | long_lake_bacon_ages <- read_delim("data-raw/LL-PC2_43_ages.txt", delim = "\t", 24 | col_types = cols(.default = col_double())) %>% 25 | rename(depth_cm = depth, age_min_year_BP = min, age_max_year_BP = max, 26 | age_median_year_BP = median, age_weighted_mean_year_BP = wmean) %>% 27 | rlang::set_attrs(spec = NULL) 28 | 29 | devtools::use_data(long_lake_14C_ages, overwrite = TRUE) 30 | devtools::use_data(long_lake_bacon_ages, overwrite = TRUE) 31 | usethis::use_data(long_lake_plottable, overwrite = TRUE) 32 | -------------------------------------------------------------------------------- /man/nested_prcomp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_prcomp.R 3 | \name{nested_prcomp} 4 | \alias{nested_prcomp} 5 | \title{Nested Principal Components Analysis (PCA)} 6 | \usage{ 7 | nested_prcomp(.data, data_column = .data$data, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{A data frame with a list column of data frames, possibly created using 11 | \link{nested_data}.} 12 | 13 | \item{data_column}{An expression that evalulates to the data object within each row of .data} 14 | 15 | \item{...}{Passed to \link[stats:prcomp]{prcomp}.} 16 | } 17 | \value{ 18 | .data with additional columns 'model', 'loadings', 'variance' and 'scores' 19 | } 20 | \description{ 21 | Powered by \link[stats:prcomp]{prcomp}. When creating the \link{nested_data}, 22 | the data should be scaled (i.e, \code{trans = scale}) if all variables are not 23 | in the same unit. 24 | } 25 | \examples{ 26 | library(dplyr, warn.conflicts = FALSE) 27 | 28 | nested_pca <- alta_lake_geochem \%>\% 29 | nested_data( 30 | qualifiers = c(depth, zone), 31 | key = param, 32 | value = value, 33 | trans = scale 34 | ) \%>\% 35 | nested_prcomp() 36 | 37 | # get variance info 38 | nested_pca \%>\% unnested_data(variance) 39 | 40 | # get loadings info 41 | nested_pca \%>\% unnested_data(loadings) 42 | 43 | # scores, requalified 44 | nested_pca \%>\% unnested_data(c(qualifiers, scores)) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /man/age_depth_interpolate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{age_depth_interpolate} 4 | \alias{age_depth_interpolate} 5 | \alias{age_depth_extrapolate} 6 | \alias{age_depth_exact} 7 | \alias{age_depth_na} 8 | \title{Age-depth model interpolators/extrapolators} 9 | \usage{ 10 | age_depth_interpolate(x, y) 11 | 12 | age_depth_extrapolate(x, y, x0 = last, y0 = last, slope = NULL) 13 | 14 | age_depth_exact(x, y) 15 | 16 | age_depth_na(x, y) 17 | } 18 | \arguments{ 19 | \item{x}{A paired vector of x values} 20 | 21 | \item{y}{A paired vector of y values} 22 | 23 | \item{x0}{The x value to anchor the transform} 24 | 25 | \item{y0}{The y value to anchor the transform} 26 | 27 | \item{slope}{The slope (in units of y/x) to use for the transform} 28 | } 29 | \value{ 30 | A list with component functions \code{trans} and \code{inverse} 31 | } 32 | \description{ 33 | Age-depth model interpolators/extrapolators 34 | } 35 | \examples{ 36 | age_depth_model( 37 | alta_lake_210Pb_ages, 38 | depth = depth_cm, age = age_year_ad, 39 | age_max = age_year_ad + age_error_yr, 40 | age_min = age_year_ad - age_error_yr, 41 | extrapolate_age_below = ~age_depth_extrapolate( 42 | tail(.x, 3), tail(.y, 3), x0 = dplyr::last, y0 = dplyr::last 43 | ), 44 | extrapolate_age_above = ~age_depth_extrapolate( 45 | head(.x, 3), head(.y, 3), x0 = dplyr::first, y0 = dplyr::first 46 | ) 47 | ) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R, R/ggstrat-facets.R, 3 | % R/ggstrat-geoms.R 4 | \docType{import} 5 | \name{reexports} 6 | \alias{reexports} 7 | \alias{first} 8 | \alias{last} 9 | \alias{vars} 10 | \alias{position_fillv} 11 | \alias{PositionFillv} 12 | \alias{position_stackv} 13 | \alias{PositionStackv} 14 | \alias{position_dodge2v} 15 | \alias{PositionDodge2v} 16 | \alias{position_dodgev} 17 | \alias{PositionDodgev} 18 | \alias{geom_colh} 19 | \alias{GeomColh} 20 | \title{Objects exported from other packages} 21 | \keyword{internal} 22 | \description{ 23 | These objects are imported from other packages. Follow the links 24 | below to see their documentation. 25 | 26 | \describe{ 27 | \item{dplyr}{\code{\link[dplyr:nth]{first}}, \code{\link[dplyr:nth]{last}}} 28 | 29 | \item{ggplot2}{\code{\link[ggplot2]{vars}}} 30 | 31 | \item{ggstance}{\code{\link[ggstance:ggstance-ggproto]{GeomColh}}, \code{\link[ggstance:ggstance-ggproto]{PositionDodge2v}}, \code{\link[ggstance:ggstance-ggproto]{PositionDodgev}}, \code{\link[ggstance:ggstance-ggproto]{PositionFillv}}, \code{\link[ggstance:ggstance-ggproto]{PositionStackv}}, \code{\link[ggstance:geom_barh]{geom_colh}}, \code{\link[ggstance:position-vertical]{position_dodge2v}}, \code{\link[ggstance:position-vertical]{position_dodgev}}, \code{\link[ggstance:position-vertical]{position_fillv}}, \code{\link[ggstance:position-vertical]{position_stackv}}} 32 | }} 33 | 34 | -------------------------------------------------------------------------------- /data-raw/alta_lake.R: -------------------------------------------------------------------------------- 1 | 2 | library(tidyverse) 3 | library(mudata2) 4 | 5 | # from Dunnington et al. 2016, doi: 10.1007/s10933-016-9919-x 6 | # and thesis version, Dunnington 2015, 7 | # http://openarchive.acadiau.ca/cdm/singleitem/collection/Theses/id/1074/rec/1 8 | 9 | alta_lake_210Pb_ages <- tibble( 10 | core = "Dunnington et al. 2016 / AL-GC2", 11 | depth_cm = c(0, 1, 1.5, 2:7), 12 | age_year_ad = c(2014.6, 2008.0, 2003.4, 1998.1, 1981.8, 1965.6, 1947.2, 1922.3, 1896.0), 13 | age_error_yr = c(0.00, 0.34, 0.56, 0.86, 2.25, 4.73, 8.21, 27.02, 57.19), 14 | type = "Sediment Lead-210 CRS" 15 | ) 16 | 17 | alta_lake_14C_ages <- tibble( 18 | core = "Dunnington et al. 2015 / AL-GC2", 19 | depth_cm = 29.5, 20 | age_14C = 340, 21 | age_error_14C = 30, 22 | type = "Carbon-14 age / fir needle" 23 | ) 24 | 25 | alta_lake_bacon_ages <- read_delim("data-raw/AL-GC2_30_ages.txt", delim = "\t", 26 | col_types = cols(.default = col_double())) %>% 27 | rename(depth_cm = depth, age_min_year_BP = min, age_max_year_BP = max, 28 | age_median_year_BP = median, age_weighted_mean_year_BP = wmean) %>% 29 | rlang::set_attrs(spec = NULL) 30 | 31 | alta_lake_geochem <- alta_lake %>% 32 | select_params("C", "C/N", "d13C", "d15N", "Ti", "Cu") %>% 33 | tbl_data() %>% 34 | select(-dataset) 35 | 36 | devtools::use_data(alta_lake_geochem, overwrite = TRUE) 37 | devtools::use_data(alta_lake_210Pb_ages, overwrite = TRUE) 38 | devtools::use_data(alta_lake_14C_ages, overwrite = TRUE) 39 | devtools::use_data(alta_lake_bacon_ages, overwrite = TRUE) 40 | -------------------------------------------------------------------------------- /man/label_geochem.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-labels.R 3 | \name{label_geochem} 4 | \alias{label_geochem} 5 | \title{Geochem facet labelers} 6 | \usage{ 7 | label_geochem( 8 | labels, 9 | units = character(0), 10 | default_units = NA_character_, 11 | geochem_facet = 1, 12 | renamers = c(`^d([0-9]+)([HCNOS])$` = "paste(delta ^ \\\\1, \\\\2)", `^210Pb$` = 13 | "paste({}^210, Pb)", `^Pb210$` = "paste({}^210, Pb)"), 14 | multi_line = TRUE 15 | ) 16 | } 17 | \arguments{ 18 | \item{labels}{A data.frame of facet label values} 19 | 20 | \item{units}{A named list of values = unit} 21 | 22 | \item{default_units}{The default units to apply} 23 | 24 | \item{geochem_facet}{Which facet to apply formatting} 25 | 26 | \item{renamers}{Search and replace operations to perform in the form 27 | search = replace. Replace text can (should) contain backreferences, 28 | and will be parsed as an expression (see \link[grDevices:plotmath]{plotmath}). Use 29 | NULL to suppress renaming.} 30 | 31 | \item{multi_line}{See \link[ggplot2:labellers]{label_parsed}} 32 | } 33 | \value{ 34 | A \code{\link[ggplot2:labeller]{ggplot2::labeller()}} 35 | } 36 | \description{ 37 | Geochem facet labelers 38 | } 39 | \examples{ 40 | 41 | library(ggplot2) 42 | 43 | ggplot(alta_lake_geochem, aes(x = value, y = depth)) + 44 | geom_lineh() + 45 | geom_point() + 46 | scale_y_reverse() + 47 | facet_wrap( 48 | vars(param), 49 | labeller = purrr::partial(label_geochem, geochem_facet = "param"), 50 | nrow = 1, 51 | scales = "free_x" 52 | ) + 53 | labs(x = NULL, y = "Depth (cm)") 54 | 55 | } 56 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tidypaleo 2 | Title: Tidy Tools for Paleoenvironmental Archives 3 | Version: 0.1.4 4 | Authors@R: person("Dewey", "Dunnington", 5 | email = "dewey@fishandwhistle.net", 6 | role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-9415-4582")) 7 | Description: Provides a set of functions with a common framework for age-depth model management, 8 | stratigraphic visualization, and common statistical transformations. The focus of the 9 | package is stratigraphic visualization, for which 'ggplot2' components are provided 10 | to reproduce the scales, geometries, facets, and theme elements commonly used in 11 | publication-quality stratigraphic diagrams. Helpers are also provided to reproduce 12 | the exploratory statistical summaries that are frequently included on 13 | stratigraphic diagrams. See Dunnington et al. (2021) . 14 | Depends: R (>= 3.4.0) 15 | License: MIT + file LICENSE 16 | Encoding: UTF-8 17 | LazyData: true 18 | RoxygenNote: 7.3.2 19 | Suggests: testthat, 20 | knitr, 21 | rmarkdown, 22 | vegan, 23 | patchwork, 24 | forcats, 25 | vdiffr 26 | URL: https://paleolimbot.github.io/tidypaleo/, https://github.com/paleolimbot/tidypaleo 27 | BugReports: https://github.com/paleolimbot/tidypaleo/issues 28 | Imports: rlang, 29 | tidyselect, 30 | dplyr, 31 | vctrs, 32 | tibble, 33 | scales, 34 | ggplot2 (>= 3.0.0), 35 | styler, 36 | purrr, 37 | ggstance, 38 | stringr, 39 | withr, 40 | tidyr (>= 1.0.2), 41 | digest, 42 | rioja 43 | VignetteBuilder: knitr 44 | Roxygen: list(markdown = TRUE) 45 | -------------------------------------------------------------------------------- /man/scale_x_abundance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-scales.R 3 | \name{scale_x_abundance} 4 | \alias{scale_x_abundance} 5 | \alias{scale_y_abundance} 6 | \title{Scales for relative abundance values} 7 | \usage{ 8 | scale_x_abundance( 9 | ..., 10 | limits = c(0, NA), 11 | breaks = seq(10, 90, 30), 12 | minor_breaks = seq(0, 100, 10), 13 | expand = c(0, 1) 14 | ) 15 | 16 | scale_y_abundance( 17 | ..., 18 | limits = c(0, NA), 19 | breaks = seq(10, 90, 30), 20 | minor_breaks = seq(0, 100, 10), 21 | expand = c(0, 1) 22 | ) 23 | } 24 | \arguments{ 25 | \item{...}{Passed to \link[ggplot2:scale_continuous]{scale_y_continuous} or \link[ggplot2:scale_continuous]{scale_x_continuous}} 26 | 27 | \item{limits}{Limits for the scale} 28 | 29 | \item{breaks}{Where to place labels on the scale} 30 | 31 | \item{minor_breaks}{Where to place minor breaks} 32 | 33 | \item{expand}{A vector of expantion constants} 34 | } 35 | \value{ 36 | A \link[ggplot2:scale_continuous]{scale_y_continuous} or \link[ggplot2:scale_continuous]{scale_x_continuous} 37 | } 38 | \description{ 39 | Continuous scales that (1) always start at 0, (2) always have the same breaks, and 40 | (3) expand using a constant rather than a percentage. These scales assume that data are 41 | in percentages (i.e., range 0 to 100 rather than 0 to 1). 42 | } 43 | \examples{ 44 | library(dplyr, warn.conflicts = FALSE) 45 | library(ggplot2) 46 | 47 | keji_lakes_plottable \%>\% 48 | filter(taxon == "Other", location == "Beaverskin Lake") \%>\% 49 | ggplot(aes(rel_abund, depth)) + 50 | geom_col_segsh() + 51 | scale_x_abundance() + 52 | scale_y_reverse() 53 | 54 | } 55 | -------------------------------------------------------------------------------- /man/geom_ribbonh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-geoms.R 3 | \docType{data} 4 | \name{geom_ribbonh} 5 | \alias{geom_ribbonh} 6 | \alias{GeomRibbonh} 7 | \alias{geom_areah} 8 | \alias{GeomAreah} 9 | \title{Vertical ribbons and area plots} 10 | \format{ 11 | An object of class \code{GeomRibbonh} (inherits from \code{Geom}, \code{ggproto}, \code{gg}) of length 6. 12 | 13 | An object of class \code{GeomAreah} (inherits from \code{GeomRibbonh}, \code{Geom}, \code{ggproto}, \code{gg}) of length 4. 14 | } 15 | \usage{ 16 | geom_ribbonh( 17 | mapping = NULL, 18 | data = NULL, 19 | stat = "identity", 20 | position = "identity", 21 | ..., 22 | na.rm = FALSE, 23 | show.legend = NA, 24 | inherit.aes = TRUE 25 | ) 26 | 27 | GeomRibbonh 28 | 29 | geom_areah( 30 | mapping = NULL, 31 | data = NULL, 32 | stat = "identity", 33 | position = "stackv", 34 | na.rm = FALSE, 35 | show.legend = NA, 36 | inherit.aes = TRUE, 37 | ... 38 | ) 39 | 40 | GeomAreah 41 | } 42 | \arguments{ 43 | \item{mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...}{See 44 | \link[ggplot2:geom_ribbon]{geom_ribbon}.} 45 | } 46 | \description{ 47 | Vertical ribbons and area plots 48 | } 49 | \examples{ 50 | library(ggplot2) 51 | 52 | # Generate data 53 | huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) 54 | h <- ggplot(huron, aes(y = year)) 55 | 56 | h + geom_ribbonh(aes(xmin=0, xmax=level)) 57 | h + geom_areah(aes(x = level)) 58 | 59 | # Add aesthetic mappings 60 | h + 61 | geom_ribbonh(aes(xmin = level - 1, xmax = level + 1), fill = "grey70") + 62 | geom_lineh(aes(x = level)) 63 | 64 | } 65 | \keyword{datasets} 66 | -------------------------------------------------------------------------------- /man/plot.nested_analysis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_data_matrix.R, R/nested_prcomp.R 3 | \name{plot.nested_analysis} 4 | \alias{plot.nested_analysis} 5 | \alias{plot_nested_analysis} 6 | \alias{biplot.nested_prcomp} 7 | \title{Plot a nested analysis} 8 | \usage{ 9 | \method{plot}{nested_analysis}(x, ..., main = "", nrow = NULL, ncol = NULL) 10 | 11 | plot_nested_analysis( 12 | .x, 13 | .fun, 14 | ..., 15 | nrow = NULL, 16 | ncol = NULL, 17 | .model_column = .data$model, 18 | .output_column = NULL 19 | ) 20 | 21 | \method{biplot}{nested_prcomp}(x, ..., nrow = NULL, ncol = NULL) 22 | } 23 | \arguments{ 24 | \item{x, .x}{A \link{nested_analysis} object (or subclass)} 25 | 26 | \item{...}{Passed to the plot function. Tidy evaluation is supported, and arguments are evaluated 27 | within a transposed version of x for each row.} 28 | 29 | \item{main}{The plot title} 30 | 31 | \item{nrow, ncol}{Force a number of rows or columns in the output} 32 | 33 | \item{.fun}{A function that produces graphical output} 34 | 35 | \item{.model_column}{The column containing the model} 36 | 37 | \item{.output_column}{The column in which the output of the plot function should be placed} 38 | } 39 | \value{ 40 | the input, invisibly 41 | } 42 | \description{ 43 | Calls \link[graphics:plot.default]{plot} or another (base) plotting function on all models, arranging the output in subplots. 44 | } 45 | \examples{ 46 | nd <- nested_data( 47 | alta_lake_geochem, 48 | qualifiers = c(age, depth, zone), 49 | key = param, 50 | value = value, 51 | trans = scale 52 | ) 53 | 54 | na <- nested_analysis(nd, vegan::rda, X = data) 55 | plot(na) 56 | 57 | } 58 | -------------------------------------------------------------------------------- /man/age_depth_model.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/age_depth_model.R 3 | \name{age_depth_model} 4 | \alias{age_depth_model} 5 | \title{Create age depth models} 6 | \usage{ 7 | age_depth_model( 8 | .data = NULL, 9 | depth, 10 | age, 11 | age_min = NA_real_, 12 | age_max = NA_real_, 13 | interpolate_age = age_depth_interpolate, 14 | extrapolate_age_below = ~age_depth_extrapolate(.x, .y, x0 = last, y0 = last), 15 | extrapolate_age_above = ~age_depth_extrapolate(.x, .y, x0 = first, y0 = first), 16 | interpolate_age_limits = age_depth_exact, 17 | extrapolate_age_limits_below = age_depth_na, 18 | extrapolate_age_limits_above = age_depth_na 19 | ) 20 | } 21 | \arguments{ 22 | \item{.data}{A data frame} 23 | 24 | \item{depth, age, age_min, age_max}{Expressions evaluated in \code{.data} that 25 | provide the known depths, known ages, and error information if available. 26 | These expressions are evaluated like they are within \link[dplyr:mutate]{mutate} 27 | if \code{.data} is present.} 28 | 29 | \item{interpolate_age, extrapolate_age_below, extrapolate_age_above}{These 30 | arguments provide the rules for interpolating and extrapolating ages based 31 | on depths.} 32 | 33 | \item{interpolate_age_limits, extrapolate_age_limits_below, extrapolate_age_limits_above}{These arguments provide the rules for interpolating and extrapolating age 34 | min and max values based on depths.} 35 | } 36 | \value{ 37 | An age depth model object. 38 | } 39 | \description{ 40 | Create age depth models 41 | } 42 | \examples{ 43 | age_depth_model( 44 | alta_lake_210Pb_ages, 45 | depth = depth_cm, age = age_year_ad, 46 | age_max = age_year_ad + age_error_yr, 47 | age_min = age_year_ad - age_error_yr 48 | ) 49 | 50 | } 51 | -------------------------------------------------------------------------------- /tests/testthat/test-data_eval.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("data_eval creates tibbles with or without data", { 3 | expect_is(data_eval(a = 1:5, b = 6:10), "tbl_df") 4 | expect_is(data_eval(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = b), "tbl_df") 5 | expect_identical( 6 | data_eval(a = 1:5, b = 6:10), 7 | data_eval(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = b) 8 | ) 9 | }) 10 | 11 | test_that("data_eval accepts tidy eval input", { 12 | wrapper <- function(.data = NULL, ...) { 13 | args <- rlang::quos(...) 14 | data_eval(.data, !!!args) 15 | } 16 | 17 | expect_is(wrapper(a = 1:5, b = 6:10), "tbl_df") 18 | expect_is(wrapper(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = b), "tbl_df") 19 | expect_identical( 20 | wrapper(a = 1:5, b = 6:10), 21 | wrapper(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = b) 22 | ) 23 | }) 24 | 25 | test_that("NULL values result in no columns", { 26 | expect_identical(colnames(data_eval(a = 1:5, b = NULL)), "a") 27 | expect_identical( 28 | colnames(data_eval(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = NULL)), 29 | "a" 30 | ) 31 | expect_silent(colnames(data_eval(.data = tibble::tibble(a = 1:5, b = 6:10), a = a, b = NULL))) 32 | }) 33 | 34 | test_that("no arguments is no problem", { 35 | expect_is(data_eval(), "tbl_df") 36 | expect_identical(ncol(data_eval()), 0L) 37 | expect_is(data_eval(tibble::tibble(a = 1:5, b = 6:10)), "tbl_df") 38 | expect_identical(ncol(data_eval(tibble::tibble(a = 1:5, b = 6:10))), 0L) 39 | expect_identical( 40 | data_eval(), 41 | data_eval(a = NULL, b = NULL) 42 | ) 43 | expect_identical( 44 | data_eval(tibble::tibble(a = 1:5, b = 6:10)), 45 | data_eval(tibble::tibble(a = 1:5, b = 6:10), a = NULL, b = NULL) 46 | ) 47 | }) 48 | -------------------------------------------------------------------------------- /man/stat_nested_hclust.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_chclust.R 3 | \docType{data} 4 | \name{stat_nested_hclust} 5 | \alias{stat_nested_hclust} 6 | \alias{StatNestedHclust} 7 | \title{Display a dendrogram as a ggplot2 layer} 8 | \format{ 9 | An object of class \code{StatNestedHclust} (inherits from \code{Stat}, \code{ggproto}, \code{gg}) of length 4. 10 | } 11 | \usage{ 12 | stat_nested_hclust( 13 | mapping = NULL, 14 | data = NULL, 15 | geom = "segment", 16 | position = "identity", 17 | ..., 18 | inherit.aes = TRUE, 19 | show.legend = NA 20 | ) 21 | 22 | StatNestedHclust 23 | } 24 | \arguments{ 25 | \item{mapping}{A mapping created using \link[ggplot2:aes]{aes}. Must map x OR y to a qualifier.} 26 | 27 | \item{data}{A \link{nested_hclust} object} 28 | 29 | \item{geom}{Any geom that takes x, xend, y, and yend. Probably \link[ggplot2:geom_segment]{geom_segment} is 30 | the only one that makes sense.} 31 | 32 | \item{position}{Position adjustment} 33 | 34 | \item{...}{Passed to the the stat/geom (see \link[ggplot2:geom_segment]{geom_segment})} 35 | 36 | \item{inherit.aes}{Inherit aesthetics from ggplot()?} 37 | 38 | \item{show.legend}{Show mapped aesthetics in the legend?} 39 | } 40 | \value{ 41 | A \link[ggplot2:Stat]{ggplot2::Stat} 42 | } 43 | \description{ 44 | Display a dendrogram as a ggplot2 layer 45 | } 46 | \examples{ 47 | library(ggplot2) 48 | library(dplyr, warn.conflicts = FALSE) 49 | 50 | alta_coniss <- nested_data( 51 | alta_lake_geochem, 52 | qualifiers = c(age, depth, zone), 53 | key = param, 54 | value = value, 55 | trans = scale 56 | ) \%>\% 57 | nested_chclust_coniss() 58 | 59 | ggplot(alta_coniss) + 60 | stat_nested_hclust(aes(model = model, y = depth)) + 61 | scale_y_reverse() 62 | 63 | } 64 | \keyword{datasets} 65 | -------------------------------------------------------------------------------- /man/layer_dendrogram.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-plot_addons.R 3 | \name{layer_dendrogram} 4 | \alias{layer_dendrogram} 5 | \alias{plot_layer_dendrogram} 6 | \alias{layer_zone_boundaries} 7 | \title{Add a dendrogram as a layer or facet} 8 | \usage{ 9 | layer_dendrogram( 10 | object, 11 | mapping, 12 | ..., 13 | colour = "black", 14 | size = 0.5, 15 | linetype = 1, 16 | alpha = NA, 17 | sequential_facets = TRUE 18 | ) 19 | 20 | plot_layer_dendrogram(object, mapping, ..., panel_label = "CONISS") 21 | 22 | layer_zone_boundaries( 23 | object, 24 | mapping, 25 | ..., 26 | linetype = 2, 27 | alpha = 0.7, 28 | colour = "black", 29 | size = 0.5 30 | ) 31 | } 32 | \arguments{ 33 | \item{object}{A \link{nested_hclust} object.} 34 | 35 | \item{mapping}{Map at least one axis (x or y) to a qualifier, like \code{aes(x = depth)} or similar.} 36 | 37 | \item{...}{Use facet_var = "CONISS" or similar to name the panel} 38 | 39 | \item{linetype, alpha, colour, size}{Customize the apperance of boundary/dendrogram segment lines} 40 | 41 | \item{sequential_facets}{TRUE will result in the panel containing the dendrogram added to the right 42 | of the plot.} 43 | 44 | \item{panel_label}{Use to label a pane on a stanalone dendrogram plot} 45 | } 46 | \value{ 47 | A \code{\link[ggplot2:layer]{ggplot2::layer()}} 48 | } 49 | \description{ 50 | Add a dendrogram as a layer or facet 51 | } 52 | \examples{ 53 | library(ggplot2) 54 | library(dplyr, warn.conflicts = FALSE) 55 | 56 | alta_coniss <- nested_data( 57 | alta_lake_geochem, 58 | qualifiers = c(age, depth, zone), 59 | key = param, 60 | value = value, 61 | trans = scale 62 | ) \%>\% 63 | nested_chclust_coniss() 64 | 65 | ggplot() + 66 | layer_dendrogram(alta_coniss, aes(y = depth)) + 67 | scale_y_reverse() 68 | 69 | } 70 | -------------------------------------------------------------------------------- /man/geom_col_segsh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-geoms.R 3 | \docType{data} 4 | \name{geom_col_segsh} 5 | \alias{geom_col_segsh} 6 | \alias{geom_col_segs} 7 | \alias{GeomColSegsh} 8 | \alias{GeomColSegs} 9 | \alias{GeomLineh} 10 | \title{Useful geometries for strat diagrams} 11 | \format{ 12 | An object of class \code{GeomColSegsh} (inherits from \code{GeomSegment}, \code{Geom}, \code{ggproto}, \code{gg}) of length 4. 13 | 14 | An object of class \code{GeomColSegs} (inherits from \code{GeomSegment}, \code{Geom}, \code{ggproto}, \code{gg}) of length 4. 15 | 16 | An object of class \code{GeomLineh} (inherits from \code{GeomPath}, \code{Geom}, \code{ggproto}, \code{gg}) of length 2. 17 | } 18 | \usage{ 19 | geom_col_segsh( 20 | mapping = NULL, 21 | data = NULL, 22 | stat = "identity", 23 | position = "identity", 24 | ..., 25 | xend = 0, 26 | arrow = NULL, 27 | arrow.fill = NULL, 28 | lineend = "butt", 29 | linejoin = "round", 30 | na.rm = FALSE, 31 | show.legend = NA, 32 | inherit.aes = TRUE 33 | ) 34 | 35 | geom_col_segs( 36 | mapping = NULL, 37 | data = NULL, 38 | stat = "identity", 39 | position = "identity", 40 | ..., 41 | yend = 0, 42 | arrow = NULL, 43 | arrow.fill = NULL, 44 | lineend = "butt", 45 | linejoin = "round", 46 | na.rm = FALSE, 47 | show.legend = NA, 48 | inherit.aes = TRUE 49 | ) 50 | 51 | GeomColSegsh 52 | 53 | GeomColSegs 54 | 55 | GeomLineh 56 | } 57 | \arguments{ 58 | \item{mapping, data, stat, position, arrow, arrow.fill, lineend, linejoin, na.rm, show.legend, inherit.aes, ...}{See 59 | \link[ggplot2:geom_segment]{geom_segment}.} 60 | 61 | \item{xend, yend}{The end of the horizontal or vertical segment bars, respectively.} 62 | } 63 | \value{ 64 | A ggplot2 layer 65 | } 66 | \description{ 67 | Useful geometries for strat diagrams 68 | } 69 | \keyword{datasets} 70 | -------------------------------------------------------------------------------- /man/layer_scores.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-plot_addons.R 3 | \name{layer_scores} 4 | \alias{layer_scores} 5 | \alias{plot_layer_scores} 6 | \title{Add scores to a plot} 7 | \usage{ 8 | layer_scores( 9 | object, 10 | mapping = NULL, 11 | which = "PC1", 12 | key = "param", 13 | value = "value", 14 | scores_geom = list(ggplot2::geom_path(), ggplot2::geom_point()), 15 | sequential_facets = TRUE 16 | ) 17 | 18 | plot_layer_scores( 19 | object, 20 | mapping, 21 | which = "PC1", 22 | key = "param", 23 | value = "value", 24 | ... 25 | ) 26 | } 27 | \arguments{ 28 | \item{object}{A \link{nested_prcomp} or similar object} 29 | 30 | \item{mapping}{A mapping created with \link[ggplot2:aes]{aes}} 31 | 32 | \item{which}{Which principal components to plot} 33 | 34 | \item{key}{The column name to use for the principal component names} 35 | 36 | \item{value}{The column name to use for the principal component score values} 37 | 38 | \item{scores_geom}{One or more geometries to which scores should be applied.} 39 | 40 | \item{sequential_facets}{TRUE will result in the panel containing the dendrogram added to the right 41 | of the plot.} 42 | 43 | \item{...}{Passed to layer_scores()} 44 | } 45 | \value{ 46 | A \code{list()} that can be addeed to a \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} 47 | } 48 | \description{ 49 | Add scores to a plot 50 | } 51 | \examples{ 52 | library(ggplot2) 53 | library(dplyr, warn.conflicts = FALSE) 54 | 55 | alta_pca <- nested_data( 56 | alta_lake_geochem, 57 | qualifiers = c(age, depth, zone), 58 | key = param, 59 | value = value, 60 | trans = scale 61 | ) \%>\% 62 | nested_prcomp() 63 | 64 | ggplot() + 65 | layer_scores(alta_pca, aes(value, depth), which = "PC1") + 66 | scale_y_reverse() 67 | 68 | plot_layer_scores(alta_pca, aes(y = depth), which = c("PC1", "PC2")) + 69 | scale_y_reverse() 70 | 71 | } 72 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tidypaleo 5 | 6 | 7 | 8 | [![Codecov test 9 | coverage](https://codecov.io/gh/paleolimbot/tidypaleo/graph/badge.svg)](https://app.codecov.io/gh/paleolimbot/tidypaleo) 10 | [![R-CMD-check](https://github.com/paleolimbot/tidypaleo/workflows/R-CMD-check/badge.svg)](https://github.com/paleolimbot/tidypaleo/actions) 11 | 12 | 13 | Working with multi-proxy paleo-archive data can be difficult. There are 14 | multiple locations, multiple parameters, and a lot of 15 | discipline-specific norms for plot layout and notation. This package 16 | simplifies a few workflows to promote the use of R for reproducible 17 | documents in paleo-based studies. 18 | 19 | ## Installation 20 | 21 | You can install the released versio of tidypaleo from 22 | [CRAN](https://cran.r-project.org/) with: 23 | 24 | ``` r 25 | install.packages("tidypaleo") 26 | ``` 27 | 28 | You can install the development version from 29 | [GitHub](https://github.com) with: 30 | 31 | ``` r 32 | # install.packages("remotes") 33 | remotes::install_github("paleolimbot/tidypaleo") 34 | ``` 35 | 36 | ## Examples 37 | 38 | ### Strat diagrams 39 | 40 | This package exposes a number of functions useful when creating 41 | stratigraphic diagrams, including `facet_abundanceh()`, which combines 42 | several other functions to help create stratigraphic plots using 43 | **ggplot2**. The `geom_col_segsh()` geometry draws horizontal segments, 44 | which are commonly used to show species abundance data. 45 | 46 | ``` r 47 | library(ggplot2) 48 | library(tidypaleo) 49 | theme_set(theme_paleo()) 50 | 51 | ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 52 | geom_col_segsh() + 53 | scale_y_reverse() + 54 | facet_abundanceh(vars(taxon), grouping = vars(location)) + 55 | labs(y = "Depth (cm)") 56 | ``` 57 | 58 | 59 | -------------------------------------------------------------------------------- /data-raw/AL-GC2_30_ages.txt: -------------------------------------------------------------------------------- 1 | depth min max median wmean 2 | 1 -59.07 -57.14 -58.09 -58.07 3 | 1.5 -54.3 -52.37 -53.34 -53.32 4 | 2 -50.52 -46.69 -48.61 -48.57 5 | 2.5 -43.94 -37.11 -40.5 -40.47 6 | 3 -39.33 -25.79 -32.45 -32.42 7 | 3.5 -30.88 -17.78 -24.46 -24.35 8 | 4 -26.84 -4.42 -16.66 -16.34 9 | 4.5 -18.04 3.28 -7.79 -7.61 10 | 5 -13.58 17.78 0.46 1.01 11 | 5.5 -5.91 28.99 9.8 10.4 12 | 6 -2.55 48.33 17.8 19.41 13 | 6.5 3.49 59.34 27.12 28.57 14 | 7 7.15 78.16 35.39 37.6 15 | 7.5 13.19 89.25 44.49 46.6 16 | 8 16.91 105.1 52.79 55.37 17 | 8.5 23.53 115.81 61.57 64.17 18 | 9 28.35 130.67 70.04 73.02 19 | 9.5 34.44 141.53 78.94 81.79 20 | 10 39.51 154.72 87.54 90.6 21 | 10.5 47.27 163.98 96.17 99.3 22 | 11 52.53 176.75 104.85 107.98 23 | 11.5 59.67 186.37 113.89 116.82 24 | 12 65.44 198.04 122.73 125.65 25 | 12.5 73.74 207.4 131.93 134.54 26 | 13 79.66 219.14 140.61 143.49 27 | 13.5 87.55 227.76 149.63 152.34 28 | 14 93.03 238.17 158.31 161.12 29 | 14.5 100.67 247.16 167.77 170.05 30 | 15 106.56 257.99 176.86 178.92 31 | 15.5 114.7 266.97 185.58 187.66 32 | 16 121.04 277.6 194.14 196.38 33 | 16.5 129.7 285.9 203.02 205.16 34 | 17 136.06 296.23 211.86 213.92 35 | 17.5 144.77 304.72 221.09 222.65 36 | 18 150.7 315.12 229.93 231.38 37 | 18.5 158.53 322.89 238.56 239.99 38 | 19 165.1 334 247.3 248.65 39 | 19.5 172.52 341.68 256 257.29 40 | 20 178.4 351.52 264.67 265.87 41 | 20.5 186.9 359.13 273.2 274.3 42 | 21 193.69 368.25 281.66 282.58 43 | 21.5 202.23 375.71 290.55 291.19 44 | 22 209.71 385.46 299.41 299.75 45 | 22.5 218.65 392.64 308.76 308.53 46 | 23 225.72 401.54 317.67 317.27 47 | 23.5 234.81 409.53 326.39 325.92 48 | 24 242.39 418.89 335.37 334.65 49 | 24.5 250.95 426.34 344.55 343.35 50 | 25 258.15 435.14 353.72 352.06 51 | 25.5 267.28 441.9 362.74 360.81 52 | 26 275.21 451.04 371.88 369.73 53 | 26.5 284.23 457.7 381 378.27 54 | 27 290.97 466.01 390.15 386.9 55 | 27.5 299.77 472.65 399.58 395.78 56 | 28 307.8 481.4 408.57 404.62 57 | 28.5 316.85 487.68 418.13 413.39 58 | 29 324.28 496.12 427.2 422.27 59 | 29.5 333.37 502.74 436.48 430.97 60 | -------------------------------------------------------------------------------- /man/scale_y_depth_age.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-scales.R 3 | \name{scale_y_depth_age} 4 | \alias{scale_y_depth_age} 5 | \alias{scale_y_age_depth} 6 | \alias{scale_x_depth_age} 7 | \alias{scale_x_age_depth} 8 | \title{Age-depth scales} 9 | \usage{ 10 | scale_y_depth_age( 11 | model = NULL, 12 | age_name = "age", 13 | age_breaks = waiver(), 14 | age_labels = waiver(), 15 | ... 16 | ) 17 | 18 | scale_y_age_depth( 19 | model = NULL, 20 | reversed = FALSE, 21 | depth_name = "depth", 22 | depth_breaks = waiver(), 23 | depth_labels = waiver(), 24 | ... 25 | ) 26 | 27 | scale_x_depth_age( 28 | model = NULL, 29 | age_name = "age", 30 | age_breaks = waiver(), 31 | age_labels = waiver(), 32 | ... 33 | ) 34 | 35 | scale_x_age_depth( 36 | model = NULL, 37 | reversed = FALSE, 38 | depth_name = "depth", 39 | depth_breaks = waiver(), 40 | depth_labels = waiver(), 41 | ... 42 | ) 43 | } 44 | \arguments{ 45 | \item{model}{An age-depth model, or NULL to suppress the second axis} 46 | 47 | \item{age_name, depth_name}{Label for the second axis} 48 | 49 | \item{age_breaks, depth_breaks}{Breaks for the second axis} 50 | 51 | \item{age_labels, depth_labels}{Labels for each break on the second axis} 52 | 53 | \item{...}{Passed to \link[ggplot2:scale_continuous]{scale_y_continuous} or \link[ggplot2:scale_continuous]{scale_x_continuous}} 54 | 55 | \item{reversed}{Reverse the primary age axis (for years BP or similar)} 56 | } 57 | \value{ 58 | A \link[ggplot2:scale_continuous]{scale_y_continuous} or \link[ggplot2:scale_continuous]{scale_x_continuous} 59 | } 60 | \description{ 61 | Age-depth scales 62 | } 63 | \examples{ 64 | library(ggplot2) 65 | library(dplyr, warn.conflicts = FALSE) 66 | 67 | adm <- age_depth_model( 68 | alta_lake_210Pb_ages, 69 | depth = depth_cm, age = age_year_ad 70 | ) 71 | 72 | alta_lake_geochem \%>\% 73 | filter(param == "Cu") \%>\% 74 | ggplot(aes(value, depth)) + 75 | geom_point() + 76 | scale_y_depth_age(adm) 77 | 78 | } 79 | -------------------------------------------------------------------------------- /man/long_lake_14C_ages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{long_lake_14C_ages} 5 | \alias{long_lake_14C_ages} 6 | \alias{long_lake_bacon_ages} 7 | \alias{long_lake_plottable} 8 | \title{Long Lake Carbon-14 Ages} 9 | \format{ 10 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 5 rows and 5 columns. 11 | 12 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 86 rows and 5 columns. 13 | 14 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 51 rows and 10 columns. 15 | } 16 | \usage{ 17 | long_lake_14C_ages 18 | 19 | long_lake_bacon_ages 20 | 21 | long_lake_plottable 22 | } 23 | \description{ 24 | This object contains several uncalibrated Carbon-14 measurements from Long 25 | Lake (Nova Scotia-New Brunswick Border Region, Canada) core LL-PC2 26 | (Dunnington et al. 2017; White 2012). The \code{long_lake_bacon_ages} object 27 | contains the result of the Carbon-14 ages as 28 | modelled by the rbacon package (Blaauw and Christen 2011). 29 | } 30 | \examples{ 31 | long_lake_14C_ages 32 | long_lake_bacon_ages 33 | long_lake_plottable 34 | 35 | } 36 | \references{ 37 | Blaauw, Maarten, and J. Andrés Christen. "Flexible Paleoclimate Age-Depth 38 | Models Using an Autoregressive Gamma Process." Bayesian Analysis 6, no. 3 39 | (September 2011): 457–74. \doi{10.1214/ba/1339616472}. 40 | 41 | Dunnington, Dewey W., Hilary White, Ian S. Spooner, Mark L. Mallory, Chris 42 | White, Nelson J. O’Driscoll, and Nic R. McLellan. "A Paleolimnological 43 | Archive of Metal Sequestration and Release in the Cumberland Basin Marshes, 44 | Atlantic Canada." FACETS 2, no. 1 (May 23, 2017): 440–60. 45 | \doi{10.1139/facets-2017-0004}. 46 | 47 | White, Hilary E. "Paleolimnological Records of Post-Glacial Lake 48 | and Wetland Evolution from the Isthmus of Chignecto Region, Eastern Canada." 49 | M.Sc. Thesis, Acadia University, 2012. 50 | \url{https://scholar.acadiau.ca/islandora/object/theses:247}. 51 | } 52 | \keyword{datasets} 53 | -------------------------------------------------------------------------------- /tests/testthat/test-nested_prcomp.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("nested_pca works as intended", { 3 | 4 | ndm <- nested_data( 5 | alta_lake_geochem, 6 | qualifiers = c(depth, zone), 7 | key = param, 8 | value = value, 9 | trans = scale 10 | ) 11 | 12 | ndm_pca <- nested_prcomp(ndm) 13 | 14 | expect_is(ndm_pca, "nested_prcomp") 15 | 16 | expect_equal( 17 | colnames(ndm_pca), 18 | c("discarded_columns", "discarded_rows", "qualifiers", "data", 19 | "model", "variance", "loadings", "scores") 20 | ) 21 | 22 | expect_identical( 23 | purrr::map_int(ndm_pca$qualifiers, nrow), 24 | purrr::map_int(ndm_pca$data, nrow) 25 | ) 26 | 27 | expect_identical( 28 | purrr::map_int(ndm_pca$qualifiers, nrow), 29 | purrr::map_int(ndm_pca$scores, nrow) 30 | ) 31 | 32 | expect_equal( 33 | ncol(ndm_pca$loadings[[1]]), 34 | ncol(ndm_pca$data[[1]]) + 1 35 | ) 36 | 37 | }) 38 | 39 | test_that("nested_prcomp works with a grouping variable", { 40 | ndm_grp <- nested_data( 41 | keji_lakes_plottable, 42 | depth, taxon, rel_abund, 43 | fill = 0, trans = sqrt, select_if = ~any(. != 0), 44 | groups = location 45 | ) 46 | prcomp_grp <- nested_prcomp(ndm_grp) 47 | 48 | expect_true("location" %in% colnames(prcomp_grp)) 49 | expect_true(is.atomic(prcomp_grp$location)) 50 | 51 | plot(prcomp_grp, main = location, sub = "grouped PCA skree") 52 | biplot(prcomp_grp, main = location, sub = "grouped PCA biplot") 53 | }) 54 | 55 | test_that("biplot works with nested_prcomp objects", { 56 | ndm <- nested_data( 57 | alta_lake_geochem, 58 | qualifiers = c(depth, zone), 59 | key = param, 60 | value = value, 61 | trans = scale 62 | ) 63 | 64 | ndm_pca <- nested_prcomp(ndm) 65 | 66 | ndm_grp <- nested_data( 67 | keji_lakes_plottable, 68 | depth, taxon, rel_abund, 69 | fill = 0, trans = sqrt, select_if = ~any(. != 0), 70 | groups = location 71 | ) 72 | prcomp_grp <- nested_prcomp(ndm_grp) 73 | 74 | biplot(prcomp_grp, main = location) 75 | biplot(ndm_pca) 76 | 77 | expect_true(TRUE) 78 | }) 79 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%", 13 | dpi = 300 14 | ) 15 | ``` 16 | 17 | # tidypaleo 18 | 19 | 20 | [![Codecov test coverage](https://codecov.io/gh/paleolimbot/tidypaleo/graph/badge.svg)](https://app.codecov.io/gh/paleolimbot/tidypaleo) 21 | [![R-CMD-check](https://github.com/paleolimbot/tidypaleo/workflows/R-CMD-check/badge.svg)](https://github.com/paleolimbot/tidypaleo/actions) 22 | 23 | 24 | Working with multi-proxy paleo-archive data can be difficult. There are multiple locations, multiple parameters, and a lot of discipline-specific norms for plot layout and notation. This package simplifies a few workflows to promote the use of R for reproducible documents in paleo-based studies. 25 | 26 | ## Installation 27 | 28 | You can install the released versio of tidypaleo from [CRAN](https://cran.r-project.org/) with: 29 | 30 | ``` r 31 | install.packages("tidypaleo") 32 | ``` 33 | 34 | You can install the development version from [GitHub](https://github.com) with: 35 | 36 | ``` r 37 | # install.packages("remotes") 38 | remotes::install_github("paleolimbot/tidypaleo") 39 | ``` 40 | 41 | ## Examples 42 | 43 | ### Strat diagrams 44 | 45 | This package exposes a number of functions useful when creating stratigraphic diagrams, including `facet_abundanceh()`, which combines several other functions to help create stratigraphic plots using **ggplot2**. The `geom_col_segsh()` geometry draws horizontal segments, which are commonly used to show species abundance data. 46 | 47 | ```{r keji-strat, message=FALSE, warning=FALSE} 48 | library(ggplot2) 49 | library(tidypaleo) 50 | theme_set(theme_paleo()) 51 | 52 | ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 53 | geom_col_segsh() + 54 | scale_y_reverse() + 55 | facet_abundanceh(vars(taxon), grouping = vars(location)) + 56 | labs(y = "Depth (cm)") 57 | ``` 58 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | env: 32 | VDIFFR_RUN_TESTS: false 33 | run: | 34 | cov <- covr::package_coverage( 35 | quiet = FALSE, 36 | clean = FALSE, 37 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 38 | ) 39 | print(cov) 40 | covr::to_cobertura(cov) 41 | shell: Rscript {0} 42 | 43 | - uses: codecov/codecov-action@v5 44 | with: 45 | # Fail if error if not on PR, or if on PR and token is given 46 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 47 | files: ./cobertura.xml 48 | plugins: noop 49 | disable_search: true 50 | token: ${{ secrets.CODECOV_TOKEN }} 51 | 52 | - name: Show testthat output 53 | if: always() 54 | run: | 55 | ## -------------------------------------------------------------------- 56 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 57 | shell: bash 58 | 59 | - name: Upload test results 60 | if: failure() 61 | uses: actions/upload-artifact@v4 62 | with: 63 | name: coverage-test-failures 64 | path: ${{ runner.temp }}/package 65 | -------------------------------------------------------------------------------- /data-raw/kellys_lake.mudata/params.csv: -------------------------------------------------------------------------------- 1 | dataset,param 2 | cbrm_2017,C_N/SINLAB 3 | cbrm_2017,C/SINLAB 4 | cbrm_2017,d13C/SINLAB 5 | cbrm_2017,d15N/SINLAB 6 | cbrm_2017,Fe/XRF/Vanta 7 | cbrm_2017,K/XRF/Vanta 8 | cbrm_2017,Mn/XRF/Vanta 9 | cbrm_2017,Pb/XRF/Vanta 10 | cbrm_2017,Ti/XRF/Vanta 11 | cbrm_2017,Zn/XRF/Vanta 12 | cbrm_2017,Cladocera/Bosmina sp./RelAbund 13 | cbrm_2017,Cladocera/D. pulex complex/RelAbund 14 | cbrm_2017,Cladocera/H. glacialis/RelAbund 15 | cbrm_2017,Cladocera/Eurycercus sp./RelAbund 16 | cbrm_2017,Cladocera/Camptocercus sp./RelAbund 17 | cbrm_2017,Cladocera/Acroperus harpae/RelAbund 18 | cbrm_2017,Cladocera/Alonopsis americanus/RelAbund 19 | cbrm_2017,Cladocera/Anchistropus minor/RelAbund 20 | cbrm_2017,Cladocera/Alona affinis/RelAbund 21 | cbrm_2017,Cladocera/Alona quadrangularis/RelAbund 22 | cbrm_2017,Cladocera/Alona guttata/RelAbund 23 | cbrm_2017,Cladocera/Alona intermedia/RelAbund 24 | cbrm_2017,Cladocera/Alona costata/RelAbund 25 | cbrm_2017,Cladocera/Alona rustica/RelAbund 26 | cbrm_2017,Cladocera/Graptoleberis testudinaria/RelAbund 27 | cbrm_2017,Cladocera/Rynchotalona falcata/RelAbund 28 | cbrm_2017,Cladocera/Monospilus dispar/RelAbund 29 | cbrm_2017,Cladocera/Alonella excisa/RelAbund 30 | cbrm_2017,Cladocera/Alonella nana/RelAbund 31 | cbrm_2017,Cladocera/Alonella pulchetta/RelAbund 32 | cbrm_2017,Cladocera/Disparalona acutirostris/RelAbund 33 | cbrm_2017,Cladocera/Kurzia sp./RelAbund 34 | cbrm_2017,Cladocera/Pleuroxus sp/RelAbund 35 | cbrm_2017,Cladocera/Chydorus bicornutus/RelAbund 36 | cbrm_2017,Cladocera/Chydorus faviformis/RelAbund 37 | cbrm_2017,Cladocera/Chydorus linguilabris/RelAbund 38 | cbrm_2017,Cladocera/Paralona pigra/RelAbund 39 | cbrm_2017,Cladocera/Chydorus brevilabris/RelAbund 40 | cbrm_2017,Cladocera/Leptodora kindti/RelAbund 41 | cbrm_2017,Cladocera/Sida crystallina/RelAbund 42 | cbrm_2017,Cladocera/Latona setifera/RelAbund 43 | cbrm_2017,Cladocera/Ophryoxus gracilis/RelAbund 44 | cbrm_2017,Cladocera/Acantholebris curvirostris/RelAbund 45 | cbrm_2017,Cladocera/Polyphemus pediculus/RelAbund 46 | cbrm_2017,Cladocera/Ilyocryptus/RelAbund 47 | cbrm_2017,210Pb/Unsupported/MyCore 48 | cbrm_2017,age_ad/210Pb/CRS/MyCore 49 | -------------------------------------------------------------------------------- /man/nested_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_data_matrix.R 3 | \name{nested_data} 4 | \alias{nested_data} 5 | \alias{unnested_data} 6 | \title{Prepare a parameter-long data frame for statistical analysis} 7 | \usage{ 8 | nested_data( 9 | .data, 10 | qualifiers = NULL, 11 | key = NULL, 12 | value, 13 | fill = NA, 14 | select_if = ~TRUE, 15 | filter_all = any_vars(TRUE), 16 | trans = identity, 17 | groups = NULL 18 | ) 19 | 20 | unnested_data(.data, ...) 21 | } 22 | \arguments{ 23 | \item{.data}{Data in parameter-long form} 24 | 25 | \item{qualifiers}{Columns that add context to observations (e.g., depth, zone, core)} 26 | 27 | \item{key}{The column name that contains the column names of the data matrix} 28 | 29 | \item{value}{The column name that contains the values} 30 | 31 | \item{fill}{If a key/value combination doesn't exist in the input, this value will be 32 | assigned in the data matrix. Generally, using NA for geochemical data and 0 for relative 33 | abundance data is advised.} 34 | 35 | \item{select_if}{Use \code{~TRUE} to keep all columns; use \code{~all(is.finite(.))} to keep columns 36 | with all finite values. See \link[dplyr:select_all]{select_if}.} 37 | 38 | \item{filter_all}{Use \code{any_vars(TRUE)} to keep all observations; use \code{all_vars(is.finite(.))} to 39 | keep only observations with finite (non-missing) values. See \link[dplyr:filter_all]{filter_all}.} 40 | 41 | \item{trans}{A function that will be applied to all columns, column-wise. Use \link[base:identity]{identity} 42 | to perform no transformation, use \link[base:scale]{scale} to scale each column to a mean of zero and 43 | variance of 1. See \link[dplyr:mutate_all]{mutate_all}.} 44 | 45 | \item{groups}{Use \link[dplyr:group_by]{group_by} or this argument to group by one or more columns (e.g., core or lake)} 46 | 47 | \item{...}{One or more columns to unnest.} 48 | } 49 | \value{ 50 | A nested data matrix, which is composed of a \code{\link[tibble:tibble]{tibble::tibble()}} 51 | with tibble list-columns \code{data}, \code{discarded_rows}, \code{discarded_columns}, and 52 | \code{qualifiers}. 53 | } 54 | \description{ 55 | Prepare a parameter-long data frame for statistical analysis 56 | } 57 | \examples{ 58 | nested_data( 59 | alta_lake_geochem, 60 | qualifiers = c(age, depth, zone), 61 | key = param, 62 | value = value, 63 | trans = scale 64 | ) 65 | 66 | } 67 | -------------------------------------------------------------------------------- /man/geom_point_exaggerate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-geoms.R 3 | \name{geom_point_exaggerate} 4 | \alias{geom_point_exaggerate} 5 | \alias{geom_line_exaggerate} 6 | \alias{geom_lineh_exaggerate} 7 | \alias{geom_area_exaggerate} 8 | \alias{geom_areah_exaggerate} 9 | \title{Exaggerated geometries that do not train scales} 10 | \usage{ 11 | geom_point_exaggerate( 12 | mapping = NULL, 13 | data = NULL, 14 | stat = "identity", 15 | position = "identity", 16 | ..., 17 | exaggerate_x = 1, 18 | exaggerate_y = 1, 19 | na.rm = FALSE, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | 24 | geom_line_exaggerate( 25 | mapping = NULL, 26 | data = NULL, 27 | stat = "identity", 28 | position = "identity", 29 | ..., 30 | exaggerate_x = 1, 31 | exaggerate_y = 1, 32 | na.rm = FALSE, 33 | show.legend = NA, 34 | inherit.aes = TRUE 35 | ) 36 | 37 | geom_lineh_exaggerate( 38 | mapping = NULL, 39 | data = NULL, 40 | stat = "identity", 41 | position = "identity", 42 | ..., 43 | exaggerate_x = 1, 44 | exaggerate_y = 1, 45 | na.rm = FALSE, 46 | show.legend = NA, 47 | inherit.aes = TRUE 48 | ) 49 | 50 | geom_area_exaggerate( 51 | mapping = NULL, 52 | data = NULL, 53 | stat = "identity", 54 | position = "identity", 55 | ..., 56 | exaggerate_x = 1, 57 | exaggerate_y = 1, 58 | na.rm = FALSE, 59 | show.legend = NA, 60 | inherit.aes = TRUE 61 | ) 62 | 63 | geom_areah_exaggerate( 64 | mapping = NULL, 65 | data = NULL, 66 | stat = "identity", 67 | position = "identity", 68 | ..., 69 | exaggerate_x = 1, 70 | exaggerate_y = 1, 71 | na.rm = FALSE, 72 | show.legend = NA, 73 | inherit.aes = TRUE 74 | ) 75 | } 76 | \arguments{ 77 | \item{mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...}{See 78 | parent geometries} 79 | 80 | \item{exaggerate_x, exaggerate_y}{The factor by which to exaggerate x or y values} 81 | } 82 | \value{ 83 | A subclass of \link[ggplot2:Geom]{ggplot2::Geom}. 84 | } 85 | \description{ 86 | Exaggerated geometries that do not train scales 87 | } 88 | \examples{ 89 | library(ggplot2) 90 | 91 | ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 92 | geom_lineh_exaggerate(exaggerate_x = 2, lty = 2) + 93 | geom_col_segsh() + 94 | scale_y_reverse() + 95 | facet_abundanceh(vars(taxon), grouping = vars(location)) + 96 | labs(y = "Depth (cm)") 97 | 98 | } 99 | -------------------------------------------------------------------------------- /data-raw/kellys.R: -------------------------------------------------------------------------------- 1 | 2 | library(tidyverse) 3 | library(mudata2) 4 | 5 | raw <- read_mudata("data-raw/kellys_lake.mudata") 6 | 7 | ages <- raw %>% 8 | select_params(contains("age_ad")) %>% 9 | tbl_data() %>% 10 | select(-dataset, -n, -n_detect, -param) %>% 11 | rename(age_ad = value) 12 | 13 | rename_param <- . %>% 14 | str_remove("/SINLAB") %>% 15 | str_remove("/XRF/Vanta") %>% 16 | str_remove("/RelAbund") %>% 17 | str_remove("/MyCore") %>% 18 | str_remove("/CRS") %>% 19 | str_remove("/210Pb") %>% 20 | str_replace("C_N", "C/N") %>% 21 | str_replace("210Pb/Unsupported", "Unsupported 210Pb") 22 | 23 | # rename params 24 | raw$params$param <- rename_param(raw$params$param) 25 | raw$data$param <- rename_param(raw$data$param) 26 | 27 | # add ages 28 | adm <- tidypaleo::age_depth_model(ages, depth, age_ad) 29 | raw$data$age_ad <- raw$data$depth %>% tidypaleo::predict_age(object = adm) 30 | raw$data <- raw$data %>% 31 | select(dataset, location, param, depth, age_ad, everything()) %>% 32 | arrange(param, depth) 33 | attr(raw, "x_columns") <- c("depth", "age_ad") 34 | 35 | # make sure we didn't invalidate the object 36 | validate_mudata(raw) 37 | 38 | # use data 39 | kellys_lake <- raw 40 | 41 | kellys_lake_geochem <- kellys_lake %>% 42 | select_params(-Fe, -Mn,-age_ad, -`Unsupported 210Pb`, -Zn, -Ti) %>% 43 | select_params(-starts_with("Cladocera")) %>% 44 | tbl_data() %>% 45 | select(-dataset) %>% 46 | filter(!is.na(value)) 47 | 48 | # ggplot(kellys_lake_geochem, aes(x = value, y = depth)) + 49 | # geom_point() + 50 | # facet_wrap(vars(param), scales = "free_x", nrow = 1) 51 | 52 | usethis::use_data(kellys_lake_geochem, overwrite = TRUE) 53 | 54 | kellys_lake_cladocera <- kellys_lake %>% 55 | select_params(starts_with("Cladocera")) %>% 56 | tbl_data() %>% 57 | select(-c(dataset, error, error_type, n_detect, n)) %>% 58 | rename(rel_abund = value, taxon = param) %>% 59 | mutate( 60 | taxon = taxon %>% 61 | str_remove("Cladocera/") %>% 62 | str_replace("Acantholebris curvirostris", "Acantholeberis curvirostris") 63 | ) %>% 64 | # select only some taxa to include in toy data set 65 | mutate( 66 | taxon = fct_lump(taxon, 12, w = rel_abund) %>% 67 | fct_reorder(rel_abund) %>% 68 | fct_recode("D. pulex-complex" = "D. pulex complex") 69 | ) %>% 70 | filter(taxon != "Other") 71 | 72 | ggplot(kellys_lake_cladocera, aes(x = rel_abund, y = depth)) + 73 | tidypaleo::geom_col_segsh() + 74 | tidypaleo::facet_abundanceh(vars(taxon)) 75 | 76 | usethis::use_data(kellys_lake_cladocera, overwrite = TRUE) 77 | 78 | kellys_lake_ages <- ages 79 | usethis::use_data(kellys_lake_ages, overwrite = TRUE) 80 | -------------------------------------------------------------------------------- /man/alta_lake_210Pb_ages.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{alta_lake_210Pb_ages} 5 | \alias{alta_lake_210Pb_ages} 6 | \alias{alta_lake_14C_ages} 7 | \alias{alta_lake_bacon_ages} 8 | \alias{alta_lake_geochem} 9 | \title{Alta Lake Lead-210 and Carbon-14 Ages} 10 | \format{ 11 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 9 rows and 5 columns. 12 | 13 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 1 rows and 5 columns. 14 | 15 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 58 rows and 5 columns. 16 | 17 | An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 192 rows and 9 columns. 18 | } 19 | \usage{ 20 | alta_lake_210Pb_ages 21 | 22 | alta_lake_14C_ages 23 | 24 | alta_lake_bacon_ages 25 | 26 | alta_lake_geochem 27 | } 28 | \description{ 29 | The \code{alta_lake_210Pb_ages} object contains raw depths and ages for Alta 30 | Lake (Whistler, British Columbia, Canada) core AL-GC2 (Dunnington et al. 31 | 2016; Dunnington 2015). For these values, ages were calculated from Lead-210 32 | activities using the constant rate of supply (CRS) model (Appleby and 33 | Oldfield 1983). The \code{alta_lake_14C_ages} object contains one 34 | uncalibrated Carbon-14 measurement from the same core. 35 | The \code{alta_lake_bacon_ages} object contains the combined result of the 36 | Lead-210 and the Carbon-14 ages as modelled by the rbacon package 37 | (Blaauw and Christen 2011). 38 | } 39 | \examples{ 40 | alta_lake_210Pb_ages 41 | alta_lake_14C_ages 42 | alta_lake_bacon_ages 43 | 44 | } 45 | \references{ 46 | Appleby, P. G., and F. Oldfield. "The Assessment of 210Pb Data from Sites 47 | with Varying Sediment Accumulation Rates." Hydrobiologia 103, no. 1 (July 1, 48 | 1983): 29–35. \doi{10.1007/BF00028424}. 49 | 50 | Blaauw, Maarten, and J. Andrés Christen. "Flexible Paleoclimate Age-Depth 51 | Models Using an Autoregressive Gamma Process." Bayesian Analysis 6, no. 3 52 | (September 2011): 457–74. \doi{10.1214/ba/1339616472}. 53 | 54 | Dunnington, Dewey W., Ian S. Spooner, Chris E. White, R. Jack Cornett, Dave 55 | Williamson, and Mike Nelson. "A Geochemical Perspective on the Impact of 56 | Development at Alta Lake, British Columbia, Canada." Journal of 57 | Paleolimnology 56, no. 4 (November 2016): 315–330. 58 | \doi{10.1007/s10933-016-9919-x}. 59 | 60 | Dunnington, Dewey W. "A 500-Year Applied Paleolimnological Assessment of 61 | Environmental Change at Alta Lake, Whistler, British Columbia, Canada." M.Sc. 62 | Thesis, Acadia University, 2015. 63 | \url{https://scholar.acadiau.ca/islandora/object/theses:411}. 64 | } 65 | \keyword{datasets} 66 | -------------------------------------------------------------------------------- /vignettes/nested_analysis.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Nested analyses" 3 | author: "Dewey Dunnington" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Nested analyses} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include = FALSE} 13 | library(ggplot2) 14 | library(dplyr) 15 | library(tidyr) 16 | library(purrr) 17 | library(tidypaleo) 18 | 19 | knitr::opts_chunk$set( 20 | collapse = TRUE, 21 | comment = "#>", 22 | fig.height = 3, 23 | fig.width = 5, 24 | dpi = 150 25 | ) 26 | ``` 27 | 28 | Load the packages: 29 | 30 | ```{r, eval=FALSE} 31 | library(tidyverse) 32 | library(tidypaleo) 33 | ``` 34 | 35 | ## Creating nested data 36 | 37 | Preparing the data: 38 | 39 | ```{r} 40 | alta_lake_geochem 41 | ``` 42 | 43 | ```{r} 44 | alta_nested <- nested_data( 45 | alta_lake_geochem, 46 | qualifiers = c(age, depth, zone), 47 | key = param, 48 | value = value, 49 | trans = scale 50 | ) 51 | 52 | alta_nested 53 | ``` 54 | 55 | ```{r} 56 | alta_nested %>% unnested_data(data) 57 | alta_nested %>% unnested_data(qualifiers, data) 58 | ``` 59 | 60 | ## Principal components analysis 61 | 62 | ```{r} 63 | pca <- alta_nested %>% nested_prcomp() 64 | pca 65 | ``` 66 | 67 | ```{r} 68 | plot(pca) 69 | pca %>% unnested_data(qualifiers, scores) 70 | pca %>% unnested_data(variance) 71 | pca %>% unnested_data(loadings) 72 | ``` 73 | 74 | ## Constrained hierarchical clustering 75 | 76 | ```{r} 77 | keji_nested <- keji_lakes_plottable %>% 78 | group_by(location) %>% 79 | nested_data(qualifiers = depth, key = taxon, value = rel_abund) 80 | 81 | keji_nested %>% unnested_data(qualifiers, data) 82 | ``` 83 | 84 | ```{r} 85 | coniss <- keji_nested %>% 86 | nested_chclust_coniss() 87 | 88 | plot(coniss, main = location) 89 | ``` 90 | 91 | ```{r} 92 | plot(coniss, main = location, xvar = qualifiers$depth, labels = "") 93 | ``` 94 | 95 | ```{r} 96 | coniss %>% select(location, zone_info) %>% unnest(zone_info) 97 | ``` 98 | 99 | ```{r} 100 | keji_nested %>% 101 | nested_chclust_coniss(n_groups = c(3, 2)) %>% 102 | select(location, zone_info) %>% 103 | unnested_data(zone_info) 104 | ``` 105 | 106 | ## Unconstrained hierarchical clustering 107 | 108 | ```{r} 109 | halifax_nested <- halifax_lakes_plottable %>% 110 | nested_data(c(location, sample_type), taxon, rel_abund, fill = 0) 111 | 112 | halifax_nested %>% unnested_data(qualifiers, data) 113 | ``` 114 | 115 | ```{r} 116 | hclust <- halifax_nested %>% 117 | nested_hclust(method = "average") 118 | 119 | plot( 120 | hclust, 121 | labels = sprintf( 122 | "%s (%s)", 123 | qualifiers$location, 124 | qualifiers$sample_type 125 | ) 126 | ) 127 | ``` 128 | 129 | ## Nested analysis of other functions 130 | 131 | ```{r} 132 | alta_nested %>% 133 | nested_analysis(vegan::rda, data) %>% 134 | plot() 135 | ``` 136 | 137 | ```{r} 138 | biplot(pca) 139 | ``` 140 | -------------------------------------------------------------------------------- /data-raw/LL-PC2_43_ages.txt: -------------------------------------------------------------------------------- 1 | depth min max median wmean 2 | 9 535.5 667 598.3 602.9 3 | 10 571.8 941.6 695.1 714.5 4 | 11 583.4 1263.3 775.2 822.3 5 | 12 637.2 1378.3 893.3 928.4 6 | 13 669.3 1580.2 995.7 1034.3 7 | 14 738.1 1703.3 1112.3 1143.9 8 | 15 786.9 1922 1217.6 1253.5 9 | 16 870.3 2030.8 1331.1 1365.1 10 | 17 924.8 2217.7 1443.3 1477.8 11 | 18 1013.7 2329.4 1555.8 1589.2 12 | 19 1073.4 2501.9 1663.8 1700 13 | 20 1164.2 2620.2 1775.2 1810 14 | 21 1220.5 2769.7 1884.2 1918.2 15 | 22 1315.3 2869.5 1992.2 2025.3 16 | 23 1375.1 3024.5 2105.3 2131.3 17 | 24 1480.3 3117.6 2223.6 2244.7 18 | 25 1554.7 3234.2 2339.8 2358 19 | 26 1645.2 3333.4 2457.7 2470.9 20 | 27 1708.3 3470.9 2572.8 2583.9 21 | 28 1828.6 3559.2 2685.2 2692 22 | 29 1913.6 3674.8 2794.9 2800.6 23 | 30 2018.2 3765.6 2909.8 2907.6 24 | 31 2097.4 3890.3 3021.9 3014.6 25 | 32 2229.5 3978.2 3137.9 3126.6 26 | 33 2316.7 4101.7 3248.7 3237.4 27 | 34 2430.8 4181 3363.9 3344.5 28 | 35 2518.8 4284.7 3481.4 3451.9 29 | 36 2649.1 4352.5 3587.2 3558.2 30 | 37 2740.3 4458.8 3701.4 3666.1 31 | 38 2909 4542.9 3847.6 3807.1 32 | 39 3025.3 4688.5 3979.8 3948.1 33 | 40 3231.6 4767 4128.9 4097.8 34 | 41 3378.8 4886.1 4279.1 4248.1 35 | 42 3678.4 4963.5 4424.9 4403.3 36 | 43 3854.3 5097.4 4585.6 4559.7 37 | 44 4176.8 5150.3 4719.5 4708.4 38 | 45 4369.5 5245.1 4865.3 4857.4 39 | 46 4765.8 5302.7 4990.6 5018.3 40 | 47 4940.7 5508 5148.7 5177.9 41 | 48 5022.6 5784.2 5324.2 5346.2 42 | 49 5057.7 6185.5 5462.9 5511.2 43 | 50 5163.5 6407.2 5646.6 5690.3 44 | 51 5224.5 6768.4 5816.8 5866.9 45 | 52 5371.2 6937.5 6009.6 6051.1 46 | 53 5454.3 7236.2 6186.6 6233 47 | 54 5594.8 7370.9 6380.8 6414.6 48 | 55 5695.6 7592.7 6571.3 6595.3 49 | 56 5862.1 7751.3 6781.9 6794.3 50 | 57 5975.6 8003.4 6987 6994.1 51 | 58 6150 8123.4 7173 7174.3 52 | 59 6290.7 8317.2 7355.9 7350.9 53 | 60 6464.7 8442.5 7552.5 7531.8 54 | 61 6581.1 8642.4 7739.3 7714.1 55 | 62 6839.6 8754.2 7930.1 7902.5 56 | 63 6990.8 8935.8 8118.9 8089.8 57 | 64 7248.7 9035.6 8302.2 8269.6 58 | 65 7404.1 9188.6 8493.7 8448.1 59 | 66 7688.4 9273.5 8674.6 8632.5 60 | 67 7886.9 9429.5 8870.9 8816.2 61 | 68 8144.9 9478.4 9049.5 8992.1 62 | 69 8331.9 9571.5 9237.1 9166.8 63 | 70 8718.1 9594.2 9395.5 9342.5 64 | 71 8911.1 9660.1 9578.8 9519.6 65 | 72 8978.9 9732.3 9619.3 9568.8 66 | 73 9044.3 9856.2 9647.2 9614.9 67 | 74 9114.1 9903 9687.9 9658.9 68 | 75 9177.9 9978 9719.5 9701.5 69 | 76 9235.6 10025.6 9762 9745.4 70 | 77 9282.5 10093.8 9800.4 9788.9 71 | 78 9351.7 10152.3 9840.8 9832.4 72 | 79 9408 10210.7 9880.1 9874.9 73 | 80 9482 10259.9 9919.6 9917.5 74 | 81 9529.2 10323.5 9956.3 9959.2 75 | 82 9594.1 10370.6 10000.5 10003.9 76 | 83 9649.6 10439 10043.2 10049.4 77 | 84 9714.7 10496.6 10085.7 10094.6 78 | 85 9765 10561.7 10128 10139.4 79 | 86 9824.3 10614.9 10167.7 10181.8 80 | 87 9860.2 10686.2 10207.9 10223.6 81 | 88 9926.7 10745.3 10249.6 10268.8 82 | 89 9976 10811 10291.2 10313.7 83 | 90 10038.7 10867 10331 10356.4 84 | 91 10087.5 10930.5 10371.9 10399.6 85 | 92 10160.1 10987.1 10410.3 10443.3 86 | 93 10206.3 11057.4 10451 10486.8 87 | 94 10289.7 11104.4 10484.6 10527.3 88 | -------------------------------------------------------------------------------- /vignettes/age_depth.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Age-depth models" 3 | author: "Dewey Dunnington" 4 | date: "`r Sys.Date()`" 5 | output: 6 | "rmarkdown::html_vignette": 7 | df_print: kable 8 | vignette: > 9 | %\VignetteIndexEntry{Age-depth models} 10 | %\VignetteEngine{knitr::rmarkdown} 11 | %\VignetteEncoding{UTF-8} 12 | --- 13 | 14 | ```{r setup, include = FALSE} 15 | knitr::opts_chunk$set( 16 | collapse = TRUE, 17 | comment = "#>", 18 | fig.height = 4, 19 | fig.width = 5, 20 | dpi = 150 21 | ) 22 | ``` 23 | 24 | 25 | Given a known depths and known (or modelled) ages, it is often convenient to approximate age as a continuous function of depth in an archive. This package provides tools to flexibly create age-depth relationships with various rules for interpolating age within known age-depth values, and extrapolating above and below these values. Typically, this is interpolation between known values and extrapolating using average sedimentation rates based on ages known at discrete points in a core. 26 | 27 | ## Example 28 | 29 | Using the built-in dataset `alta_lake_210Pb_ages`, which contains a Lead-210 (CRS) age-depth relationship for a core from [Alta Lake, Whistler, British Columbia](https://en.wikipedia.org/wiki/Alta_Lake_(British_Columbia)), we can create an age-depth model (note that `age` and `depth` are evaluated within `.data`, if it is provided, and support tidy evaluation): 30 | 31 | ```{r} 32 | library(tidypaleo) 33 | alta_lake_adm <- age_depth_model( 34 | alta_lake_210Pb_ages, 35 | depth = depth_cm, age = age_year_ad, 36 | age_max = age_year_ad + age_error_yr, 37 | age_min = age_year_ad - age_error_yr 38 | ) 39 | alta_lake_adm 40 | ``` 41 | 42 | Then, we can plot the relationship: 43 | 44 | ```{r alta_lake_adm_plot} 45 | plot(alta_lake_adm) 46 | ``` 47 | 48 | ...Or predict raw data: 49 | 50 | ```{r} 51 | predict(alta_lake_adm, depth = seq(-1, 10, 0.5)) 52 | ``` 53 | 54 | The default behaviour is to interpolate within known ages/depths, and extrapolate using a linear fit of ages/depths. These can be specified using transform functions, which take XY data and produce forward and inverse predictions based on them. The default call is: 55 | 56 | ```{r, eval = FALSE} 57 | age_depth_model( 58 | ..., 59 | interpolate_age = age_depth_interpolate, 60 | extrapolate_age_below = ~age_depth_extrapolate(.x, .y, x0 = last, y0 = last), 61 | extrapolate_age_above = ~age_depth_extrapolate(.x, .y, x0 = first, y0 = first), 62 | interpolate_age_limits = trans_exact, 63 | extrapolate_age_limits_below = trans_na, 64 | extrapolate_age_limits_above = trans_na 65 | ) 66 | ``` 67 | 68 | To customize the behaviour of the predictions (e.g., disable extrapolating above or below), specify a transform function in the appropriate category. One-sided formulas are turned into functions using the `rlang::as_function()`. A more advanced way might be to only use the first/last few observations to extrapolate above and below, which one could do like this: 69 | 70 | ```{r} 71 | alta_lake_adm2 <- age_depth_model( 72 | alta_lake_210Pb_ages, 73 | depth = depth_cm, age = age_year_ad, 74 | age_max = age_year_ad + age_error_yr, 75 | age_min = age_year_ad - age_error_yr, 76 | extrapolate_age_below = ~age_depth_extrapolate( 77 | tail(.x, 3), tail(.y, 3), x0 = dplyr::last, y0 = dplyr::last 78 | ), 79 | extrapolate_age_above = ~age_depth_extrapolate( 80 | head(.x, 3), head(.y, 3), x0 = dplyr::first, y0 = dplyr::first 81 | ) 82 | ) 83 | 84 | plot(alta_lake_adm2) 85 | ``` 86 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(biplot,nested_prcomp) 4 | S3method(fortify,nested_hclust) 5 | S3method(ggplot_add,rotate_facet_label_spec) 6 | S3method(ggplot_add,sequential_layer_facet_spec) 7 | S3method(plot,age_depth_model) 8 | S3method(plot,nested_analysis) 9 | S3method(plot,nested_chclust) 10 | S3method(plot,nested_hclust) 11 | S3method(predict,age_depth_model) 12 | S3method(print,age_depth_model) 13 | export(GeomAreah) 14 | export(GeomColSegs) 15 | export(GeomColSegsh) 16 | export(GeomColh) 17 | export(GeomLineh) 18 | export(GeomRibbonh) 19 | export(PositionDodge2v) 20 | export(PositionDodgev) 21 | export(PositionFillv) 22 | export(PositionStackv) 23 | export(StatNestedHclust) 24 | export(age_depth_as_sec_axis) 25 | export(age_depth_exact) 26 | export(age_depth_extrapolate) 27 | export(age_depth_interpolate) 28 | export(age_depth_model) 29 | export(age_depth_na) 30 | export(as_trans_factory) 31 | export(facet_abundance) 32 | export(facet_abundanceh) 33 | export(facet_geochem_grid) 34 | export(facet_geochem_gridh) 35 | export(facet_geochem_wrap) 36 | export(facet_geochem_wraph) 37 | export(first) 38 | export(geom_area_exaggerate) 39 | export(geom_areah) 40 | export(geom_areah_exaggerate) 41 | export(geom_col_segs) 42 | export(geom_col_segsh) 43 | export(geom_colh) 44 | export(geom_line_exaggerate) 45 | export(geom_lineh) 46 | export(geom_lineh_exaggerate) 47 | export(geom_point_exaggerate) 48 | export(geom_ribbonh) 49 | export(label_geochem) 50 | export(label_species) 51 | export(last) 52 | export(layer_dendrogram) 53 | export(layer_scores) 54 | export(layer_zone_boundaries) 55 | export(nested_analysis) 56 | export(nested_chclust_coniss) 57 | export(nested_chclust_conslink) 58 | export(nested_data) 59 | export(nested_hclust) 60 | export(nested_prcomp) 61 | export(plot_layer_dendrogram) 62 | export(plot_layer_scores) 63 | export(plot_nested_analysis) 64 | export(position_dodge2v) 65 | export(position_dodgev) 66 | export(position_fillv) 67 | export(position_stackv) 68 | export(predict_age) 69 | export(predict_depth) 70 | export(rotated_axis_labels) 71 | export(rotated_facet_labels) 72 | export(scale_x_abundance) 73 | export(scale_x_age_depth) 74 | export(scale_x_depth_age) 75 | export(scale_y_abundance) 76 | export(scale_y_age_depth) 77 | export(scale_y_depth_age) 78 | export(sequential_layer_facets) 79 | export(stat_nested_hclust) 80 | export(theme_paleo) 81 | export(unnested_data) 82 | export(validate_trans) 83 | export(validate_trans_factory) 84 | export(vars) 85 | importFrom(dplyr,all_vars) 86 | importFrom(dplyr,any_vars) 87 | importFrom(dplyr,first) 88 | importFrom(dplyr,last) 89 | importFrom(ggplot2,fortify) 90 | importFrom(ggplot2,ggplot_add) 91 | importFrom(ggplot2,vars) 92 | importFrom(ggplot2,waiver) 93 | importFrom(ggstance,GeomColh) 94 | importFrom(ggstance,PositionDodge2v) 95 | importFrom(ggstance,PositionDodgev) 96 | importFrom(ggstance,PositionFillv) 97 | importFrom(ggstance,PositionStackv) 98 | importFrom(ggstance,geom_colh) 99 | importFrom(ggstance,position_dodge2v) 100 | importFrom(ggstance,position_dodgev) 101 | importFrom(ggstance,position_fillv) 102 | importFrom(ggstance,position_stackv) 103 | importFrom(graphics,plot) 104 | importFrom(purrr,"%||%") 105 | importFrom(rlang,"!!!") 106 | importFrom(rlang,"!!") 107 | importFrom(rlang,.data) 108 | importFrom(rlang,enquo) 109 | importFrom(rlang,quos) 110 | importFrom(stats,biplot) 111 | importFrom(stats,predict) 112 | -------------------------------------------------------------------------------- /man/nested_hclust.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/nested_chclust.R 3 | \name{nested_hclust} 4 | \alias{nested_hclust} 5 | \alias{nested_chclust_conslink} 6 | \alias{nested_chclust_coniss} 7 | \title{Nested (Constrained) hierarchical clustering} 8 | \usage{ 9 | nested_hclust( 10 | .data, 11 | data_column = "data", 12 | qualifiers_column = "qualifiers", 13 | distance_fun = stats::dist, 14 | n_groups = NULL, 15 | ..., 16 | .fun = stats::hclust, 17 | .reserved_names = character(0) 18 | ) 19 | 20 | nested_chclust_conslink( 21 | .data, 22 | data_column = "data", 23 | qualifiers_column = "qualifiers", 24 | distance_fun = stats::dist, 25 | n_groups = NULL, 26 | ... 27 | ) 28 | 29 | nested_chclust_coniss( 30 | .data, 31 | data_column = "data", 32 | qualifiers_column = "qualifiers", 33 | distance_fun = stats::dist, 34 | n_groups = NULL, 35 | ... 36 | ) 37 | } 38 | \arguments{ 39 | \item{.data}{A data frame with a list column of data frames, possibly created using 40 | \link{nested_data}.} 41 | 42 | \item{data_column}{An expression that evalulates to the data object within each row of .data} 43 | 44 | \item{qualifiers_column}{The column that contains the qualifiers} 45 | 46 | \item{distance_fun}{A distance function like \link[stats:dist]{dist} or \link[vegan:vegdist]{vegdist}.} 47 | 48 | \item{n_groups}{The number of groups to use (can be a vector or expression using vars in .data)} 49 | 50 | \item{...}{Passed to \link[rioja:chclust]{chclust} or \link[stats:hclust]{hclust}.} 51 | 52 | \item{.fun}{Function powering the clustering. Must return an hclust object of some kind.} 53 | 54 | \item{.reserved_names}{Names that should not be allowed as columns in any 55 | data frame within this object} 56 | } 57 | \value{ 58 | \code{.data} with additional columns 59 | } 60 | \description{ 61 | Powered by \link[rioja:chclust]{chclust} and \link[stats:hclust]{hclust}; broken stick using \link[rioja:chclust]{bstick}. 62 | } 63 | \examples{ 64 | library(tidyr) 65 | library(dplyr, warn.conflicts = FALSE) 66 | 67 | nested_coniss <- keji_lakes_plottable \%>\% 68 | group_by(location) \%>\% 69 | nested_data(depth, taxon, rel_abund, fill = 0) \%>\% 70 | nested_chclust_coniss() 71 | 72 | # plot the dendrograms using base graphics 73 | plot(nested_coniss, main = location, ncol = 1) 74 | 75 | # plot broken stick dispersion to verify number of plausible groups 76 | library(ggplot2) 77 | 78 | nested_coniss \%>\% 79 | select(location, broken_stick) \%>\% 80 | unnest(broken_stick) \%>\% 81 | tidyr::gather(type, value, broken_stick_dispersion, dispersion) \%>\% 82 | ggplot(aes(x = n_groups, y = value, col = type)) + 83 | geom_line() + 84 | geom_point() + 85 | facet_wrap(vars(location)) 86 | 87 | } 88 | \references{ 89 | Bennett, K. (1996) Determination of the number of zones in a biostratigraphic sequence. 90 | New Phytologist, 132, 155-170. 91 | \doi{10.1111/j.1469-8137.1996.tb04521.x} (Broken stick) 92 | 93 | Grimm, E.C. (1987) CONISS: A FORTRAN 77 program for stratigraphically constrained cluster 94 | analysis by the method of incremental sum of squares. Computers & Geosciences, 13, 13-35. 95 | \doi{10.1016/0098-3004(87)90022-7} 96 | 97 | Juggins, S. (2017) rioja: Analysis of Quaternary Science Data, R package version (0.9-15.1). 98 | (\url{https://cran.r-project.org/package=rioja}). 99 | 100 | See \link[stats:hclust]{hclust} for hierarchical clustering references 101 | } 102 | -------------------------------------------------------------------------------- /R/nested_prcomp.R: -------------------------------------------------------------------------------- 1 | 2 | #' Nested Principal Components Analysis (PCA) 3 | #' 4 | #' Powered by [prcomp][stats::prcomp]. When creating the [nested_data], 5 | #' the data should be scaled (i.e, `trans = scale`) if all variables are not 6 | #' in the same unit. 7 | #' 8 | #' @inheritParams nested_analysis 9 | #' @param data_column An expression that evalulates to the data object within each row of .data 10 | #' @param ... Passed to [prcomp][stats::prcomp]. 11 | #' 12 | #' @return .data with additional columns 'model', 'loadings', 'variance' and 'scores' 13 | #' @export 14 | #' 15 | #' @examples 16 | #' library(dplyr, warn.conflicts = FALSE) 17 | #' 18 | #' nested_pca <- alta_lake_geochem %>% 19 | #' nested_data( 20 | #' qualifiers = c(depth, zone), 21 | #' key = param, 22 | #' value = value, 23 | #' trans = scale 24 | #' ) %>% 25 | #' nested_prcomp() 26 | #' 27 | #' # get variance info 28 | #' nested_pca %>% unnested_data(variance) 29 | #' 30 | #' # get loadings info 31 | #' nested_pca %>% unnested_data(loadings) 32 | #' 33 | #' # scores, requalified 34 | #' nested_pca %>% unnested_data(c(qualifiers, scores)) 35 | #' 36 | nested_prcomp <- function(.data, data_column = .data$data, ...) { 37 | data_column <- enquo(data_column) 38 | 39 | npca <- nested_analysis( 40 | .data, stats::prcomp, !!data_column, ..., 41 | .reserved_names = c( 42 | "variance", "loadings", "scores", 43 | paste0("PC", 1:100), 44 | "component", "component_text", "standard_deviation", "variance", 45 | "variance_proportion", "variance_proportion_cumulative", 46 | "variable" 47 | ) 48 | ) 49 | 50 | npca$variance <- purrr::map( 51 | npca$model, 52 | function(model) { 53 | tibble::tibble( 54 | component = seq_along(model$sdev), 55 | component_text = paste0("PC", seq_along(model$sdev)), 56 | standard_deviation = model$sdev, 57 | variance = model$sdev ^ 2, 58 | variance_proportion = (model$sdev ^ 2) / sum(model$sdev ^ 2), 59 | variance_proportion_cumulative = cumsum((model$sdev ^ 2) / sum(model$sdev ^ 2)) 60 | ) 61 | } 62 | ) 63 | 64 | npca$loadings <- purrr::map( 65 | npca$model, 66 | function(model) { 67 | df <- tibble::rownames_to_column( 68 | as.data.frame(model$rotation), 69 | var = "variable" 70 | ) 71 | tibble::as_tibble(df) 72 | } 73 | ) 74 | 75 | npca$scores <- purrr::map( 76 | npca$model, 77 | function(model) { 78 | tibble::as_tibble(stats::predict(model)) 79 | } 80 | ) 81 | 82 | new_nested_analysis(npca, "nested_prcomp") 83 | } 84 | 85 | #' @importFrom stats biplot 86 | #' @export 87 | #' @rdname plot.nested_analysis 88 | biplot.nested_prcomp <- function(x, ..., nrow = NULL, ncol = NULL) { 89 | plot_nested_analysis(x, .fun = stats::biplot, ..., nrow = nrow, ncol = ncol) 90 | } 91 | 92 | # places data and a default mapping behind a previously specified layer 93 | override_data <- function(layer, data = NULL, mapping = NULL) { 94 | if(inherits(layer, "Layer")) { 95 | if(!is.null(data)) { 96 | layer$data <- data 97 | } 98 | if(!is.null(mapping)) { 99 | layer$mapping <- override_mapping(layer$mapping, mapping) 100 | } 101 | } else if(is.list(layer)) { 102 | layer <- lapply(layer, override_data, data = data, mapping = mapping) 103 | } 104 | 105 | layer 106 | } 107 | 108 | override_mapping <- function(mapping, default_mapping = ggplot2::aes()) { 109 | mapping <- c(mapping, default_mapping) 110 | mapping <- mapping[unique(names(mapping))] 111 | class(mapping) <- "uneval" 112 | mapping 113 | } 114 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-xaxis-depth-age.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 2.5 35 | 5.0 36 | 7.5 37 | 10.0 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 5 47 | 10 48 | 15 49 | 20 50 | depth 51 | value 52 | adm null xaxis depth age 53 | 54 | 55 | -------------------------------------------------------------------------------- /R/ggstrat-scales.R: -------------------------------------------------------------------------------- 1 | 2 | #' Scales for relative abundance values 3 | #' 4 | #' Continuous scales that (1) always start at 0, (2) always have the same breaks, and 5 | #' (3) expand using a constant rather than a percentage. These scales assume that data are 6 | #' in percentages (i.e., range 0 to 100 rather than 0 to 1). 7 | #' 8 | #' @param ... Passed to [scale_y_continuous][ggplot2::scale_y_continuous] or [scale_x_continuous][ggplot2::scale_x_continuous] 9 | #' @param limits Limits for the scale 10 | #' @param breaks Where to place labels on the scale 11 | #' @param minor_breaks Where to place minor breaks 12 | #' @param expand A vector of expantion constants 13 | #' 14 | #' @return A [scale_y_continuous][ggplot2::scale_y_continuous] or [scale_x_continuous][ggplot2::scale_x_continuous] 15 | #' @export 16 | #' 17 | #' @examples 18 | #' library(dplyr, warn.conflicts = FALSE) 19 | #' library(ggplot2) 20 | #' 21 | #' keji_lakes_plottable %>% 22 | #' filter(taxon == "Other", location == "Beaverskin Lake") %>% 23 | #' ggplot(aes(rel_abund, depth)) + 24 | #' geom_col_segsh() + 25 | #' scale_x_abundance() + 26 | #' scale_y_reverse() 27 | #' 28 | scale_x_abundance <- function(..., limits = c(0, NA), breaks = seq(10, 90, 30), 29 | minor_breaks = seq(0, 100, 10), expand = c(0, 1)) { 30 | ggplot2::scale_x_continuous(..., limits = limits, breaks = breaks, expand = expand, minor_breaks = minor_breaks) 31 | } 32 | 33 | #' @rdname scale_x_abundance 34 | #' @export 35 | scale_y_abundance <- function(..., limits = c(0, NA), breaks = seq(10, 90, 30), 36 | minor_breaks = seq(0, 100, 10), expand = c(0, 1)) { 37 | ggplot2::scale_y_continuous(..., limits = limits, breaks = breaks, expand = expand, minor_breaks = minor_breaks) 38 | } 39 | 40 | #' Age-depth scales 41 | #' 42 | #' @param model An age-depth model, or NULL to suppress the second axis 43 | #' @param reversed Reverse the primary age axis (for years BP or similar) 44 | #' @param age_name,depth_name Label for the second axis 45 | #' @param age_breaks,depth_breaks Breaks for the second axis 46 | #' @param age_labels,depth_labels Labels for each break on the second axis 47 | #' @param ... Passed to [scale_y_continuous][ggplot2::scale_y_continuous] or [scale_x_continuous][ggplot2::scale_x_continuous] 48 | #' 49 | #' @return A [scale_y_continuous][ggplot2::scale_y_continuous] or [scale_x_continuous][ggplot2::scale_x_continuous] 50 | #' @export 51 | #' 52 | #' @examples 53 | #' library(ggplot2) 54 | #' library(dplyr, warn.conflicts = FALSE) 55 | #' 56 | #' adm <- age_depth_model( 57 | #' alta_lake_210Pb_ages, 58 | #' depth = depth_cm, age = age_year_ad 59 | #' ) 60 | #' 61 | #' alta_lake_geochem %>% 62 | #' filter(param == "Cu") %>% 63 | #' ggplot(aes(value, depth)) + 64 | #' geom_point() + 65 | #' scale_y_depth_age(adm) 66 | #' 67 | #' @importFrom ggplot2 waiver 68 | #' 69 | scale_y_depth_age <- function(model = NULL, age_name = "age", age_breaks = waiver(), 70 | age_labels = waiver(), ...) { 71 | second_axis <- age_depth_as_sec_axis(model, primary = "depth", name = age_name, breaks = age_breaks, labels = age_labels) 72 | ggplot2::scale_y_reverse(..., sec.axis = second_axis) 73 | } 74 | 75 | #' @rdname scale_y_depth_age 76 | #' @export 77 | scale_y_age_depth <- function(model = NULL, reversed = FALSE, depth_name = "depth", depth_breaks = waiver(), 78 | depth_labels = waiver(), ...) { 79 | second_axis <- age_depth_as_sec_axis(model, primary = "age", name = depth_name, breaks = depth_breaks, labels = depth_labels) 80 | if(reversed) { 81 | ggplot2::scale_y_reverse(..., sec.axis = second_axis) 82 | } else { 83 | ggplot2::scale_y_continuous(..., sec.axis = second_axis) 84 | } 85 | } 86 | 87 | #' @rdname scale_y_depth_age 88 | #' @export 89 | scale_x_depth_age <- function(model = NULL, age_name = "age", age_breaks = waiver(), 90 | age_labels = waiver(), ...) { 91 | second_axis <- age_depth_as_sec_axis(model, primary = "depth", name = age_name, breaks = age_breaks, labels = age_labels) 92 | ggplot2::scale_x_reverse(..., sec.axis = second_axis) 93 | } 94 | 95 | #' @rdname scale_y_depth_age 96 | #' @export 97 | scale_x_age_depth <- function(model = NULL, reversed = FALSE, depth_name = "depth", depth_breaks = waiver(), 98 | depth_labels = waiver(), ...) { 99 | second_axis <- age_depth_as_sec_axis(model, primary = "age", name = depth_name, breaks = depth_breaks, labels = depth_labels) 100 | if(reversed) { 101 | ggplot2::scale_x_reverse(..., sec.axis = second_axis) 102 | } else { 103 | ggplot2::scale_x_continuous(..., sec.axis = second_axis) 104 | } 105 | } 106 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-xaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 2.5 35 | 5.0 36 | 7.5 37 | 10.0 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | -20 47 | -15 48 | -10 49 | -5 50 | age 51 | value 52 | adm null xaxis age depth 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-yaxis-depth-age.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 5 35 | 10 36 | 15 37 | 20 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 2.5 47 | 5.0 48 | 7.5 49 | 10.0 50 | value 51 | depth 52 | adm null yaxis depth age 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-yaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -20 35 | -15 36 | -10 37 | -5 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 2.5 47 | 5.0 48 | 7.5 49 | 10.0 50 | value 51 | age 52 | adm null yaxis age depth 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-rev-xaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 2.5 35 | 5.0 36 | 7.5 37 | 10.0 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | -20 47 | -15 48 | -10 49 | -5 50 | age 51 | value 52 | adm null rev xaxis age depth 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-null-rev-yaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -20 35 | -15 36 | -10 37 | -5 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 2.5 47 | 5.0 48 | 7.5 49 | 10.0 50 | value 51 | age 52 | adm null rev yaxis age depth 53 | 54 | 55 | -------------------------------------------------------------------------------- /tests/testthat/test-ggstrat-plot_addons.R: -------------------------------------------------------------------------------- 1 | 2 | test_that("facet reordering works", { 3 | 4 | p <- mtcars %>% 5 | dplyr::mutate( 6 | # factor not in sorted order 7 | cyl_fct = paste("cyl =", cyl) %>% factor(levels = c("cyl = 8", "cyl = 4", "cyl = 6")), 8 | # character 9 | gear_fct = paste("gear =", gear) 10 | ) %>% 11 | ggplot2::ggplot(ggplot2::aes(wt, mpg)) + 12 | ggplot2::geom_point() + 13 | 14 | # additional layer with character versions of what is a factor in original data 15 | ggplot2::geom_point( 16 | ggplot2::aes(x = 5, y = mpg_line), 17 | data = tibble::tibble( 18 | gear_fct = c("gear = 3", "gear = 4", "gear = 5", "gear = 6"), 19 | cyl_fct = c("cyl = 4", "cyl = 6", "cyl = 8", "cyl = 2"), 20 | mpg_line = c(15, 25, 35, 45) 21 | ), 22 | col = "red" 23 | ) 24 | 25 | vdiffr::expect_doppelganger( 26 | "sequential_layer_facet grid", 27 | p + 28 | ggplot2::facet_grid(ggplot2::vars(cyl_fct), ggplot2::vars(gear_fct)) + 29 | sequential_layer_facets() 30 | ) 31 | 32 | vdiffr::expect_doppelganger( 33 | "sequential_layer_facet wrap", 34 | p + 35 | ggplot2::facet_wrap(ggplot2::vars(cyl_fct, gear_fct)) + 36 | sequential_layer_facets() 37 | ) 38 | 39 | expect_silent( 40 | ggplot2::ggplot_build( 41 | p + ggplot2::facet_null() 42 | ) 43 | ) 44 | }) 45 | 46 | test_that("CONISS can be added to a plot", { 47 | coniss <- alta_lake_geochem %>% 48 | nested_data(age, param, value, trans = scale) %>% 49 | nested_chclust_coniss() 50 | 51 | # skip("CONISS plots do not render identically between vdiffrAddin() and CMD check") 52 | withr::with_envvar(list(VDIFFR_RUN_TESTS = FALSE), { 53 | vdiffr::expect_doppelganger( 54 | "plot coniss y", 55 | ggplot2::ggplot(alta_lake_geochem, ggplot2::aes(x = value, y = age)) + 56 | geom_lineh() + 57 | ggplot2::facet_grid(cols = vars(param)) + 58 | layer_dendrogram(coniss, ggplot2::aes(y = age), param = "CONISS") + 59 | layer_zone_boundaries(coniss, ggplot2::aes(y = age)) 60 | ) 61 | 62 | vdiffr::expect_doppelganger( 63 | "plot coniss x", 64 | ggplot2::ggplot(alta_lake_geochem, ggplot2::aes(x = age, y = value)) + 65 | ggplot2::geom_line() + 66 | ggplot2::facet_grid(rows = vars(param)) + 67 | layer_dendrogram(coniss, ggplot2::aes(x = age), param = "CONISS") + 68 | layer_zone_boundaries(coniss, ggplot2::aes(x = age)) 69 | ) 70 | 71 | grp_coniss <- keji_lakes_plottable %>% 72 | dplyr::group_by(location) %>% 73 | nested_data(depth, taxon, rel_abund) %>% 74 | nested_chclust_coniss() 75 | 76 | vdiffr::expect_doppelganger( 77 | "plot coniss abundance y", 78 | plot_layer_dendrogram(grp_coniss, ggplot2::aes(y = depth), taxon = "CONISS") + 79 | ggplot2::facet_grid(rows = vars(location), cols = vars(taxon)) + 80 | ggplot2::scale_y_reverse() 81 | ) 82 | 83 | vdiffr::expect_doppelganger( 84 | "plot coniss abundance x", 85 | plot_layer_dendrogram(grp_coniss, ggplot2::aes(x = depth), taxon = "CONISS") + 86 | ggplot2::facet_grid(cols = vars(location)) + 87 | ggplot2::scale_y_reverse() 88 | ) 89 | }) 90 | }) 91 | 92 | test_that("PCAs can be added to a plot", { 93 | 94 | pca <- alta_lake_geochem %>% 95 | nested_data(age, param, value, trans = scale) %>% 96 | nested_prcomp() 97 | 98 | # skip("PCA plots do not render identically between vdiffrAddin() and CMD check") 99 | withr::with_envvar(list(VDIFFR_RUN_TESTS = FALSE), { 100 | vdiffr::expect_doppelganger( 101 | "plot PCA x", 102 | ggplot2::ggplot(alta_lake_geochem, ggplot2::aes(x = value, y = age)) + 103 | geom_lineh() + 104 | ggplot2::facet_grid(cols = vars(param)) + 105 | layer_scores(pca, key = "param", which = c("PC1", "PC2")) 106 | ) 107 | 108 | vdiffr::expect_doppelganger( 109 | "plot PCA y", 110 | ggplot2::ggplot(alta_lake_geochem, ggplot2::aes(y = value, x = age)) + 111 | ggplot2::geom_line() + 112 | ggplot2::facet_grid(rows = vars(param)) + 113 | layer_scores(pca, key = "param", value = "value", which = c("PC1", "PC2")) 114 | ) 115 | 116 | grp_pca <- keji_lakes_plottable %>% 117 | dplyr::group_by(location) %>% 118 | nested_data(depth, taxon, rel_abund, trans = sqrt) %>% 119 | nested_prcomp() 120 | 121 | vdiffr::expect_doppelganger( 122 | "plot PCA scores y (rev)", 123 | plot_layer_scores(grp_pca, ggplot2::aes(y = depth), which = c("PC1", "PC2")) + 124 | ggplot2::scale_y_reverse() 125 | ) 126 | 127 | vdiffr::expect_doppelganger( 128 | "plot PCA scores x", 129 | plot_layer_scores(grp_pca, ggplot2::aes(x = depth), which = c("PC1", "PC2")) 130 | ) 131 | }) 132 | }) 133 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | 2 | #' Halifax lakes water chemistry and top/bottom diatom counts 3 | #' 4 | #' A subset of well-labeled, clean diatom count data for 44 Halifax-area (Nova Scotia) lakes, 5 | #' an analysis of which has been published by Ginn et al. (2015). 6 | #' 7 | #' @source 8 | #' Neotoma paleoecology database () 9 | #' 10 | #' @references 11 | #' Ginn, Brian K., Thiyake Rajaratnam, Brian F. Cumming, and John P. 12 | #' Smol. "Establishing Realistic Management Objectives for Urban Lakes Using 13 | #' Paleolimnological Techniques: An Example from Halifax Region (Nova Scotia, 14 | #' Canada)." Lake and Reservoir Management 31, no. 2 (April 3, 2015): 92-108. 15 | #' \doi{10.1080/10402381.2015.1013648}. 16 | #' 17 | #' @examples 18 | #' halifax_lakes_plottable 19 | #' 20 | "halifax_lakes_plottable" 21 | 22 | #' Keji lakes core diatom counts 23 | #' 24 | #' A subset of well-labeled, clean diatom count data for 3 Keji-area (Nova 25 | #' Scotia) lakes, which form part of the analysis in Ginn et al. (2007). 26 | #' 27 | #' @source Neotoma paleoecology database () 28 | #' 29 | #' @references 30 | #' Ginn, Brian K., Brian F. Cumming, and John P. Smol. "Long-Term 31 | #' Lake Acidification Trends in High- and Low-Sulphate Deposition Regions from 32 | #' Nova Scotia, Canada." Hydrobiologia 586, no. 1 (July 1, 2007): 261-75. 33 | #' \doi{10.1007/s10750-007-0644-3}. 34 | #' 35 | #' @examples 36 | #' keji_lakes_plottable 37 | #' 38 | "keji_lakes_plottable" 39 | 40 | #' Alta Lake Lead-210 and Carbon-14 Ages 41 | #' 42 | #' The `alta_lake_210Pb_ages` object contains raw depths and ages for Alta 43 | #' Lake (Whistler, British Columbia, Canada) core AL-GC2 (Dunnington et al. 44 | #' 2016; Dunnington 2015). For these values, ages were calculated from Lead-210 45 | #' activities using the constant rate of supply (CRS) model (Appleby and 46 | #' Oldfield 1983). The `alta_lake_14C_ages` object contains one 47 | #' uncalibrated Carbon-14 measurement from the same core. 48 | #' The `alta_lake_bacon_ages` object contains the combined result of the 49 | #' Lead-210 and the Carbon-14 ages as modelled by the rbacon package 50 | #' (Blaauw and Christen 2011). 51 | #' 52 | #' @references 53 | #' Appleby, P. G., and F. Oldfield. "The Assessment of 210Pb Data from Sites 54 | #' with Varying Sediment Accumulation Rates." Hydrobiologia 103, no. 1 (July 1, 55 | #' 1983): 29–35. \doi{10.1007/BF00028424}. 56 | #' 57 | #' Blaauw, Maarten, and J. Andrés Christen. "Flexible Paleoclimate Age-Depth 58 | #' Models Using an Autoregressive Gamma Process." Bayesian Analysis 6, no. 3 59 | #' (September 2011): 457–74. \doi{10.1214/ba/1339616472}. 60 | #' 61 | #' Dunnington, Dewey W., Ian S. Spooner, Chris E. White, R. Jack Cornett, Dave 62 | #' Williamson, and Mike Nelson. "A Geochemical Perspective on the Impact of 63 | #' Development at Alta Lake, British Columbia, Canada." Journal of 64 | #' Paleolimnology 56, no. 4 (November 2016): 315–330. 65 | #' \doi{10.1007/s10933-016-9919-x}. 66 | #' 67 | #' Dunnington, Dewey W. "A 500-Year Applied Paleolimnological Assessment of 68 | #' Environmental Change at Alta Lake, Whistler, British Columbia, Canada." M.Sc. 69 | #' Thesis, Acadia University, 2015. 70 | #' . 71 | #' 72 | #' @examples 73 | #' alta_lake_210Pb_ages 74 | #' alta_lake_14C_ages 75 | #' alta_lake_bacon_ages 76 | #' 77 | "alta_lake_210Pb_ages" 78 | 79 | #' @rdname alta_lake_210Pb_ages 80 | "alta_lake_14C_ages" 81 | 82 | #' @rdname alta_lake_210Pb_ages 83 | "alta_lake_bacon_ages" 84 | 85 | #' @rdname alta_lake_210Pb_ages 86 | "alta_lake_geochem" 87 | 88 | #' Long Lake Carbon-14 Ages 89 | #' 90 | #' This object contains several uncalibrated Carbon-14 measurements from Long 91 | #' Lake (Nova Scotia-New Brunswick Border Region, Canada) core LL-PC2 92 | #' (Dunnington et al. 2017; White 2012). The `long_lake_bacon_ages` object 93 | #' contains the result of the Carbon-14 ages as 94 | #' modelled by the rbacon package (Blaauw and Christen 2011). 95 | #' 96 | #' @references 97 | #' Blaauw, Maarten, and J. Andrés Christen. "Flexible Paleoclimate Age-Depth 98 | #' Models Using an Autoregressive Gamma Process." Bayesian Analysis 6, no. 3 99 | #' (September 2011): 457–74. \doi{10.1214/ba/1339616472}. 100 | #' 101 | #' Dunnington, Dewey W., Hilary White, Ian S. Spooner, Mark L. Mallory, Chris 102 | #' White, Nelson J. O’Driscoll, and Nic R. McLellan. "A Paleolimnological 103 | #' Archive of Metal Sequestration and Release in the Cumberland Basin Marshes, 104 | #' Atlantic Canada." FACETS 2, no. 1 (May 23, 2017): 440–60. 105 | #' \doi{10.1139/facets-2017-0004}. 106 | #' 107 | #' White, Hilary E. "Paleolimnological Records of Post-Glacial Lake 108 | #' and Wetland Evolution from the Isthmus of Chignecto Region, Eastern Canada." 109 | #' M.Sc. Thesis, Acadia University, 2012. 110 | #' . 111 | #' 112 | #' @examples 113 | #' long_lake_14C_ages 114 | #' long_lake_bacon_ages 115 | #' long_lake_plottable 116 | #' 117 | "long_lake_14C_ages" 118 | 119 | #' @rdname long_lake_14C_ages 120 | "long_lake_bacon_ages" 121 | 122 | #' @rdname long_lake_14C_ages 123 | "long_lake_plottable" 124 | 125 | #' Kellys Lake Data 126 | #' 127 | #' Geochemistry measurements and Cladocera counts from Kellys Lake, 128 | #' Cape Breton Island, Nova Scotia, Canada. 129 | #' 130 | #' @rdname kellys_lake 131 | #' 132 | #' @references 133 | #' Joshua Kurek, Ian Spooner, and Dewey Dunnington (unpublished data). 134 | #' 135 | "kellys_lake_cladocera" 136 | 137 | #' @rdname kellys_lake 138 | "kellys_lake_geochem" 139 | 140 | #' @rdname kellys_lake 141 | "kellys_lake_ages" 142 | -------------------------------------------------------------------------------- /man/facet_abundanceh.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggstrat-facets.R 3 | \name{facet_abundanceh} 4 | \alias{facet_abundanceh} 5 | \alias{facet_abundance} 6 | \alias{facet_geochem_wraph} 7 | \alias{facet_geochem_wrap} 8 | \alias{facet_geochem_grid} 9 | \alias{facet_geochem_gridh} 10 | \title{Facet for relative abundance data} 11 | \usage{ 12 | facet_abundanceh( 13 | taxon, 14 | grouping = NULL, 15 | rotate_facet_labels = 45, 16 | labeller = label_species, 17 | scales = "free_x", 18 | space = "free_x", 19 | dont_italicize = c("\\\\(.*?\\\\)", "spp?\\\\.", "-complex", "[Oo]ther"), 20 | ... 21 | ) 22 | 23 | facet_abundance( 24 | taxon, 25 | grouping = NULL, 26 | rotate_facet_labels = 0, 27 | labeller = label_species, 28 | scales = "free_y", 29 | space = "free_y", 30 | dont_italicize = c("\\\\(.*?\\\\)", "spp?\\\\.", "-complex", "[Oo]ther"), 31 | ... 32 | ) 33 | 34 | facet_geochem_wraph( 35 | param, 36 | grouping = NULL, 37 | rotate_axis_labels = 90, 38 | scales = "free_x", 39 | labeller = label_geochem, 40 | renamers = c(`^d([0-9]+)([HCNOS])$` = "paste(delta ^ \\\\1, \\\\2)", `^210Pb$` = 41 | "paste({}^210, Pb)", `^Pb210$` = "paste({}^210, Pb)"), 42 | units = character(0), 43 | default_units = NA_character_, 44 | ... 45 | ) 46 | 47 | facet_geochem_wrap( 48 | param, 49 | grouping = NULL, 50 | scales = "free_y", 51 | labeller = label_geochem, 52 | renamers = c(`^d([0-9]+)([HCNOS])$` = "paste(delta ^ \\\\1, \\\\2)", `^210Pb$` = 53 | "paste({}^210, Pb)", `^Pb210$` = "paste({}^210, Pb)"), 54 | units = character(0), 55 | default_units = NA_character_, 56 | ... 57 | ) 58 | 59 | facet_geochem_grid( 60 | param, 61 | grouping = NULL, 62 | rotate_axis_labels = 0, 63 | scales = "free_y", 64 | space = "fixed", 65 | labeller = label_geochem, 66 | renamers = c(`^d([0-9]+)([HCNOS])$` = "paste(delta ^ \\\\1, \\\\2)", `^210Pb$` = 67 | "paste({}^210, Pb)", `^Pb210$` = "paste({}^210, Pb)"), 68 | units = character(0), 69 | default_units = NA_character_, 70 | ... 71 | ) 72 | 73 | facet_geochem_gridh( 74 | param, 75 | grouping = NULL, 76 | rotate_axis_labels = 90, 77 | scales = "free_x", 78 | space = "fixed", 79 | labeller = label_geochem, 80 | renamers = c(`^d([0-9]+)([HCNOS])$` = "paste(delta ^ \\\\1, \\\\2)", `^210Pb$` = 81 | "paste({}^210, Pb)", `^Pb210$` = "paste({}^210, Pb)"), 82 | units = character(0), 83 | default_units = NA_character_, 84 | ... 85 | ) 86 | } 87 | \arguments{ 88 | \item{taxon, param}{A call to \link[ggplot2:vars]{vars}, defining the column that identifies the taxon (parameter).} 89 | 90 | \item{grouping}{A call to \link[ggplot2:vars]{vars}, identifying additional grouping columns} 91 | 92 | \item{rotate_facet_labels, rotate_axis_labels}{Facet (axis) label rotation (degrees)} 93 | 94 | \item{labeller}{Labeller to process facet names. Use \link{label_species} to italicize 95 | species names, \link{label_geochem} to perform common formatting and units, 96 | or \link[ggplot2:labellers]{label_value} to suppress.} 97 | 98 | \item{space, scales}{Modify default scale freedom behaviour} 99 | 100 | \item{dont_italicize}{Regular expressions that should not be italicized} 101 | 102 | \item{...}{Passed to \link[ggplot2:facet_grid]{facet_grid} (abundance) or \link[ggplot2:facet_wrap]{facet_wrap} (geochem).} 103 | 104 | \item{renamers}{Search and replace operations to perform in the form 105 | search = replace. Replace text can (should) contain backreferences, 106 | and will be parsed as an expression (see \link[grDevices:plotmath]{plotmath}). Use 107 | NULL to suppress renaming.} 108 | 109 | \item{units}{A named list of values = unit} 110 | 111 | \item{default_units}{The default units to apply} 112 | } 113 | \value{ 114 | A subclass of \code{\link[ggplot2:facet_grid]{ggplot2::facet_grid()}} or \code{\link[ggplot2:facet_wrap]{ggplot2::facet_wrap()}}. 115 | } 116 | \description{ 117 | Provides a number of modifications to the plot that are necessary for relative abundance plots 118 | of a number of species. See \link{scale_x_abundance}, \link[ggplot2:facet_grid]{facet_grid}, 119 | \link[ggplot2:facet_grid]{facet_grid}, \link{label_species}, \link{label_geochem}, 120 | and \link{rotated_facet_labels} \link{rotated_axis_labels} 121 | for examples of how to customize the default behaviour. 122 | } 123 | \examples{ 124 | library(ggplot2) 125 | 126 | ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 127 | geom_col_segsh() + 128 | scale_y_reverse() + 129 | facet_abundanceh(vars(taxon), grouping = vars(location)) + 130 | labs(y = "Depth (cm)") 131 | 132 | ggplot(keji_lakes_plottable, aes(y = rel_abund, x = depth)) + 133 | geom_col_segs() + 134 | scale_x_reverse() + 135 | facet_abundance(vars(taxon), grouping = vars(location)) + 136 | labs(x = "Depth (cm)") 137 | 138 | ggplot(alta_lake_geochem, aes(x = value, y = depth)) + 139 | geom_lineh() + 140 | geom_point() + 141 | scale_y_reverse() + 142 | facet_geochem_wrap(vars(param), units = c(C = "\%", Cu = "ppm", Ti = "ppm"), nrow = 1) + 143 | labs(x = NULL, y = "Depth (cm)") 144 | 145 | ggplot(alta_lake_geochem, aes(x = value, y = depth)) + 146 | geom_lineh() + 147 | geom_point() + 148 | scale_y_reverse() + 149 | facet_geochem_gridh(vars(param), units = c(C = "\%", Cu = "ppm", Ti = "ppm")) + 150 | labs(x = NULL, y = "Depth (cm)") 151 | 152 | ggplot(alta_lake_geochem, aes(y = value, x = depth)) + 153 | geom_line() + 154 | geom_point() + 155 | scale_x_reverse() + 156 | facet_geochem_grid(vars(param), units = c(C = "\%", Cu = "ppm", Ti = "ppm")) + 157 | labs(y = NULL, x = "Depth (cm)") 158 | 159 | } 160 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-yaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -20 35 | -15 36 | -10 37 | -5 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 4 48 | 8 49 | 12 50 | 16 51 | 20 52 | 53 | 54 | 55 | 56 | 2.5 57 | 5.0 58 | 7.5 59 | 10.0 60 | value 61 | age 62 | depth axis 63 | adm yaxis age depth 64 | 65 | 66 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-rev-yaxis-depth-age.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 5 35 | 10 36 | 15 37 | 20 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | -4 48 | -8 49 | -12 50 | -16 51 | -20 52 | 53 | 54 | 55 | 56 | 2.5 57 | 5.0 58 | 7.5 59 | 10.0 60 | value 61 | depth 62 | age axis 63 | adm rev yaxis depth age 64 | 65 | 66 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-xaxis-age-depth.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 4 40 | 8 41 | 12 42 | 16 43 | 20 44 | 2.5 45 | 5.0 46 | 7.5 47 | 10.0 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | -20 57 | -15 58 | -10 59 | -5 60 | depth axis 61 | age 62 | value 63 | adm xaxis age depth 64 | 65 | 66 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/adm-rev-xaxis-depth-age.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -4 40 | -8 41 | -12 42 | -16 43 | -20 44 | 2.5 45 | 5.0 46 | 7.5 47 | 10.0 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 5 57 | 10 58 | 15 59 | 20 60 | age axis 61 | depth 62 | value 63 | adm rev xaxis depth age 64 | 65 | 66 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/horizontal-col-segs.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 5 55 | 10 56 | 15 57 | 20 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | -6 66 | -4 67 | -2 68 | b 69 | a 70 | horizontal col segs 71 | 72 | 73 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/vertical-col-segs.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | -6 55 | -4 56 | -2 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 5 65 | 10 66 | 15 67 | 20 68 | a 69 | b 70 | vertical col segs 71 | 72 | 73 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/horizontal-ribbon.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 1875 35 | 1900 36 | 1925 37 | 1950 38 | 1975 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 0 49 | 200 50 | 400 51 | 600 52 | year 53 | horizontal ribbon 54 | 55 | 56 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/ggstrat/horizontal-area.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 1875 35 | 1900 36 | 1925 37 | 1950 38 | 1975 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 0 49 | 200 50 | 400 51 | 600 52 | level 53 | year 54 | horizontal area 55 | 56 | 57 | -------------------------------------------------------------------------------- /R/ggstrat-labels.R: -------------------------------------------------------------------------------- 1 | 2 | #' Species facet labellers 3 | #' 4 | #' Use these to label species with partial italic formatting. See [label_parsed][ggplot2::label_parsed]. 5 | #' 6 | #' @param labels A data.frame of facet label values 7 | #' @param dont_italicize Regular expressions that should not be italicized 8 | #' @param species_facet Which facet(s) contain species values 9 | #' @param multi_line See [label_parsed][ggplot2::label_parsed] 10 | #' 11 | #' @return A [ggplot2::labeller()] 12 | #' @export 13 | #' 14 | #' @examples 15 | #' 16 | #' library(ggplot2) 17 | #' 18 | #' ggplot(keji_lakes_plottable, aes(x = rel_abund, y = depth)) + 19 | #' geom_col_segsh() + 20 | #' scale_y_reverse() + 21 | #' facet_grid( 22 | #' cols = vars(taxon), 23 | #' rows = vars(location), 24 | #' scales = "free_x", 25 | #' space = "free_x", 26 | #' labeller = purrr::partial(label_species, species_facet = "taxon") 27 | #' ) + 28 | #' labs(y = "Depth (cm)") 29 | #' 30 | label_species <- function(labels, dont_italicize = c("\\(.*?\\)", "spp?\\.", "-complex", "[Oo]ther"), 31 | species_facet = 1, multi_line = TRUE) { 32 | stopifnot( 33 | is.character(dont_italicize), 34 | is.logical(multi_line), length(multi_line) == 1 35 | ) 36 | 37 | if(is.character(species_facet)) { 38 | all_facets <- colnames(labels) 39 | # ignore if labels doesn't contain the target facet 40 | species_facet <- intersect(species_facet, all_facets) 41 | } else if(is.numeric(species_facet)) { 42 | all_facets <- seq_along(labels) 43 | stopifnot(all(species_facet %in% seq_along(labels))) 44 | } else { 45 | stop("species_facet must be numeric or character") 46 | } 47 | 48 | # apply italic() around specific components 49 | for(facet in species_facet) { 50 | vals <- labels[[facet]] 51 | exprs <- partial_italic_expr(unique(as.character(vals)), dont_italicize = dont_italicize) 52 | 53 | if(is.factor(vals)) { 54 | levs <- levels(vals) 55 | labels[[facet]] <- factor(exprs[as.character(vals)], levels = exprs[levs]) 56 | } else { 57 | labels[[facet]] <- exprs[vals] 58 | } 59 | } 60 | 61 | # wrap other facets in "" so that label_parsed() doesn't try to parse non-parseable items 62 | for(facet in setdiff(all_facets, species_facet)) { 63 | escaped <- stringr::str_replace_all(labels[[facet]], '"', '\\\\"') 64 | labels[[facet]] <- paste0('"', escaped, '"') 65 | } 66 | 67 | ggplot2::label_parsed(labels, multi_line = multi_line) 68 | } 69 | 70 | # workhorse behind partial italicizing 71 | partial_italic_expr <- function(labs, dont_italicize) { 72 | not_italics_regex <- paste0("(\\s*", dont_italicize, "\\s*)", collapse = "|") 73 | 74 | locs <- stringr::str_locate_all(labs, not_italics_regex) 75 | names(locs) <- labs 76 | inv_locs <- lapply(locs, stringr::invert_match) 77 | names(inv_locs) <- labs 78 | 79 | locs_df <- dplyr::bind_rows(lapply(locs, as.data.frame), .id = "label") 80 | locs_df$pattern <- rep_len('"%s"', nrow(locs_df)) 81 | inv_locs_df <- dplyr::bind_rows(lapply(inv_locs, as.data.frame), .id = "label") 82 | inv_locs_df$pattern <- rep_len('italic("%s")', nrow(inv_locs_df)) 83 | 84 | labs_df <- dplyr::bind_rows(locs_df, inv_locs_df) 85 | labs_df$match <- stringr::str_sub(labs_df$label, labs_df$start, labs_df$end) 86 | labs_df <- labs_df[order(labs_df$label, labs_df$start), , drop = FALSE] 87 | labs_df <- labs_df[stringr::str_length(labs_df$match) > 0, , drop = FALSE] 88 | 89 | labs_df$match_esc <- stringr::str_replace_all(labs_df$match, '"', '\\\\"') 90 | labs_df$label_expr <- sprintf(labs_df$pattern, labs_df$match_esc) 91 | 92 | final_split <- split(labs_df$label_expr, labs_df$label) 93 | 94 | final_chr <- sprintf( 95 | "paste(%s)", 96 | vapply( 97 | final_split, 98 | paste, 99 | collapse = ", ", 100 | FUN.VALUE = character(1) 101 | ) 102 | ) 103 | names(final_chr) <- names(final_split) 104 | final_chr 105 | } 106 | 107 | #' Geochem facet labelers 108 | #' 109 | #' @param labels A data.frame of facet label values 110 | #' @param units A named list of values = unit 111 | #' @param default_units The default units to apply 112 | #' @param geochem_facet Which facet to apply formatting 113 | #' @param renamers Search and replace operations to perform in the form 114 | #' search = replace. Replace text can (should) contain backreferences, 115 | #' and will be parsed as an expression (see [plotmath][grDevices::plotmath]). Use 116 | #' NULL to suppress renaming. 117 | #' @param multi_line See [label_parsed][ggplot2::label_parsed] 118 | #' 119 | #' @return A [ggplot2::labeller()] 120 | #' @export 121 | #' 122 | #' @examples 123 | #' 124 | #' library(ggplot2) 125 | #' 126 | #' ggplot(alta_lake_geochem, aes(x = value, y = depth)) + 127 | #' geom_lineh() + 128 | #' geom_point() + 129 | #' scale_y_reverse() + 130 | #' facet_wrap( 131 | #' vars(param), 132 | #' labeller = purrr::partial(label_geochem, geochem_facet = "param"), 133 | #' nrow = 1, 134 | #' scales = "free_x" 135 | #' ) + 136 | #' labs(x = NULL, y = "Depth (cm)") 137 | #' 138 | label_geochem <- function( 139 | labels, 140 | units = character(0), 141 | default_units = NA_character_, 142 | geochem_facet = 1, 143 | renamers = c( 144 | "^d([0-9]+)([HCNOS])$" = "paste(delta ^ \\1, \\2)", 145 | "^210Pb$" = "paste({}^210, Pb)", 146 | "^Pb210$" = "paste({}^210, Pb)" 147 | ), 148 | multi_line = TRUE 149 | ) { 150 | 151 | stopifnot( 152 | (length(renamers) == 0) || (is.character(renamers) && !is.null(names(renamers))), 153 | is.character(units), 154 | is.character(default_units), length(default_units) == 1, 155 | is.logical(multi_line), length(multi_line) == 1 156 | ) 157 | 158 | if(is.character(geochem_facet)) { 159 | all_facets <- colnames(labels) 160 | # ignore if labels doesn't contain the target facet 161 | geochem_facet <- intersect(geochem_facet, all_facets) 162 | } else if(is.numeric(geochem_facet)) { 163 | all_facets <- seq_along(labels) 164 | stopifnot(all(geochem_facet %in% seq_along(labels))) 165 | } else { 166 | stop("geochem_facet must be numeric or character") 167 | } 168 | 169 | for(facet in geochem_facet) { 170 | vals <- labels[[facet]] 171 | new_vals <- search_replace_expr( 172 | as.character(vals), 173 | renamers = renamers, 174 | units = units, 175 | default_units = default_units 176 | ) 177 | 178 | if(is.factor(vals)) { 179 | labels[[facet]] <- factor( 180 | new_vals, 181 | levels = search_replace_expr( 182 | levels(vals), 183 | renamers = renamers, 184 | units = units, 185 | default_units = default_units 186 | ) 187 | ) 188 | } else { 189 | labels[[facet]] <- new_vals 190 | } 191 | } 192 | 193 | for(facet in setdiff(all_facets, geochem_facet)) { 194 | escaped <- stringr::str_replace_all(labels[[facet]], '"', '\\\\"') 195 | labels[[facet]] <- paste0('"', escaped, '"') 196 | } 197 | 198 | ggplot2::label_parsed(labels, multi_line = multi_line) 199 | } 200 | 201 | search_replace_expr <- function(vals, renamers, units, default_units) { 202 | 203 | if(!is.null(names(units))) { 204 | units <- units[vals] 205 | units[is.na(units) & is.na(names(units))] <- default_units 206 | 207 | unit_add <- dplyr::if_else( 208 | is.na(units), 209 | "", 210 | paste0('~("', stringr::str_replace_all(units, '"', '\\\\"'), '")') 211 | ) 212 | } else { 213 | unit_add <- rlang::rep_along(vals, "") 214 | } 215 | 216 | replaced <- rlang::rep_along(vals, FALSE) 217 | for(i in seq_along(renamers)) { 218 | new_vals <- stringr::str_replace(vals, names(renamers)[[i]], renamers[[i]]) 219 | new_replaced <- replaced | stringr::str_detect(vals, names(renamers)[[i]]) 220 | vals[!replaced] <- new_vals[!replaced] 221 | replaced <- new_replaced 222 | } 223 | 224 | vals[!replaced] <- paste0('"', stringr::str_replace_all(vals[!replaced], '"', '\\\\"'), '"') 225 | 226 | paste0(vals, unit_add) 227 | } 228 | -------------------------------------------------------------------------------- /data-raw/nova_scotia_diatoms.R: -------------------------------------------------------------------------------- 1 | 2 | library(tidyverse) 3 | # library(neotoma) 4 | library(mudata2) 5 | 6 | ginn_ns_search <- read_csv( 7 | "data-raw/neotoma_ginn_nova_scotia.csv", 8 | col_types = cols( 9 | SiteID = col_integer(), 10 | SiteName = col_character(), 11 | Latitude = col_double(), 12 | Longitude = col_double(), 13 | DatasetID = col_integer(), 14 | DatasetType = col_character(), 15 | AgeOldest = col_integer(), 16 | AgeYoungest = col_integer() 17 | ) 18 | ) 19 | 20 | # skip download from neotoma 21 | # datasets_download_flat <- neotoma::get_download(ginn_ns_search$DatasetID) %>% 22 | # write_rds("data-raw/neotoma_ginn_nova_scotia.rds") 23 | datasets_download_flat <- read_rds("data-raw/neotoma_ginn_nova_scotia.rds") 24 | 25 | site_info <- map(datasets_download_flat, neotoma::get_site) %>% 26 | bind_rows(.id = "dataset.id") %>% 27 | mutate(dataset.id = suppressWarnings(as.numeric(dataset.id))) %>% 28 | filter(!is.na(dataset.id)) 29 | 30 | # leaflet::leaflet(site_info) %>% 31 | # leaflet::addTiles() %>% 32 | # leaflet::addMarkers(lng = ~long, lat = ~lat) 33 | 34 | dataset_info <- map(datasets_download_flat, c("dataset", "dataset.meta")) %>% 35 | bind_rows() 36 | 37 | taxon_info <- map(datasets_download_flat, "taxon.list") %>% 38 | map(mutate_if, is.factor, as.character) %>% 39 | bind_rows(.id = "dataset.id") %>% 40 | mutate(dataset.id = as.numeric(dataset.id)) 41 | 42 | sample_info <- map(datasets_download_flat, "sample.meta") %>% 43 | map(mutate_if, is.factor, as.character) %>% 44 | bind_rows() 45 | 46 | counts <- tibble( 47 | sample.id = map(datasets_download_flat, c("sample.meta", "sample.id")), 48 | counts = map(datasets_download_flat, "counts") %>% map(as_tibble), 49 | long_data = map2(counts, sample.id, ~mutate(.x, sample.id = .y)) %>% 50 | map(~gather(.x, key = "taxon.name", value = "value", -sample.id)) 51 | ) %>% 52 | unnest(long_data) 53 | 54 | 55 | # cores: PSKWSK07B (17953), BEAVERS07B (17958), PESKAWA07B (17957) 56 | keji_lakes_datasets <- dataset_info %>% 57 | filter(dataset.id %in% c(17953, 17958, 17957)) 58 | 59 | keji_lakes_locations <- site_info %>% 60 | filter(dataset.id %in% keji_lakes_datasets$dataset.id) %>% 61 | select(location = site.name, neotoma_dataset_id = dataset.id, everything()) %>% 62 | rename_all(str_replace_all, "\\.", "_") 63 | 64 | keji_lakes_params <- taxon_info %>% 65 | filter(dataset.id %in% keji_lakes_datasets$dataset.id) %>% 66 | select(-dataset.id) %>% 67 | distinct() %>% 68 | rename(param = taxon.name) %>% 69 | rename_all(str_replace_all, "\\.", "_") 70 | 71 | keji_lakes_data <- counts %>% 72 | # two samples have (probably erroneous) duplicate depth information for causes mudata() validation fail 73 | filter(sample.id != 166477, sample.id != 166546) %>% 74 | left_join(sample_info %>% select(depth, unit.name, sample.id, dataset.id), by = "sample.id") %>% 75 | left_join(taxon_info %>% select(taxon.name, dataset.id, variable.units), by = c("taxon.name", "dataset.id")) %>% 76 | left_join(site_info %>% select(dataset.id, site.name), by = "dataset.id") %>% 77 | filter(dataset.id %in% keji_lakes_datasets$dataset.id) %>% 78 | rename(neotoma_dataset_id = dataset.id, location = site.name, param = taxon.name, neotoma_sample_id = sample.id) %>% 79 | rename_all(str_replace_all, "\\.", "_") %>% 80 | select(location, param, depth, value, everything()) 81 | 82 | keji_lakes <- mudata( 83 | data = keji_lakes_data, 84 | params = keji_lakes_params, 85 | locations = keji_lakes_locations, 86 | dataset_id = "neotoma_keji_lakes", 87 | x_columns = "depth" 88 | ) %>% 89 | update_datasets(source = "Neotoma", url = "https://www.neotomadb.org/") 90 | 91 | # also create plottable version for vignette 92 | keji_lakes_plottable <- keji_lakes %>% 93 | select_locations("Beaverskin Lake", "Peskawa Lake") %>% 94 | tbl_data() %>% 95 | 96 | # relative abundance 97 | group_by(location, depth) %>% 98 | mutate(rel_abund = value / sum(value) * 100) %>% 99 | ungroup() %>% 100 | rename(count = value) %>% 101 | 102 | # select only 5 most common taxa 103 | mutate(taxon = fct_lump(param, 5, w = rel_abund)) %>% 104 | group_by(location, depth, taxon) %>% 105 | summarise(count = sum(count), rel_abund = sum(rel_abund)) %>% 106 | ungroup() 107 | 108 | devtools::use_data(keji_lakes, overwrite = TRUE) 109 | devtools::use_data(keji_lakes_plottable, overwrite = TRUE) 110 | 111 | # diatom samples from Halifax Lakes: 112 | # (Banook has some unfortunate labeling inconsistencies, and thus can't be included) 113 | halifax_lakes_datasets <- dataset_info %>% 114 | filter(str_detect(dataset.name, "Halifax Lakess?"), !str_detect(collection.handle, "BANOOK")) %>% 115 | spread(dataset.type, dataset.id) %>% 116 | filter(!is.na(diatom), !is.na(`water chemistry`)) %>% 117 | gather(dataset.type, dataset.id, diatom, `water chemistry`) %>% 118 | arrange(collection.handle) 119 | 120 | halifax_lakes_locations <- site_info %>% 121 | filter(dataset.id %in% halifax_lakes_datasets$dataset.id) %>% 122 | group_by_at(vars(-dataset.id)) %>% 123 | summarise(neotoma_dataset_ids = paste(dataset.id, collapse = ", ")) %>% 124 | ungroup() %>% 125 | select(location = site.name, everything()) %>% 126 | rename_all(str_replace_all, "\\.", "_") 127 | 128 | halifax_lakes_params <- taxon_info %>% 129 | filter(dataset.id %in% halifax_lakes_datasets$dataset.id) %>% 130 | select(-dataset.id) %>% 131 | distinct() %>% 132 | group_by(taxon.name) %>% 133 | mutate(variable.units = paste(variable.units, collapse = "; ")) %>% 134 | ungroup() %>% 135 | # there is an issue with units: some params are both in ug/L and mg/L 136 | distinct() %>% 137 | rename(param = taxon.name) %>% 138 | rename_all(str_replace_all, "\\.", "_") 139 | 140 | halifax_lakes_data <- counts %>% 141 | left_join(sample_info %>% select(depth, unit.name, sample.id, dataset.id), by = "sample.id") %>% 142 | left_join(taxon_info %>% select(taxon.name, dataset.id, variable.units), by = c("taxon.name", "dataset.id")) %>% 143 | left_join(dataset_info %>% select(dataset.id, dataset.type), by = "dataset.id") %>% 144 | left_join(site_info %>% select(dataset.id, site.name), by = "dataset.id") %>% 145 | filter(dataset.id %in% halifax_lakes_datasets$dataset.id) %>% 146 | # convert ug/L to mg/L 147 | mutate( 148 | value = if_else(!is.na(variable.units) & variable.units == "µg/L", value / 1000, value), 149 | variable.units = if_else(!is.na(variable.units) & variable.units == "µg/L", "mg/L", variable.units) 150 | ) %>% 151 | 152 | # set sample_type to 'top', 'bottom', or 'water chemistry' 153 | mutate( 154 | sample_type = case_when( 155 | dataset.type == "water chemistry" ~ "water chemistry", 156 | str_detect(unit.name, "top$") ~ "top", 157 | str_detect(unit.name, "tom$") ~ "bottom", 158 | # several mislabeled units 159 | unit.name == "Bisset_wch" & dataset.type == "diatom" ~ "top", 160 | unit.name == "Major_wch" & dataset.type == "diatom" ~ "top", 161 | TRUE ~ NA_character_ 162 | ) 163 | ) %>% 164 | rename(neotoma_dataset_id = dataset.id, location = site.name, param = taxon.name, neotoma_sample_id = sample.id) %>% 165 | rename_all(str_replace_all, "\\.", "_") %>% 166 | select(location, param, sample_type, value, everything()) 167 | 168 | # create mudata 169 | halifax_lakes <- mudata( 170 | data = halifax_lakes_data, 171 | params = halifax_lakes_params %>% select(-variable_units), 172 | locations = halifax_lakes_locations, 173 | dataset_id = "neotoma_halifax_lakes", 174 | x_columns = "sample_type" 175 | ) %>% 176 | update_datasets(source = "Neotoma", url = "https://www.neotomadb.org/") 177 | 178 | # also create plottable version for vignette 179 | halifax_lakes_plottable <- halifax_lakes %>% 180 | select_locations(1:10) %>% 181 | tbl_data() %>% 182 | filter(sample_type %in% c("top", "bottom")) %>% 183 | 184 | # relative abundance 185 | group_by(location, sample_type) %>% 186 | mutate(rel_abund = value / sum(value) * 100) %>% 187 | ungroup() %>% 188 | rename(count = value) %>% 189 | 190 | # select only 5 most common taxa 191 | mutate(taxon = fct_lump(param, 5, w = rel_abund)) %>% 192 | group_by(location, sample_type, taxon) %>% 193 | summarise(count = sum(count), rel_abund = sum(rel_abund)) %>% 194 | ungroup() 195 | 196 | 197 | usethis::use_data(halifax_lakes, overwrite = TRUE) 198 | usethis::use_data(halifax_lakes_plottable, overwrite = TRUE) 199 | --------------------------------------------------------------------------------