R/da_take_or_leave.R

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

#' Create exercise about taking or leaving special orders
#' @param vol        Numeric. Volume of the normal product.
#' @param p          Numeric. Price of the normal product.
#' @param uvc        Numeric. Unit variable cost of the normal product.
#' @param fc         Numeric. Initial fixed costs.
#' @param chg_p      Numeric. -1 for decrease in price, 1 for an increase, 0 otherwise.
#' @param chg_uvc    Numeric. -1 for decrease in unit variable cost, 1 for an increase, 0 otherwise.
#' @param chg_fc     Numeric. 1 for an increase in fixed costs, 0 otherwise.
#' @param enough_cap Logical. TRUE if the special order fits in available capacity.
#' @return List. base, solution, wrong_nei, wrong_min_vol, wrong_max_vol, wrong_min_p
#' @importFrom dplyr case_when
#' @export


da_take_or_leave <- function(vol = 1000,
                             p = 10,
                             uvc = 4,
                             fc = 1000,
                             chg_p = -1,
                             chg_uvc = 1,
                             chg_fc = 1,
                             enough_cap = FALSE) {
  
  ucm <- p - uvc
  
  new_p <- dplyr::case_when(
    chg_p != 0 ~ manacc::wiggle(p, delta = 0.2, dir = chg_p),
    TRUE ~ p
  )
  delta_p <- new_p - p
  
  new_uvc <- dplyr::case_when(
    chg_uvc != 0 ~ manacc::wiggle(uvc, delta = 0.2, dir = chg_uvc),
    TRUE ~ uvc
  )
  delta_uvc <- new_uvc - uvc
  
  new_fc <- dplyr::case_when(
    chg_fc != 0 ~ manacc::wiggle(fc, delta = 0.3, dir = chg_fc),
    TRUE ~ fc
  )
  delta_fc <- new_fc - fc
  
  new_vol <- ceiling(vol * sample(seq(from = 0.01, to = 0.2, by = 0.01),1))
  cap <- dplyr::case_when(
    enough_cap == FALSE ~ vol + floor(new_vol * sample(seq(from = 0.4, to = 0.6, by = 0.01),1)),
    TRUE ~ vol + ceiling(new_vol * sample(seq(from = 1.1, to = 1.20, by = 0.01),1))
  )
  
  new_ucm <- new_p - new_uvc
  delta_norm_sales <- min(0, cap - vol - new_vol)
  
  nei <- new_vol * new_ucm - delta_fc + delta_norm_sales * ucm
  
  min_vol <- ceiling(delta_fc / new_ucm)
  
  if (enough_cap == TRUE) {
    max_vol <- NA
    min_p <- round((new_vol * new_uvc + delta_fc) / new_vol,2)
  } else {
    max_vol <- floor(((cap - vol) * ucm - delta_fc)/(ucm - new_ucm))
    min_p <- round((new_vol * new_uvc + delta_fc - delta_norm_sales * ucm) / new_vol,2)
  }
  
  base <- data.frame(
    type = c("normal","special"),
    vol = c(vol, new_vol),
    p = c(p, new_p),
    uvc = c(uvc, new_uvc),
    ucm = c(ucm, new_ucm),
    fc = c(fc, delta_fc),
    cap = c(cap,0),
    chg_vol = c(delta_norm_sales, 0)
  )
  
  solution <- c(
    nei = nei,
    min_vol = min_vol,
    max_vol = max_vol,
    min_p = min_p
  )
  
  wrong_nei <- c(
    wnei1 = new_vol * new_ucm - delta_fc,
    wnei2 = new_vol * new_ucm + delta_norm_sales * ucm,
    wnei3 = new_vol * new_ucm + delta_fc - delta_norm_sales * ucm,
    wnei4 = new_vol * ucm - delta_fc + delta_norm_sales * ucm,
    wnei5 = new_vol * new_ucm - delta_fc - fc + delta_norm_sales * ucm,
    wnei6 = new_vol * new_ucm - delta_fc - delta_norm_sales * ucm
  )
  wrong_nei <- unique(setdiff(wrong_nei, nei))
  
  wrong_min_vol <- c(
    wminvol1 = ceiling(delta_fc / ucm),
    wminvol2 = ceiling(fc / new_ucm),
    wminvol3 = ceiling(fc / ucm),
    wminvol4 = ceiling(abs(delta_fc / (ucm - new_ucm))),
    wminvol5 = ceiling(delta_fc / new_p),
    wminvol6 = ceiling(delta_fc / new_uvc)
  )
  wrong_min_vol <- unique(setdiff(wrong_min_vol, min_vol))
  
  wrong_max_vol <- c(
    wmaxvol1 = floor(((new_vol) * ucm - delta_fc)/(ucm - new_ucm)),
    wmaxvol2 = floor(((cap - vol) * new_ucm - delta_fc)/(ucm - new_ucm)),
    wmaxvol3 = floor(((new_vol) * ucm + delta_fc)/(ucm - new_ucm)),
    wmaxvol4 = floor(((cap - vol) * new_ucm + delta_fc)/(ucm - new_ucm)),
    wmaxvol5 = floor(((new_vol) * new_ucm - delta_fc)/(ucm - new_ucm)),
    wmaxvol6 = floor(((cap - vol) * ucm + delta_fc)/(ucm - new_ucm)),
    wmaxvol7 = floor(((cap - vol) * ucm)/(ucm - new_ucm))
  )
  wrong_max_vol <- unique(setdiff(wrong_max_vol, max_vol))
  
  wrong_min_p <- c(
    wminp1 = round((new_vol * new_uvc + delta_fc) / new_vol,2),
    wminp2 = round((new_vol * new_uvc - delta_norm_sales * ucm) / new_vol,2),
    wminp3 = round((new_vol * new_uvc) / new_vol,2),
    wminp4 = round((new_vol * uvc + delta_fc - delta_norm_sales * ucm) / new_vol,2),
    wminp5 = round((new_vol * new_uvc - delta_fc - delta_norm_sales * p) / new_vol,2),
    wminp6 = round((new_vol * new_uvc + delta_fc - delta_norm_sales * p) / new_vol,2)
  )
  wrong_min_p <- unique(setdiff(wrong_min_p, min_p))
  
  
  results <- list(
    base = base,
    solution = solution,
    wrong_nei = wrong_nei,
    wrong_min_vol = wrong_min_vol,
    wrong_max_vol = wrong_max_vol,
    wrong_min_p = wrong_min_p
  )
  
  return(results)
}