library(conjoint)
library(tidyverse)
## Create the attribute list by DOE
doe = expand.grid(Package = c("A", "B", "c"),
                  Brand = c("K2R", "Glory", "Bissell"),
                  Price = c("$1.19", "1.39", "1.59"),
                  Seal = c("No", "Yes"),
                  Money = c("No", "Yes"))

Determine fractional, orthogonal factorial design with variable names and their levels

factdesign <- caFactorialDesign(data= doe, type="orthogonal", seed = 123)
print(factdesign)
##     Package   Brand Price Seal Money
## 2         B     K2R $1.19   No    No
## 4         A   Glory $1.19   No    No
## 5         B   Glory $1.19   No    No
## 7         A Bissell $1.19   No    No
## 10        A     K2R  1.39   No    No
## 11        B     K2R  1.39   No    No
## 21        c     K2R  1.59   No    No
## 25        A Bissell  1.59   No    No
## 27        c Bissell  1.59   No    No
## 30        c     K2R $1.19  Yes    No
## 33        c   Glory $1.19  Yes    No
## 40        A   Glory  1.39  Yes    No
## 41        B   Glory  1.39  Yes    No
## 42        c   Glory  1.39  Yes    No
## 45        c Bissell  1.39  Yes    No
## 47        B     K2R  1.59  Yes    No
## 52        A Bissell  1.59  Yes    No
## 53        B Bissell  1.59  Yes    No
## 58        A   Glory $1.19   No   Yes
## 62        B Bissell $1.19   No   Yes
## 65        B     K2R  1.39   No   Yes
## 69        c   Glory  1.39   No   Yes
## 70        A Bissell  1.39   No   Yes
## 72        c Bissell  1.39   No   Yes
## 75        c     K2R  1.59   No   Yes
## 77        B   Glory  1.59   No   Yes
## 78        c   Glory  1.59   No   Yes
## 82        A     K2R $1.19  Yes   Yes
## 84        c     K2R $1.19  Yes   Yes
## 89        B Bissell $1.19  Yes   Yes
## 90        c Bissell $1.19  Yes   Yes
## 91        A     K2R  1.39  Yes   Yes
## 98        B Bissell  1.39  Yes   Yes
## 100       A     K2R  1.59  Yes   Yes
## 103       A   Glory  1.59  Yes   Yes
## 104       B   Glory  1.59  Yes   Yes
dim(factdesign)
## [1] 36  5

Select 22 profile case for survey only

profile22 = factdesign[1:22, ]
dim(profile22)
## [1] 22  5

Encoding variable levels of the fractional design

encode = caEncodedDesign(design = profile22)
print(encode)
##    Package Brand Price Seal Money
## 2        2     1     1    1     1
## 4        1     2     1    1     1
## 5        2     2     1    1     1
## 7        1     3     1    1     1
## 10       1     1     2    1     1
## 11       2     1     2    1     1
## 21       3     1     3    1     1
## 25       1     3     3    1     1
## 27       3     3     3    1     1
## 30       3     1     1    2     1
## 33       3     2     1    2     1
## 40       1     2     2    2     1
## 41       2     2     2    2     1
## 42       3     2     2    2     1
## 45       3     3     2    2     1
## 47       2     1     3    2     1
## 52       1     3     3    2     1
## 53       2     3     3    2     1
## 58       1     2     1    1     2
## 62       2     3     1    1     2
## 65       2     1     2    1     2
## 69       3     2     2    1     2

Verification (using covariance and correlation matrix) of the fractional design quality

print(round(cov(encode), 5))
##          Package    Brand    Price     Seal    Money
## Package  0.66667 -0.09524  0.04762  0.09524  0.00000
## Brand   -0.09524  0.66667  0.09524  0.04762  0.00000
## Price    0.04762  0.09524  0.65801  0.08658 -0.07792
## Seal     0.09524  0.04762  0.08658  0.25325 -0.07792
## Money    0.00000  0.00000 -0.07792 -0.07792  0.15584
print(round(cor(encode), 5))
##          Package    Brand    Price     Seal    Money
## Package  1.00000 -0.14286  0.07190  0.23178  0.00000
## Brand   -0.14286  1.00000  0.14379  0.11589  0.00000
## Price    0.07190  0.14379  1.00000  0.21209 -0.24333
## Seal     0.23178  0.11589  0.21209  1.00000 -0.39223
## Money    0.00000  0.00000 -0.24333 -0.39223  1.00000
print(det(cor(encode)))
## [1] 0.6814977

