tests/testthat/test-nested_prcomp.R

In tidypaleo: Tidy Tools for Paleoenvironmental Archives

test_that("nested_pca works as intended", {

  ndm <- nested_data(
    alta_lake_geochem,
    qualifiers = c(depth, zone),
    key = param,
    value = value,
    trans = scale
  )

  ndm_pca <- nested_prcomp(ndm)

  expect_is(ndm_pca, "nested_prcomp")

  expect_equal(
    colnames(ndm_pca),
    c("discarded_columns", "discarded_rows", "qualifiers", "data",
      "model", "variance", "loadings", "scores")
  )

  expect_identical(
    purrr::map_int(ndm_pca$qualifiers, nrow),
    purrr::map_int(ndm_pca$data, nrow)
  )

  expect_identical(
    purrr::map_int(ndm_pca$qualifiers, nrow),
    purrr::map_int(ndm_pca$scores, nrow)
  )

  expect_equal(
    ncol(ndm_pca$loadings[[1]]),
    ncol(ndm_pca$data[[1]]) + 1
  )

})

test_that("nested_prcomp works with a grouping variable", {
  ndm_grp <- nested_data(
    keji_lakes_plottable,
    depth, taxon, rel_abund,
    fill = 0, trans = sqrt, select_if = ~any(. != 0),
    groups = location
  )
  prcomp_grp <- nested_prcomp(ndm_grp)

  expect_true("location" %in% colnames(prcomp_grp))
  expect_true(is.atomic(prcomp_grp$location))

  plot(prcomp_grp, main = location, sub = "grouped PCA skree")
  biplot(prcomp_grp, main = location, sub = "grouped PCA biplot")
})

test_that("biplot works with nested_prcomp objects", {
  ndm <- nested_data(
    alta_lake_geochem,
    qualifiers = c(depth, zone),
    key = param,
    value = value,
    trans = scale
  )

  ndm_pca <- nested_prcomp(ndm)

  ndm_grp <- nested_data(
    keji_lakes_plottable,
    depth, taxon, rel_abund,
    fill = 0, trans = sqrt, select_if = ~any(. != 0),
    groups = location
  )
  prcomp_grp <- nested_prcomp(ndm_grp)

  biplot(prcomp_grp, main = location)
  biplot(ndm_pca)

  expect_true(TRUE)
})