tests/testthat/test-03_wide_id.R

library(tabshiftr)
library(testthat)
library(checkmate)
context("wide_id")


test_that("one wide identifying variable into long form", {

  input <- tabs2shift$one_wide_id_alt

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = 3) %>%
    setIDVar(name = "commodities", columns = c(4:7), rows = 1) %>%
    setObsVar(name = "harvested", columns = c(4, 5), top = 2) %>%
    setObsVar(name = "production", columns = c(6, 7), top = 2)

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("wide variable in first row of header", {

  input <- tabs2shift$one_wide_id

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = 3) %>%
    setIDVar(name = "commodities", columns = c(4, 6), rows = 1) %>%
    setObsVar(name = "harvested", columns = c(4, 6), top = 2) %>%
    setObsVar(name = "production", columns = c(5, 7), top = 2)

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("wide variable (that needs to be split) in first row of header", {

  input <- tabs2shift$one_wide_id
  input$X4[1] <- "soybean_something"
  input$X6[1] <- "maize_something"

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = 3) %>%
    setIDVar(name = "commodities", columns = c(4, 6), rows = 1, split = "(.+?(?=_))") %>%
    setObsVar(name = "harvested", columns = c(4, 6), top = 2) %>%
    setObsVar(name = "production", columns = c(5, 7), top = 2)

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("wide variable in second row of header", {

  input <- tabs2shift$wide_obs

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = 2) %>%
    setIDVar(name = "commodities", columns = c(3:6), rows = 2) %>%
    setObsVar(name = "harvested", columns = c(3, 4)) %>%
    setObsVar(name = "production", columns = c(5, 6))

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("wide variable in second rows of header, values spearated", {

  input <- tabs2shift$wide_obs_alt

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = 2) %>%
    setIDVar(name = "commodities", columns = c(3, 5), rows = 2) %>%
    setObsVar(name = "harvested", columns = c(3, 5)) %>%
    setObsVar(name = "production", columns = c(4, 6))

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("several wide identifying variables", {

  input <- tabs2shift$two_wide_id

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = c(2, 6), rows = 1) %>%
    setIDVar(name = "commodities", columns = c(2, 4, 6, 8), rows = 2) %>%
    setObsVar(name = "harvested", columns = c(2, 4, 6, 8), top = 3) %>%
    setObsVar(name = "production", columns = c(3, 5, 7, 9), top = 3)

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})


test_that("when the 'wider' identifying variable is registered first", {

  input <- tabs2shift$two_wide_id2

  schema <-
    setIDVar(name = "territories", columns = 1) %>%
    setIDVar(name = "year", columns = c(2, 4, 6, 8), rows = 2) %>%
    setIDVar(name = "commodities", columns = c(2, 6), rows = 1) %>%
    setObsVar(name = "harvested", columns = c(2, 4, 6, 8), top = 3) %>%
    setObsVar(name = "production", columns = c(3, 5, 7, 9), top = 3)

  reorganise(input = input, schema = schema) %>%
    arrange(territories, year, commodities) %>%
    .expect_valid_table(units = 2)

})
EhrmannS/tabshiftr documentation built on Feb. 17, 2025, 9:26 p.m.