Set Level Name

levelnames = c("A", "B", "C", "K2R", "Glory", "Bissell", "$1.19", "$1.39", "$1.59",
               "No","Yes","No", "Yes")
levelnames = as.data.frame(levelnames)
levelnames
##    levelnames
## 1           A
## 2           B
## 3           C
## 4         K2R
## 5       Glory
## 6     Bissell
## 7       $1.19
## 8       $1.39
## 9       $1.59
## 10         No
## 11        Yes
## 12         No
## 13        Yes

Read the performance file by respondents

setwd("C:/Users/SK/Desktop/SK/NUS EBA/Semester 4/Complex Predictive Modeling & For/Day 3/Workshop Material")
library(readxl)
pref=read_excel("Carpet_pref.xls")
pref=pref %>% dplyr:: select(-c(ID))
head(pref)
## # A tibble: 6 x 22
##   PREF1 PREF2 PREF3 PREF4 PREF5 PREF6 PREF7 PREF8 PREF9 PREF10 PREF11
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>  <dbl>
## 1    13    15     1    20    14     7    11    19     3     10     17
## 2    15     7    18     2    12     3    11    20    16     21      6
## 3     2    18    14    16    22    13    20    10    15      3      1
## 4    13    10    20    14     2    18    16    22    15      3      1
## 5    13    18     2    10    20    15     9     5     3      7     11
## 6    15     2     3    12    18     7    20    10    11      4      9
## # ... with 11 more variables: PREF12 <dbl>, PREF13 <dbl>, PREF14 <dbl>,
## #   PREF15 <dbl>, PREF16 <dbl>, PREF17 <dbl>, PREF18 <dbl>, PREF19 <dbl>,
## #   PREF20 <dbl>, PREF21 <dbl>, PREF22 <dbl>

Transform ranking data into rating data

rating = caRankToScore(y.rank = pref)
head(rating)
##   PREF1 PREF2 PREF3 PREF4 PREF5 PREF6 PREF7 PREF8 PREF9 PREF10 PREF11
## 1    10     8    22     3     9    16    12     4    20     13      6
## 2     8    16     5    21    11    20    12     3     7      2     17
## 3    21     5     9     7     1    10     3    13     8     20     22
## 4    10    13     3     9    21     5     7     1     8     20     22
## 5    10     5    21    13     3     8    14    18    20     16     12
## 6     8    21    20    11     5    16     3    13    12     19     14
##   PREF12 PREF13 PREF14 PREF15 PREF16 PREF17 PREF18 PREF19 PREF20 PREF21
## 1     15     18     14     17     11     19      2      5     21      1
## 2      1     15      6      4     22      9     19     14     18     13
## 3     17     14     18     16     11      4     15      6      2     12
## 4     14     18     17     15      6     12     16      4     19     11
## 5     19     11      1      9      7     22     17      4      2      6
## 6     18     10      7      9      1     15     17     22      2      4
##   PREF22
## 1      7
## 2     10
## 3     19
## 4      2
## 5     15
## 6      6

Conjoint analysis model for first respondent

