Conjoint Analysis

#install.packages("conjoint")
#install.packages("mclust")
#install.packages("robustbase")
#install.packages("kernlab")
library("conjoint")

data(ice)
experiment<-expand.grid(
flavor=c("chocolate","vanilla","strawberry"),
price=c("$1.50","$2.00","$2.50"),
container=c("cone","cup"),
topping=c("yes","no"))

factdesign<-caFactorialDesign(data=experiment,type="orthogonal")
prof=caEncodedDesign(design=factdesign)
(round(cov(prof),5))

          flavor price container topping
flavor      0.75  0.00      0.00    0.00
price       0.00  0.75      0.00    0.00
container   0.00  0.00      0.25    0.00
topping     0.00  0.00      0.00    0.25

(round(cor(prof),5))

          flavor price container topping
flavor         1     0         0       0
price          0     1         0       0
container      0     0         1       0
topping        0     0         0       1

#the preferences of one or more respondents
pref=ipref 
pref

# profiles to vote by the survey respondents
profiles= iprof
profiles

#the levels of the attributes
levelnames=ilevn
levelnames

preferences=caRankToScore(y.rank=pref)
caModel(preferences[1,],profiles)

Call:
lm(formula = frml)

Residuals:
         1          2          3          4          5          6          7          8 
 6.667e-01 -6.667e-01  1.500e+00 -1.500e+00 -2.833e+00  2.833e+00  8.327e-16 -2.167e+00 
         9 
 2.167e+00 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)  
(Intercept)            5.2500     1.4633   3.588   0.0697 .
factor(x$flavour)1     1.0000     1.8509   0.540   0.6431  
factor(x$flavour)2     0.3333     1.8509   0.180   0.8737  
factor(x$price)1       1.0000     1.8509   0.540   0.6431  
factor(x$price)2      -1.0000     1.8509  -0.540   0.6431  
factor(x$container)1   1.2500     1.3882   0.900   0.4629  
factor(x$topping)1     0.5000     1.3882   0.360   0.7532  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.926 on 2 degrees of freedom
Multiple R-squared:  0.4861,    Adjusted R-squared:  -1.056 
F-statistic: 0.3153 on 6 and 2 DF,  p-value: 0.8851

importance=caImportance(y=preferences[1,],x=profiles)

Conjoint(y=preferences,x=profiles,z=levelnames)

Call:
lm(formula = frml)

Residuals:
    Min      1Q  Median      3Q     Max 
-3,9444 -1,6944  0,0833  1,3333  5,6944 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)            5,3472     0,3747  14,269   <2e-16 ***
factor(x$flavour)1    -0,2222     0,4740  -0,469   0,6414    
factor(x$flavour)2     0,7222     0,4740   1,524   0,1343    
factor(x$price)1       0,8333     0,4740   1,758   0,0853 .  
factor(x$price)2      -0,3333     0,4740  -0,703   0,4854    
factor(x$container)1   0,9167     0,3555   2,578   0,0131 *  
factor(x$topping)1    -0,1250     0,3555  -0,352   0,7267    
---
Signif. codes:  0 ‘***’ 0,001 ‘**’ 0,01 ‘*’ 0,05 ‘.’ 0,1 ‘ ’ 1

Residual standard error: 2,463 on 47 degrees of freedom
Multiple R-squared:  0,2079,    Adjusted R-squared:  0,1068 
F-statistic: 2,057 on 6 and 47 DF,  p-value: 0,07656

[1] "Part worths (utilities) of levels (model parameters for whole sample):"

[1] "Average importance of factors (attributes):"
[1] 35,13 31,39 20,43 13,05
[1] Sum of average importance:  100
[1] "Chart of average factors importance"