Exercise 4: Multinomial probit
In mlogit: Multinomial Logit Models

knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, widtht = 65)
options(width = 65)

We have data on the mode choice of 453 commuters. Four modes are available: (1) bus, (2) car alone, (3) carpool, and (4) rail. We have data for each commuter on the cost and time on each mode and the chosen mode.

mlogit estimates the multinomial probit model if the probit argument is TRUE using the GHK procedure. This program estimates the full covariance matrix subject to normalization.

More precisely, utility differences are computed respective to the reference level of the response (by default the bus alternative) and the 3 $\times$ 3 matrix of covariance is estimated. As the scale of utility is unobserved, the first element of the matrix is further set to 1. The Choleski factor of the covariance is :

$$ L = \left( \begin{array}{ccc} 1 & 0 & 0 \ \theta_{32} & \theta_{33} & 0 \ \theta_{42} & \theta_{43} & \theta_{44} \end{array} \right) $$

that is, five covariance parameters are estimated. The covariance matrix of the utility differences is then $\Omega = L L^{\top}$. By working in a Choleski factor that has this form, the normalization constraints are automatically imposed and the covariance matrix is guaranteed to be positive semi-definite (with the covariance matrix for any error differences being positive-definite).

@. Estimate a model where mode choice is explained by the time and the cost of an alternative, using 100 draws and set the seed to 20. Calculate the covariance matrix that is implied by the estimates of the Choleski factor. What, if anything, can you say about the degree of heteroskedasticity and correlation? For comparison, what would the covariance matrix be if there were no heteroskedasticity or correlation (ie, iid errors for each alternative)? Can you tell whether the covariance is higher between car alone and carpool or between bus and rail?

library("mlogit")
data("Mode", package="mlogit")
Mo <- dfidx(Mode, choice = "choice", varying = 2:9)

p1 <- mlogit(choice ~ cost + time, Mo, seed = 20, 
             R = 100, probit = TRUE)

summary(p1)

The estimated Choleski factor $L_1$ is :

L1 <- matrix(0, 3, 3)
L1[! upper.tri(L1)] <- c(1, coef(p1)[6:10])

Multiplying L1 by its transpose gives $\Omega_1$ :

L1 %*% t(L1)

With iid errors, $\Omega_1$ would be :

$$ \left( \begin{array}{ccc} 1 & 0.5 & 0.5 \ 0.5 & 1 & 0.5 \ 0.5 & 0.5 & 1 \ \end{array} \right) $$

I find it hard to tell anything from the estimated covariance terms.

I agree: it is hard -- if not impossible -- to meaningfully interpret the covariance parameters when all free parameters are estimated. However, the substitutiuon patterns that the estimates imply can be observed by forecasting with the model; we do this in exercise 4 below. Also, when structure is placed on the covariance matrix, the estimates are usually easier to interpret; this is explored in exercise 6.]

@. Change the seed to 21 and rerun the model. (Even though the seed is just one digit different, the random draws are completely different.) See how much the estimates change. Does there seem to be a relation between the standard error of a parameter and the amount that its estimate changes with the new seed? (Of course, you are only getting two estimates, and so you are not estimating the true simulation variance very well. But the two estimates will probably give you an indication.)

p2 <- mlogit(choice ~ cost + time, Mo, seed = 21, 
             R = 100, probit = TRUE)

coef(p2)

The estimates seem to change more for parameters with larger standard error, though this is not uniformly the case by any means. One would expect larger samplign variance (which arises from a flatter $\ln L$ near the max) to translate into greater simulation variance (which raises when the location of the max changes with different draws).

@. Compute the probit shares (average probabilities) under user-specified parameters and data. How well do predicted shares match the actual share of commuters choosing each mode?

The actual shares are :

actShares <- tapply(Mo$choice, Mo$id2, mean)

The predicted shares are :

predShares <- apply(fitted(p1, outcome = FALSE), 2, mean)
rbind(predShares, actShares)
sum(predShares)

The correspondence is very close but not exact.

Note: Simulated GHK probabilities do not necessarily sum to one over alternatives. This summing-up error at the individual level tends to cancel out when the probabilities are averaged over the sample. The forecasted shares (ie, average probabilities) sum to 0.9991102, which is only slightly different from 1.

@. We want to examine the impact of a large tax on driving alone. Raise the cost of the car alone mode by 50\% and forecast shares at these higher costs. Is the substitution proportional, as a logit model would predict? Which mode has the greatest percent increase in demand? What is the percent change in share for each mode?

Mo2 <- Mo
Mo2[idx(Mo2, 2) == 'car', 'cost'] <- Mo2[idx(Mo2, 2) == 'car', 'cost'] * 2
newShares <- apply(predict(p1, newdata = Mo2), 2, mean)
cbind(original = actShares, new = newShares, 
      change = round((newShares - actShares) / actShares * 100))