tests/testthat/test-inspect.R

In appling/unitted: Track Units as you Manipulate Data

context("inspect")
knownbug <- function(expr, notes) invisible(NULL)

#### is_a(unitted), is.unitted, class(unitted) ####

test_that("Objects are recognized as unitted IFF the outer object is unitted", {
  units <- "mg dm^-3 sec^-1 dm^4 sec"
  
  # vectors
  expect_that(is.unitted(u(101:106, "dalmatians")), is_true()) # numeric
  expect_that(u(rep(c(T,F,NA),4), units), is_a("unitted")) # logical
  knownbug(expect_that(class(u(Sys.Date()+(-2):6, units)), equals(c("unitted","Date"))))
  knownbug(expect_that(class(u(Sys.time()+1:9, units)), equals(c("unitted","POSIXct","POSIXt"))))
  knownbug(expect_that(class(u(as.POSIXlt(Sys.time()+1:9), units)), equals(c("unitted","POSIXlt","POSIXt"))))
  expect_that(is.unitted(u(as.POSIXlt(Sys.time()+1:9), units)), is_true()) # POSIXlt
  
  # data.frames
  df <- data.frame(z=1:5, y=sample(letters,5))
  expect_that(class(df), equals("data.frame"))
  dfu <- transform(df, x=u(z,"bluebottles"))
  expect_that(class(dfu), equals("data.frame"))
  expect_that(is.unitted(dfu), is_false())
  udf <- u(df, c("hi","mom"))
  expect_that(c(class(udf)), equals(c("unitted_data.frame")))
  expect_that(is.unitted(udf), is_true())
  
  # arrays
  uarr <- u(array(1:60, c(3,5,4)),"bees")
  expect_that(is.unitted(uarr), is_true())
  expect_that(c(class(uarr)), equals("unitted_array"))
  expect_that(typeof(uarr), equals("integer"))

  # matrices
  umat <- u(matrix(1:60, c(15,4)),"bees")
  expect_that(is.unitted(umat), is_true())
  expect_that(c(class(umat)), equals("unitted_matrix"))
  expect_that(typeof(umat), equals("integer"))

  # lists
  ulist <- u(list(a=1,b=2,5))
  listu <- list(a=u(1,"lasso"),b=u(2,"spurs"),c=5)
  expect_that(is.unitted(listu), is_false())
  expect_that(is.unitted(listu$b), is_true())  
})


#### get_units ####

test_that("get_units returns a unit string or vector of unit strings", {
  # vectors
  expect_that(get_units(1:5), equals(NA))
  expect_that(get_units(u(1:5,"pumpkins")), equals("pumpkins"))
  
  # data.frames
  df <- data.frame(co=1:4,balt=4:7)
  expect_that(get_units(u(df, c("u1","u2^4"))), is_equivalent_to(c("u1","u2^4")))
  expect_that(get_units(u(df, c("u1",NA))), is_equivalent_to(c("u1","")))
  expect_that(get_units(u(df, NA)), is_equivalent_to(c("","")))
  expect_that(get_units(data.frame(y=1:5, x=u(2:6,"pins"))), equals(c(y=NA,x="pins")))
  expect_that(get_units(data.frame(y=1:5, x=u(2:6,"pins")))[["x"]], equals("pins"))
  
  # arrays
  expect_that(get_units(u(array(1:300),"dog")), equals("dog"))
  expect_that(get_units(u(array(1:3,dim=c(1,3),dimnames=list("spotted",NULL)),"dog")), equals("dog"))
  
  # matrices
  expect_that(get_units(u(matrix(1:400),"cats")), equals("cats"))
  
  # lists
  expect_that(get_units(list(a=u(5,"golden rings"))), equals(c(a="golden rings")))
  expect_that(get_units(list(a=u(5,"golden rings")), recursive=FALSE), equals(NA))
  knownbug(expect_that(get_units(u(as.list(u(rnorm(5),"brown")),"rice"), recursive=TRUE), equals(rep("brown",5))))
  expect_that(get_units(u(as.list(u(rnorm(5),"brown")),"rice"), recursive=FALSE), equals("rice"))
  expect_that(get_units(u(list(a=u(4,"brown"), b=u(5,"jasmine")),"rice"), recursive=TRUE), equals(c(a="brown",b="jasmine")))
  expect_that(get_units(u(list(a=u(4,"brown"), b=u(5,"jasmine")),"rice"), recursive=FALSE), equals("rice"))
  # lists - strange stuff when you try to actually use deep recursion
  uls <- u(list(x=1,y=list(q=u("b","letters"))), c("q"))
  get_units(uls, recursive=TRUE)
  get_units(list(q=u("b","letters")), recursive=FALSE)
  get_units(list(q=u("b","letters")), recursive=TRUE)
  knownbug(expect_that(get_units(list(q=list(z=u("b","letters"))), recursive=TRUE), equals(c(q.z="letters"))), "not sure what this should actually equal, but probably not what we're getting right now.")
})



