peter — May 11, 2014, 4:26 PM
#####################
#SERVICE INVOLVEMENT
#####################
#Preliminaries
library(psych) #Package for personality, psychometric, and psychological research
options(width=100) #Modify screen width
# LOAD AND ATTACH DATA
setwd("~/Documents/PhD/Presentations/WWC2014/") #Set working directory
PII <- read.delim("PIIpilot.csv") #Read pilot data (Twitter)
PII[,1:10] <- PII[,1:10]*7/5 #CConvert to 7-point Likert-Scale
Utilities <- read.delim("../../Analysis/Utilities/customers_quant.csv", sep=",")[,1:10] #Read utility data (PII only)
Utilities[,11:15] <- NA #Dummy data
names(Utilities) <- names(PII) #Use same dimnames
PII <- rbind(PII, Utilities) #Merge pilot and utility data
PII$checksum <- rowSums(PII[,1:10]) #Check for incomplete responses
PII <- PII[!is.na(PII$checksum),] #Remove incomplete responses
remove(Utilities) #Remove temporary data
write.csv(PII, "involvement.csv") #Save munched data
#Download file at: http://prevos.net/owncloud/public.php?service=files&t=c598b03ae5183dd7b2e36a3bfba3cec8
#Define Constructs
PII[,c(1,2,7,8,9,10)] <-8-PII[,c(1,2,7,8,9,10)] # Reverse retrograde values
describe(PII[,1:10])
vars n mean sd median trimmed mad min max range skew kurtosis se
importance 1 263 6.69 0.84 7 6.87 0.00 1 7 6 -4.82 25.31 0.05
relevance 2 263 6.41 1.04 7 6.65 0.00 1 7 6 -2.77 8.77 0.06
meaning 3 263 6.09 1.50 7 6.43 0.00 1 7 6 -1.91 3.11 0.09
value 4 263 6.72 0.89 7 6.95 0.00 1 7 6 -4.13 19.11 0.05
need 5 263 6.84 0.78 7 7.00 0.00 1 7 6 -6.01 38.00 0.05
interest 6 263 4.79 1.62 5 4.90 1.48 1 7 6 -0.34 -0.60 0.10
excitement 7 263 4.20 1.59 4 4.24 1.48 1 7 6 -0.18 -0.30 0.10
appeal 8 263 5.50 1.59 6 5.73 1.48 1 7 6 -1.00 0.23 0.10
fascination 9 263 4.40 1.54 4 4.45 1.48 1 7 6 -0.27 -0.20 0.10
involvement 10 263 4.58 1.64 4 4.67 1.48 1 7 6 -0.24 -0.53 0.10
colour <- c(rep("dodgerblue4",5),rep("dodgerblue",5))
par(mar=c(4,8,1,1), lty=1) # Set margins
boxplot(PII[,1:10], las=2, xlab="Score", col=colour, horizontal=T, cex.axis=1.5, cex.lab=1.5, lab=1)
involvement <- rowSums(PII[,1:10]) # Calculate involvement index (PII)
describe(involvement)
vars n mean sd median trimmed mad min max range skew kurtosis se
1 1 263 56.21 7.72 57 56.53 7.41 34 70 36 -0.41 -0.1 0.48
wilcox.test(involvement, mu=40, exact=F) #H0: involvement=40
Wilcoxon signed rank test with continuity correction
data: involvement
V = 33844, p-value < 2.2e-16
alternative hypothesis: true location is not equal to 40
par(mar=c(4,5,1,1), lty=1) # Set margins
hist(involvement, xlim=c(10,70), col="dodgerblue", main="", cex.axis=1.5, cex.lab=1.5, las=3)
cognitive <- rowSums(PII[,1:5]) # Calculate cognitive dimensions
affective <- rowSums(PII[,6:10]) # Calculate affective dimensions
describe(cognitive)
vars n mean sd median trimmed mad min max range skew kurtosis se
1 1 263 32.74 3.09 34.2 33.36 1.19 17 35 18 -1.87 3.71 0.19
describe(affective)
vars n mean sd median trimmed mad min max range skew kurtosis se
1 1 263 23.47 6.16 23.6 23.63 5.34 8 35 27 -0.21 -0.19 0.38
wilcox.test(cognitive, affective, exact=F) #H0: cognitive=affective
Wilcoxon rank sum test with continuity correction
data: cognitive and affective
W = 62717, p-value < 2.2e-16
alternative hypothesis: true location shift is not equal to 0
par(mar=c(5,3,1,1)) #Reset margins
hist(cognitive, col=colour[1], main="", xlab="Score", xlim=c(5,35), breaks=20)
hist(affective, col=colour[6], add=T, xlim=c(5,25), breaks=20)
legend("topleft",c("Cognitive", "Affective"), fill=c("dodgerblue4", "dodgerblue"), bty='n', border=NA)
#Other products (Zaichowski, 1985)
products <- c("instant coffee", "breakfast cereal", "red wine", "tissues", "television", "jeans", "car", "tap water")
PIIp <- c(66/2, 69/2, 83/2, 87/2, 97/2, 99/2, 122/2, median(involvement))
products <- data.frame(products, PIIp)
products <- products[order(PIIp),]
par(mar=c(6,7,1,1)) #Reset margins
barplot(products$PIIp, col=c(rep("dodgerblue",6), "dodgerblue4", "dodgerblue"), xlab="Peronsal Involvement Index", names.arg=products$products, horiz=T, las=2)
#H0: professional=non-professional
describe(affective[PII$professional==1], na.rm=T)
vars n mean sd median trimmed mad min max range skew kurtosis se
1 1 28 27.35 4.59 27.1 27.39 7.26 20.8 33.4 12.6 0.02 -1.42 0.87
describe(affective[PII$professional==0], na.rm=T)
vars n mean sd median trimmed mad min max range skew kurtosis se
1 1 42 20.1 4.9 20.8 20.43 4.15 8.2 30.6 22.4 -0.58 0.1 0.76
wilcox.test(affective[PII$professional==1],affective[PII$professional==0], exact=F)
Wilcoxon rank sum test with continuity correction
data: affective[PII$professional == 1] and affective[PII$professional == 0]
W = 1004, p-value = 5.732e-07
alternative hypothesis: true location shift is not equal to 0
#FACTOR ANALYSIS
par(mar=c(4,4,3,1)) #Reset margins
Pfactors <- fa.parallel(PII[,1:10], fa="fa")
Loading required package: parallel
Loading required package: MASS
Parallel analysis suggests that the number of factors = 3 and the number of components = 3
PFA <- fa(PII[,1:10],nfactors=2, rotate="promax")
par(mar=c(4,4,4,4))
fa.diagram(PFA)
#PUBLICATION GRAPHS
jpeg("figure2.jpg", width=1024, height=768)
par(mar=c(4,8,1,1), cex=2) # Set margins
boxplot(PII[,1:10], las=2, xlab="Score", col=colour, horizontal=T, lab=1, outline=F)
dev.off()
pdf
2
jpeg("figure3.jpg", width=1024, height=768)
par(mar=c(4,5,1,1), lty=1, cex=2) # Set margins
hist(involvement, xlim=c(10,70), col="dodgerblue", main="", las=3)
dev.off()
pdf
2
jpeg("figure4.jpg", width=1024, height=768)
par(mar=c(6,7,1,1), lty=0, cex=2) #Reset margins
barplot(products$PIIp, col=c(rep("dodgerblue",6), "dodgerblue4", "dodgerblue"), xlab="Peronsal Involvement Index", names.arg=products$products, horiz=T, las=2)
dev.off()
pdf
2