tests/testthat/test_stats.R

In radiant-rstats/radiant.model: Model Menu for Radiant: Business Analytics using R and Shiny

# library(radiant.model)
# library(testthat)
trim <- function(x) gsub("^\\s+|\\s+$", "", x)

######### tests ########
context("Linear regression (regress)")

test_that("regress", {
  result <- regress(diamonds, "price", c("carat", "clarity"))
  res1 <- capture.output(summary(result))[10] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "carat           8438.030    51.101 165.125  < .001 ***"
  expect_equal(res1, res2)

  result <- regress(diamonds, "price", "carat:clarity")
  res1 <- capture.output(summary(result))[10] %>% trim()
  expect_equal(res1, res2)

  res1 <- capture.output(summary(result)) %>% trim()
  # cat(paste0(res1,"\n"), file = "~/GitHub/radiant/tests/testthat/output/regression1.txt")
  ## full output - cannot open file when testing the tests
  res2 <- paste0(readLines("output/regress1.txt")) %>% trim()
  expect_equal(res1, res2)
})

test_that("regress - predict", {
  result <- regress(diamonds, "price", c("carat", "clarity"))
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "SI1     9  72769.811 71948.301 73591.322 821.511"
  expect_equal(res1, res2)

  result <- regress(diamonds, "price", "carat:clarity")
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  expect_equal(res1, res2)
})

test_that("regress - predict with quadratic term", {
  result <- regress(diamonds, "price", c("carat", "clarity"), int = "I(carat^2)")
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  cat(paste0(res1, "\n"))
  res2 <- "SI1     9 114304.420 104924.680 123684.159  9379.739"
  expect_equal(res1, res2)

  result <- regress(diamonds, "price", "carat:clarity", int = "I(carat^2)")
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  expect_equal(res1, res2)
})

test_that("regress - predict with date", {
  result <- regress(diamonds, "price", c("carat", "clarity", "date"))
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  res2 <- "SI1 2012-03-19     9  72719.464 71896.008 73542.920 823.456"
  expect_equal(res1, res2)
  res1 <- capture.output(predict(result, pred_cmd = "date = '2012-1-1'"))[9] %>% trim()
  res2 <- "0.794     SI1 2012-01-01   3471.070 3357.438 3584.701 113.631"
  expect_equal(res1, res2)
})


context("Logistic regression (logistic)")

test_that("logistic", {
  result <- logistic(titanic, "survived", c("pclass", "sex"))
  res1 <- capture.output(summary(result))[13] %>% trim()
  cat(paste0(res1, "\n"))
  res2 <- "sex|male    0.080 -92.0%      -2.522     0.163 -15.447  < .001 ***"
  expect_equal(res1, res2)
  result <- logistic(titanic, "survived", "pclass:sex")
  res1 <- capture.output(summary(result))[13] %>% trim()
  expect_equal(res1, res2)
})

test_that("logistic - predict", {
  result <- logistic(titanic, "survived", c("pclass", "sex"))
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'"))[11] %>% trim()
  cat(paste0(res1, "\n"))
  res2 <- "2nd female      0.779 0.712 0.833"
  expect_equal(res1, res2)

  result <- logistic(titanic, "survived", "pclass:sex")
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'"))[11] %>% trim()
  expect_equal(res1, res2)

  res1 <- capture.output(predict(result, pred_data = titanic))[11] %>% trim()
  cat(paste0(res1, "\n"))
  res2 <- "1st female      0.896 0.856 0.926"
  expect_equal(res1, res2)
})

test_that("logistic - predict with quadratic term", {
  result <- logistic(titanic, "survived", c("pclass", "sex", "age"), int = "I(age^2)")
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'; age = 1:100"))[11] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "1st female   1      0.976 0.952 0.988"
  expect_equal(res1, res2)

  result <- logistic(titanic, "survived", "pclass:age", int = "I(age^2)")
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'; age = 1:100"))[11] %>% trim()
  expect_equal(res1, res2)

  res1 <- capture.output(predict(result, pred_data = titanic))[11] %>% trim()
  cat(paste0(res1, "\n"))
  res2 <- "1st female 29.000      0.919 0.880 0.945"
  expect_equal(res1, res2)
})

context("Neural Network (nn)")

test_that("Neural Network - predict for classification", {
  result <- nn(titanic, "survived", c("pclass", "sex"), seed = 1234)
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'", dec = 1))[10] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "2nd female        0.8"
  expect_equal(res1, res2)

  result <- nn(titanic, "survived", "pclass:sex", seed = 1234)
  res1 <- capture.output(predict(result, pred_cmd = "pclass = levels(pclass); sex = 'female'", dec = 1))[10] %>% trim()
  expect_equal(res1, res2)

  res1 <- capture.output(predict(result, pred_data = titanic, dec = 1))[10] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "1st female        0.9"
  expect_equal(res1, res2)
})

test_that("Neural Network - predict for regression", {
  result <- nn(diamonds, "price", c("carat", "clarity"), type = "regression", seed = 1234)
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10", dec = 1))[16] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "SI1     9    18466.7"
  expect_equal(res1, res2)

  result <- nn(diamonds, "price", "carat:clarity", type = "regression", seed = 1234)
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10", dec = 1))[16] %>% trim()
  expect_equal(res1, res2)

  res1 <- capture.output(predict(result, pred_data = diamonds, dec = 1))[16] %>% trim()
  # cat(paste0(res1, "\n"))
  res2 <- "0.9     SI1     3997.9"
  expect_equal(res1, res2)
})

test_that("Neural Network - predict with date", {
  result <- nn(diamonds, "price", c("carat", "clarity", "date"), type = "regression", seed = 1234)
  res1 <- capture.output(predict(result, pred_cmd = "carat = 1:10"))[17] %>% trim()
  res2 <- "SI1 2012-03-19    10   3907.186"
  expect_equal(res1, res2)
  res1 <- capture.output(predict(result, pred_cmd = "date = '2012-1-1'"))[8] %>% trim()
  res2 <- "0.794     SI1 2012-01-01   3907.186"
  expect_equal(res1, res2)
})

# context("Gradient Boosted Trees (gbt)")
#
# test_that("Gradient Boosting - NoLD test", {
#   result <- gbt(titanic, "survived", c("pclass", "sex"), lev = "Yes", early_stopping_rounds = 0)
#   res1 <- round(result$model$importance$Gain, 3)
#   res2 <- c(0.758, 0.210, 0.032)
#   expect_equal(res1, res2, tolerance = 1e-3)
# })

# context("Linear regression (plot.regress)")

# test_that("regress - plots", {
#   result <- regress(diamonds, "price", c("carat", "clarity"))
#   grb <- plot(result, plots = "dashboard", shiny = TRUE)
#   expect_true(all(c("patchwork", "gg", "ggplot") %in% class(grb)))
#   unlink("Rplots.pdf")
# })