tests/testthat/test_regtable.R

In KatoPachi/FlextableLikeStar: Generating Regression Table Using Flextable

context("Regression Table")

library(lmtest)

x <- rnorm(100, sd = 3)
z <- c(rep(-10, 30), rep(2, 30), rep(10, 40))
y <- 10*x + z + rnorm(100)

reg1 <- lm(y ~ x)
coeftest.reg1 <- coeftest(reg1)

reg2 <- lm(y ~ z)
coeftest.reg2 <- coeftest(reg2)

base <- list(reg1, reg2)
rob <- list(coeftest.reg1, coeftest.reg2)
trick <- list(reg1, coeftest.reg1)

test_that("#.regressions section",{

  regn.base <- length(base)
  regn.rob <- length(rob)

  expect_equal(regn.base, 2)
  expect_equal(regn.rob, 2)

})

test_that("regcut section 1", {

  keep <- c("x", "z")
  digits <- 2
  star <- c("*", "**", "***")
  covariate.labels <- c("wage", "ability")

  want <- list(lm.regcut(reg1, keep = keep, digits = digits, star = star),
               lm.regcut(reg2, keep = keep, digits = digits, star = star))

  want <- regcuttable(want, covariate.labels)

  test <- base %>%
    list.map(
      if (class(.) == "lm") {
        lm.regcut(., keep = keep, digits = digits, star = star)
      } else if (class(.) == "coeftest") {
        coeftest.regcut(., keep = keep, digits = digits, star = star)
      } else {
        stop("Unsupported class.")
      }
    )
  test <- regcuttable(test, covariate.labels)

  expect_equal(test, want)

})

test_that("regcut section 2", {

  keep <- c("x", "z")
  digits <- 2
  star <- c("*", "**", "***")
  covariate.labels <- c("wage", "ability")

  want <- list(lm.regcut(reg1, keep = keep, digits = digits, star = star),
               coeftest.regcut(coeftest.reg1, keep = keep, digits = digits, star = star))

  want <- regcuttable(want, covariate.labels)

  test <- trick %>%
    list.map(
      if (class(.) == "lm") {
        lm.regcut(., keep = keep, digits = digits, star = star)
      } else if (class(.) == "coeftest") {
        coeftest.regcut(., keep = keep, digits = digits, star = star)
      } else {
        stop("Unsupported class.")
      }
    )

  test <- regcuttable(test, covariate.labels)

  expect_equal(test, want)

})

test_that("regcut section 3", {

  omit <- c("x", "z")
  digits <- 2
  star <- c("*", "**", "***")
  covariate.labels <- c("wage", "ability")

  want <- list(lm.regcut(reg1, keep = NULL, omit = omit, digits = digits, star = star),
               coeftest.regcut(coeftest.reg1, keep = NULL, omit = omit, digits = digits, star = star))

  want <- regcuttable(want, covariate.labels)

  test <- trick %>%
    list.map(
      if (class(.) == "lm") {
        lm.regcut(., keep = NULL, omit = omit, digits = digits, star = star)
      } else if (class(.) == "coeftest") {
        coeftest.regcut(., keep = NULL, omit = omit, digits = digits, star = star)
      } else {
        stop("Unsupported class.")
      }
    )

  test <- regcuttable(test, covariate.labels)

  expect_equal(test, want)

})

test_that("regcut section 4", {

  omit <- c("x")
  digits <- 2
  star <- c("*", "**", "***")

  want <- list(lm.regcut(reg1, omit = omit, digits = digits, star = star),
               lm.regcut(reg2, omit = omit, digits = digits, star = star))

  want <- regcuttable(want)

  test <- base %>%
    list.map(
      if (class(.) == "lm") {
        lm.regcut(., omit = omit, digits = digits, star = star)
      } else if (class(.) == "coeftest") {
        coeftest.regcut(., omit = omit, digits = digits, star = star)
      } else {
        stop("Unsupported class.")
      }
    )
  test <- regcuttable(test)

  expect_equal(test, want)

})

test_that("reginfo section", {

  keep.stat <- c("n", "adj.rsq")
  df <- FALSE
  digits <- 2

  want <- list(lm.reginfo(reg1, keep.stat = keep.stat, df = df, digits = digits),
               lm.reginfo(reg2, keep.stat = keep.stat, df = df, digits = digits))
  want <- reginfotable(want)

  test <- base %>%
    list.map(
      if (class(.) == "lm") {
        lm.reginfo(., keep.stat = keep.stat, df = df, digits = digits)
      } else {
        stop("Unsupported class included. update now...")
      }
    )
  test <- reginfotable(test)

  expect_equal(want, test)
})

test_that("dataframe section", {

  keep <- c("x", "z")
  digits <- 2
  star <- c("*", "**", "***")
  covariate.labels <- c("wage", "ability")
  keep.stat <- c("n", "adj.rsq")
  df <- FALSE

  #######
  coef <- list(lm.regcut(reg1, keep = keep, digits = digits, star = star),
               lm.regcut(reg2, keep = keep, digits = digits, star = star))
  coef <- regcuttable(coef, covariate.labels)

  stat <- list(lm.reginfo(reg1, keep.stat = keep.stat, df = df, digits = digits),
               lm.reginfo(reg2, keep.stat = keep.stat, df = df, digits = digits))
  stat <- reginfotable(stat)
  stat <- stat %>% setNames(c("name", rep("v", 2)))

  want.tab <- data.frame(rbind(coef, stat))
  reg_name <- 1:2 %>%
    list.map(paste("(", ., ")", sep="")) %>%
    unlist
  colnames(want.tab) <- c("Variables", reg_name)
  #######

  #######
  regn <- length(rob)

  cut <- rob %>%
    list.map(
      if (class(.) == "lm") {
        lm.regcut(., keep = keep, digits = digits, star = star)
      } else if (class(.) == "coeftest") {
        coeftest.regcut(., keep = keep, digits = digits, star = star)
      } else {
        stop("Unsupported class.")
      }
    )

  cut.tab <- regcuttable(cut, covariate.labels)

  info <- base %>%
    list.map(
      if (class(.) == "lm") {
        lm.reginfo(., keep.stat = keep.stat, df = df, digits = digits)
      } else {
        stop("Unsupported class included. update now...")
      }
    )

  info.tab <- reginfotable(info) %>% setNames(c("name", rep("v", regn)))

  show.tab <- data.frame(rbind(cut.tab, info.tab))

  reg_name <- 1:regn %>%
    list.map(~paste("(", ., ")", sep="")) %>%
    unlist()
  colnames(show.tab) <- c("Variables", reg_name)
  #######

  expect_equal(want.tab, show.tab)
})

test_that("column label", {

  column.labels <- c("A", "B", "C")
  column.separate <- c(1, 2)

  sep <- column.separate

  labs <- 1:length(sep) %>%
    list.map(c(rep(column.labels[.], sep[.]))) %>%
    unlist()
  labs <- c("", labs)

  want <- c("", "A", "B", "B")

  expect_equal(labs, want)
})