R/ata_2cp_2cp_sequential.R

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

#' Prepare allocation bases and rates using the sequential method.
#' @param magnitudes       Numeric vector. 2 numbers indicating the order of magnitude of the allocation bases (later wiggled and multiplied by 100)
#' @param allocation_rates Numeric vector. 2 numbers indicating the desired approximate allocation rates (later wiggled)
#' @return A list with the allocation bases, the amounts accumulated in each cost pool, the solution, the wrong_ar1 and the wrong_ar2.
#' @importFrom dplyr %>%
#' @importFrom dplyr select
#' @importFrom dplyr filter
#' @importFrom dplyr sample_n
#' @importFrom dplyr mutate
#' @importFrom dplyr mutate_all
#' @importFrom dplyr bind_rows
#' @export


ata_2cp_2co_sequential <- function(magnitudes = c(50,10), allocation_rates = c(10,50)){
  
  stopifnot(
    is.numeric(magnitudes),
    is.numeric(allocation_rates),
    length(magnitudes) == 2,
    length(allocation_rates) == 2
  )
  
  V0 <- NULL
  V1 <- NULL
  V2 <- NULL
  V3 <- NULL
  
  magnitudes <- ceiling(c(manacc::wiggle(magnitudes[1]), manacc::wiggle(magnitudes[2])))
  allocation_rates <- c(manacc::wiggle(allocation_rates[1]), manacc::wiggle(allocation_rates[2]))
  
  repartition1 <- list(manacc::allocations$`3_by_2`, manacc::allocations$`3_by_5`)
  repartition2 <- list(manacc::allocations$`2_by_2`, manacc::allocations$`2_by_5`)
  
  # Sequential, 2 CP and 2 CO
  first <- repartition1[[sample(c(1,2),1)]] %>%
    as.data.frame() %>%
    dplyr::filter(V1 <= 35, V1 >= 15, V2 >= 10, V3 >= 10, V2 > V3) %>%
    dplyr::sample_n(1) %>%
    dplyr::mutate(V0 = 0) %>%
    dplyr::mutate_all(function(x,y) x*y, y = magnitudes[1])
  
  second <- repartition2[[sample(c(1,2),1)]] %>%
    as.data.frame() %>%
    dplyr::filter(V1 >= 20, V2 >= 20, V1 < V2) %>%
    dplyr::sample_n(1) %>%
    dplyr::select(V3 = V2, V2 = V1) %>%
    dplyr::mutate(V0 = 0, V1 = 0) %>%
    dplyr::mutate_all(function(x,y) x*y, y = magnitudes[2])
  
  allocation_bases <- bind_rows(first, second) %>%
    dplyr::select(V0,V1,V2,V3)
  
  allocated_amounts <- dplyr::mutate_all(allocation_bases, function(x,y) x*y, y = allocation_rates)
  
  accumulated <- rowSums(allocated_amounts) - colSums(allocated_amounts[,1:2])
  
  allocation_bases[1,1] <- sample(c(1:10),1)*magnitudes[1]
  allocation_bases[2,1] <- sample(c(1:10),1)*magnitudes[2]
  allocation_bases[2,2] <- sample(c(1:5),1)*magnitudes[2]
  
  
  error1 <- round(accumulated / rowSums(allocation_bases),2)
  error2 <- round(accumulated / rowSums(allocation_bases[,c(3,4)]),2)
  error3 <- round(accumulated / c(sum(allocation_bases[1,c(2,3,4)]), sum(allocation_bases[2,c(1,3,4)])),2)
  error4 <- round(accumulated / c(sum(allocation_bases[1,c(1,3,4)]), sum(allocation_bases[2,c(2,3,4)])),2)
  error5 <- round(accumulated / c(sum(allocation_bases[2,c(2,3,4)]), sum(allocation_bases[1,c(1,3,4)])),2)
  error6 <- round(accumulated / c(sum(allocation_bases[2,c(1,3,4)]), sum(allocation_bases[1,c(2,3,4)])),2)
  error7 <- round(accumulated / c(sum(allocation_bases[1,c(3,4)]), sum(allocation_bases[2,c(3,4)])),2)
  error8 <- round(accumulated / c(sum(allocation_bases[2,c(3,4)]), sum(allocation_bases[1,c(3,4)])),2)
  
  wrong_ar1 <- c(
    allocation_rates[2],
    error1[1],
    error2[1],
    error3[1],
    error4[1],
    error5[1],
    error6[1],
    error7[1],
    error8[1]
  )
  
  wrong_ar1 <- unique(setdiff(wrong_ar1, allocation_rates[1]))
  
  wrong_ar2 <- c(
    allocation_rates[1],
    error1[2],
    error2[2],
    error3[2],
    error4[2],
    error5[2],
    error6[2],
    error7[2],
    error8[2]
  )
  
  wrong_ar2 <- unique(setdiff(wrong_ar2, allocation_rates[2]))
  
  results <- list(
    allocation_bases = allocation_bases,
    accumulated = accumulated,
    solution = allocation_rates,
    wrong_ar1 = wrong_ar1,
    wrong_ar2 = wrong_ar2
  )
  
  return(results)
}