inst/doc/vertical-merger-simulations.R

In mergersim: Merger Simulation and Calibration

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
options(rmarkdown.html_vignette.check_title = FALSE)

## -----------------------------------------------------------------------------
library(mergersim)

library(BB)
library(rootSolve)
library(antitrust)
library(numDeriv)  # for jacobian() function

## -----------------------------------------------------------------------------
alpha  <- -0.9
R <- 3
W <- 2
delta <- c(0.2, 0.3, 0.9, 1.0, 0.8, 0.9)
c_R_vec <- matrix(.1, nrow = (R*W), ncol = 1)
c_W_vec <- matrix(.2, nrow = (R*W), ncol = 1)

## -----------------------------------------------------------------------------
# Define market structure/ownership
own_down_pre <- paste0("R",rep(c(1,2,3),each=2))
own_up_pre <- paste0("W",rep(c(1,2),3))
own_down_pre
own_up_pre

## -----------------------------------------------------------------------------
p_W_vec <- matrix(.25, nrow = (R*W), ncol = 1)  # dummy wholesale prices

p_r_start <- c_R_vec*1.1
out1 <- multiroot(f = mergersim:::bertrand_foc_novert ,start = p_r_start, 
                  own_down = own_down_pre, alpha= alpha, 
                  delta = delta, cost = c_R_vec,
                  price_w = p_W_vec)

p1 <- out1$root
p1


## -----------------------------------------------------------------------------

p_r_start <- as.numeric(c_R_vec*1.1)
out1b <- BBoptim(f = mergersim:::bertrand_foc_novert, par = p_r_start, 
                  own_down = own_down_pre, alpha= alpha, 
                  delta = delta, cost = c_R_vec,
                  price_w = p_W_vec, sumFOC = TRUE)

p1b <- out1b$par
p1b


## -----------------------------------------------------------------------------
lambda <-  0.5

x0 <- as.numeric(c_W_vec*1.0)

mergersim:::bargain_foc_novert_sim(price_w = x0, own_down = own_down_pre, own_up = own_up_pre, 
         alpha= alpha, delta = delta, 
         cost_w = c_W_vec, cost_r = c_R_vec, 
         lambda = lambda, price_r = (p1*2))

out2 <- BBoptim(par = x0, fn = mergersim:::bargain_foc_novert_sim, 
                own_down = own_down_pre, own_up = own_up_pre,
                alpha= alpha, delta = delta, 
                cost_w = c_W_vec, cost_r = c_R_vec, 
                lambda = lambda, price_r = (p1*1))

out2$par

p_W2 <- out2$par
shares2 <- (exp(delta + alpha*p1))/(1+sum(exp(delta + alpha*p1)))


## ----results = "hide", warning=FALSE, include=FALSE---------------------------
tol <- .0001
error <- 1

p_W0 <- matrix(.25, nrow = (R*W), ncol = 1)  # dummy wholesale prices
p_R0 <- p_r_start
  
while (error > tol) {

  # use EITHER multiroot OR BBoptim to solve for downstream prices
  # multiroot:
  # out1 <- multiroot(f = bertrand_foc_novert ,start = p_R0, 
  #                 own_down = own_down_pre, alpha= alpha, 
  #                 delta = delta, cost = c_R_vec,
  #                 p_W = p_W0)
  # 
  # p_R1 <- out1$root
  # BBoptim:
  out1 <- BBoptim(f = mergersim:::bertrand_foc_novert, par = p_R0, 
                  own_down = own_down_pre, alpha= alpha, 
                  delta = delta, cost = c_R_vec,
                  price_w = p_W0, sumFOC = TRUE)

  p_R1 <- out1$par
  
  out2 <- BBoptim(par = as.numeric(p_W0), fn = mergersim:::bargain_foc_novert_sim, 
                  own_down = own_down_pre, own_up = own_up_pre, 
                  alpha= alpha, delta = delta, 
                  cost_w = c_W_vec, cost_r = c_R_vec, lambda = lambda, 
                  price_r = p_R1)

  p_W1 <- out2$par
  
  error <- max(abs(c(p_W1-p_W0,p_R1-p_R0)))
  print(error)
  
  p_W0 <- p_W1
  p_R0 <- p_R1
}

## -----------------------------------------------------------------------------
# Check if values make sense
print(p_R1)
print(p_W1)

shares1 <- (exp(delta + alpha*p_R1))/(1+sum(exp(delta + alpha*p_R1)))
as.numeric(shares1)
sum(shares1)

