Author : tmlab / Date : 2017. 2. 17. 14:38 / Category : Analytics
setwd("d:/KSG/R/MA")
print.digits = 2 #숫지 두자리만 표시
library(support.CEs) # 설문구성 패키지
## 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.suvey = Lma.design(attribute.names =
list(brand = c("AT&T", "T-Mobile", "US Cellular", "Verizon"),
startup = c('$100', '$200', '$300', '$400'),
monthly = c('$100', '$200', '$300', '$400'),
service = c("4G NO", "4G YES"),
retail = c("retail NO", "retail YES"),
apple = c("Apple No", "Apple YES"),
samsung = c("Samsung NO", 'Samsumg 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.suvey))
##
## 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 "Samsumg YES"
## google "Nexus NO"
##
## Question 3
## alt.1
## brand "US Cellular"
## startup "$400"
## monthly "$200"
## service "4G NO"
## retail "retail NO"
## apple "Apple No"
## samsung "Samsumg YES"
## google "Nexus NO"
##
## Question 4
## alt.1
## brand "Verizon"
## startup "$400"
## monthly "$400"
## service "4G YES"
## retail "retail YES"
## apple "Apple No"
## samsung "Samsung NO"
## google "Nexus NO"
##
## Question 5
## alt.1
## brand "Verizon"
## startup "$200"
## monthly "$300"
## service "4G NO"
## retail "retail NO"
## apple "Apple No"
## samsung "Samsumg YES"
## google "Nexus YES"
##
## Question 6
## alt.1
## brand "Verizon"
## startup "$100"
## monthly "$200"
## service "4G YES"
## retail "retail NO"
## apple "Apple YES"
## samsung "Samsung NO"
## google "Nexus YES"
##
## Question 7
## alt.1
## brand "US Cellular"
## startup "$300"
## monthly "$300"
## 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 "$300"
## 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 "$400"
## service "4G YES"
## retail "retail NO"
## apple "Apple YES"
## samsung "Samsumg 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 "Samsumg YES"
## google "Nexus YES"
##
## Question 11
## alt.1
## brand "US Cellular"
## startup "$100"
## monthly "$400"
## service "4G NO"
## retail "retail YES"
## apple "Apple YES"
## samsung "Samsumg YES"
## google "Nexus YES"
##
## Question 12
## alt.1
## brand "T-Mobile"
## startup "$200"
## monthly "$200"
## 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 "$300"
## service "4G YES"
## retail "retail YES"
## apple "Apple No"
## samsung "Samsumg YES"
## google "Nexus NO"
##
## Question 14
## alt.1
## brand "US Cellular"
## 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 "$400"
## 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 "$200"
## service "4G YES"
## retail "retail YES"
## apple "Apple No"
## samsung "Samsumg YES"
## google "Nexus YES"
##
## NULL
sink("question_for_suvey.txt")
sink()
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("offer 4g service")
if(effect.name=="retail") return("has nearby retail store")
if(effect.name=="apple") return("sell apple product")
if(effect.name=="samsung") return("sell samsung product")
if(effect.name=="google") return("sell google/nexus product")
}
conjoint.df = read.csv("mobile_services_ranking.csv")
summary(conjoint.df)
## brand startup monthly service retail
## "AT&T" :4 "$100":4 "$100":4 "4G NO" :8 "Retail NO" :8
## "T-Mobile" :4 "$200":4 "$200":4 "4G YES":8 "Retail YES":8
## "US Cellular":4 "$300":4 "$300":4
## "Verizon" :4 "$400":4 "$400":4
##
##
## apple samsung google ranking
## "Apple NO" :8 "Samsung NO" :8 "Nexus NO" :8 Min. : 1.00
## "Apple YES":8 "Samsung YES":8 "Nexus YES":8 1st Qu.: 4.75
## Median : 8.50
## Mean : 8.50
## 3rd Qu.:12.25
## Max. :16.00
options(contrasts=c("contr.sum","contr.poly"))
main.effect.model = {ranking ~ brand+startup+monthly+service+retail+apple+samsung+google}
main.fit = lm(main.effect.model, data=conjoint.df)
print(summary(main.fit))
##
## Call:
## lm.default(formula = main.effect.model, data = conjoint.df)
##
## Residuals:
## 1 2 3 4 5 6 7 8 9 10
## -0.125 0.125 0.125 -0.125 -0.125 0.125 -0.125 0.125 0.125 -0.125
## 11 12 13 14 15 16
## -0.125 -0.125 0.125 0.125 0.125 -0.125
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.500e+00 1.250e-01 68.000 0.00936 **
## brand1 1.374e-16 2.165e-01 0.000 1.00000
## brand2 -2.500e-01 2.165e-01 -1.155 0.45437
## brand3 -1.202e-16 2.165e-01 0.000 1.00000
## startup1 7.500e-01 2.165e-01 3.464 0.17891
## startup2 8.240e-16 2.165e-01 0.000 1.00000
## startup3 -2.794e-16 2.165e-01 0.000 1.00000
## monthly1 5.000e+00 2.165e-01 23.094 0.02755 *
## monthly2 2.000e+00 2.165e-01 9.238 0.06865 .
## monthly3 -1.250e+00 2.165e-01 -5.774 0.10918
## service1 -1.750e+00 1.250e-01 -14.000 0.04540 *
## retail1 2.500e-01 1.250e-01 2.000 0.29517
## apple1 2.500e-01 1.250e-01 2.000 0.29517
## samsung1 -1.125e+00 1.250e-01 -9.000 0.07045 .
## google1 -7.500e-01 1.250e-01 -6.000 0.10514
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5 on 1 degrees of freedom
## Multiple R-squared: 0.9993, Adjusted R-squared: 0.989
## F-statistic: 97.07 on 14 and 1 DF, p-value: 0.0794
main.fit["contrasts"]
## $contrasts
## $contrasts$brand
## [1] "contr.sum"
##
## $contrasts$startup
## [1] "contr.sum"
##
## $contrasts$monthly
## [1] "contr.sum"
##
## $contrasts$service
## [1] "contr.sum"
##
## $contrasts$retail
## [1] "contr.sum"
##
## $contrasts$apple
## [1] "contr.sum"
##
## $contrasts$samsung
## [1] "contr.sum"
##
## $contrasts$google
## [1] "contr.sum"
main.fit["xlevels"]
## $xlevels
## $xlevels$brand
## [1] "\"AT&T\"" "\"T-Mobile\"" "\"US Cellular\"" "\"Verizon\""
##
## $xlevels$startup
## [1] "\"$100\"" "\"$200\"" "\"$300\"" "\"$400\""
##
## $xlevels$monthly
## [1] "\"$100\"" "\"$200\"" "\"$300\"" "\"$400\""
##
## $xlevels$service
## [1] "\"4G NO\"" "\"4G YES\""
##
## $xlevels$retail
## [1] "\"Retail NO\"" "\"Retail YES\""
##
## $xlevels$apple
## [1] "\"Apple NO\"" "\"Apple YES\""
##
## $xlevels$samsung
## [1] "\"Samsung NO\"" "\"Samsung YES\""
##
## $xlevels$google
## [1] "\"Nexus NO\"" "\"Nexus YES\""
main.fit["coefficients"]
## $coefficients
## (Intercept) brand1 brand2 brand3 startup1
## 8.500000e+00 1.373831e-16 -2.500000e-01 -1.201852e-16 7.500000e-01
## startup2 startup3 monthly1 monthly2 monthly3
## 8.240037e-16 -2.794305e-16 5.000000e+00 2.000000e+00 -1.250000e+00
## service1 retail1 apple1 samsung1 google1
## -1.750000e+00 2.500000e-01 2.500000e-01 -1.125000e+00 -7.500000e-01
conjoint.results = main.fit[c("contrasts","xlevels","coefficients")]
conjoint.results
## $contrasts
## $contrasts$brand
## [1] "contr.sum"
##
## $contrasts$startup
## [1] "contr.sum"
##
## $contrasts$monthly
## [1] "contr.sum"
##
## $contrasts$service
## [1] "contr.sum"
##
## $contrasts$retail
## [1] "contr.sum"
##
## $contrasts$apple
## [1] "contr.sum"
##
## $contrasts$samsung
## [1] "contr.sum"
##
## $contrasts$google
## [1] "contr.sum"
##
##
## $xlevels
## $xlevels$brand
## [1] "\"AT&T\"" "\"T-Mobile\"" "\"US Cellular\"" "\"Verizon\""
##
## $xlevels$startup
## [1] "\"$100\"" "\"$200\"" "\"$300\"" "\"$400\""
##
## $xlevels$monthly
## [1] "\"$100\"" "\"$200\"" "\"$300\"" "\"$400\""
##
## $xlevels$service
## [1] "\"4G NO\"" "\"4G YES\""
##
## $xlevels$retail
## [1] "\"Retail NO\"" "\"Retail YES\""
##
## $xlevels$apple
## [1] "\"Apple NO\"" "\"Apple YES\""
##
## $xlevels$samsung
## [1] "\"Samsung NO\"" "\"Samsung YES\""
##
## $xlevels$google
## [1] "\"Nexus NO\"" "\"Nexus YES\""
##
##
## $coefficients
## (Intercept) brand1 brand2 brand3 startup1
## 8.500000e+00 1.373831e-16 -2.500000e-01 -1.201852e-16 7.500000e-01
## startup2 startup3 monthly1 monthly2 monthly3
## 8.240037e-16 -2.794305e-16 5.000000e+00 2.000000e+00 -1.250000e+00
## service1 retail1 apple1 samsung1 google1
## -1.750000e+00 2.500000e-01 2.500000e-01 -1.125000e+00 -7.500000e-01
names(conjoint.results$contrasts)
## [1] "brand" "startup" "monthly" "service" "retail" "apple" "samsung"
## [8] "google"
conjoint.results$attributes = names(conjoint.results$contrasts)
part.worths = conjoint.results$xlevels # list of same structure as xlevels
end.index.for.coefficient = 1 #절편을 스킵하는것을 초기화
part.worth.vector = NULL
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
conjoint.results$part.worths
## $brand
## [1] 1.373831e-16 -2.500000e-01 -1.201852e-16 2.500000e-01
##
## $startup
## [1] 7.500000e-01 8.240037e-16 -2.794305e-16 -7.500000e-01
##
## $monthly
## [1] 5.00 2.00 -1.25 -5.75
##
## $service
## [1] -1.75 1.75
##
## $retail
## [1] 0.25 -0.25
##
## $apple
## [1] 0.25 -0.25
##
## $samsung
## [1] -1.125 1.125
##
## $google
## [1] -0.75 0.75
standardize <- function(x) {(x - mean(x)) / sd(x)}
conjoint.results$standardized.part.worths = lapply(conjoint.results$part.worths,standardize)
conjoint.results$standardized.part.worths
## $brand
## [1] 6.859505e-16 -1.224745e+00 -5.758711e-16 1.224745e+00
##
## $startup
## [1] 1.224745e+00 1.349886e-15 -4.520147e-16 -1.224745e+00
##
## $monthly
## [1] 1.0857172 0.4342869 -0.2714293 -1.2485748
##
## $service
## [1] -0.7071068 0.7071068
##
## $retail
## [1] 0.7071068 -0.7071068
##
## $apple
## [1] 0.7071068 -0.7071068
##
## $samsung
## [1] -0.7071068 0.7071068
##
## $google
## [1] -0.7071068 0.7071068
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))
sum.part.worth.ranges
## [1] 21
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
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"])
conjoint.results$internal.consistency = summary(main.fit)$r.squared
conjoint.results$internal.consistency
## [1] 0.9992647
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))}
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]])))
}
##
##
## monthly Levels: "$100" "$200" "$300" "$400"
## Part-Worths: 5.00 2.00 -1.25 -5.75
## Standardized Part-Worths: 1.09 0.43 -0.27 -1.25
## Attribute Importance: 51.19
##
## service Levels: "4G NO" "4G YES"
## Part-Worths: -1.75 1.75
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 16.67
##
## samsung Levels: "Samsung NO" "Samsung YES"
## Part-Worths: -1.12 1.12
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 10.71
##
## google Levels: "Nexus NO" "Nexus YES"
## Part-Worths: -0.75 0.75
## Standardized Part-Worths: -0.71 0.71
## Attribute Importance: 7.14
##
## startup Levels: "$100" "$200" "$300" "$400"
## Part-Worths: 0.75 0.00 -0.00 -0.75
## Standardized Part-Worths: 1.22 0.00 -0.00 -1.22
## Attribute Importance: 7.14
##
## retail Levels: "Retail NO" "Retail YES"
## Part-Worths: 0.25 -0.25
## Standardized Part-Worths: 0.71 -0.71
## Attribute Importance: 2.38
##
## apple Levels: "Apple NO" "Apple YES"
## Part-Worths: 0.25 -0.25
## Standardized Part-Worths: 0.71 -0.71
## Attribute Importance: 2.38
##
## brand Levels: "AT&T" "T-Mobile" "US Cellular" "Verizon"
## Part-Worths: 0.00 -0.25 -0.00 0.25
## Standardized Part-Worths: 0.00 -1.22 -0.00 1.22
## Attribute Importance: 2.38