Case I: The Launch of Super Bock Mini

Please download and load data “super_bock_mini.Rdata” from Canvas.

head(data)

To Estimate the Binary Choice Model

mdl <- glm(choice ~ price + brand + capacity + shape, family = "binomial", data)
results <- summary(mdl)
results

Call:
glm(formula = choice ~ price + brand + capacity + shape, family = "binomial", 
    data = data)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.9879  -0.4170  -0.3096   0.1522   4.1570  

Coefficients:
                Estimate Std. Error z value Pr(>|z|)    
(Intercept)       1.7294     0.4361   3.965 7.33e-05 ***
price50ct        -2.0558     0.4746  -4.332 1.48e-05 ***
price60ct        -0.5594     0.3778  -1.481    0.139    
price70ct        -1.9348     0.3312  -5.842 5.16e-09 ***
brandSagres       2.4692     0.3181   7.761 8.40e-15 ***
brandSuper Bock   2.7227     0.4127   6.597 4.19e-11 ***
capacity250ml    -2.5363     0.3263  -7.773 7.69e-15 ***
capacity330ml    -4.1839     0.3899 -10.730  < 2e-16 ***
shapeRocket      -2.0051     0.3050  -6.575 4.87e-11 ***
shapeSpanish     -4.1298     0.3888 -10.621  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1057.06  on 935  degrees of freedom
Residual deviance:  464.55  on 926  degrees of freedom
AIC: 484.55

Number of Fisher Scoring iterations: 6

To Obtain the Partworths

Three rules to transform the coefficients to partworths:

1. Baseline levels partworths = 0
2. Insignificant levels partworths = 0
3. Significant levels partworths = coefficients
    

A list called “partworth” is loaded for the collection of partworths.
You may also create tables or vectors for partworths.

partworth

$brand
   Cristal     Sagres Super Bock 
         0          0          0 

$capacity
200ml 250ml 330ml 
    0     0     0 

$price
30ct 50ct 60ct 70ct 
   0    0    0    0 

$shape
Long Neck    Rocket   Spanish 
        0         0         0 

We need to first set insignificant coefficients to zeros, with the cutoff of p-values as 0.05.

coeffs <- results$coefficients[,1]*(results$coefficients[,4]<.05)
coeffs

    (Intercept)       price50ct       price60ct       price70ct     brandSagres brandSuper Bock 
       1.729359       -2.055824        0.000000       -1.934842        2.469227        2.722735 
  capacity250ml   capacity330ml     shapeRocket    shapeSpanish 
      -2.536253       -4.183921       -2.005092       -4.129809 

Set the partworths based on the transformed coefficients - “coeff”.

partworth$brand[2:3] <- coeffs[5:6]
partworth$capacity[2:3] <- coeffs[7:8]
partworth$price[2:4] <- coeffs[2:4]
partworth$shape[2:3] <- coeffs[9:10]
partworth

$brand
   Cristal     Sagres Super Bock 
  0.000000   2.469227   2.722735 

$capacity
    200ml     250ml     330ml 
 0.000000 -2.536253 -4.183921 

$price
     30ct      50ct      60ct      70ct 
 0.000000 -2.055824  0.000000 -1.934842 

$shape
Long Neck    Rocket   Spanish 
 0.000000 -2.005092 -4.129809 

Next, we evaluate the 4 strategies of new product designs:

• To attack with Cristal long-neck shape 200ml priced at 50 cents
• To attack with Super Bock rocket shape 330ml priced at 60 cents
• To launch a Super Bock long-neck shape 200ml priced at 50 cents
• To re-launch a Super Bock long-neck shape 250ml priced at 50 cents
  

We first define a function to compute the (binary) logistic choice probabilities.

f <- function(ind) {
  x <- coeffs[1] + 
    partworth$brand[ind[1]] + 
    partworth$capacity[ind[2]] + 
    partworth$price[ind[3]] + 
    partworth$shape[ind[4]]
  return(1/(1+exp(-x)))
}

decision.prob <- c(f(c(1,1,2,1)),
                   f(c(3,3,3,2)),
                   f(c(3,1,2,1)),
                   f(c(3,2,2,1))
                   )
100*as.numeric(decision.prob)

[1] 41.91009 14.97047 91.65424 46.50612