# GFT
mergersim:::bargain_foc_novert_sim(price_w = p_W1, own_down = own_down_pre, own_up = own_up_pre, 
         alpha= alpha, 
         delta = delta, cost_w = c_W_vec, cost_r = c_R_vec, lambda = lambda, 
         price_r = p_R1,
         returnGFT = TRUE)

# wholesaler profits
#as.numeric(own_W_pre %*% ((p_W1 - c_W_vec)*shares1) )

# retailer profits
#as.numeric(own_R_pre %*% ((p_R1 - p_W1 - c_R_vec)*shares1) )

## -----------------------------------------------------------------------------

# Create post ownership
own_up_post <- own_up_pre
own_down_post <- own_down_pre
own_down_post[own_down_post == "R1"] <- "W1"

bertrand_foc_vert(price_r = p_R1,own_down=own_down_post,own_up=own_up_post,
          alpha=alpha,delta=delta,
          cost_r = c_R_vec, price_w = p_W1, cost_w = c_W_vec)


bargain_foc_vert_sim(price_w = p_W1,own_down=own_down_post,own_up=own_up_post,
          alpha=alpha,delta=delta, cost_w =c_W_vec,
          cost_r =c_R_vec, lambda=0.5, price_r = p_R1)


# Test that foc_vert gives same result as before when VI = 0.
mergersim:::bargain_foc_novert_sim(price_w = p_W1, own_down = own_down_pre, own_up = own_up_pre, 
         alpha= alpha, delta = delta, cost_w = c_W_vec, 
         cost_r = c_R_vec, lambda = lambda, price_r = p_R1)

bargain_foc_vert_sim(price_w = p_W1,own_down=own_down_pre,own_up=own_up_pre,
          alpha=alpha,delta=delta, cost_w =c_W_vec,
          cost_r =c_R_vec, lambda=0.5, price_r = p_R1)

# And for upstream
bertrand_foc_vert(price_r = p_R1, own_down = own_down_pre, own_up = own_up_pre,
          alpha = alpha, delta = delta,
          cost_r = c_R_vec, price_w = p_W1, 
          cost_w = c_W_vec)

mergersim:::bertrand_foc_novert(price_r = p_R1, own_down = own_down_pre, alpha = alpha, 
         delta = delta, cost = c_R_vec, price_w = p_W1)
  

## ----results = "hide", warning=FALSE------------------------------------------
J <- length(p_R1)
alpha_start <- -1
delta_start <- rep(0.5,J)
x00b <- -1.1
wt_matrix <- diag(c(rep(1,J),rep(10,J)))

c_j <- c_R_vec  # eventually remove c_j from code

out3 <- BBoptim(f = bertrand_vert_calibrate, par = x00b, 
                   own_down = own_down_pre, price = p_R1, 
                   shares = shares1, cost  = c_j, price_w = p_W1)



## -----------------------------------------------------------------------------

alpha3 <- out3$par
delta3 <- log(shares1) - log(1-sum(shares1)) - alpha3*p_R1

# recover true parameters
alpha
delta
alpha3
delta3


## -----------------------------------------------------------------------------
# note that this optimization recovers the true demand parameters and shares

shares3 <- (exp(delta3 + alpha3*p_R1))/(1+sum(exp(delta3 + alpha3*p_R1)))
shares3
as.numeric(shares1)

## ----results = "hide", warning=FALSE------------------------------------------
lambda_start <- 0.4   # starting value for lambda 

out4 <- BBoptim(f = bargain_vert_sim_calibrate, par = lambda_start, 
                price_w = p_W1,own_down = own_down_pre,
                own_up =own_up_pre,alpha=alpha3,delta=delta3,
                cost_w = c_W_vec, cost_r = c_R_vec, price_r = p_R1,
                lower = 0, upper = 1)

## -----------------------------------------------------------------------------
lambda_end <- out4$par
lambda_end

## -----------------------------------------------------------------------------
# Set some costs to NA -- (this line not fully general yet)
c_R_vec_NA <- c(c_R_vec[own_down_pre == "R1"], NA, NA, NA, NA)


x00b <- -1.1
bertrand_vert_calibrate(param = x00b, 
                   own_down = own_down_pre, price = p_R1, 
                   shares = shares1, cost  = c_R_vec_NA, price_w = p_W1 )


out3d <- BBoptim(f = bertrand_vert_calibrate, par = x00b, 
                   own_down = own_down_pre, price = p_R1, 
                   shares = shares1, cost  = c_R_vec_NA, price_w = p_W1)

alpha3d <- out3d$par
delta3d <- log(shares1) - log(1-sum(shares1)) - alpha3d*p_R1

