###########################################
#SAS Institute Inc. (1993).
#Sas Technical Report R-109: Conjoint analysis example. Author.
###########################################
source("http://blue.zero.jp/yokumura/R/conjoint/conjoint.r")

#--------------------------------------#
#Example 1. Chocolate candy: Metric conjoint analysis (pp.5-9)
#--------------------------------------#
##(a) データの作成
dat <-  data.frame(matrix(c(
     "dark", "hard","nuts",
     "dark", "hard","no nuts",
     "dark", "soft","nuts",
     "dark", "soft","no nuts",
     "milk", "hard","nuts",
     "milk", "hard","no nuts",
     "milk", "soft","nuts",
     "milk", "soft","no nuts"
     ), ncol=3, byrow=T)
    )
names(dat) <- c("choc","center","nuts")
dat$ratings <- c(7,6,6,4,9,8,9,7)
dat


##(b) コンジョイント分析
#conjoint(dat), datの最終列に従属変数，その他に直交表を記載する 
conjoint(dat)
conjoint(dat, graph=T)
conjoint(dat, graph=T, mfrow=c(3,3))
graphics.off()


#--------------------------------------#
#Example 2. Tea tasting: Metric conjoint analysis (pp.13-16)
#--------------------------------------#
##(a) データの作成
dat <- data.frame(matrix(c(
          1,1,0,3,1,
          1,1,1,1,9,
          1,1,2,2,17,
          1,2,0,1,3,
          1,2,1,2,11,
          1,2,2,3,13,
          1,3,0,2,5,
          1,3,1,3,7,
          1,3,2,1,15,
          2,1,0,1,4,
          2,1,1,2,12,
          2,1,2,3,14,
          2,2,0,2,6,
          2,2,1,3,8,
          2,2,2,1,16,
          2,3,0,3,2,
          2,3,1,1,10,
          2,3,2,2,18
 ), ncol=5, byrow=T))
cor(dat[,-5])
names(dat) <- c("lemf","strf","swf","temf","ranking")
dat$lemf <- factor(dat$lemf, labels=c("yes","no"))
dat$strf <- factor(dat$strf, labels=c("strong","moderate","weak"))
dat$swf <- factor(dat$swf, labels=c("no.sugar","1teaspoon","2teaspoon"))
dat$temf <- factor(dat$temf, labels=c("hot","warm","iced"))
dat$ranking <- max(dat$ranking) + 1 - dat$ranking   #A small rank means high preference!


##(b) コンジョイント分析
conjoint(dat)
conjoint(dat, graph=T)
graphics.off()



#--------------------------------------#
#Example 3. Tea tasting: Metric conjoint analysis (pp.16-33)
#--------------------------------------#
##(a) 直交表
orthogonal <- data.frame(matrix(c(
          "Yes","Moderate","No Sugar"   ,"Hot" ,"Active",
          "No" ,"Weak"    ,"No Sugar"   ,"Iced","Active",
          "No" ,"Moderate","2 Teaspoons","Hot" ,"Active",
          "No" ,"Strong"  ,"1 Teaspoon" ,"Warm","Active",
          "Yes","Strong"  ,"No Sugar"   ,"Iced","Active",
          "Yes","Moderate","1 Teaspoon" ,"Warm","Active",
          "Yes","Strong"  ,"2 Teaspoons","Iced","Holdout",
          "Yes","Moderate","2 Teaspoons","Iced","Active",
          "Yes","Strong"  ,"2 Teaspoons","Warm","Active",
          "No" ,"Weak"    ,"1 Teaspoon" ,"Hot" ,"Active",
          "Yes","Weak"    ,"1 Teaspoon" ,"Iced","Active",
          "No" ,"Weak"    ,"2 Teaspoons","Warm","Active",
          "No" ,"Moderate","1 Teaspoon" ,"Iced","Active",
          "No" ,"Strong"  ,"2 Teaspoons","Iced","Active",
          "No" ,"Strong"  ,"No Sugar"   ,"Hot" ,"Active",
          "No" ,"Moderate","No Sugar"   ,"Warm","Active",
          "No" ,"Weak"    ,"1 Teaspoon" ,"Warm","Holdout",
          "Yes","Weak"    ,"2 Teaspoons","Hot" ,"Active",
          "Yes","Strong"  ,"2 Teaspoons","Hot" ,"Holdout",
          "Yes","Weak"    ,"2 Teaspoons","Warm","Holdout",
          "Yes","Strong"  ,"1 Teaspoon" ,"Hot" ,"Active",
          "Yes","Weak"    ,"No Sugar"   ,"Warm","Active",
          "No" ,"Moderate","No Sugar"   ,"Hot" ,"Simulation",
          "No" ,"Strong"  ,"No Sugar"   ,"Hot" ,"Simulation",
          "No" ,"Weak"    ,"No Sugar"   ,"Hot" ,"Simulation",
          "No" ,"Moderate","1 Teaspoon" ,"Hot" ,"Simulation",
          "No" ,"Strong"  ,"1 Teaspoon" ,"Hot" ,"Simulation",
          "No" ,"Weak"    ,"1 Teaspoon" ,"Hot" ,"Simulation",
          "No" ,"Moderate","2 Teaspoons","Hot" ,"Simulation",
          "No" ,"Strong"  ,"2 Teaspoons","Hot" ,"Simulation"
          ), ncol=5, byrow=T))
names(orthogonal) <- c("lemon","strength","sweetness","temperature","weight")
orthogonal


##(b) 反応データ
dat <- data.frame(matrix(c(
        3 ,2 ,19,12,1 ,11,14,15,20,10,7 ,22,8 ,16,4 ,6 ,13,18,17,21,9 ,5 ,
        18,21,4 ,8 ,20,10,2 ,5 ,9 ,11,12,14,6 ,3 ,17,19,15,13,1 ,16,7 ,22
        ), nrow=2, byrow=T))


##(c) コンジョイント分析
#sub.conjoint(orthogonal, dat), orthogonalに直交表，datにデータを記載する 
subcon <- subj.conjoint(orthogonal, dat, rank=T)
subj.graph(subcon)
orthogonal <- create.simulation(orthogonal)
subj.conjoint(orthogonal, dat, rank=T)
graphics.off()