tests/testthat/test-initialize.R

In plume: A Simple Author Handler for Scientific Writing

test_that("initialize() builds a plume dataset", {
  aut <- Plume$new(basic_df)
  nms_en <- c(
    "id", "initials", "given_name", "family_name", "literal_name",
    "affiliation", "role", "note", "email", "phone", "orcid"
  )

  expect_named(aut$get_plume(), nms_en, ignore.order = TRUE)

  df_fr <- set_names(basic_df, c(
    "prénom", "nom", "nom_complet", "initiales", "affiliation", "affiliation2",
    "analyse", "rédaction", "note", "note2", "courriel", "téléphone", "orcid"
  ))
  nms_fr <- c(
    "id", "initiales", "prénom", "nom", "nom_complet", "affiliation",
    "role", "note", "courriel", "téléphone", "orcid"
  )
  aut <- Plume$new(
    df_fr,
    names = set_names(nms_fr, nms_en),
    roles = c(analyse = "a", rédaction = "b")
  )

  expect_named(aut$get_plume(), nms_fr, ignore.order = TRUE)
})

test_that("objects of class `data.frame` are converted to tibbles", {
  aut <- Plume$new(data.frame(given_name = "X", family_name = "Y"))
  expect_true(tibble::is_tibble(aut$get_plume()))
})

test_that("`Plume` drops `PlumeQuarto`-specific variables", {
  df <- data.frame(given_name = "X", family_name = "Y", dropping_particle = "o")

  aut <- Plume$new(df)
  nms <- c("id", "given_name", "family_name", "literal_name", "initials")
  expect_named(aut$get_plume(), nms)

  aut <- PlumeQuarto$new(df, tempfile_())
  nms <- c(nms, "dropping_particle")
  expect_named(aut$get_plume(), nms)
})

test_that("initialize() ignores unknown variables", {
  aut <- Plume$new(data.frame(given_name = "X", family_name = "Y", foo = ""))
  expect_false(has_name(aut$get_plume(), "foo"))
})

test_that("initialize() makes proper literal names", {
  aut <- Plume$new(basic_df)
  expect_equal(
    aut$get_plume()$literal_name,
    c("Zip Zap", "Ric Rac", "Pim-Pam Pom")
  )
})

test_that("initialize() ignores variables with the same name as internal ones", {
  aut <- Plume$new(data.frame(
    given_name = "X",
    family_name = "Y",
    literal_name = "A B"
  ))
  expect_equal(aut$get_plume()$literal_name, "X Y")
})

test_that("initialize() makes proper initials", {
  aut <- Plume$new(data.frame(
    given_name = c("Zip", "ric", "Pim-Pam", "Tic", "Fip", "12"),
    family_name = c("Zap", "rac", "Pom", "tac Toc", "A'Fop", "34")
  ))
  expect_equal(
    aut$get_plume()$initials,
    c("ZZ", "rr", "P-PP", "TtT", "FA'F", "13")
  )
})

test_that("initials remove dots (#31)", {
  aut <- Plume$new(data.frame(given_name = "X Y.", family_name = "Z"))
  expect_equal(aut$get_plume()$initials, "XYZ")
})

test_that("`affiliation`, `role` and `note` columns are nestable", {
  aut <- Plume$new(basic_df)

  get_nested_cols <- function(x) {
    names(x)[sapply(x, is.list)]
  }

  cols <- get_nested_cols(aut$get_plume())
  expect_equal(cols, c("affiliation", "role", "note"))
})

test_that("single nestables don't nest", {
  aut <- Plume$new(data.frame(given_name = "X", family_name = "Y", note = "a"))
  expect_false(is_nested(aut$get_plume(), "note"))
})

test_that("`roles = credit_roles()` handles CRediT roles", {
  aut <- Plume$new(data.frame(
    given_name = "X",
    family_name = "Y",
    supervision = 1,
    writing = 1,
    editing = NA
  ), roles = credit_roles())

  expect_equal(
    unlist(aut$get_plume()$role, use.names = FALSE),
    c("Supervision", "Writing - original draft", NA)
  )
})

test_that("`initials_given_name = TRUE` initialises given names", {
  aut <- Plume$new(basic_df, initials_given_name = TRUE)

  expect_equal(aut$get_plume()$given_name, c("Z.", "R.", "P.-P."))
  expect_equal(
    aut$get_plume()$literal_name,
    c("Z. Zap", "R. Rac", "P.-P. Pom")
  )
})

test_that("`initials_given_name` doesn't make initials in scripts not using letter cases (#73)", {
  aut <- Plume$new(
    data.frame(given_name = "菖蒲", family_name = "佐藤"),
    initials_given_name = TRUE
  )
  expect_equal(aut$get_plume()$given_name, "菖蒲")
})

