tests/testthat/helper.R

In pre: Prediction Rule Ensembles

#####
# Useful scripts to save and load .RDS files for testing

#' @importFrom utils head object.size
#' @importFrom stringr str_match
save_to_test <- function(obj, file_name, tolerance = sqrt(.Machine$double.eps)){
  if(!interactive())
    stop("save_to_test called not in interactive mode. Likely an error")
  
  cat("Largest sizes:\n")
  if(is.list(obj))
    print(head(sort(unlist(lapply(obj, object.size)), decreasing = T))) else
      print(object.size(obj))
  
  out_file <- paste0(
    str_match(getwd(), ".+pre"), "/tests/testthat/previous_results/", file_name, ".RDS")
  saveRDS(obj, compress = T, out_file)
  
  cat("RDS file size is ", file.size(out_file) / 1000, "KB\n", sep = "")
  
  str_tol <- if(any_numeric(obj)) 
    paste0(", tolerance = ", signif(tolerance, 4)) else ""
  
  cat("Call 'expect_equal(", deparse(substitute(obj)), ", read_to_test(\"",  file_name, "\")",
      str_tol, ")' to test\n", sep = "")
}

any_numeric <- function(x){
  if(!is.recursive(x))
    return(is.numeric(x))
  
  
  for(i in x){
    out <- any_numeric(i)
    if(out)
      return(TRUE)
  }
  
  return(FALSE)
}

# Sanity check
# any_numeric(c(1, 2))
# any_numeric(c("a", "b"))
# any_numeric(
#   list(a = "a", b = list(a = "a", b = 1)))
# any_numeric(
#   list(a = "a", b = list(a = "a", b = "c")))

#' @importFrom stringr str_match
read_to_test <- function(file_name){
  path <- if(!interactive()) "./previous_results/" else
    paste0(stringr::str_match(getwd(), ".+pre"), "/tests/testthat/previous_results/")
  
  readRDS(paste0(path, file_name, ".RDS"))
}

#####
# Load libraries if interactive
if(interactive()){
  library(pre)
  library(stringr)
  library(testthat)
  library(partykit)
  
  list.rules <- environment(pre)$list.rules
}

#####
# Prepare data sets for test

data(PimaIndiansDiabetes, package = "mlbench", envir = environment())
# We sub-sample to decrease computation time
suppressWarnings(RNGversion("3.1.0"))
set.seed(58594084)
PimaIndiansDiabetes_full <- PimaIndiansDiabetes
PimaIndiansDiabetes <- PimaIndiansDiabetes[
  sample.int(nrow(PimaIndiansDiabetes), 200 , replace = FALSE), ]

airquality <- airquality[complete.cases(airquality), ]

data(BostonHousing, package = "mlbench", envir = environment())
BostonHousing <- BostonHousing[
  sample.int(nrow(BostonHousing), 200, replace = FALSE), ]

library("survival")
Lung <- survival::lung
Lung$sex <- factor(Lung$sex)
Lung <- Lung[complete.cases(Lung), ]