Multinomial Logit Model
[Link]<-[Link]("[Link]
[Link]")
str([Link])
## '[Link]': 9000 obs. of 9 variables:
## $ [Link]: int 1 1 1 1 1 1 1 1 1 1 ...
## $ ques : int 1 1 1 2 2 2 3 3 3 4 ...
## $ alt : int 1 2 3 1 2 3 1 2 3 1 ...
## $ carpool: Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ seat : int 6 8 6 6 7 6 8 7 8 7 ...
## $ cargo : Factor w/ 2 levels "2ft","3ft": 1 2 2 1 2 1 2 2 1 2 ...
## $ eng : Factor w/ 3 levels "elec","gas","hyb": 2 3 2 2 2 1 2 1 1 1 ...
## $ price : int 35 30 30 30 35 35 35 30 40 40 ...
## $ choice : int 0 0 1 0 1 0 1 0 0 1 ...
[Link]$seat<-[Link]([Link]$seat)
summary([Link])
## [Link] ques alt carpool seat cargo
## Min. : 1.00 Min. : 1 Min. :1 no :6345 6:3024 2ft:4501
## 1st Qu.: 50.75 1st Qu.: 4 1st Qu.:1 yes:2655 7:2993 3ft:4499
## Median :100.50 Median : 8 Median :2 8:2983
## Mean :100.50 Mean : 8 Mean :2
## 3rd Qu.:150.25 3rd Qu.:12 3rd Qu.:3
## Max. :200.00 Max. :15 Max. :3
## eng price choice
## elec:3010 Min. :30 Min. :0.0000
## gas :3005 1st Qu.:30 1st Qu.:0.0000
## hyb :2985 Median :35 Median :0.0000
## Mean :35 Mean :0.3333
## 3rd Qu.:40 3rd Qu.:1.0000
## Max. :40 Max. :1.0000
xtabs(choice ~ price, data=[Link])
## price
## 30 35 40
## 1486 956 558
# We now study customer choice behavior using the multinomial logit model.
# Below is some data set up for mlogit:
# [Link]("mlogit")
library(mlogit)
## Loading required package: dfidx
##
## Attaching package: 'dfidx'
## The following object is masked from 'package:stats':
##
## filter
[Link]$chid<-rep(1:(nrow([Link])/3), each=3) # Adding an identifier for each
choice scenario
[Link]<-dfidx([Link], choice="choice", idx=list(c("chid",
"[Link]"),"alt"))
# 1. Estimating the Multinomial Logit Model
m1<-mlogit(choice ~ seat + cargo + eng + price, data=[Link])
summary(m1)
##
## Call:
## mlogit(formula = choice ~ seat + cargo + eng + price, data = [Link],
## method = "nr")
##
## Frequencies of alternatives:choice
## 1 2 3
## 0.32700 0.33467 0.33833
##
## nr method
## 5 iterations, 0h:0m:0s
## g'(-H)^-1g = 8.01E-05
## successive function values within tolerance limits
##
## Coefficients :
## Estimate Std. Error z-value Pr(>|z|)
## (Intercept):2 0.0289278 0.0512669 0.5643 0.5726
## (Intercept):3 0.0417852 0.0513660 0.8135 0.4159
## seat7 -0.5346380 0.0623610 -8.5733 < 2.2e-16 ***
## seat8 -0.3046051 0.0611538 -4.9810 6.327e-07 ***
## cargo3ft 0.4769506 0.0508739 9.3752 < 2.2e-16 ***
## enggas 1.5278103 0.0674137 22.6632 < 2.2e-16 ***
## enghyb 0.7168514 0.0655213 10.9407 < 2.2e-16 ***
## price -0.1734026 0.0069419 -24.9791 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Log-Likelihood: -2581.7
## McFadden R^2: 0.2166
## Likelihood ratio test : chisq = 1427.7 ([Link] = < 2.22e-16)
m2<-mlogit(choice ~ 0 + seat + cargo + eng + price, data=[Link]) # To
drop alternate specific constants in the model
summary(m2)
##
## Call:
## mlogit(formula = choice ~ 0 + seat + cargo + eng + price, data =
[Link],
## method = "nr")
##
## Frequencies of alternatives:choice
## 1 2 3
## 0.32700 0.33467 0.33833
##
## nr method
## 5 iterations, 0h:0m:0s
## g'(-H)^-1g = 8E-05
## successive function values within tolerance limits
##
## Coefficients :
## Estimate Std. Error z-value Pr(>|z|)
## seat7 -0.5345392 0.0623518 -8.5730 < 2.2e-16 ***
## seat8 -0.3061074 0.0611184 -5.0084 5.488e-07 ***
## cargo3ft 0.4766936 0.0508632 9.3721 < 2.2e-16 ***
## enggas 1.5291247 0.0673982 22.6879 < 2.2e-16 ***
## enghyb 0.7183908 0.0654963 10.9684 < 2.2e-16 ***
## price -0.1733053 0.0069398 -24.9726 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Log-Likelihood: -2582.1
lrtest(m1, m2)
## Likelihood ratio test
##
## Model 1: choice ~ seat + cargo + eng + price
## Model 2: choice ~ 0 + seat + cargo + eng + price
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 8 -2581.7
## 2 6 -2582.1 -2 0.693 0.7072
# The likelihood ratio test suggests we don't need the alternate specific
constants to fit the present data (p-value = 0.7122 > 0.05)
# 2. Willingness to pay
coef(m2)
## seat7 seat8 cargo3ft enggas enghyb price
## -0.5345392 -0.3061074 0.4766936 1.5291247 0.7183908 -0.1733053
1000*(coef(m2)/-coef(m2)[6])
## seat7 seat8 cargo3ft enggas enghyb price
## -3084.380 -1766.290 2750.601 8823.302 4145.234 -1000.000
# Consumers are willing to pay $2,750 for 3ft cargo space in place of 2ft.
That is, on average, customers would be indifferent between a minivam with
2ft of cargo space and a minivan with a 3ft cargo space that costs $2,750
more.
# Likewise, we can also evaluate how much customers value the other features
as well.
# 3. Simulating Choice Shares
# writing a function
[Link]<-function(model, data){
[Link]<-[Link](update(model$formula, 0~.), data=data)[,-1]
value<-[Link]%*%model$coef
share<-exp(value)/sum(exp(value))
cbind(share,data)
}
# selecting competitors in the marketplace
attrib<-list(seat=c("6","7","8"),
cargo=c("2ft","3ft"),
eng=c("gas","hyb","elec"),
price=c(30,35,40))
allcombinations<-[Link](attrib)
marketprofiles<-allcombinations[c(8,1,3,41,49,26),]
[Link](m2, marketprofiles)
## share seat cargo eng price
## 8 0.44278782 7 2ft hyb 30
## 1 0.16377692 6 2ft gas 30
## 3 0.12059018 8 2ft gas 30
## 41 0.02731967 7 3ft gas 40
## 49 0.05937323 6 2ft elec 40
## 26 0.18615216 7 2ft hyb 35