caModel(rating[1,], profile22)
## 
## Call:
## lm(formula = frml)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12.6030  -2.9677   0.9009   2.6958   9.8774 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)   
## (Intercept)         9.47504    2.38815   3.968  0.00161 **
## factor(x$Package)1 -3.28411    2.43415  -1.349  0.20031   
## factor(x$Package)2  2.19632    2.32139   0.946  0.36134   
## factor(x$Brand)1   -2.55381    2.51173  -1.017  0.32782   
## factor(x$Brand)2    0.72958    2.60061   0.281  0.78348   
## factor(x$Price)1   -0.06028    2.38080  -0.025  0.98019   
## factor(x$Price)2    1.25849    2.42881   0.518  0.61306   
## factor(x$Seal)1     0.38601    1.93183   0.200  0.84472   
## factor(x$Money)1    2.69163    2.38815   1.127  0.28009   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.347 on 13 degrees of freedom
## Multiple R-squared:  0.2076, Adjusted R-squared:  -0.28 
## F-statistic: 0.4258 on 8 and 13 DF,  p-value: 0.8853

Determine the relative importance of attributes for the first respondent

importance = caImportance(y=rating[1,], x=profile22)
importance
## [1] 29.67 23.70 13.30  4.18 29.15

Measurement of part-worths utilities

utilities = caPartUtilities(y=rating, x=profile22, z=levelnames)
utilities
##       intercept      A      B      C    K2R  Glory Bissell  $1.19  $1.39
##  [1,]     9.475 -3.284  2.196  1.088 -2.554  0.730   1.824 -0.060  1.258
##  [2,]    12.312 -0.565  3.393 -2.829  0.468 -0.231  -0.237  0.755 -1.757
##  [3,]    11.313 -3.326  0.570  2.756 -0.281  1.094  -0.813  1.235  1.019
##  [4,]    11.738  0.225 -0.845  0.620  1.239 -3.048   1.809  3.501  1.840
##  [5,]    10.252 -0.607 -0.103  0.711 -2.642  1.547   1.095 -1.529 -2.400
##  [6,]    10.052  2.505 -0.710 -1.795 -2.540  3.193  -0.653  2.702 -1.984
##  [7,]    10.549  1.636 -0.132 -1.504  2.529 -0.867  -1.662 -1.180  0.415
##  [8,]    10.148 -1.255 -1.890  3.145  0.187 -2.606   2.419 -0.691  4.366
##  [9,]     9.985 -0.519 -1.210  1.728  0.514  0.580  -1.094  1.595  0.236
## [10,]    11.488  0.084 -0.960  0.876  2.895 -1.822  -1.073 -0.977  2.559
##        $1.59     No    Yes     No    Yes
##  [1,] -1.198  0.386 -0.386  2.692 -2.692
##  [2,]  1.002 -0.164  0.164 -1.312  1.312
##  [3,] -2.253 -2.529  2.529  0.576 -0.576
##  [4,] -5.341 -4.117  4.117  0.318 -0.318
##  [5,]  3.929  0.404 -0.404  2.303 -2.303
##  [6,] -0.718 -0.417  0.417  2.115 -2.115
##  [7,]  0.765 -1.549  1.549  2.118 -2.118
##  [8,] -3.675  1.407 -1.407  1.519 -1.519
##  [9,] -1.831  1.495 -1.495  1.738 -1.738
## [10,] -1.583  0.512 -0.512 -0.154  0.154

Total measurement of total utilities

