# Conjoint Analysis
# user-defined function for spine chart
load(file = "/Users/jyothi/Downloads/MDS_Chapter_1/mtpa_spine_chart.Rdata")
print.digits <- 2 # set number of digits on print and spine chart
library(support.CEs) # package for survey construction
## Loading required package: DoE.base
## Loading required package: grid
## Loading required package: conf.design
##
## Attaching package: 'DoE.base'
##
## The following objects are masked from 'package:stats':
##
## aov, lm
##
## The following object is masked from 'package:graphics':
##
## plot.design
##
## The following object is masked from 'package:base':
##
## lengths
##
## Loading required package: MASS
## Loading required package: simex
## Loading required package: RCurl
## Loading required package: bitops
## Loading required package: XML
provider.survey <- Lma.design(attribute.names = list(brand = c("AT&T", "T-Mobile", "Sprint", "Verizon"),
startup = c("$100", "$200", "$300", "$400"), monthly = c("$100", "$120", "$140", "$160"),
service = c("4G NO", "4G YES"), retail = c("Retail NO", "Retail YES"), apple = c("Apple NO", "Apple YES"),
samsung = c("Samsung NO", "Samsung YES"), google = c("Nexus NO", "Nexus YES")),
nalternatives = 1, nblocks = 1, seed = 9999)
## The columns of the array have been used in order of appearance.
## For designs with relatively few columns,
## the properties can sometimes be substantially improved
## using option columns with min3 or even min34.
print(questionnaire(provider.survey)) # print survey design for review
##
## Block 1
##
## Question 1
## alt.1
## brand "AT&T"
## startup "$100"
## monthly "$100"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 2
## alt.1
## brand "Verizon"
## startup "$300"
## monthly "$100"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 3
## alt.1
## brand "Sprint"
## startup "$400"
## monthly "$120"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 4
## alt.1
## brand "Verizon"
## startup "$400"
## monthly "$160"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 5
## alt.1
## brand "Verizon"
## startup "$200"
## monthly "$140"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 6
## alt.1
## brand "Verizon"
## startup "$100"
## monthly "$120"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 7
## alt.1
## brand "Sprint"
## startup "$300"
## monthly "$140"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 8
## alt.1
## brand "AT&T"
## startup "$400"
## monthly "$140"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 9
## alt.1
## brand "AT&T"
## startup "$200"
## monthly "$160"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 10
## alt.1
## brand "T-Mobile"
## startup "$400"
## monthly "$100"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 11
## alt.1
## brand "Sprint"
## startup "$100"
## monthly "$160"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 12
## alt.1
## brand "T-Mobile"
## startup "$200"
## monthly "$120"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 13
## alt.1
## brand "T-Mobile"
## startup "$100"
## monthly "$140"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 14
## alt.1
## brand "Sprint"
## startup "$200"
## monthly "$100"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 15
## alt.1
## brand "T-Mobile"
## startup "$300"
## monthly "$160"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 16
## alt.1
## brand "AT&T"
## startup "$300"
## monthly "$120"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus YES"
##
## NULL
#######sink("questions_for_survey.txt") # send survey to external text file
questionnaire(provider.survey)
##
## Block 1
##
## Question 1
## alt.1
## brand "AT&T"
## startup "$100"
## monthly "$100"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 2
## alt.1
## brand "Verizon"
## startup "$300"
## monthly "$100"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 3
## alt.1
## brand "Sprint"
## startup "$400"
## monthly "$120"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 4
## alt.1
## brand "Verizon"
## startup "$400"
## monthly "$160"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 5
## alt.1
## brand "Verizon"
## startup "$200"
## monthly "$140"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 6
## alt.1
## brand "Verizon"
## startup "$100"
## monthly "$120"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 7
## alt.1
## brand "Sprint"
## startup "$300"
## monthly "$140"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 8
## alt.1
## brand "AT&T"
## startup "$400"
## monthly "$140"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 9
## alt.1
## brand "AT&T"
## startup "$200"
## monthly "$160"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 10
## alt.1
## brand "T-Mobile"
## startup "$400"
## monthly "$100"
## service "4G YES"
## retail "Retail NO"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 11
## alt.1
## brand "Sprint"
## startup "$100"
## monthly "$160"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung YES"
## google "Nexus YES"
##
## Question 12
## alt.1
## brand "T-Mobile"
## startup "$200"
## monthly "$120"
## service "4G NO"
## retail "Retail YES"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 13
## alt.1
## brand "T-Mobile"
## startup "$100"
## monthly "$140"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus NO"
##
## Question 14
## alt.1
## brand "Sprint"
## startup "$200"
## monthly "$100"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 15
## alt.1
## brand "T-Mobile"
## startup "$300"
## monthly "$160"
## service "4G NO"
## retail "Retail NO"
## apple "Apple NO"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 16
## alt.1
## brand "AT&T"
## startup "$300"
## monthly "$120"
## service "4G YES"
## retail "Retail YES"
## apple "Apple NO"
## samsung "Samsung YES"
## google "Nexus YES"
sink() # send output back to the screen
# user-defined function for plotting descriptive attribute names
effect.name.map <- function(effect.name) {
if (effect.name == "brand")
return("Mobile Service Provider")
if (effect.name == "startup")
return("Start-up Cost")
if (effect.name == "monthly")
return("Monthly Cost")
if (effect.name == "service")
return("Offers 4G Service")
if (effect.name == "retail")
return("Has Nearby Retail Store")
if (effect.name == "apple")
return("Sells Apple Products")
if (effect.name == "samsung")
return("Sells Samsung Products")
if (effect.name == "google")
return("Sells Google/Nexus Products")
}
# read in conjoint survey profiles with respondent ranks
conjoint.data.frame <- read.csv("/Users/jyothi/Downloads/MDS_Chapter_1/assignment_1.1_ranking.csv")
# set up sum contrasts for effects coding as needed for conjoint analysis
options(contrasts = c("contr.sum", "contr.poly"))
# fit linear regression model using main effects only (no interaction terms)
main.effects.model <- lm(ranking ~ brand + startup + monthly + service + retail +
apple + samsung + google, data = conjoint.data.frame)
print(summary(main.effects.model))
##
## Call:
## lm.default(formula = ranking ~ brand + startup + monthly + service +
## retail + apple + samsung + google, data = conjoint.data.frame)
##
## Residuals:
## 1 2 3 4 5 6 7 8 9 10 11 12
## -0.25 0.25 0.25 -0.25 -0.25 0.25 -0.25 0.25 0.25 -0.25 -0.25 -0.25
## 13 14 15 16
## 0.25 0.25 0.25 -0.25
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.500e+00 2.500e-01 34.000 0.0187 *
## brand1 -1.884e-15 4.330e-01 0.000 1.0000
## brand2 4.000e+00 4.330e-01 9.238 0.0686 .
## brand3 2.500e-01 4.330e-01 0.577 0.6667
## startup1 -7.500e-01 4.330e-01 -1.732 0.3333
## startup2 1.500e+00 4.330e-01 3.464 0.1789
## startup3 1.500e+00 4.330e-01 3.464 0.1789
## monthly1 -1.750e+00 4.330e-01 -4.041 0.1544
## monthly2 7.500e-01 4.330e-01 1.732 0.3333
## monthly3 -2.500e-01 4.330e-01 -0.577 0.6667
## service1 -1.375e+00 2.500e-01 -5.500 0.1145
## retail1 -1.500e+00 2.500e-01 -6.000 0.1051
## apple1 3.750e-01 2.500e-01 1.500 0.3743
## samsung1 -1.250e-01 2.500e-01 -0.500 0.7048
## google1 -2.125e+00 2.500e-01 -8.500 0.0746 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1 on 1 degrees of freedom
## Multiple R-squared: 0.9971, Adjusted R-squared: 0.9559
## F-statistic: 24.21 on 14 and 1 DF, p-value: 0.1581
# save key list elements of the fitted model as needed for conjoint measures
conjoint.results <- main.effects.model[c("contrasts", "xlevels", "coefficients")]
conjoint.results$attributes <- names(conjoint.results$contrasts)
# compute and store part-worths in the conjoint.results list structure
part.worths <- conjoint.results$xlevels # list of same structure as xlevels
end.index.for.coefficient <- 1 # intitialize skipping the intercept
part.worth.vector <- NULL # used for accumulation of part worths
for (index.for.attribute in seq(along = conjoint.results$contrasts)) {
nlevels <- length(unlist(conjoint.results$xlevels[index.for.attribute]))
begin.index.for.coefficient <- end.index.for.coefficient + 1
end.index.for.coefficient <- begin.index.for.coefficient + nlevels - 2
last.part.worth <- -sum(conjoint.results$coefficients[begin.index.for.coefficient:end.index.for.coefficient])
part.worths[index.for.attribute] <- list(as.numeric(c(conjoint.results$coefficients[begin.index.for.coefficient:end.index.for.coefficient],
last.part.worth)))
part.worth.vector <- c(part.worth.vector, unlist(part.worths[index.for.attribute]))
}
conjoint.results$part.worths <- part.worths
# compute standardized part-worths
conjoint.results$standardized.part.worths <- lapply(conjoint.results$part.worths,
scale)
# compute and store part-worth ranges for each attribute
part.worth.ranges <- conjoint.results$contrasts
for (index.for.attribute in seq(along = conjoint.results$contrasts)) part.worth.ranges[index.for.attribute] <- dist(range(conjoint.results$part.worths[index.for.attribute]))
conjoint.results$part.worth.ranges <- part.worth.ranges
sum.part.worth.ranges <- sum(as.numeric(conjoint.results$part.worth.ranges))
# compute and store importance values for each attribute
attribute.importance <- conjoint.results$contrasts
for (index.for.attribute in seq(along = conjoint.results$contrasts)) attribute.importance[index.for.attribute] <- (dist(range(conjoint.results$part.worths[index.for.attribute]))/sum.part.worth.ranges) *
100
conjoint.results$attribute.importance <- attribute.importance
# data frame for ordering attribute names
attribute.name <- names(conjoint.results$contrasts)
attribute.importance <- as.numeric(attribute.importance)
temp.frame <- data.frame(attribute.name, attribute.importance)
conjoint.results$ordered.attributes <- as.character(temp.frame[sort.list(temp.frame$attribute.importance,
decreasing = TRUE), "attribute.name"])
# respondent internal consistency added to list structure
conjoint.results$internal.consistency <- summary(main.effects.model)$r.squared
# user-defined function for printing conjoint measures
if (print.digits == 2) pretty.print <- function(x) {
sprintf("%1.2f", round(x, digits = 2))
}
if (print.digits == 3) pretty.print <- function(x) {
sprintf("%1.3f", round(x, digits = 3))
}
# report the conjoint measures to console use pretty.print to provide nicely
# formated output
for (k in seq(along = conjoint.results$ordered.attributes)) {
cat("\n", "\n")
cat(conjoint.results$ordered.attributes[k], "Levels: ", unlist(conjoint.results$xlevels[conjoint.results$ordered.attributes[k]]))
cat("\n", " Part-Worths: ")
cat(pretty.print(unlist(conjoint.results$part.worths[conjoint.results$ordered.attributes[k]])))
cat("\n", " Standardized Part-Worths: ")
cat(pretty.print(unlist(conjoint.results$standardized.part.worths[conjoint.results$ordered.attributes[k]])))
cat("\n", " Attribute Importance: ")
cat(pretty.print(unlist(conjoint.results$attribute.importance[conjoint.results$ordered.attributes[k]])))
}
##
##
## brand Levels: "AT&T" "T-Mobile" "US Cellular" "Verizon"
## Part-Worths: -0.00 4.00 0.25 -4.25
## Standardized Part-Worths: -0.00 1.19 0.07 -1.26
## Attribute Importance: 31.73
##
## google Levels: "Nexus NO" "Nexus YES"
## Part-Worths: -2.12 2.12
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 16.35
##
## startup Levels: "$100" "$200" "$300" "$400"
## Part-Worths: -0.75 1.50 1.50 -2.25
## Standardized Part-Worths: -0.41 0.82 0.82 -1.22
## Attribute Importance: 14.42
##
## retail Levels: "Retail NO" "Retail YES"
## Part-Worths: -1.50 1.50
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 11.54
##
## monthly Levels: "$100" "$200" "$300" "$400"
## Part-Worths: -1.75 0.75 -0.25 1.25
## Standardized Part-Worths: -1.32 0.57 -0.19 0.94
## Attribute Importance: 11.54
##
## service Levels: "4G NO" "4G YES"
## Part-Worths: -1.38 1.38
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 10.58
##
## apple Levels: "Apple NO" "Apple YES"
## Part-Worths: 0.38 -0.38
## Standardized Part-Worths: 0.71 -0.71
## Attribute Importance: 2.88
##
## samsung Levels: "Samsung NO" "Samsung YES"
## Part-Worths: -0.13 0.13
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 0.96
pdf(file = "fig_preference_mobile_services_results_assign.pdf", width = 8.5, height = 11)
spine.chart(conjoint.results)
dev.off()
## quartz_off_screen
## 2