[R] Conjoint Analysis

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

컨조인트분석에 sum contrast 효과 셋업을위한 코딩

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-worth를 계산하고 저장함

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

part-worths 표준화

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

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 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]])))
  }
## 
##  
## 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


Archives

05-16 08:06

Contact Us

Address
경기도 수원시 영통구 원천동 산5번지 아주대학교 다산관 429호

E-mail
textminings@gmail.com

Phone
031-219-2910

Tags

Calendar

«   2024/05   »
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
Copyright © All Rights Reserved
Designed by CMSFactory.NET