R/get_lr_tbl.R

In MiguelRodo/gamlssutils:

#' @title Get LR test results
#'
#' @description
#' Get the GAMLSS LR test results into a neatly formatted table.
#'
#' @param mod,mod_null objects of class \code{'gamlss'}. The model and a
#' corresponding null model, respectively.
#' @param mod_null_null character. Name by which to refer to null model.
#' @param silent logical. If \code{FALSE}, then warning messages are suppressed.
#' Default is \code{FALSE}.
#'
#' @return
#' A table with columns Comp. model, LR DF, LR Chi^2 and LR P-value.
#'
#' @examples
#' set.seed(1)
#' data_mod <- data.frame(x = rnorm(20, 5) + rgamma(20, 0.01, 0.0001))
#' data_mod[['y']] <- 3 * data_mod[['x']] + rnorm(20, sd = 5)
# models
#' mod_mu <- gamlss::gamlss(formula = y ~ -1 +  x,
#'                          family = "NO",
#'                          data = data_mod,
#'                          control = gamlss::gamlss.control(trace = FALSE))
#' mod_sigma <- gamlss::gamlss(formula = y ~ -1 +  x,
#'                             sigma.formula =  ~ x,
#'                             family = "NO",
#'                             data = data_mod,
#'                             control = gamlss::gamlss.control(trace = FALSE))
# table
#' lr_tbl <- get_lr_tbl(mod = mod_sigma, mod_null = mod_mu, mod_null_name = "sigma")
#'
#' @export
get_lr_tbl <- function(mod, mod_null, mod_null_name, silent = FALSE){
  mod_null_curr <- mod_null
  lr_test_vec <- try(gamlss::LR.test(mod_null, mod, print = FALSE))

  if(class(lr_test_vec) == 'try-error'){
    lr_test_tbl <- tibble::tibble("Comp. model" = mod_null_name,  "LR Chi^2" = NA_real_, "LR DF" = NA_real_, "LR P-value" = NA_real_)
    return(lr_test_tbl)
  }
  lr_test_tbl <- tibble::as_tibble(lr_test_vec)
  col_name_lab_vec <- c("df" = "LR DF", "chi" = "LR Chi^2", "p.val" = "LR P-value")
  colnames(lr_test_tbl) <- col_name_lab_vec[colnames(lr_test_tbl)]
  lr_test_tbl[["Comp. model"]] <-  mod_null_name
  lr_test_tbl %<>% dplyr::select(`Comp. model`, dplyr::everything())
  lr_test_tbl
}