#### verify_units ####

test_that("verify_units passes IFF the units are the same", {
  ### Warnings (or not) for non-unittedness
  # Non-unitted objects give warnings by default
  expect_that(verify_units(1:5, NA), gives_warning("First value is not unitted"))
  expect_that(verify_units(1:5, NA, nounits.handler=stop), throws_error("First value is not unitted"))
  expect_that(verify_units(1:5, NA, nounits.handler=function(msg){}), equals(1:5))
  expect_that(verify_units(1:5, "", nounits.handler=function(msg){}), equals(1:5))
  
  # data.frames or lists with no unitted elements give warnings by default
  knownbug({
    expect_that(verify_units(data.frame(a=1:5, b=1:5),c(NA,"m")), gives_warning("First value is not unitted and has no unitted elements"))
    expect_that(verify_units(list(a=1:5, b=1:5),c(NA,"m")), gives_warning("First value is not unitted and has no unitted elements"))
  })
  expect_that(verify_units(data.frame(a=1:5, b=1:5),c(NA,"m"), nounits.handler=function(msg){}), throws_error("Unexpected units"))
  expect_that(verify_units(list(a=1:5, b=1:5),c(NA,NA), nounits.handler=function(msg){}), equals(list(a=1:5, b=1:5)))
  expect_that(verify_units(list(a=1:5, b=1:5),c("",""), nounits.handler=function(msg){}), equals(list(a=1:5, b=1:5)))
  expect_that(verify_units(list(a=1:5, b=1:5),c(NA,""), nounits.handler=function(msg){}), equals(list(a=1:5, b=1:5)))
  
  # data.frames or lists with one or more unitted elements give no warnings for unittedness
  expect_that(verify_units(data.frame(a=1:5, b=u(1:5,"m")),c(NA,"m")), equals(data.frame(a=1:5, b=u(1:5,"m"))))
  expect_that(verify_units(data.frame(a=u(1:5,"hi"),b=6:10),c("hi",NA)), equals(data.frame(a=u(1:5,"hi"),b=6:10)))
  expect_that(verify_units(list(a=u(10:1,"happy new year")),c("happy new year")), equals(list(a=u(10:1,"happy new year"))))
  
  ### Defaults: stop on error, return x otherwise
  # vectors
  expect_that(verify_units(u(1:5,"m"),c("m","m")), throws_error("Conflicting dimensions for given units"))
  expect_that(verify_units(u(1:5,"m"),"q"), throws_error("Unexpected units: given 'm', expected 'q'"))
  expect_that(verify_units(u(1:5,"m"),"m"), is_identical_to(u(1:5,"m")))
  
  # arrays
  expect_that(verify_units(u(array(1:5),"kids"),c("kiddos","kids")), throws_error("Conflicting dimensions for given units"))
  expect_that(verify_units(u(array(1:5),"kids"),"kiddos"), throws_error("Unexpected units"))
  expect_that(verify_units(u(array(1:5),"kids"),c("kids")), is_identical_to(u(array(1:5),"kids")))
  
  # matrices
  expect_that(verify_units(u(matrix(1:6,ncol=3),"kids"),c("kiddos","kids")), throws_error("Conflicting dimensions for given units"))
  expect_that(verify_units(u(matrix(1:6,ncol=3),"kids"),"kiddos"), throws_error("Unexpected units"))
  expect_that(verify_units(u(matrix(1:6,ncol=3),"kids"),c("kids")), is_identical_to(u(matrix(1:6,ncol=3),"kids")))
  
  # data.frames
  expect_that(verify_units(data.frame(a=u(1:5,"m"),b=u(6:10,"m")),c("q")), throws_error("Conflicting dimensions for given units"))
  expect_that(verify_units(data.frame(a=u(1:5,"m"),b=u(6:10,"m")),c("p","q")), throws_error("Unexpected units"))
  expect_that(verify_units(data.frame(a=u(1:5,"m"),b=u(6:10,"m")),c("m","m")), is_identical_to(data.frame(a=u(1:5,"m"),b=u(6:10,"m"))))
  
  # unitted data.frames
  expect_that(verify_units(u(data.frame(a=1:5,b=6:10),c("m","m")),c("q")), throws_error("Conflicting dimensions for given units"))
  expect_that(verify_units(u(data.frame(a=1:5,b=6:10),c("m","m")),c("p","q")), throws_error("Unexpected units"))
  expect_that(verify_units(u(data.frame(a=1:5,b=6:10),c("m","m")),c("m","m")), is_identical_to(u(data.frame(a=1:5,b=6:10),c("m","m"))))
  
  # lists
  expect_that(verify_units(list(a=u(10:1,"h n y")),c("y h^3 n h^-2")), equals(list(a=u(10:1,"n y h"))))
  
  # unitted_lists - check the outer, not the inner, units
  expect_that(verify_units(u(list(a=u(10:1,"wildflower")),"honey"),c("wildflower")), throws_error("Unexpected units"))
  expect_that(verify_units(u(list(a=u(10:1,"wildflower")),"honey"),c("honey")), equals(u(list(a=u(10:1,"wildflower")),"honey")))
  # unitted_lists - here's how to check the inner units:
  expect_that(verify_units(v(u(list(a=u(10:1,"wildflower")),"honey"),partial=TRUE),c("wildflower")), equals(list(a=u(10:1,"wildflower"))))
  
})


