tests/testthat/test_regcut.R

In KatoPachi/FlextableLikeStar: Generating Regression Table Using Flextable

context("Regression Cut")

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)

reg3 <- lm(y ~ x + z)
coeftest.reg3 <- coeftest(reg3)


test_that("lm_keep", {
  keep <- c("x")
  digits <- 2
  star <- c("*", "**", "***")

  keep.var <- paste(keep, collapse = "|")
  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(summary(reg1)$coefficient)

  bool <- str_detect(covariate.label, keep.var)

  cut <- summary(reg1)$coefficient[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- lm.regcut(reg1, keep = keep)

  expect_equal(test, cut)
})

test_that("coeftest_keep", {
  keep <- c("z")
  digits <- 2
  star <- c("*", "**", "***")

  keep.var <- paste(keep, collapse = "|")
  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(coeftest.reg2)
  bool <- str_detect(covariate.label, keep.var)

  cut <- coeftest.reg2[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- coeftest.regcut(coeftest.reg2, keep = keep)

  expect_equal(test, cut)
})

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

  omit.var <- paste(omit, collapse = "|")
  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(summary(reg3)$coefficient)

  bool <- !str_detect(covariate.label, omit.var)

  cut <- summary(reg3)$coefficient[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- lm.regcut(reg3, omit = omit)

  expect_equal(test, cut)
})

test_that("coeftest_omit", {
  omit <- c("z")
  digits <- 2
  star <- c("*", "**", "***")

  omit.var <- paste(omit, collapse = "|")
  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(coeftest.reg3)
  bool <- !str_detect(covariate.label, omit.var)

  cut <- coeftest.reg3[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- coeftest.regcut(coeftest.reg3, omit = omit)

  expect_equal(test, cut)
})

test_that("lm_omit", {
  digits <- 2
  star <- c("*", "**", "***")

  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(summary(reg3)$coefficient)

  bool <- rep(TRUE, length(covariate.label))

  cut <- summary(reg3)$coefficient[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- lm.regcut(reg3)

  expect_equal(test, cut)
})

test_that("coeftest_omit", {
  digits <- 2
  star <- c("*", "**", "***")

  sig <- 1:3 %>% list.map(paste("%1.", digits, "f", star[.], sep = ""))
  insig <- paste("%1.", digits, "f", sep = "")
  se <- paste("(%1.", digits, "f)", sep = "")

  covariate.label <- rownames(coeftest.reg3)
  bool <- rep(TRUE, length(covariate.label))

  cut <- coeftest.reg3[bool, c("Estimate", "Std. Error", "Pr(>|t|)")] %>%
    matrix(.,ncol = 3) %>%
    data.frame() %>%
    setNames(c("coef", "s.e.", "pval")) %>%
    bind_cols(variables = covariate.label[bool], .)

  cut <- cut %>%
    mutate(
      coef = case_when(
        pval < 0.01 ~ sprintf(sig[[3]], coef),
        pval < 0.05 ~ sprintf(sig[[2]], coef),
        pval < 0.1  ~ sprintf(sig[[1]], coef),
        TRUE        ~ sprintf(insig, coef)
      ),
      s.e. = sprintf(se, s.e.)
    ) %>%
    select(-pval) %>%
    gather(key = stat, value = v, -variables) %>%
    arrange(variables)

  test <- coeftest.regcut(coeftest.reg3)

  expect_equal(test, cut)
})

test_that("regtable",{

  regcut <- list(lm.regcut(reg1, keep = c("x")),
                 coeftest.regcut(coeftest.reg2, keep = c("z")))

  var_name <- regcut %>%
    list.map(~c(.[,"variables"])) %>%
    list.cases(variables)

  var_merge <- var_name %>%
    list.map(~matrix(c(rep(.,2), "coef", "s.e."), nrow = 2)) %>%
    list.rbind() %>%
    data.frame() %>% setNames(c("variables", "stat"))

  coeftab <- suppressWarnings(
    regcut %>%
      list.map(
        right_join(., var_merge, by = c("variables", "stat")) %>%
          select(v)
      ) %>%
      list.cbind()
  )

  name <- var_name %>%
    list.map(c(., "")) %>%
    unlist()

  tab <- cbind(name, coeftab)
  rownames(tab) <- NULL


  test <- regcuttable(regcut)
  expect_equal(test, tab)
})

test_that("regtable_order",{

  order <- c(2, 1)

  regcut <- list(lm.regcut(reg1, keep = c("x")),
                 coeftest.regcut(coeftest.reg2, keep = c("z")))

  var_name <- regcut %>%
    list.map(~c(.[,"variables"])) %>%
    list.cases(variables)

  var_name <- var_name[order]

  var_merge <- var_name %>%
    list.map(~matrix(c(rep(.,2), "coef", "s.e."), nrow = 2)) %>%
    list.rbind() %>%
    data.frame() %>% setNames(c("variables", "stat"))

  coeftab <- suppressWarnings(
    regcut %>%
      list.map(
        right_join(., var_merge, by = c("variables", "stat")) %>%
          select(v)
      ) %>%
      list.cbind()
  )

  name <- var_name %>%
    list.map(c(., "")) %>%
    unlist()

  tab <- cbind(name, coeftab)
  rownames(tab) <- NULL


  test <- regcuttable(regcut, order = order)
  expect_equal(test, tab)
})

test_that("regtable_equallabel",{

  covariate.labels <- c("wage", "ability")

  regcut <- list(lm.regcut(reg1, keep = c("x")),
                 coeftest.regcut(coeftest.reg2, keep = c("z")))

  var_name <- regcut %>%
    list.map(~c(.[,"variables"])) %>%
    list.cases(variables)

  var_merge <- var_name %>%
    list.map(~matrix(c(rep(.,2), "coef", "s.e."), nrow = 2)) %>%
    list.rbind() %>%
    data.frame() %>% setNames(c("variables", "stat"))

  coeftab <- suppressWarnings(
    regcut %>%
      list.map(
        right_join(., var_merge, by = c("variables", "stat")) %>%
          select(v)
      ) %>%
      list.cbind()
  )

  n1 <- length(var_name)
  n2 <- length(covariate.labels)

  if (n2 == n1) {
    name <- covariate.labels %>%
      list.map(c(., "")) %>%
      unlist()
  } else if (n2 < n1) {
    name <- c(covariate.labels, var_name[-(1:n2)])
    name <- name %>%
      list.map(c(., "")) %>%
      unlist()
  } else {
    name <- covariate.labels[1:n1] %>%
      list.map(c(., "")) %>%
      unlist()
  }

  tab <- cbind(name, coeftab)
  rownames(tab) <- NULL


  test <- regcuttable(regcut, covariate.labels = covariate.labels)
  expect_equal(test, tab)
})

test_that("regtable_overlabel",{

  covariate.labels <- c("wage", "ability", "brah")

  regcut <- list(lm.regcut(reg1, keep = c("x")),
                 coeftest.regcut(coeftest.reg2, keep = c("z")))

  var_name <- regcut %>%
    list.map(~c(.[,"variables"])) %>%
    list.cases(variables)

  var_merge <- var_name %>%
    list.map(~matrix(c(rep(.,2), "coef", "s.e."), nrow = 2)) %>%
    list.rbind() %>%
    data.frame() %>% setNames(c("variables", "stat"))

  coeftab <- suppressWarnings(
    regcut %>%
      list.map(
        right_join(., var_merge, by = c("variables", "stat")) %>%
          select(v)
      ) %>%
      list.cbind()
  )

  n1 <- length(var_name)
  n2 <- length(covariate.labels)

  if (n2 == n1) {
    name <- covariate.labels %>%
      list.map(c(., "")) %>%
      unlist()
  } else if (n2 < n1) {
    name <- c(covariate.labels, var_name[-(1:n2)])
    name <- name %>%
      list.map(c(., "")) %>%
      unlist()
  } else {
    name <- covariate.labels[1:n1] %>%
      list.map(c(., "")) %>%
      unlist()
  }

  tab <- cbind(name, coeftab)
  rownames(tab) <- NULL


  test <- regcuttable(regcut, covariate.labels = covariate.labels)
  expect_equal(test, tab)
})