R/ce_highlow.R

In NicolasJBM/manacc: Functions to simulate exercises in management accounting, and templates for these questions

#' Prepare figures for small exercises about the high-low method of cost estimation.
#' @param vols    Numeric vector. List of at least 4 volumes for which total costs should be simulated.
#' @param uvc     Numeric. Unit Variable Cost.
#' @param fc      Numeric. Fixed Costs.
#' @param fdc     Numeric. Magnitude of the discretionary part.
#' @return A list with the base for the computation, the solution, the wrong_uvc and the wrong_fc for MCQ.
#' @importFrom stats runif
#' @export

ce_highlow <- function(vols = NULL, uvc = 5, fc = 5000, fdc = 500){
  
  stopifnot(
    length(vols) >= 4,
    is.numeric(vols),
    is.numeric(fc),
    is.numeric(fdc),
    fc/fdc >= 2
  )
  
  base <- data.frame(
    volumes = vols,
    fixed_costs = fc,
    discretionary_fluctuations = round(fdc * 2 * (runif(length(vols)) - 0.5),1)
  )
  
  base$discretionary_fluctuations[base$volumes == min(base$volumes)] <- 0
  base$discretionary_fluctuations[base$volumes == max(base$volumes)] <- 0

  base$variable_costs <- base$volumes * uvc
  base$fixed_costs <- base$fixed_costs + base$discretionary_fluctuations
  base$total_costs <- base$variable_costs + base$fixed_costs
  base <- as.data.frame(apply(base, 2, round, digits = 2))
  base <- base[order(base$volumes),]
  base$discretionary_fluctuations <- NULL
  
  selection <- base[base$volumes == min(base$volumes) | base$volumes == max(base$volumes),c("volumes","total_costs")]

  solution <- list(
    deltavol = selection$volumes[[2]] - selection$volumes[[1]],
    deltacost = selection$total_costs[[2]] - selection$total_costs[[1]],
    uvc = round((selection$total_costs[[2]] - selection$total_costs[[1]]) / (selection$volumes[[2]] - selection$volumes[[1]]),2),
    fc = selection$total_costs[[1]] - selection$volumes[[1]] * round((selection$total_costs[[2]] - selection$total_costs[[1]]) / (selection$volumes[[2]] - selection$volumes[[1]]),2)
  )
  
  badselection <- base[base$volumes != min(base$volumes) & base$volumes != max(base$volumes),]
  badselection <- badselection[badselection$volumes == min(badselection$volumes) | badselection$volumes == max(badselection$volumes),c("volumes","total_costs")]
  badselection <- badselection[order(badselection$total_costs),]
  
  
  wrong_uvc <- c(
    wuvc1 = round((badselection$total_costs[[2]] - badselection$total_costs[[1]]) / (badselection$volumes[[2]] - badselection$volumes[[1]]),2),
    wuvc2 = round((badselection$total_costs[[2]] - badselection$total_costs[[1]]) / (selection$volumes[[2]] - selection$volumes[[1]]),2),
    wuvc3 = round((selection$total_costs[[2]] - badselection$total_costs[[1]]) / (selection$volumes[[2]] - badselection$volumes[[1]]),2),
    wuvc4 = round((badselection$total_costs[[2]] - selection$total_costs[[1]]) / (badselection$volumes[[2]] - selection$volumes[[1]]),2),
    wuvc5 = round(sample(c(0.75,0.8),1)*solution$uvc,2),
    wuvc6 = round(sample(c(0.85,0.9),1)*solution$uvc,2),
    wuvc7 = round((selection$total_costs[[2]] / selection$volumes[[2]]),2),
    wuvc8 = round((selection$total_costs[[1]] / selection$volumes[[1]]),2),
    wuvc9 = 0
  )
  
  wrong_uvc <- unique(setdiff(wrong_uvc, solution$uvc))
  
  wrong_fc <- c(
    wfc1 = badselection$total_costs[[1]] - badselection$volumes[[1]] * wrong_uvc[[1]],
    wfc2 = badselection$total_costs[[1]] - selection$volumes[[1]] * wrong_uvc[[2]],
    wfc3 = badselection$total_costs[[1]] - badselection$volumes[[1]] * wrong_uvc[[3]],
    wfc4 = selection$total_costs[[1]] - selection$volumes[[1]] * wrong_uvc[[4]],
    wfc5 = selection$total_costs[[1]] - selection$volumes[[1]] * wrong_uvc[[5]],
    wfc6 = selection$total_costs[[1]] - selection$volumes[[1]] * wrong_uvc[[6]],
    wfc7 = selection$total_costs[[1]],
    wfc8 = selection$total_costs[[2]],
    wfc9 = 0
  )
  
  wrong_fc <- unique(setdiff(wrong_fc, solution$fc))
  
  output <- list(
    base = base,
    solution = solution,
    wrong_uvc = wrong_uvc,
    wrong_fc = wrong_fc
  )
  
  return(output)
}