tests/testthat/test-CRAN-melt.R

In nc: Named Capture to Data Tables

library(nc)
library(testthat)
library(data.table)
context("melt")
source(system.file("test_engines.R", package="nc", mustWork=TRUE), local=TRUE)

iris.dt <- data.table(observation=1:nrow(iris), iris)
test_engines("error for regex that matches no column names", {
  expect_error({
    capture_melt_single(iris.dt, part="foo")
  }, "no column names match regex")
})

test_engines("error for fun always returning NA", {
  expect_error(suppressWarnings({
    capture_melt_single(iris.dt, part=".*", as.numeric)
  }),
  "need to change type conversion function(s), which should return at least one non-NA, but are always returning NA, even though regex matched 6 column(s): observation,Sepal.Length,Sepal.Width,Petal.Length,Petal.Width,Species",
  fixed=TRUE)
})

test_engines("error for fun always returning NA abbrev cols", {
  subject <- data.frame(t(1:99))
  expect_error(suppressWarnings({
    capture_melt_single(subject, part=".*", as.numeric)
  }),
  "need to change type conversion function(s), which should return at least one non-NA, but are always returning NA, even though regex matched 99 column(s): X1,X2,X3,X4,X5,...,X95,X96,X97,X98,X99",
  fixed=TRUE)
})

test_engines("possessive (.*+) error(RE2) or OK(others)", {
  posmatch <- function(){
    capture_melt_single(
      iris.dt,
      part=".*",
      "[.]",
      dim=".*+")
  }
  if(identical(getOption("nc.engine"), "RE2")){
    expect_error({
      posmatch()
    }, "bad repetition operator")
  }else{
    iris.tall <- posmatch()
    exp.names <- c(
      "observation", "Species", "part", "dim", "value")
    expect_identical(names(iris.tall), exp.names)
  }
})

test_engines("error if first arg not df", {
  expect_error({
    capture_melt_single("foo", bar="baz")
  }, "first argument (subject) must be a data.frame", fixed=TRUE)
})

## what if an input column is named .variable?
DV <- data.table(
  .variable=c("foo", "bar"), "p10.5"=c(3L, 5L), "p1.1"=c(0L, 1L))
test_engines(".variable input column ok", {
  tall.dt <- capture_melt_single(DV, "p", penalty=".*", as.numeric)
  expect_identical(tall.dt$penalty, c(10.5, 10.5, 1.1, 1.1))
})

## what if a capture group has the same name as variable.name?
test_engines("capture group with funny name is ok", {
  tall.dt <- capture_melt_single(
    DV, "p", .variable.p10.5.p1.1=".*", as.numeric)
  expect_identical(tall.dt$.variable.p10.5.p1.1, c(10.5, 10.5, 1.1, 1.1))
})

## what if input df has repeated names?
bad.df <- data.frame(1, 2)
names(bad.df) <- c("foo", "foo")
test_engines("melting df with same col names is an error", {
  expect_error({
    capture_melt_single(bad.df, o="o+")
  }, "input must have columns with unique names, problems: foo")
})

## what if there are two groups with the same name?
test_engines("groups with the same name is an error", {
  expect_error({
    capture_melt_single(DV, foo="p", foo="1")
  }, "duplicate capture group names are only allowed in alternatives, problem: foo")
})

## what if a capture group has the same name as an input column?
test_engines("err change capture group if same as input col", {
  expect_error({
    capture_melt_single(DV, .variable="p")
  },
  "some capture group names (.variable) are the same as input column names that did not match the pattern; please change either the pattern or the capture group names so that all output column names will be unique",
  fixed=TRUE)
})

## what if value.name is the same as input col?
test_engines("err change value.name if same as input col", {
  expect_error({
    capture_melt_single(DV, "p", num=".*", value.name=".variable")
  },
  "value.name (.variable) is the same as an input column name that did not match the pattern; please change one so that all output column names will be unique",
  fixed=TRUE)
})

test_engines("err change value.name or group names", {
  expect_error({
    capture_melt_single(DV, "p", num=".*", value.name="num")
  },
  "value.name (num) is the same as a capture group name; please change one so that all output column names will be unique",
  fixed=TRUE)
})

i.vec <- 1:10000
one.row <- data.frame(t(i.vec))
test_engines("melting lots of columns is OK", {
  out <- capture_melt_single(one.row, "X", col="[0-9]+", as.integer)
  expect_identical(out$col, i.vec)
  expect_identical(out$value, i.vec)
})

DT.wide <- data.table(id=0, num_ref=1, name_ref="foo", num=2, name="bar")
test_engines("converting NA to non-NA is an error", {
  expect_error({
    nc::capture_melt_multiple(DT.wide, column="name|num", type=".*", function(x)fcase(x=="", "other", default="reference"))
  }, "a non-match(NA) was converted to a match(non-NA) by the conversion function in group 2(type); please fix conversion function", fixed=TRUE)
})