totalutilities = caTotalUtilities(y=rating, x=profile22)
totalutilities
##         [,1]   [,2]   [,3]   [,4]   [,5]   [,6]   [,7]   [,8]   [,9]
##  [1,] 12.135  9.938 15.418 11.033  7.973 13.454  9.888  9.895 14.266
##  [2,] 15.452 10.796 14.754 10.790  8.982 12.940  9.477 11.037  8.773
##  [3,] 10.884  8.363 12.259  6.456  6.772 10.668  9.581  2.968  9.049
##  [4,] 11.834  8.617  7.547 13.473 11.242 10.172  4.456  4.631  5.026
##  [5,]  8.685 12.371 12.875 11.918  7.311  7.814 14.957 17.376 18.694
##  [6,] 11.202 20.149 16.935 16.303  9.731  6.517  6.697 12.883  8.584
##  [7,] 12.335 10.707  8.939  9.912 15.697 13.929 12.907 11.857  8.717
##  [8,] 10.679  8.521  7.886 13.547 16.372 15.737 12.731 10.563 14.963
##  [9,] 14.117 14.873 14.183 13.199 13.448 12.757 13.629  9.773 12.020
## [10,] 12.804  9.131  8.087  9.880 17.384 16.340 14.034  9.274 10.066
##        [,10]  [,11]  [,12]  [,13]  [,14]  [,15]  [,16]  [,17]  [,18]
##  [1,] 10.254 13.538 10.485 15.965 14.857 15.951 10.225  9.123 14.603
##  [2,]  9.558  8.859  8.611 12.569  6.347  6.342 16.027 11.364 15.322
##  [3,] 18.127 19.502 13.205 17.100 19.286 17.379 12.453  8.026 11.922
##  [4,] 21.533 17.246 15.190 14.120 15.584 20.441 11.226 12.865 11.796
##  [5,]  8.691 12.880 10.692 11.196 12.010 11.557 13.335 16.568 17.072
##  [6,] 10.951 16.683 16.298 13.083 11.998  8.152  8.616 13.717 10.503
##  [7,] 14.061 10.665 15.400 13.631 12.259 11.464 17.377 14.955 13.187
##  [8,] 12.900 10.107 10.764 10.129 15.165 20.191  4.881  7.748  7.113
##  [9,] 14.065 14.131 10.524  9.833 12.771 11.097  7.701  6.784  6.093
## [10,] 13.616  8.899 11.643 10.598 12.435 13.183 11.173  8.249  7.205
##        [,19]  [,20]  [,21]  [,22]
##  [1,]  4.555 11.130  8.070 10.245
##  [2,] 13.420 17.372 15.564  8.644
##  [3,]  7.210  9.199  9.515 13.075
##  [4,]  7.981 11.768  9.537  6.714
##  [5,]  7.765  7.816  3.208  8.212
##  [6,] 15.919  8.859  2.287  6.935
##  [7,]  6.472  3.909  9.693  4.926
##  [8,]  5.484  9.874 12.700 14.942
##  [9,] 11.398  9.033  9.282 12.286
## [10,]  9.440  9.144 16.649 13.768

SUmmary of the most importan preference measurement result using conjoint analysis

Conjoint(y=rating, x=profile22, z=levelnames)
## 
## Call:
## lm(formula = frml)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12,2713  -4,9670   0,0947   5,2602  13,0356 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        10,73108    0,65250  16,446   <2e-16 ***
## factor(x$Package)1 -0,51058    0,66507  -0,768   0,4435    
## factor(x$Package)2  0,03096    0,63426   0,049   0,9611    
## factor(x$Brand)1   -0,01853    0,68626  -0,027   0,9785    
## factor(x$Brand)2   -0,14297    0,71055  -0,201   0,8407    
## factor(x$Price)1    0,53510    0,65049   0,823   0,4117    
## factor(x$Price)2    0,55527    0,66361   0,837   0,4037    
## factor(x$Seal)1    -0,45712    0,52782  -0,866   0,3874    
## factor(x$Money)1    1,19115    0,65250   1,826   0,0693 .  
## ---
## Signif. codes:  0 '***' 0,001 '**' 0,01 '*' 0,05 '.' 0,1 ' ' 1
## 
## Residual standard error: 6,347 on 211 degrees of freedom
## Multiple R-squared:  0,03994,    Adjusted R-squared:  0,00354 
## F-statistic: 1,097 on 8 and 211 DF,  p-value: 0,3663
## [1] "Part worths (utilities) of levels (model parameters for whole sample):"
##       levnms    utls
## 1  intercept 10,7311
## 2          A -0,5106
## 3          B   0,031
## 4          C  0,4796
## 5        K2R -0,0185
## 6      Glory  -0,143
## 7    Bissell  0,1615
## 8      $1.19  0,5351
## 9      $1.39  0,5553
## 10     $1.59 -1,0904
## 11        No -0,4571
## 12       Yes  0,4571
## 13        No  1,1911
## 14       Yes -1,1911
## [1] "Average importance of factors (attributes):"
## [1] 22,42 21,05 25,54 13,81 17,19
## [1] Sum of average importance:  100,01
## [1] "Chart of average factors importance"