R/calculate_tail_ratio.R

In cyplessen/tailRatio: What the Package Does (One Line, Title Case)

#' Calculate tail ratio
#'
#' This function calculates tail ratios for two overlapping normal distributed populations.
#'
#' @param area Area below or above a cutoff
#' @param mean_high Mean of group with higher mean
#' @param mean_low Mean of group with lower mean
#' @param sd_high Standard deviation of group with higher mean
#' @param sd_low Standard deviation of group with lower mean
#' @param cutoff Cutoff value of interest, indicated in standard deviations from the higher mean group
#' @return A tail ratio
#' @export
calculate_tail_ratio <- function(area, mean_high, sd_high, mean_low, sd_low, cutoff) {
  if (!(area == "above" || area == "below")) {
    stop("Indicate area of interest (above or below cutoff)")
  }
  if (area == "above") {
    area_above_higher_mean <- pnorm(cutoff * sd_low, mean_high - mean_low, sd_high, lower.tail = F)
    area_above_lower_mean <- pnorm(cutoff * sd_low, 0, sd_low, lower.tail = F) # lower mean group
    area_above_higher_mean/area_above_lower_mean # more red than blue
  }
  else if (area == "below") {
    area_below_higher_mean <- pnorm(cutoff * sd_low, mean_high - mean_low, sd_high, lower.tail = T)
    area_below_lower_mean <- pnorm(cutoff * sd_low, 0, sd_low,lower.tail = T)
    area_below_lower_mean/area_below_higher_mean # more blue than red
  }
}