##############################################################################
# Packages
library(exams)
library(manacc)
library(tidyverse)
library(knitr)
library(kableExtra)
library(randomNames)


##############################################################################
# Initialization
question_id <- "EN00000040"
wdir <- getwd()
parameters <- teachR::param_quest(wdir, question_id, alttype = "mcq", altlevel = "3 Apply")
for (i in 1:length(parameters)) assign(names(parameters)[[i]], parameters[[i]])
options(xtable.comment = FALSE, xtable.floating = FALSE, xtable.timestamp = "")
set.seed(seed)


##############################################################################
# Preparation
basepar <- manacc::income_statements(basevol = 20000, profitable = c(TRUE,TRUE))
company <- basepar$company[[1]]
product <- basepar$product[[1]]
singular <- basepar$singular[[1]]
plural <- basepar$plural[[1]]

person <- manacc::make_persons(2)
currentmonth <- lubridate::month(Sys.Date(), label = TRUE, abbr = FALSE)
lastmonth <- lubridate::month(Sys.Date()-30, label = TRUE, abbr = FALSE)

enough_cap <- sample(c(TRUE,FALSE),1)
force_buy <- sample(c(TRUE,FALSE),1)

tp <- manacc::ratp_range_tp(
  vol = basepar$vol[[1]],
  p = basepar$p[[1]],
  uvcp = basepar$umat[[1]] + basepar$ulab[[1]],
  uvcs = basepar$uper[[1]],
  ufc = round(basepar$fc[[1]] / basepar$vol[[1]], 2),
  enough_cap = enough_cap, force_buy = force_buy
)

if (force_buy){
  comment_allow_out <- "but the buyer would be forced to buy internally"
} else {
  comment_allow_out <- "and the buyer would be allowed to buy externally"
}


##############################################################################
# Answers

if (reqexpl != "" & exasolu == "exam" & type_table != "html") lines <- paste0("\\vspace{",15,"cm}") else lines <- rep(" \\ ", 2)
#lines <- rep("\\ ", 2)

rightrtp <- paste0("The minimum acceptable transfer price would be ", currencysymb, tp$solution["min_itp"], " and the maximum acceptable transfer price would be ",currencysymb, tp$solution["max_itp"],".")

wrongrtp <- c(
  paste0("The minimum acceptable transfer price would be ", currencysymb, tp$wrong_min_itp[1], " and the maximum acceptable transfer price would be ",currencysymb, tp$solution["max_itp"],"."),
  paste0("The minimum acceptable transfer price would be ", currencysymb, tp$solution["max_itp"], " and the maximum acceptable transfer price would be ",currencysymb, tp$wrong_max_itp[1],"."),
  paste0(
    paste0("The minimum acceptable transfer price would be ", currencysymb, sample(tp$wrong_min_itp[-1],2, replace = TRUE), " and the maximum acceptable transfer price would be ", currencysymb, sample(tp$wrong_max_itp[-1],2, replace = TRUE),".")
  )
)

questions <- c(rightrtp, wrongrtp)

solutions <- c(TRUE, rep(FALSE,4))

explanations <- c(
  "",
  "",
  "",
  "",
  ""
)


##############################################################################
# Randomize order (do not edit)
alea <- sample(c(1, sample(2:length(questions), (alternatives-1))), alternatives)
questions <- questions[alea]
solutions <- solutions[alea]
explanations <- explanations[alea]

Question

r txt_question_id r company is composed of two business units (BU) organized as pseudo profit centers. The first BU sells r product for a unit price of r currencysymb r writR::dbl(tp$base$p[[1]]). Its unit variable cost of production is r currencysymb r writR::dbl(tp$base$uvcp[[1]]) and an additional r currencysymb r writR::dbl(tp$base$ufc[[1]]) of fixed cost is allocated to each unit to compute the unit cost of production of r currencysymb r writR::dbl(tp$base$uvcp[[1]] + tp$base$ufc[[1]]). Shipping r plural to external customers costs an additional r currencysymb r writR::dbl(tp$base$uvcs[[1]]) per unit. The monthly maximum capacity of production is r writR::int(tp$base$cap[[1]]) r plural and the monthly demand in typically r writR::int(tp$base$vol[[1]]) r plural.
\ The second BU would like to diversify its product portfolio and would need every month r writR::int(tp$base$vol[[3]]) custom made r plural. r tp$comments["uvcp"], with a unit variable cost of production of r currencysymb r writR::dbl(tp$base$uvcp[[2]]). Each custom unit would consume the same amount of capacity as a normal r singular. The internal transfer of products between BUs would cost r currencysymb r writR::dbl(tp$base$uvcs[[2]]) per r singular to the internal seller. In addition, the internal buyer would incur an extra r currencysymb r writR::dbl(tp$base$uvcs[[3]]) per unit for shipping to the final customer. The selling price of this custom product on this new market would be r currencysymb r writR::dbl(tp$base$p[[3]]).
\ Knowing that an external supplier could deliver these custom r plural for a unit price of r currencysymb r writR::dbl(tp$base$uvcp[[3]]) r comment_allow_out, what is the range of acceptable transfer prices? r reqexpl r points

