R/helpers.R

In colinorourke/simpower: Conducts Power Analyses Through Simulation

#' This function inspects the lengths of vectors and makes sure they are either
#' 1 or the max length.
#'
#' @param x A list of vectors to check the lengths of.
#'
#' @return A logical value describing whether the condition is met or not.
checkLength = function(x){
  lens = vapply(x, length, integer(1))
  max_len = max(lens)
  if(all(lens == 1L | lens == max_len)) TRUE else glue::glue("All lengths must be 1 or {max_len}")
}

#' Alias of checkLength
#'
#' @inheritParams checkLength
#'
#' @return A logical value describing whether the condition is met or not.
check_length = checkLength


#' This function turns checkLength into an assertion function.
#'
#' @param x Object to check.
#' @param .var.name Optional name for \code{x} to overide default.
#' @param add Name of an assertion collection to add to.
#' @importFrom checkmate makeAssertionFunction
#'
#' @return If successful, the original value, if not an error message.
assertLengths = makeAssertionFunction(checkLength)

select_except = function(list, exclude){
  lst_names = names(list)
  setdiff(lst_names, exclude)
}

#' Compute sum of squares around the mean.
#'
#' @param x A numeric vector on which to compute SS.
#'
#' @return A numeric scalar value representing the SS of \code{x}.
compute_ss = function(x){
  x_bar = mean(x)
  sum((x - x_bar)^2)
}

#' Format P-values
#'
#' @param p A numeric vector of P-values
#' @param digits The numeric of digits to round P-values to before formatting
#' @param eps Number below which to express P-values as "< 0.001", for examples.
#'
#' @return A character vector of formatted P-values
#' @importFrom checkmate makeAssertCollection assertNumeric assertIntegerish assertNumber reportAssertions
#' @importFrom dplyr case_when
#' @importFrom magrittr %>%
format_pval = function(p, digits=3, eps=0.001){
  chks = makeAssertCollection()
  assertNumeric(p, lower=0, upper = 1, min.len = 1, add=chks)
  assertIntegerish(digits, len = 1, lower = 0, any.missing = FALSE, add = chks)
  assertNumber(eps, lower = 0, upper = 1, finite = TRUE, na.ok = FALSE, null.ok = FALSE, add = chks)
  reportAssertions(chks)

  p_round = round(p, digits)
  case_when(p_round < eps ~ "<0.001", TRUE ~ format(p_round, scientific = FALSE)) %>% format(justify="right")
}

#' Create design matrix.
#'
#' @param lst A list. This list contains the samples from each group.  The
#'   number of items in the list is equal to the number of groups.
#' @param add_intercept Should a column of ones be included in the design matrix
#'   as the intercept.
#'
#' @importFrom foreach foreach
#' @return An indicator matrix using the reference coding.
create_model_matrix = function(lst, add_intercept = FALSE){
  lens = vapply(lst, length, numeric(1))
  total_lens = sum(lens)
  n_groups = length(lens)

  grp_one = matrix(0, nrow = lens[1], ncol = n_groups - 1)

  mod_mat = foreach(i = 2:n_groups, .combine = rbind) %do% {
    x = matrix(0, nrow = lens[i], ncol = n_groups - 1)
    x[,i-1] = 1
    x
  }

  if(add_intercept)
    cbind(1, rbind(grp_one, mod_mat)) else
      rbind(grp_one, mod_mat)
}