R/cvp_bktp.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 volumes.
#' @param ps   Numeric vector. List of .prices.
#' @param uvcs Numeric vector. List of unit variable costs.
#' @param fc   Numeric. Fixed costs.
#' @param tgt  Numeric. Target profit.
#' @return A list with the base for the computation, the solution, the wrong_vol and the wrong_rev for MCQ.
#' @importFrom stats runif
#' @export


cvp_bktp <- function(vols = NA, ps = NA, uvcs = NA, fc = NA, tgt = 0){
  
  stopifnot(
    is.numeric(vols),
    is.numeric(ps),
    is.numeric(uvcs),
    is.numeric(fc),
    is.numeric(tgt),
    length(vols) == length(ps),
    length(ps) == length(uvcs)
  )
  
  # Base
  base <- data.frame(
    vol = vols,
    p = ps,
    uvc = uvcs,
    rev = vols * ps
  )
  base$ucm <- ps - uvcs
  base$vcr <- uvcs / ps
  base$cmr <- (ps-uvcs) / ps
  base$mix_vol <- round(vols / sum(vols),4)
  base$mix_rev <- round((vols * ps) / sum(vols * ps),4)
  
  # Solution
  revs <- vols * ps
  cms <- vols * (ps - uvcs)
  wucm <- round(sum(cms) / sum(vols),2)
  wcmr <- round(sum(cms) / sum(revs),4)
  bktp_vol <- ceiling((fc + tgt) / wucm)
  bktp_rev <- round((fc + tgt) / wcmr, 2)
  
  solution <- c(
    wucm = wucm,
    wcmr = wcmr,
    fc = fc,
    tgt = tgt,
    bktp_vol = bktp_vol,
    bktp_rev = bktp_rev
  )
  
  # Errors
  wrong_vol <- c(
    wvol1 = ceiling((fc) / wucm),
    wvol2 = ceiling((fc - tgt) / wucm),
    wvol3 = ceiling(runif(1)+0.5 * bktp_vol),
    wvol4 = ceiling((fc) / (1-wucm)),
    wvol5 = ceiling((fc - tgt) / (1-wucm)),
    wvol6 = ceiling((fc + tgt) / (1-wucm))
    
  )
  
  if (nrow(base > 1)){
    wrong_vol["wvol7"] = ceiling((fc + tgt) / round(sum(base$uvc * base$mix_rev),2))
    wrong_vol["wvol8"] = ceiling((fc - tgt) / round(sum(base$uvc * base$mix_rev),2))
    wrong_vol["wvol9"] = ceiling((fc) / round(sum(base$uvc * base$mix_rev),2))
  }
  
  wrong_vol <- unique(setdiff(wrong_vol, bktp_vol))
  
  wrong_rev <- c(
    wrev1 = round((fc) / wcmr, 2),
    wrev2 = round((fc - tgt) / wcmr, 2),
    wrev3 = round(runif(1)+0.5 * bktp_rev,2),
    wrev4 = round((fc) / (1-wcmr),2),
    wrev5 = round((fc - tgt) / (1-wcmr),2),
    wrev6 = round((fc + tgt) / (1-wcmr),2)
  )
  
  if (nrow(base > 1)){
    wrong_rev["wrev7"] = ceiling((fc + tgt) / round(sum(base$cmr * base$mix_vol),2))
    wrong_rev["wrev8"] = ceiling((fc - tgt) / round(sum(base$cmr * base$mix_vol),2))
    wrong_rev["wrev9"] = ceiling((fc) / round(sum(base$cmr * base$mix_vol),2))
  }
  
  wrong_rev <- unique(setdiff(wrong_rev, bktp_rev))
  
  
  output <- list(
    base = base,
    solution = solution,
    wrong_vol = wrong_vol,
    wrong_rev = wrong_rev
  )
}