# still recover true parameters
alpha
delta
alpha3d
delta3d


## ----results = "hide", warning=FALSE------------------------------------------


x00b <- rep(1,J)
mergersim:::bertrand_vert_calibrate_costs(param = x00b, 
                   own_down = own_down_pre, price = p_R1, 
                   shares = shares1, alpha = alpha, delta = delta,
                   price_w = p_W1 )


out3e <- BBoptim(f = mergersim:::bertrand_vert_calibrate_costs, par = x00b, 
                   own_down = own_down_pre, price = p_R1, 
                   shares = shares1, alpha = alpha, delta = delta,
                   price_w = p_W1)

## -----------------------------------------------------------------------------
out3e$par
c(c_R_vec)


## -----------------------------------------------------------------------------
shares1
m_downstream <- p_R1 - c_R_vec - p_W1

cor(shares1,m_downstream)
# plot(shares1,m_downstream)


## ----results = "hide", warning=FALSE------------------------------------------
# ( Ideally, first recover pre-merger prices, using VI functions.)

bertrand_foc_vert(price_r=p_R1,own_down=own_down_post,own_up=own_up_post,
          alpha=alpha,delta=delta,
          cost_r=c_R_vec,price_w=p_W1, cost_w=c_W_vec)

bargain_foc_vert_sim(price_w=p_W1,own_down = own_down_post,own_up=own_up_post,
          alpha=alpha,delta=delta, cost_w=c_W_vec,
          cost_r=c_R_vec, lambda=0.5, price_r = p_R1)

tol <- .0001
error <- 1

p_W0_post <- matrix(.25, nrow = (R*W), ncol = 1)  # dummy wholesale prices
p_R0_post <- p_r_start
  
while (error > tol) {

  # Use EITHER multiroot or BBoptim
  # multiroot:
  # out1 <- multiroot(f = bertrand_foc_vert ,start = p_R0_post, 
  #                 own_down = own_down_post, own_up = own_up_post,
  #                 alpha = alpha3, delta = delta3, c_R = c_R_vec, 
  #                 p_W = p_W0_post, c_W = c_W_vec)
  # 
  # p_R1_post <- out1$root
  # BBoptim:
  out1 <- BBoptim(f = bertrand_foc_vert, par = p_R0_post, 
                  own_down = own_down_post, own_up = own_up_post,
                  alpha = alpha3, delta = delta3, cost_r = c_R_vec, 
                  price_w = p_W0_post, cost_w = c_W_vec, sumFOC = TRUE)

  p_R1_post <- out1$par
  
  out2 <- BBoptim(par = as.numeric(p_W0_post), fn = bargain_foc_vert_sim, 
                  own_down = own_down_post, own_up = own_up_post, 
                  alpha= alpha3, delta = delta3, 
                  cost_w = c_W_vec, cost_r = c_R_vec, lambda = lambda_end, 
                  price_r = p_R1_post)
  
  p_W1_post <- out2$par
  
  error <- max(abs(c(p_W1_post-p_W0_post,p_R1_post-p_R0_post)))
  print(error)
  
  p_W0_post <- p_W1_post
  p_R0_post <- p_R1_post
}

## -----------------------------------------------------------------------------
p_R1
p_W1
p_R1_post
p_W1_post

# retail price change with vertical integration
(p_R1_post-p_R1)/p_R1


## -----------------------------------------------------------------------------
shareDown <- as.numeric(shares1)
priceDown <- as.numeric(p_R1)
ownerPreDown <- own_down_pre
priceUp <- as.numeric(p_W1)
ownerPreUp <- own_up_pre
priceOutSide <- 0

# Downstream margin as a percent
marginDown <- (priceDown - c_R_vec - priceUp)/ priceDown
# Upstream margin as a percent
marginUp <- (priceUp - c_W_vec) / priceUp

## Simulate a vertical merger
ownerPostUp <- own_up_post
ownerPostDown <- own_down_post

simres_vert <- vertical.barg(sharesDown =shareDown,
                             pricesDown = priceDown,
                             marginsDown = as.numeric(marginDown),
                             ownerPreDown = ownerPreDown,
                             ownerPostDown = ownerPostDown,
                             pricesUp = priceUp,
                             marginsUp = as.numeric(marginUp),
                             ownerPreUp = ownerPreUp,
                             ownerPostUp = ownerPostUp,
                             priceOutside = priceOutSide)

summary(simres_vert)

simres_vert@down@slopes

(simres_vert@down@pricePost - simres_vert@down@pricePre) / simres_vert@down@pricePre