if (reqexpl == "") exams::answerlist(questions, markup = "markdown") else writeLines(lines)

Solution

The minimum acceptable transfer price (TP) is the transfer price for which the change in profit is null for the seller. This is a case of "take or leave a special order" that you can solve with differential analysis by computing an indifferent point in price. Relevant costs and benefits for the seller are 1) the additional contribution margin made on the internal transfer and 2) the contribution margin lost on other sales because of the internal transfer. r tp$comments["lost"]:

$$ \begin{aligned} \Delta OI = r writR::int(tp$base$vol[[3]]) \times (TP - r writR::dbl(tp$base$uvcp[[2]]) - r writR::dbl(tp$base$uvcs[[2]])) - r writR::int(tp$solution["lost"]) \times (r writR::dbl(tp$base$p[[1]]) - r writR::dbl(tp$base$uvcp[[1]]) - r writR::dbl(tp$base$uvcs[[1]])) & \geq 0 \ r writR::int(tp$base$vol[[3]]) \times TP - r writR::dbl(tp$base$vol[[3]] * tp$base$uvcp[[2]]) - r writR::dbl(tp$base$vol[[3]] * tp$base$uvcs[[2]]) - r writR::dbl(tp$solution["lost"] * (tp$base$p[[1]]-tp$base$uvcp[[1]]-tp$base$uvcs[[1]])) & \geq 0 \ TP & \geq \frac{r writR::dbl(tp$base$vol[[3]] * (tp$base$uvcp[[2]] + tp$base$uvcs[[2]]) + (tp$solution["lost"]) * (tp$base$p[[1]]-tp$base$uvcp[[1]]-tp$base$uvcs[[1]]))}{r writR::int(tp$base$vol[[3]])} \ TP & \geq r writR::dbl(tp$solution["min_itp"]) \end{aligned} $$

If the buyer can deal oustide, the maximum acceptable transfer price is the smallest of the external alternative (the supplier's offer) or the transfer price for which the change in profit of the buyer is null. If the buyer cannot deal oustide, external alternatives are irrelevant and should thus be disregarded. This is a situation similar to a "make or buy" decision where you also look for the indifferent point in price. The buyer would not buy at a price higher than its indifference point, and would prefer the lowest possible price. The price for which the increase in profit would be null for the buyer is given by the following inequality:

$$ \begin{aligned} \Delta OI = r writR::int(tp$base$vol[[3]]) \times (r writR::dbl(tp$base$p[[3]]) - TP - r writR::dbl(tp$base$uvcs[[3]])) & \leq 0 \ r writR::int(tp$base$vol[[3]]*tp$base$p[[3]]) - r writR::int(tp$base$vol[[3]]) \times TP - r writR::dbl(tp$base$vol[[3]] * tp$base$uvcs[[3]]) & \leq 0 \ TP & \leq \frac{r writR::dbl(tp$base$vol[[3]]*tp$base$p[[3]]-tp$base$vol[[3]]*tp$base$uvcs[[3]])}{r writR::int(tp$base$vol[[3]])} \ TP & \leq r writR::dbl(tp$solution["com_marg"]) \end{aligned} $$

r tp$comments["bid"]. r rightrtp r tp$comments["possible"].

if (reqexpl == "") exams::answerlist(ifelse(solutions, "True", "False"), explanations, markup = "markdown") else writeLines(c("\\ ","\\ "))

Meta-information

extype: r extype exsolution: r exams::mchoice2string(solutions, single = TRUE) exname: r question_id



NicolasJBM/manacc documentation built on Jan. 16, 2020, 1:42 p.m.