tests/testthat/test_tidyverse.R

In tidypopgen: Tidy Population Genetics

# create file
test_indiv_meta <- data.frame(
  id = c("a", "b", "c"),
  population = c("pop1", "pop1", "pop2")
)
test_genotypes <- rbind(
  c(1, 1, 0, 1, 1, 0),
  c(2, 1, 0, 0, 0, 0),
  c(2, 2, 0, 0, 1, 1)
)
test_loci <- data.frame(
  name = paste0("rs", 1:6),
  chromosome = paste0("chr", c(1, 1, 1, 1, 2, 2)),
  position = as.integer(c(3, 5, 65, 343, 23, 456)),
  genetic_dist = as.double(rep(0, 6)),
  allele_ref = c("A", "T", "C", "G", "C", "T"),
  allele_alt = c("T", "C", NA, "C", "G", "A")
)

test_gt <- gen_tibble(
  x = test_genotypes,
  loci = test_loci,
  indiv_meta = test_indiv_meta,
  quiet = TRUE
)

# this also tests show_genotypes and show_loci
test_that("inheritance of group tibbles", {
  # test operations on standard gen_tibbles
  expect_true(inherits(test_gt, "gen_tbl"))
  # add column
  test_gt <- test_gt %>% mutate(x = c(1, 2, 3))
  expect_true(inherits(test_gt, "gen_tbl"))
  # remove column
  test_sub_gt <- test_gt %>% select(-x)
  expect_true(inherits(test_sub_gt, "gen_tbl"))
  # remove genotype column
  test_sub_gt <- test_gt %>% select(-genotypes)
  expect_false(inherits(test_sub_gt, "gen_tbl"))
  # filter
  test_sub_gt <- test_gt %>% filter(population == "pop1")
  expect_true(inherits(test_sub_gt, "gen_tbl"))

  # now group it
  test_group_gt <- test_gt %>% group_by(population)
  expect_true(inherits(test_group_gt, "gen_tbl"))
  expect_true(inherits(test_group_gt, "grouped_gen_tbl"))
  # slice rows
  test_group_gt <- test_group_gt %>% filter(population == "pop1")
  expect_true(inherits(test_group_gt, "gen_tbl"))
  expect_true(inherits(test_group_gt, "grouped_gen_tbl"))
  # add columns
  test_group_gt <- test_group_gt %>% mutate(n = c(1, 2))
  expect_true(inherits(test_group_gt, "gen_tbl"))
  expect_true(inherits(test_group_gt, "grouped_gen_tbl"))

  test_group <- test_group_gt %>% select(-genotypes)
  expect_false(inherits(test_group, "gen_tbl"))
  expect_false(inherits(test_group, "grouped_gen_tbl"))

  test_ungroup_gt <- ungroup(test_group_gt)
  expect_true(inherits(test_ungroup_gt, "gen_tbl"))
})


test_that("sf and grouped methods work", {
  # Load tibbles
  grouped_gen_tbl <- load_example_gt("grouped_gen_tbl")
  grouped_gen_tbl_sf <- load_example_gt("grouped_gen_tbl_sf")
  gen_tbl_sf <- load_example_gt("gen_tbl_sf")

  # Filter
  filtered_group <- grouped_gen_tbl %>% filter(id %in% c("a", "c"))
  expect_equal(class(grouped_gen_tbl), class(filtered_group))
  filtered_group_sf <- grouped_gen_tbl_sf %>% filter(id %in% c("a", "c"))
  expect_equal(class(grouped_gen_tbl_sf), class(filtered_group_sf))
  filtered_sf <- gen_tbl_sf %>% filter(id %in% c("a", "c"))
  expect_equal(class(gen_tbl_sf), class(filtered_sf))

  # Arrange
  arranged_group <- grouped_gen_tbl %>% arrange(id)
  expect_equal(class(grouped_gen_tbl), class(arranged_group))
  arranged_group_sf <- grouped_gen_tbl_sf %>% arrange(id)
  expect_equal(class(grouped_gen_tbl_sf), class(arranged_group_sf))
  arranged_sf <- gen_tbl_sf %>% arrange(id)
  expect_equal(class(gen_tbl_sf), class(arranged_sf))

  # Mutate
  mutated_group <- grouped_gen_tbl %>% mutate(region = "East")
  expect_equal(class(grouped_gen_tbl), class(mutated_group))
  mutated_group_sf <- grouped_gen_tbl_sf %>% mutate(region = "East")
  expect_equal(class(grouped_gen_tbl_sf), class(mutated_group_sf))
  mutated_sf <- gen_tbl_sf %>% mutate(region = "East")
  expect_equal(class(gen_tbl_sf), class(mutated_sf))

  # Cbind
  df <- data.frame(region = c("A", "A", "B", "B", "A", "B", "B"))
  gen_tbl_sf_cbind <- cbind(gen_tbl_sf, df)
  expect_equal(class(gen_tbl_sf), class(gen_tbl_sf_cbind))

  # Assignment "$<-"
  class_before <- class(grouped_gen_tbl)
  grouped_gen_tbl$region <- "East"
  expect_equal(class(grouped_gen_tbl), class_before)
  class_before_sf <- class(grouped_gen_tbl_sf)
  grouped_gen_tbl_sf$region <- "East"
  expect_equal(class(grouped_gen_tbl_sf), class_before_sf)
  class_before_sf_un <- class(gen_tbl_sf)
  gen_tbl_sf$region <- "East"
  expect_equal(class(gen_tbl_sf), class_before_sf_un)
})