tests/testthat/test-lm-tab.R

In lifecycle-project/ds-helper: Helper Functions for Use with 'DataSHIELD'

library(dplyr)

ipd.fit <- readRDS("data/test_glm.rds")
slma.fit <- readRDS("~/ds-helper/tests/testthat/data/test_slma.rds")
lmer.fit <- readRDS("data/test_lmer.rds")

coh_names <- c("alspac", "chop", "dnbc", "eden", "genr", "moba", "raine", 
               "rhea")

nstudy <- paste0("study", seq(1, slma.fit$num.valid.studies))

################################################################################
# check_args  
################################################################################
test_that("check_args returns an error when arguments are incorrect", {
  
  expect_error(
    lm_tab_check_args(model = 99, type = 99, direction = 99, 
                      ci_format = "asdasd", family = 99, coh_names = 99), 
    "5 assertions failed:\n * Variable 'model': Must be of type 'list', not 'double'.\n * Variable 'model': Must be element of set\n * {'glm_ipd','glm_slma','lmer_slma'}, but types do not match (numeric\n * != character).\n * Variable 'model': Must be element of set {'long','wide'}, but types\n * do not match (numeric != character).\n * Variable 'model': Must be element of set {'paste','separate'}, but\n * is 'asdasd'.\n * Variable 'model': Must be element of set {'gaussian','binomial'},\n * but types do not match (numeric != character).", 
    fixed = TRUE
  )
})

test_that("check_args doesn't return an error if arguments are correct", {
  
  expect_true(
    lm_tab_check_args(model = list("test"), type = "glm_ipd", direction = "wide", 
                ci_format = "paste", family = "binomial", 
                coh_names = c("test_1", "test_2"))
  )
  
})

################################################################################
# extract_ipd  
################################################################################
test_that("Check extract_ipd returns correct column names", {
  
  expect_equal(
    colnames(extract_ipd(ipd.fit, "glm_ipd")), 
    c("variable", "Estimate", "Std. Error", "z-value", "p-value", "low0.95CI",  
      "high0.95CI"))
  
})

test_that("Check that extract_ipd returns correct data types", {
  
  expect_equal(
   extract_ipd(ipd.fit, "glm_ipd") %>% 
     summarise_all(class) %>% 
     as.character(), 
   c("character", "numeric", "numeric", "numeric", "numeric", "numeric", 
     "numeric")
  )
})

################################################################################
# rename_ipd  
################################################################################
ipd_rename_expected <- tibble(
  "variable" = "test", 
  "Estimate" = rnorm(1), 
  "Std. Error" = rnorm(1), 
  "z-value" = rnorm(1), 
  "p-value" = rnorm(1), 
  "low0.95CI" = rnorm(1), 
  "high0.95CI" = rnorm(1))

test_that("Check that rename_ipd returns correct column names", {
  
  expect_equal(
    colnames(rename_ipd(ipd_rename_expected)), 
    c("variable", "est", "se", "pvalue", "lowci", "uppci")
    )
})

ipd_rename_not_expected <- ipd_rename_expected %>%
  dplyr::rename(test = variable)
  
test_that("rename_ipd throws error if provided incorrect variable names", {
  
  expect_error(
    rename_ipd(ipd_rename_not_expected), 
    "Can't subset columns that don't exist\\.\\
\\✖ Column `variable` doesn't exist\\."
  )
})
    
################################################################################
# add_ns_ipd  
################################################################################
add_ns_expected <- ipd_rename_expected %>%
  mutate(n_obs = rnorm(1))
  
test_that("Check add_ns_ipd returns correct column names", {
  
  expect_equal(
    colnames(add_ns_ipd(add_ns_expected, ipd.fit)), 
    c("variable", "Estimate", "Std. Error", "z-value", "p-value", "low0.95CI",  
      "high0.95CI", "n_obs"))
  
})

test_that("Check that add_ns_ipd returns correct data types", {
  
  expect_equal(
    add_ns_ipd(add_ns_expected, ipd.fit) %>%
      summarise_all(class) %>% 
      as.character(), 
    c("character", "numeric", "numeric", "numeric", "numeric", "numeric",
      "numeric", "integer")
  )
})

################################################################################
# extract_slma_coh
################################################################################