test_that("`family_name_first = TRUE` switches given and family name", {
  aut <- Plume$new(basic_df, family_name_first = TRUE)
  expect_equal(
    aut$get_plume()$literal_name,
    c("Zap Zip", "Rac Ric", "Pom Pim-Pam")
  )
})

test_that("languages with no capital letters don't use initials", {
  df <- data.frame(given_name = "耳", family_name = "李")
  aut <- Plume$new(df)
  expect_false(has_name(aut$get_plume(), "initials"))
})

test_that("`interword_spacing = FALSE` binds given and family names", {
  aut <- Plume$new(
    data.frame(given_name = "耳", family_name = "李"),
    interword_spacing = FALSE
  )
  expect_equal(aut$get_plume()$literal_name, "耳李")
})

test_that("`by` overrides default `by` value", {
  aut <- Plume$new(basic_df, by = "initials")
  aut$set_corresponding_authors(zz)
  expect_equal(aut$get_plume()$corresponding, c(TRUE, FALSE, FALSE))

  aut <- PlumeQuarto$new(basic_df, tempfile_(), by = "initials")
  aut$set_corresponding_authors(zz)
  expect_equal(aut$get_plume()$corresponding, c(TRUE, FALSE, FALSE))
})

test_that("initialize() converts blank and empty strings to `NA` (#2)", {
  aut <- Plume$new(data.frame(
    given_name = "X",
    family_name = "Y",
    email = "",
    affiliation = "a",
    affiliation2 = "  ",
    affiliation3 = "\n"
  ))

  expect_equal(
    unlist(aut$get_plume(), use.names = FALSE),
    c("1", "X", "Y", "X Y", "XY", NA, "a", NA, NA)
  )
})

test_that("initialize() trims leading/trailing white spaces", {
  aut <- Plume$new(data.frame(
    given_name = "zip\n ",
    family_name = "zap",
    email = "  zipzap@email.com ",
    affiliation = "\n\na",
    affiliation2 = " b\t"
  ))

  expect_equal(
    unlist(aut$get_plume(), use.names = FALSE),
    c("1", "zip", "zap", "zip zap", "zipzap@email.com", "a", "b")
  )
})

# Errors ----

test_that("initialize() gives meaningful error messages", {
  expect_snapshot({
    (expect_error(
      Plume$new(list(x = 1))
    ))
    (expect_error(
      Plume$new(data.frame(family_name = "x"))
    ))
    (expect_error(
      Plume$new(data.frame(given_name = "x", family_name = ""))
    ))
    (expect_error(
      Plume$new(data.frame(given_name = "x"))
    ))
    (expect_error(
      Plume$new(basic_df, names = list(given_name = "prénom"))
    ))
    (expect_error(
      Plume$new(basic_df, names = "prénom")
    ))
    (expect_error(
      Plume$new(
        basic_df,
        names = c(given_name = "prénom", family_name = "prénom")
      )
    ))
    (expect_error(
      Plume$new(basic_df, names = c(given_name = "prénom", given_name = "nom"))
    ))
    (expect_error(
      Plume$new(basic_df, symbols = c(note = letters))
    ))
    (expect_error(
      Plume$new(basic_df, symbols = list(note = NULL, note = NULL))
    ))
    (expect_error(
      Plume$new(basic_df, orcid_icon = NULL)
    ))
    (expect_error(
      Plume$new(basic_df, initials_given_name = 1)
    ))
    (expect_error(
      Plume$new(basic_df, family_name_first = 1)
    ))
    (expect_error(
      Plume$new(basic_df, credit_roles = 1)
    ))
    (expect_error(
      Plume$new(basic_df, interword_spacing = 1)
    ))
    (expect_error({
      withr::local_options(lifecycle_verbosity = "quiet")
      Plume$new(data.frame(
        given_name = "x", family_name = "y",
        role_1 = c("a", ""),
        role_2 = c("b", "c")
      ))
    }))
    (expect_error(
      Plume$new(basic_df, roles = 1)
    ))
    (expect_error(
      Plume$new(basic_df, roles = "foo")
    ))
    (expect_error(
      Plume$new(basic_df, roles = c(role = "foo", role = "bar"))
    ))
    (expect_error(
      Plume$new(basic_df, roles = c(role = "foo", role_2 = "foo"))
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, file = 1)
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, file = "")
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, file = "test.rmd")
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, file = "~/test.qmd")
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, tempfile_(), by = 1)
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, tempfile_(), by = "")
    ))
    (expect_error(
      PlumeQuarto$new(basic_df, tempfile_(), by = "foo")
    ))
  })
})