test_that("verify_units options allow flexibility", {
  ### Options
  # return.values=list(x,NULL)
  expect_that(verify_units(u(1:5,"m"), "m", return.values=list(TRUE,FALSE)), is_true())
  expect_that(verify_units(u(1:5,"m"), "m", return.values=list(list(a=1:4,b=5),FALSE)), equals(list(a=1:4,b=5)))
  expect_that(verify_units(u(1:5,"m"), "m", return.values=c(TRUE,FALSE)), is_true())
  expect_that(verify_units(u(1:5,"m"), "M", return.values=c("apples","oranges")), throws_error("Unexpected units"))
  # violation.handler=stop
  expect_that(verify_units(u(1:5,"m"), "M", violation.handler=warning), gives_warning("Unexpected units"))
  expect_that(verify_units(u(1:5,"m"), "M", violation.handler=message), shows_message("Unexpected units"))
  expect_that(verify_units(u(1:5,"m"), "M", violation.handler=function(x){}), equals(NULL))
  expect_that(verify_units(u(1:5,"m"), "M", return.values=c("apples","oranges"), violation.handler=warning), gives_warning("Unexpected units"))
  expect_that(verify_units(u(1:5,"m"), "M", return.values=c("apples","oranges"), violation.handler=function(x){}), equals("oranges"))
})