## ---- Model is glm_slma ------------------------------------------------------
test_that("Check extract_slma_coh returns correct column names with glm_slma", {
  
  expect_equal(
    colnames(extract_slma_coh(slma.fit, coh_names, nstudy)), 
    c("cohort", "variable", "Estimate", "Std. Error", "t value", "Pr(>|t|)"))
  
})

test_that("Check that extract_slma_coh returns correct data types with glm_slma", {
  
  expect_equal(
    extract_slma_coh(slma.fit, coh_names, nstudy) %>% 
      summarise_all(class) %>% 
      as.character(), 
    c("character", "character", "numeric", "numeric", "numeric", "numeric")
  )
})

## ---- Model is lmer_slma -----------------------------------------------------
test_that("Check extract_slma_coh returns correct column names with lmer_slma", {
  
  expect_equal(
    colnames(extract_slma_coh(lmer.fit, coh_names, nstudy)), 
    c("cohort", "variable", "Estimate", "Std. Error", "t value"))
  
})

test_that("Check that extract_slma_coh returns correct data types with lmer_slma", {
  
  expect_equal(
    extract_slma_coh(lmer.fit, coh_names, nstudy) %>% 
      summarise_all(class) %>% 
      as.character(), 
    c("character", "character", "numeric", "numeric", "numeric")
  )
})

################################################################################
# rename_glm_slma  
################################################################################
slma_rename_expected <- tibble(
  "cohort" = "test",
  "variable" = "test", 
  "Estimate" = 0.99, 
  "Std. Error" = 0.99, 
  "t value" = 0.99, 
  "Pr(>|t|)" = 0.99)

test_that("Check that rename_glm_slma returns correct column names", {
  
  expect_equal(
    colnames(rename_glm_slma(slma_rename_expected)), 
    c("cohort", "variable", "est", "se", "pvalue")
  )
})

slma_rename_not_expected <- slma_rename_expected %>%
  dplyr::rename(test = variable)

test_that("rename_glm_slma throws error if provided incorrect variable names", {
  
  expect_error(
    rename_glm_slma(slma_rename_not_expected), 
    "Can't subset columns that don't exist\\.\\
\\✖ Column `variable` doesn't exist\\."
  )
})

################################################################################
# extract_ns_slma  
################################################################################
test_that("Check that extract_ns_slma returns vector with correct integers", {
  
  expect_equal(
    extract_ns_slma(slma.fit, nstudy), 
    c(47434, 1088, 146239, 3349, 16432, 149598, 7173, 896)
  )
})

################################################################################
# add_ns_slma  
################################################################################
add_ns_expected <- ipd_rename_expected %>%
  mutate(ns = 999)

ns_slma_expected_in <- tibble(
  cohort = coh_names,
  variable = rep("test", 8),
  est = rnorm(8),
  se =  rnorm(8),
  pvalue =  rnorm(8))

slma_ns <- rnorm(8)

ns_slma_expected_out <- ns_slma_expected_in %>%
  mutate(n_obs = slma_ns, n_coh = 1)

test_that("Check add_ns_slma returns correct column names and data", {
  
  expect_equal(
    add_ns_slma(slma_ns, ns_slma_expected_in, coh_names), 
    ns_slma_expected_out)
  
})

################################################################################
# rename_lmer_slma  
################################################################################
lmer_rename_expected <- tibble(
  "cohort" = coh_names,
  "variable" = rep("test", 8),
  "Estimate" = rnorm(8), 
  "Std. Error" = rnorm(8), 
  "t value" = rnorm(8))

test_that("Check that rename_lmer_slma returns correct column names", {
  
  expect_equal(
    colnames(rename_lmer_slma(lmer_rename_expected)), 
    c("cohort", "variable", "est", "se", "pvalue")
  )
})

lmer_rename_not_expected <- lmer_rename_expected %>%
  dplyr::rename(test = variable)

test_that("rename_lmer_slma throws error if provided incorrect variable names", {
  
  expect_error(
    rename_lmer_slma(lmer_rename_not_expected), 
    "Can't subset columns that don't exist\\.\\
\\✖ Column `variable` doesn't exist\\."
  )
})

################################################################################
# extract_ns_lmer  
################################################################################
test_that("Check that extract_ns_lmer returns vector with correct integers", {
  
  expect_equal(
    extract_ns_lmer(lmer.fit, nstudy), 
    c(47434, 1088, 146239, 3349, 16432, 149598, 7173, 896)
  )
})

################################################################################
# extract_random  
################################################################################
test_that("Check that extract_random returns correct column names", {
  
  expect_equal(
    colnames(extract_random(lmer.fit, coh_names, nstudy)), 
    c("cohort", "group", "var1", "var2", "stddev"))
})

test_that("Check that extract_random returns correct data types", {
  
  expect_equal(
    extract_random(lmer.fit, coh_names, nstudy) %>%
      summarise_all(class) %>% 
      as.character(), 
    c(rep("character", 4), "numeric")
  )
  
})

################################################################################
# extract_slma_pooled  
################################################################################

## ---- Model is glm_slma ------------------------------------------------------
test_that("Check extract_slma_pooled returns correct column names with glm_slma
          as input", {
  
  expect_equal(
    colnames(extract_slma_pooled(slma.fit, nstudy)), 
    c("variable", "pooled.ML", "se.ML", "pooled.REML", "se.REML", "pooled.FE",
      "se.FE", "cohort"))
  
})

test_that("Check that extract_slma_pooled returns correct data types with 
          glm_slma as input", {
  
  expect_equal(
    extract_slma_pooled(slma.fit, nstudy) %>% 
      summarise_all(class) %>% 
      as.character(), 
    c("character", "numeric", "numeric", "numeric", "numeric", "numeric", 
      "numeric", "character")
  )
})

## ---- Model is lmer_slma -----------------------------------------------------
test_that("Check extract_slma_pooled returns correct column names with lmer_slma
          as input", {
            
            expect_equal(
              colnames(extract_slma_pooled(lmer.fit, nstudy)), 
              c("variable", "pooled.ML", "se.ML", "pooled.REML", "se.REML", "pooled.FE",
                "se.FE", "cohort"))
            
          })

test_that("Check that extract_slma_pooled returns correct data types with 
          lmer_slma as input", {
            
            expect_equal(
              extract_slma_pooled(lmer.fit, nstudy) %>% 
                summarise_all(class) %>% 
                as.character(), 
              c("character", "numeric", "numeric", "numeric", "numeric", "numeric", 
                "numeric", "character")
            )
          })

################################################################################
# rename_slma_pooled  
################################################################################
pooled_rename_expected <- tibble(
  "variable" = rep("test", 5),
  "pooled.ML" = rnorm(5),
  "se.ML" = rnorm(5),
  "pooled.REML" = rnorm(5),
  "se.REML" = rnorm(5),
  "pooled.FE" = rnorm(5),
  "se.FE" = rnorm(5),
  "cohort" = rep("test2", 5)) 
  
test_that("Check that rename_slma_pooled returns correct column names", {
  
  expect_equal(
    colnames(rename_slma_pooled(pooled_rename_expected)), 
    c("cohort", "variable", "est", "se")
  )
})

pooled_rename_not_expected <- pooled_rename_expected %>%
  dplyr::rename(test = variable)

test_that("rename_slma_pooled throws error if provided incorrect variable names", {
  
  expect_error(
    rename_slma_pooled(pooled_rename_not_expected), 
    "Can't subset columns that don't exist\\.\\
\\✖ Column `variable` doesn't exist\\."
  )
})

################################################################################
# add_ci  
################################################################################



################################################################################
# paste_ci  
################################################################################
ci_input <- tibble(
  cohort = coh_names, 
  variable = rep("test", 8),
  est = rnorm(8),
  se = rnorm(8),
  pvalue = rnorm(8),
  n_obs = rnorm(8),
  n_coh = rnorm(8), 
  lowci = rnorm(8), 
  uppci = rnorm(8))

test_that("Check that paste_ci returns correct column names", {
  
  expect_equal(
    colnames(paste_ci(ci_input)), 
    c( "cohort", "variable", "est", "se", "pvalue", "n_obs", "n_coh")
  )
})

test_that("Check that paste_ci returns correct column type", {
  
  expect_equal(
    class(paste_ci(ci_input)$est), 
    "character"
  )
})


################################################################################
# rename_intercept  
################################################################################
intercept_in <- tibble(
  variable = c("test", "intercept", "(Intercept)"), 
  est = rnorm(3))

test_that("Check that rename_intercept has removed brackets", {
  
  expect_equal(
    rename_intercept(intercept_in)$variable, 
    c("test", "intercept", "intercept")
  )
})