library(mapproj) # map
## Warning: package 'mapproj' was built under R version 3.0.3
## Loading required package: maps
## Warning: package 'maps' was built under R version 3.0.3
library(reshape2) # melt
## Warning: package 'reshape2' was built under R version 3.0.3
library(nparcomp) # gao_cs
## Warning: package 'nparcomp' was built under R version 3.0.3
## Loading required package: multcomp
## Warning: package 'multcomp' was built under R version 3.0.3
## Loading required package: mvtnorm
## Warning: package 'mvtnorm' was built under R version 3.0.3
## Loading required package: survival
## Loading required package: splines
## Loading required package: TH.data
library(car) # leveneTest
## Warning: package 'car' was built under R version 3.0.3
library(MASS) # lda
library(psy) # cronbach
library(psych) # KMO
## Warning: package 'psych' was built under R version 3.0.3
##
## Attaching package: 'psych'
##
## The following object is masked from 'package:psy':
##
## wkappa
##
## The following object is masked from 'package:car':
##
## logit
library(Hmisc) # correlation matrix
## Warning: package 'Hmisc' was built under R version 3.0.3
## Loading required package: grid
## Loading required package: lattice
## Warning: package 'lattice' was built under R version 3.0.3
## Loading required package: Formula
## Warning: package 'Formula' was built under R version 3.0.3
##
## Attaching package: 'Hmisc'
##
## The following object is masked from 'package:psych':
##
## describe
##
## The following objects are masked from 'package:base':
##
## format.pval, round.POSIXt, trunc.POSIXt, units
library(lavaan) # SEM
## Warning: package 'lavaan' was built under R version 3.0.3
## This is lavaan 0.5-17
## lavaan is BETA software! Please report any bugs.
library(semPlot) # SEM graph
## Warning: package 'semPlot' was built under R version 3.0.3
cat("\014") # cleans screen
rm(list=ls(all=T)) # remove variables in working memory
setwd("D:/Backup - ASUS Erik Ernesto Vzz Hdz/Downloads/Results") # sets working directory
Pretest1<-read.csv("Pretests/Pretest_1.csv", skip=2, header=F) # reads pre-test 1 file and creates a data frame
NamesandHeaders<-read.csv("Pretests/Pretest_1.csv") # assigns headers and names to data frame
names(Pretest1)<-names(NamesandHeaders)
Pretest1[which(!duplicated(Pretest1$V6)&Pretest1$mTurkCode<"",)] # Validating and cleaning Data
## data frame with 0 columns and 57 rows
summary(Pretest1$V3) # Number of individuals that took this survey
## Anonymous
## 57
Facebook<-na.omit(Pretest1$X1)
Twitter<-na.omit(Pretest1$X2)
YouTube<-na.omit(Pretest1$X3)
table(Facebook)/57 # Relative freq. of people that know Facebook website 1=Yes, 2=No
## Facebook
## 1 2
## 0.8947368 0.0877193
table(Twitter)/57 # Relative freq. of people that know Twitter website 1=Yes, 2=No
## Twitter
## 1 2
## 0.8947368 0.0877193
table(YouTube)/57 # Relative freq. of people that know YouTube website 1=Yes, 2=No
## YouTube
## 1 2
## 0.8596491 0.1228070
Pretest1$Samsung<-(Pretest1$S1a+Pretest1$S1b+Pretest1$S1c)/3
Pretest1$Currys<-(Pretest1$S2a+Pretest1$S2b+Pretest1$S2c)/3
Pretest1$Pixmania<-(Pretest1$S3a+Pretest1$S3b+Pretest1$S3c)/3
mean(na.omit(Pretest1$Samsung))
## [1] 8.450617
mean(na.omit(Pretest1$Currys))
## [1] 1.395062
mean(na.omit(Pretest1$Pixmania))
## [1] 1.487654
sd(na.omit(Pretest1$Samsung))
## [1] 1.36926
sd(na.omit(Pretest1$Currys))
## [1] 1.309655
sd(na.omit(Pretest1$Pixmania))
## [1] 1.432935
score<-as.data.frame(rbind(cbind(Pretest1$Samsung,"1"),cbind(Pretest1$Currys,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 52.241 7.915e-11 ***
## 106
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
t.test(Pretest1$Samsung,Pretest1$Currys,paired=T,var.equal=F)
##
## Paired t-test
##
## data: Pretest1$Samsung and Pretest1$Currys
## t = 25.0496, df = 53, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 6.490609 7.620502
## sample estimates:
## mean of the differences
## 7.055556
score<-as.data.frame(rbind(cbind(Pretest1$Pixmania,"1"),cbind(Pretest1$Currys,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.3901 0.5336
## 106
t.test(Pretest1$Pixmania,Pretest1$Currys,paired=T,var.equal=T)
##
## Paired t-test
##
## data: Pretest1$Pixmania and Pretest1$Currys
## t = 1.6953, df = 53, p-value = 0.09588
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.01695295 0.20213813
## sample estimates:
## mean of the differences
## 0.09259259
Pretest1$ASOS<-(Pretest1$S4a+Pretest1$S4b+Pretest1$S4c)/3
Pretest1$Next<-(Pretest1$S5a+Pretest1$S5b+Pretest1$S5c)/3
Pretest1$boohoo<-(Pretest1$S6a+Pretest1$S6b+Pretest1$S6c)/3
mean(na.omit(Pretest1$ASOS))
## [1] 2.081761
mean(na.omit(Pretest1$Next))
## [1] 1.67284
mean(na.omit(Pretest1$boohoo))
## [1] 1.425926
sd(na.omit(Pretest1$ASOS))
## [1] 2.265408
sd(na.omit(Pretest1$Next))
## [1] 1.508176
sd(na.omit(Pretest1$boohoo))
## [1] 1.303787
score<-as.data.frame(rbind(cbind(Pretest1$ASOS,"1"),cbind(Pretest1$boohoo,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 6.1824 0.01448 *
## 105
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
t.test(Pretest1$ASOS,Pretest1$boohoo,paired=T,var.equal=F)
##
## Paired t-test
##
## data: Pretest1$ASOS and Pretest1$boohoo
## t = 2.3949, df = 52, p-value = 0.02026
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.1050134 1.1905840
## sample estimates:
## mean of the differences
## 0.6477987
score<-as.data.frame(rbind(cbind(Pretest1$Next,"1"),cbind(Pretest1$boohoo,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 2.686 0.1042
## 106
t.test(Pretest1$Next,Pretest1$boohoo,paired=T,var.equal=T)
##
## Paired t-test
##
## data: Pretest1$Next and Pretest1$boohoo
## t = 1.5468, df = 53, p-value = 0.1279
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.07326653 0.56709369
## sample estimates:
## mean of the differences
## 0.2469136
Pretest1$Healthspan<-(Pretest1$S7a+Pretest1$S7b+Pretest1$S7c)/3
Pretest1$iHerb<-(Pretest1$S8a+Pretest1$S8b+Pretest1$S8c)/3
Pretest1$PROZIS<-(Pretest1$S9a+Pretest1$S9b+Pretest1$S9c)/3
mean(na.omit(Pretest1$Healthspan))
## [1] 1.493827
mean(na.omit(Pretest1$iHerb))
## [1] 1.440252
mean(na.omit(Pretest1$PROZIS))
## [1] 1.333333
sd(na.omit(Pretest1$Healthspan))
## [1] 1.124793
sd(na.omit(Pretest1$iHerb))
## [1] 1.174468
sd(na.omit(Pretest1$PROZIS))
## [1] 1.17488
score<-as.data.frame(rbind(cbind(Pretest1$Healthspan,"1"),cbind(Pretest1$PROZIS,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 1.7414 0.1898
## 105
t.test(Pretest1$Healthspan,Pretest1$PROZIS,paired=T,var.equal=F)
##
## Paired t-test
##
## data: Pretest1$Healthspan and Pretest1$PROZIS
## t = 1.5671, df = 52, p-value = 0.1232
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.04762872 0.38725136
## sample estimates:
## mean of the differences
## 0.1698113
score<-as.data.frame(rbind(cbind(Pretest1$iHerb,"1"),cbind(Pretest1$PROZIS,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.5596 0.4561
## 104
t.test(Pretest1$iHerb,Pretest1$PROZIS,paired=T,var.equal=T)
##
## Paired t-test
##
## data: Pretest1$iHerb and Pretest1$PROZIS
## t = 1.5802, df = 52, p-value = 0.1201
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.02885002 0.24268649
## sample estimates:
## mean of the differences
## 0.1069182
Samsung<-(mean(na.omit(Pretest1$S1a))+mean(na.omit(Pretest1$S1b))+mean(na.omit(Pretest1$S1c)))/3
Currys<-(mean(na.omit(Pretest1$S2a))+mean(na.omit(Pretest1$S2b))+mean(na.omit(Pretest1$S2c)))/3
Pixmania<-(mean(na.omit(Pretest1$S3a))+mean(na.omit(Pretest1$S3b))+mean(na.omit(Pretest1$S3c)))/3
ASOS<-(mean(na.omit(Pretest1$S4a))+mean(na.omit(Pretest1$S4b))+mean(na.omit(Pretest1$S4c)))/3
Next<-(mean(na.omit(Pretest1$S5a))+mean(na.omit(Pretest1$S5b))+mean(na.omit(Pretest1$S5c)))/3
boohoo<-(mean(na.omit(Pretest1$S6a))+mean(na.omit(Pretest1$S6b))+mean(na.omit(Pretest1$S6c)))/3
Healthspan<-(mean(na.omit(Pretest1$S7a))+mean(na.omit(Pretest1$S7b))+mean(na.omit(Pretest1$S7c)))/3
iHerb<-(mean(na.omit(Pretest1$S8a))+mean(na.omit(Pretest1$S8b))+mean(na.omit(Pretest1$S8c)))/3
PROZIS<-(mean(na.omit(Pretest1$S9a))+mean(na.omit(Pretest1$S9b))+mean(na.omit(Pretest1$S9c)))/3
rbind(Samsung,Currys,Pixmania)
## [,1]
## Samsung 8.450617
## Currys 1.395062
## Pixmania 1.487654
rbind(ASOS,Next,boohoo)
## [,1]
## ASOS 2.081761
## Next 1.672840
## boohoo 1.425926
rbind(Healthspan,iHerb,PROZIS)
## [,1]
## Healthspan 1.493827
## iHerb 1.440252
## PROZIS 1.333333
Pretest<-read.csv("Main_Study/Main_study__3x3_United_States.csv", skip=2, header=F) # reads raw data from Qualtrics
NamesandHeaders<-read.csv("Main_Study/Main_study__3x3_United_States.csv") # assigns headers and names to data frame
names(Pretest)<-names(NamesandHeaders)
Pretest$V6<-as.character(Pretest$V6)
Pretest<-Pretest[which(!duplicated(Pretest$V6)&Pretest$t2.frmwrk_3>0&Pretest$t12_3>0),] # This procedure displays a freq. table and a bar plot showing grouping' without IPs duplicates
framework.wide=data.frame(Pretest[1],Pretest[34:36],Pretest[596:598],Pretest[603:604])
names(framework.wide)<-c("Subject","Credence","Experience","Search","Age","Gender","Income","Education","RE")
summary(framework.wide[1:90,2:4])
## Credence Experience Search
## Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:4.000 1st Qu.:3.000 1st Qu.:3.000
## Median :7.000 Median :5.000 Median :3.500
## Mean :5.889 Mean :4.811 Mean :4.178
## 3rd Qu.:8.000 3rd Qu.:7.000 3rd Qu.:6.000
## Max. :9.000 Max. :9.000 Max. :9.000
framework.wide.sample<-framework.wide[1:90,]
framework.long.sample<-melt(framework.wide.sample,id.vars=c("Subject","Age","Gender","Income","Education","RE"),measure.vars=c("Credence", "Experience", "Search" ),variable.name="Framework", value.name="Measurement")
framework.long.sample1<-subset(framework.long.sample,framework.long.sample$Framework!="Credence")
leveneTest(framework.long.sample1$Measurement~framework.long.sample1$Framework,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 2.0869 0.1503
## 178
t.test(framework.wide.sample$Search,framework.wide.sample$Experience,paired=T,var.equal=T)
##
## Paired t-test
##
## data: framework.wide.sample$Search and framework.wide.sample$Experience
## t = -2.46, df = 89, p-value = 0.01582
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.144878 -0.121789
## sample estimates:
## mean of the differences
## -0.6333333
mean(framework.wide.sample$Search)
## [1] 4.177778
sd(framework.wide.sample$Search)
## [1] 2.02
mean(framework.wide.sample$Experience)
## [1] 4.811111
sd(framework.wide.sample$Experience)
## [1] 2.207721
framework.long.sample2<-subset(framework.long.sample,framework.long.sample$Framework!="Search")
leveneTest(framework.long.sample2$Measurement~framework.long.sample2$Framework,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.1897 0.6637
## 178
t.test(framework.wide.sample$Credence,framework.wide.sample$Experience,paired=T,var.equal=T)
##
## Paired t-test
##
## data: framework.wide.sample$Credence and framework.wide.sample$Experience
## t = 3.5838, df = 89, p-value = 0.0005522
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.480216 1.675340
## sample estimates:
## mean of the differences
## 1.077778
mean(framework.wide.sample$Credence)
## [1] 5.888889
sd(framework.wide.sample$Credence)
## [1] 2.305072
Pretest2<-read.csv("Pretests/Pretest_2.csv", skip=2, header=F) # reads pre-test 2 file and creates a data frame
NamesandHeaders<-read.csv("Pretests/Pretest_2.csv") # assigns headers and names to data frame
names(Pretest2)<-names(NamesandHeaders)
Pretest2[ which(!duplicated(Pretest2$V6) & Pretest2$mTurkCode < "",)] # Validating and cleaning Data
## data frame with 0 columns and 62 rows
TieStrength1<-cbind(Pretest2$X15,Pretest2$X17,Pretest2$X19) # Reliability of measures
TieStrength2<-cbind(Pretest2$X16,Pretest2$X18,Pretest2$X20)
cronbach(na.omit(TieStrength1)) # Cronbach's alpha for Tie Strength **These items were used in the final study
## $sample.size
## [1] 55
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8574432
cronbach(na.omit(TieStrength2))
## $sample.size
## [1] 55
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8604863
TieStrength1<-(na.omit(Pretest2$X15)+na.omit(Pretest2$X17)+na.omit(Pretest2$X19))/3 # Weak Ties
TieStrength2<-(na.omit(Pretest2$X16)+na.omit(Pretest2$X18)+na.omit(Pretest2$X20))/3 # Strong Ties
score<-as.data.frame(rbind(cbind(TieStrength1,"1"),cbind(TieStrength2,"2")))
leveneTest(as.numeric(score$TieStrength1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.392 0.5325
## 108
t.test(TieStrength1,TieStrength2,paired=T,var.equal=T) # Means comparison - Tie Strength ** Included in report
##
## Paired t-test
##
## data: TieStrength1 and TieStrength2
## t = -8.6, df = 54, p-value = 1.074e-11
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.394411 -2.732862
## sample estimates:
## mean of the differences
## -3.563636
sd(TieStrength1)
## [1] 1.960363
sd(TieStrength2)
## [1] 2.264133
mean(TieStrength1)
## [1] 2.842424
mean(TieStrength2)
## [1] 6.406061
Pretest3<-read.csv("Pretests/Pretest_3.csv", skip=2, header=F) # reads pre-test 3 file and creates a data frame
NamesandHeaders<-read.csv("Pretests/Pretest_3.csv") # assigns headers and names to data frame
names(Pretest3)<-names(NamesandHeaders)
Pretest3[c("X14c", "X14e", "X14s")][is.na(Pretest3[c("X14c", "X14e", "X14s")])] <- 0 # Validating and cleaning Data
Pretest3 <- Pretest3[ which(!duplicated(Pretest3$V6) & Pretest3$mTurkCode > 0 & Pretest3$X4 != Pretest3$X5 & Pretest3$X14c+Pretest3$X14e+Pretest3$X14s>47),] # Takes out duplicated and whoever failed attention controls
SocialPresence1<-cbind(Pretest3$X33sp,Pretest3$X35sp,Pretest3$X37sp) # Getting High Social Presence Items
SocialPresence2<-cbind(Pretest3$X34sp,Pretest3$X36sp,Pretest3$X38sp) # Getting Low Social Presence Items
cronbach(SocialPresence1) # Cronbach's alpha for Social Presence
## $sample.size
## [1] 46
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8745991
cronbach(SocialPresence2) # Cronbach's alpha for Social Presence
## $sample.size
## [1] 46
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8769481
InfoRichness1<-cbind(Pretest3$X31i,Pretest3$X33i) # Getting High Info. Richness Items *only first two items
InfoRichness2<-cbind(Pretest3$X32i,Pretest3$X34i) # Getting Low Info. Richness Items *only first two items
cronbach(InfoRichness1) # Cronbach's alpha for Info. Richness *only first two items
## $sample.size
## [1] 51
##
## $number.of.items
## [1] 2
##
## $alpha
## [1] 0.8676553
cronbach(InfoRichness2) # Cronbach's alpha for Info. Richness *only first two items
## $sample.size
## [1] 51
##
## $number.of.items
## [1] 2
##
## $alpha
## [1] 0.844254
SocialPresence1<-(na.omit(Pretest3$X33sp)+na.omit(Pretest3$X35sp)+na.omit(Pretest3$X37sp))/3
SocialPresence2<-(na.omit(Pretest3$X34sp)+na.omit(Pretest3$X36sp)+na.omit(Pretest3$X38sp))/3
score<-as.data.frame(rbind(cbind(SocialPresence1,"1"),cbind(SocialPresence2,"2")))
leveneTest(as.numeric(score$SocialPresence1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.2824 0.5964
## 90
t.test(SocialPresence1,SocialPresence2,paired=T,var.equal=T) # Means comparison - Social Presence
##
## Paired t-test
##
## data: SocialPresence1 and SocialPresence2
## t = 3.2287, df = 45, p-value = 0.002324
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.4279769 1.8473855
## sample estimates:
## mean of the differences
## 1.137681
sd(SocialPresence1)
## [1] 2.535163
sd(SocialPresence2)
## [1] 2.457158
mean(SocialPresence1)
## [1] 4.869565
mean(SocialPresence2)
## [1] 3.731884
InfoRichness1<-(na.omit(Pretest3$X31i)+na.omit(Pretest3$X33i))/2
InfoRichness2<-(na.omit(Pretest3$X32i)+na.omit(Pretest3$X34i))/2
score<-as.data.frame(rbind(cbind(InfoRichness1,"1"),cbind(InfoRichness2,"2")))
leveneTest(as.numeric(score$InfoRichness1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.0044 0.9471
## 100
t.test(InfoRichness1,InfoRichness2,paired=T,var.equal=T) # Means comparison - Information Richness
##
## Paired t-test
##
## data: InfoRichness1 and InfoRichness2
## t = 5.9025, df = 50, p-value = 3.102e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.675145 3.403287
## sample estimates:
## mean of the differences
## 2.539216
sd(InfoRichness1)
## [1] 2.50873
sd(InfoRichness2)
## [1] 2.323452
mean(InfoRichness1)
## [1] 6.078431
mean(InfoRichness2)
## [1] 3.539216
TieStrength1<-cbind(na.omit(Pretest2$X15),na.omit(Pretest2$X17),na.omit(Pretest2$X19))
SocialPresence2<-cbind(na.omit(Pretest3$X34sp),na.omit(Pretest3$X36sp),na.omit(Pretest3$X38sp)) # Getting Low Social Presence Items
InfoRichness2<-cbind(na.omit(Pretest3$X32i),na.omit(Pretest3$X34i)) # Getting Low Info. Richness Items *only first two items
str(TieStrength1)
## int [1:55, 1:3] 1 1 1 1 6 1 4 5 4 7 ...
str(SocialPresence2)
## int [1:46, 1:3] 8 8 6 5 2 8 10 3 5 8 ...
str(InfoRichness2)
## int [1:51, 1:2] 3 6 1 1 4 4 1 4 5 5 ...
index<-(1:46)
TieStrength1<-TieStrength1[index,]
InfoRichness2<-InfoRichness2[index,]
cronbach(TieStrength1)
## $sample.size
## [1] 46
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8722783
cronbach(SocialPresence2)
## $sample.size
## [1] 46
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.8769481
cronbach(InfoRichness2)
## $sample.size
## [1] 46
##
## $number.of.items
## [1] 2
##
## $alpha
## [1] 0.827958
validity<-data.frame(cbind(TieStrength1[,1],TieStrength1[,2],TieStrength1[,3],SocialPresence2[,1],SocialPresence2[,2],SocialPresence2[,3],InfoRichness2[,1],InfoRichness2[,2]))
factanal(validity,3,rotation="varimax")
##
## Call:
## factanal(x = validity, factors = 3, rotation = "varimax")
##
## Uniquenesses:
## X1 X2 X3 X4 X5 X6 X7 X8
## 0.436 0.054 0.263 0.414 0.010 0.364 0.454 0.005
##
## Loadings:
## Factor1 Factor2 Factor3
## X1 0.716 0.203
## X2 0.970
## X3 0.857
## X4 0.756
## X5 0.994
## X6 -0.158 0.779
## X7 0.164 0.715
## X8 0.997
##
## Factor1 Factor2 Factor3
## SS loadings 2.227 2.206 1.566
## Proportion Var 0.278 0.276 0.196
## Cumulative Var 0.278 0.554 0.750
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 5.72 on 7 degrees of freedom.
## The p-value is 0.573
KMO(validity)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = validity)
## Overall MSA = 0.6
## MSA for each item =
## X1 X2 X3 X4 X5 X6 X7 X8
## 0.76 0.61 0.65 0.66 0.55 0.71 0.43 0.40
summary(prcomp(validity))
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 4.3410 3.4375 3.1449 1.67632 1.5157 1.18092 1.01475
## Proportion of Variance 0.3872 0.2428 0.2032 0.05774 0.0472 0.02865 0.02116
## Cumulative Proportion 0.3872 0.6300 0.8332 0.89093 0.9381 0.96679 0.98794
## PC8
## Standard deviation 0.76599
## Proportion of Variance 0.01206
## Cumulative Proportion 1.00000
screeplot(prcomp(validity),type="lines")
biplot(prcomp(validity,scale.=T),cex=0.5,xlabs=rep(".",nrow(validity)))
rcorr(as.matrix(validity))
## X1 X2 X3 X4 X5 X6 X7 X8
## X1 1.00 0.68 0.60 -0.05 -0.08 -0.15 0.19 0.18
## X2 0.68 1.00 0.83 0.10 0.06 -0.13 0.04 -0.08
## X3 0.60 0.83 1.00 0.09 0.03 -0.12 0.09 -0.08
## X4 -0.05 0.10 0.09 1.00 0.75 0.61 0.09 0.08
## X5 -0.08 0.06 0.03 0.75 1.00 0.77 0.18 -0.01
## X6 -0.15 -0.13 -0.12 0.61 0.77 1.00 0.12 0.05
## X7 0.19 0.04 0.09 0.09 0.18 0.12 1.00 0.71
## X8 0.18 -0.08 -0.08 0.08 -0.01 0.05 0.71 1.00
##
## n= 46
##
##
## P
## X1 X2 X3 X4 X5 X6 X7 X8
## X1 0.0000 0.0000 0.7546 0.6050 0.3306 0.1947 0.2192
## X2 0.0000 0.0000 0.5080 0.6776 0.3985 0.7747 0.6141
## X3 0.0000 0.0000 0.5476 0.8606 0.4164 0.5709 0.6018
## X4 0.7546 0.5080 0.5476 0.0000 0.0000 0.5492 0.6188
## X5 0.6050 0.6776 0.8606 0.0000 0.0000 0.2347 0.9477
## X6 0.3306 0.3985 0.4164 0.0000 0.0000 0.4329 0.7218
## X7 0.1947 0.7747 0.5709 0.5492 0.2347 0.4329 0.0000
## X8 0.2192 0.6141 0.6018 0.6188 0.9477 0.7218 0.0000
CredHigh<-read.csv("Pilot/Pilot_Credence__High_Info_Richness.csv", skip=2, header=F) # reads six files and creates six data frames
CredLow<-read.csv("Pilot/Pilot_Credence__Low_Info_Richness.csv", skip=2, header=F)
ExpHigh<-read.csv("Pilot/Pilot_Experience__High_Social_Presence.csv", skip=2, header=F)
ExpLow<-read.csv("Pilot/Pilot_Experience__Low_Social_Presence.csv", skip=2, header=F)
SrchStrong<-read.csv("Pilot/Pilot_Search__Strong_Ties.csv", skip=2, header=F)
SrchWeak<-read.csv("Pilot/Pilot_Search__Weak_Ties.csv", skip=2, header=F)
TreatmentGroup1<-na.omit(CredHigh[,52:55])
TreatmentGroup2<-na.omit(CredLow[52:55])
TreatmentGroup3<-na.omit(ExpHigh[52:55])
TreatmentGroup4<-na.omit(ExpLow[52:55])
TreatmentGroup5<-na.omit(SrchStrong[52:55])
TreatmentGroup6<-na.omit(SrchWeak[52:55])
TreatmentGroup1$Quality<-(TreatmentGroup1$V52+TreatmentGroup1$V53+TreatmentGroup1$V54+TreatmentGroup1$V55)/4
TreatmentGroup2$Quality<-(TreatmentGroup2$V52+TreatmentGroup2$V53+TreatmentGroup2$V54+TreatmentGroup2$V55)/4
TreatmentGroup3$Quality<-(TreatmentGroup3$V52+TreatmentGroup3$V53+TreatmentGroup3$V54+TreatmentGroup3$V55)/4
TreatmentGroup4$Quality<-(TreatmentGroup4$V52+TreatmentGroup4$V53+TreatmentGroup4$V54+TreatmentGroup4$V55)/4
TreatmentGroup5$Quality<-(TreatmentGroup5$V52+TreatmentGroup5$V53+TreatmentGroup5$V54+TreatmentGroup5$V55)/4
TreatmentGroup6$Quality<-(TreatmentGroup6$V52+TreatmentGroup6$V53+TreatmentGroup6$V54+TreatmentGroup6$V55)/4
score<-as.data.frame(rbind(cbind(TreatmentGroup5$Quality,"1"),cbind(TreatmentGroup6$Quality,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.3904 0.5422
## 14
t.test(TreatmentGroup5$Quality,TreatmentGroup6$Quality,paired=F,var.equal=T)
##
## Two Sample t-test
##
## data: TreatmentGroup5$Quality and TreatmentGroup6$Quality
## t = -0.6085, df = 14, p-value = 0.5526
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.7595657 0.9817879
## sample estimates:
## mean of x mean of y
## 4.611111 5.000000
sd(TreatmentGroup5$Quality)
## [1] 1.381299
sd(TreatmentGroup6$Quality)
## [1] 1.099242
## Inconclusive results p > .1 not supporting H1a
score<-as.data.frame(rbind(cbind(TreatmentGroup3$Quality,"1"),cbind(TreatmentGroup4$Quality,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.0033 0.9551
## 13
t.test(TreatmentGroup3$Quality,TreatmentGroup4$Quality,paired=F,var.equal=T)
##
## Two Sample t-test
##
## data: TreatmentGroup3$Quality and TreatmentGroup4$Quality
## t = 1.5038, df = 13, p-value = 0.1565
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.541908 3.024051
## sample estimates:
## mean of x mean of y
## 5.562500 4.321429
sd(TreatmentGroup3$Quality)
## [1] 1.741049
sd(TreatmentGroup4$Quality)
## [1] 1.404711
## Significant difference p < .1 partially supporting H2a
score<-as.data.frame(rbind(cbind(TreatmentGroup1$Quality,"1"),cbind(TreatmentGroup2$Quality,"2")))
leveneTest(as.numeric(score$V1)~score$V2,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.2506 0.6231
## 17
t.test(TreatmentGroup1$Quality,TreatmentGroup2$Quality,paired=F,var.equal=T)
##
## Two Sample t-test
##
## data: TreatmentGroup1$Quality and TreatmentGroup2$Quality
## t = 2.0572, df = 17, p-value = 0.05534
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.01960839 1.55369930
## sample estimates:
## mean of x mean of y
## 5.704545 4.937500
sd(TreatmentGroup5$Quality)
## [1] 1.381299
sd(TreatmentGroup6$Quality)
## [1] 1.099242
## Significant difference p < .05 supporting H3a
CredHigh$Type<-"CredHigh" # Adds a column with the type
CredLow$Type<-"CredLow"
ExpHigh$Type<-"ExpHigh"
ExpLow$Type<-"ExpLow"
SrchStrong$Type<-"SrchStrong"
SrchWeak$Type<-"SrchWeak"
Pilot<-rbind(CredHigh,CredLow,ExpHigh,ExpLow,SrchStrong,SrchWeak) # merges data frames
NamesandHeaders<-read.csv("Pilot/Pilot_Credence__High_Info_Richness.csv") # assigns headers and names to data frame
names(Pilot)<-names(NamesandHeaders)
colnames(Pilot)[82]<-"Type"
Pilot$Type <- as.factor(Pilot$Type) # declares column "Type" as a factor
# Adds a column with the total time
Pilot$TotalTime<-Pilot$T0_3+Pilot$T1_3+Pilot$Stimuli_3+Pilot$T2_3+Pilot$T3_3+Pilot$T4_3+Pilot$T5_3+Pilot$T6_3
shapiro.test(Pilot$TotalTime) # normality test
##
## Shapiro-Wilk normality test
##
## data: Pilot$TotalTime
## W = 0.7637, p-value = 4.148e-07
leveneTest(TotalTime~Type,data=Pilot,center=mean) # tests homegeneity of variance - total time
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 5 1.6514 0.1694
## 39
leveneTest(TotalTime~Type,data=Pilot,center=median)
## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 5 0.8647 0.5134
## 39
boxplot(Pilot$TotalTime~Pilot$Type,log="y") # however, a box plot shows similarities in a log-scale
TotalTime.lda<-lda(Type~TotalTime,data=Pilot)
points(TotalTime.lda$means,col="black",pch=19)
gao_cs(TotalTime~Type,data=Pilot,alpha=0.05,silent=T) # multiple nonparametric test - total time
## $Info
## Order Sample Size Effect Variance
## 1 1 CredLow 8 0.4166667 0.03735450
## 2 2 SrchStrong 8 0.4555556 0.08902998
## 3 3 ExpHigh 8 0.4722222 0.11199295
## 4 4 SrchWeak 7 0.4904762 0.09330982
## 5 5 ExpLow 6 0.5222222 0.10311111
## 6 6 CredHigh 8 0.6472222 0.10708113
##
## $Single.Analysis
## Comp Effect Statistic DF P.RAW p.BONF p.HOLM
## 1 CredHigh-CredLow 0.2306 1.7159 11.3540 0.1133 1 1
## 2 ExpLow-CredLow 0.1056 0.7140 7.6811 0.4963 1 1
## 3 CredHigh-SrchStrong 0.1917 1.2242 13.8824 0.2413 1 1
## 4 SrchWeak-CredLow 0.0738 0.5502 9.8986 0.5944 1 1
## 5 ExpLow-SrchStrong 0.0667 0.3962 10.4441 0.6999 1 1
## 6 CredHigh-ExpHigh 0.1750 1.0575 13.9930 0.3082 1 1
## 7 ExpHigh-CredLow 0.0556 0.4066 11.2021 0.6920 1 1
## 8 SrchWeak-SrchStrong 0.0349 0.2233 12.6456 0.8269 1 1
## 9 ExpLow-ExpHigh 0.0500 0.2831 11.1697 0.7822 1 1
## 10 CredHigh-SrchWeak 0.1567 0.9590 12.9271 0.3552 1 1
## 11 SrchStrong-CredLow 0.0389 0.3094 11.9947 0.7623 1 1
## 12 ExpHigh-SrchStrong 0.0167 0.1051 13.8197 0.9178 1 1
## 13 SrchWeak-ExpHigh 0.0183 0.1104 12.9641 0.9138 1 1
## 14 ExpLow-SrchWeak 0.0317 0.1817 10.5003 0.8593 1 1
## 15 CredHigh-ExpLow 0.1250 0.7149 11.0387 0.4895 1 1
##
## $CS.Analysis
## Comp Effect Statistic DF Quantiles Adj.P Alpha
## 1 CredHigh-CredLow 0.2306 2.4266 11.3540 4.7956 0.5484 0.0500
## 2 ExpLow-CredLow 0.1115 0.9827 7.8203 4.7956 0.9519 0.0500
## 3 CredHigh-SrchStrong 0.1824 1.7247 13.7389 4.418 0.7408 0.0500
## 4 SrchWeak-CredLow 0.0351 0.3406 11.3593 4.418 0.9948 0.0336
## 5 ExpLow-SrchStrong 0.0632 0.5396 10.3092 4.418 0.9801 0.0336
## 6 CredHigh-ExpHigh 0.1724 1.5597 13.9993 4.4144 0.6936 0.0336
## 7 ExpHigh-CredLow 0.0365 0.3454 12.0507 4.3118 0.9677 0.0253
## 8 SrchWeak-SrchStrong 0.0637 0.5876 12.5592 4.2828 0.9099 0.0253
## 9 ExpLow-ExpHigh 0.0536 0.4454 11.0905 4.2828 0.947 0.0253
## 10 CredHigh-SrchWeak 0.1556 1.3793 12.9135 4.264 0.6046 0.0253
## 11 SrchStrong-CredLow 0.0312 0.2874 12.7100 3.8814 0.8422 0.0170
## 12 ExpHigh-SrchStrong 0.0469 0.4319 13.8064 3.8363 0.7646 0.0170
## 13 SrchWeak-ExpHigh 0.0357 0.3182 12.9716 3.8363 0.8255 0.0170
## 14 ExpLow-SrchWeak 0.0000 0.0000 10.7238 3.8363 1 0.0170
## 15 CredHigh-ExpLow 0.1875 1.7367 11.9782 3.8363 0.243 0.0170
## Rejected Layer
## 1 FALSE 1
## 2 FALSE 2
## 3 FALSE 2
## 4 FALSE 3
## 5 FALSE 3
## 6 FALSE 3
## 7 FALSE 4
## 8 FALSE 4
## 9 FALSE 4
## 10 FALSE 4
## 11 FALSE 5
## 12 FALSE 5
## 13 FALSE 5
## 14 FALSE 5
## 15 FALSE 5
pairwise.wilcox.test(Pilot$TotalTime,Pilot$Type,paired=F) # multiple nonparametric test - total time
##
## Pairwise comparisons using Wilcoxon rank sum test
##
## data: Pilot$TotalTime and Pilot$Type
##
## CredHigh CredLow ExpHigh ExpLow SrchStrong
## CredLow 1 - - - -
## ExpHigh 1 1 - - -
## ExpLow 1 1 1 - -
## SrchStrong 1 1 1 1 -
## SrchWeak 1 1 1 1 1
##
## P value adjustment method: holm
boxplot(Pilot$Stimuli_3~Pilot$Type,log="y") # box plot for stimuli time
Stimuli_3.lda<-lda(Type~Stimuli_3,data=Pilot)
points(Stimuli_3.lda$means,col="black",pch=19)
gao_cs(Stimuli_3~Type,data=Pilot,alpha=0.05,silent=T) # multiple nonparametric test - stimuli time
## $Info
## Order Sample Size Effect Variance
## 1 1 SrchStrong 10 0.4326923 0.08431953
## 2 2 CredLow 8 0.4447115 0.08146001
## 3 3 ExpHigh 9 0.4455128 0.03698225
## 4 4 ExpLow 9 0.5224359 0.10946746
## 5 5 CredHigh 8 0.5721154 0.16459742
## 6 6 SrchWeak 8 0.6033654 0.06439534
##
## $Single.Analysis
## Comp Effect Statistic DF P.RAW p.BONF p.HOLM
## 1 SrchWeak-SrchStrong 0.1707 1.3294 15.8333 0.2025 1 1
## 2 CredHigh-SrchStrong 0.1394 0.8186 12.3057 0.4286 1 1
## 3 SrchWeak-CredLow 0.1587 1.1750 13.8110 0.2599 1 1
## 4 ExpLow-SrchStrong 0.0897 0.6253 16.0712 0.5405 1 1
## 5 CredHigh-CredLow 0.1274 0.7265 12.5655 0.4809 1 1
## 6 SrchWeak-ExpHigh 0.1579 1.4316 13.0055 0.1759 1 1
## 7 ExpHigh-SrchStrong 0.0128 0.1145 15.7116 0.9103 1 1
## 8 ExpLow-CredLow 0.0777 0.5200 14.9927 0.6107 1 1
## 9 CredHigh-ExpHigh 0.1266 0.8058 9.7355 0.4396 1 1
## 10 SrchWeak-ExpLow 0.0809 0.5692 14.7230 0.5778 1 1
## 11 CredLow-SrchStrong 0.0120 0.0881 15.2564 0.9309 1 1
## 12 ExpHigh-CredLow 0.0008 0.0067 12.0698 0.9948 1 1
## 13 ExpLow-ExpHigh 0.0769 0.6030 12.8517 0.5570 1 1
## 14 CredHigh-ExpLow 0.0497 0.2746 13.5723 0.7878 1 1
## 15 SrchWeak-CredHigh 0.0312 0.1847 11.7502 0.8566 1 1
##
## $CS.Analysis
## Comp Effect Statistic DF Quantiles Adj.P Alpha
## 1 SrchWeak-SrchStrong 0.1707 1.8801 15.8333 4.5628 0.7653 0.0500
## 2 CredHigh-SrchStrong 0.1335 1.1183 12.3914 4.4851 0.9286 0.0500
## 3 SrchWeak-CredLow 0.1458 1.5317 13.8617 4.4126 0.8121 0.0500
## 4 ExpLow-SrchStrong 0.0673 0.6044 16.0608 4.3338 0.9729 0.0336
## 5 CredHigh-CredLow 0.1140 0.9319 12.4038 4.3338 0.9104 0.0336
## 6 SrchWeak-ExpHigh 0.1536 1.9528 13.3974 4.3338 0.5314 0.0336
## 7 ExpHigh-SrchStrong 0.0078 0.0846 15.4205 4.1586 0.998 0.0253
## 8 ExpLow-CredLow 0.0561 0.4741 14.9983 4.1586 0.9402 0.0253
## 9 CredHigh-ExpHigh 0.0887 0.8134 9.9560 4.1586 0.8361 0.0253
## 10 SrchWeak-ExpLow 0.0472 0.5373 14.9974 4.1586 0.9239 0.0253
## 11 CredLow-SrchStrong 0.0250 0.2445 15.2558 3.7877 0.865 0.0170
## 12 ExpHigh-CredLow 0.0278 0.2577 12.0913 3.7877 0.8584 0.0170
## 13 ExpLow-ExpHigh 0.0062 0.0606 12.8469 3.7877 0.9665 0.0170
## 14 CredHigh-ExpLow 0.0139 0.1280 11.2802 3.7877 0.9295 0.0170
## 15 SrchWeak-CredHigh 0.0156 0.1435 12.1639 3.7877 0.9208 0.0170
## Rejected Layer
## 1 FALSE 1
## 2 FALSE 2
## 3 FALSE 2
## 4 FALSE 3
## 5 FALSE 3
## 6 FALSE 3
## 7 FALSE 4
## 8 FALSE 4
## 9 FALSE 4
## 10 FALSE 4
## 11 FALSE 5
## 12 FALSE 5
## 13 FALSE 5
## 14 FALSE 5
## 15 FALSE 5
pairwise.wilcox.test(Pilot$Stimuli_3,Pilot$Type,paired=F) # multiple nonparametric test - stimuli time
##
## Pairwise comparisons using Wilcoxon rank sum test
##
## data: Pilot$Stimuli_3 and Pilot$Type
##
## CredHigh CredLow ExpHigh ExpLow SrchStrong
## CredLow 1 - - - -
## ExpHigh 1 1 - - -
## ExpLow 1 1 1 - -
## SrchStrong 1 1 1 1 -
## SrchWeak 1 1 1 1 1
##
## P value adjustment method: holm
write.csv(Pilot, file="Pilot/Pilot.csv")
TotalTime<-(na.omit(Pilot$T6_3)) # total time analysis
TotalTime<-quantile(na.omit(Pilot$TotalTime), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
TotalTime
## 10% 15% 20% 50% 80% 85% 90%
## 157.5484 174.6892 179.3540 262.8470 445.8482 480.0902 660.0762
mean(na.omit(Pilot$TotalTime))
## [1] 340.1876
median(na.omit(Pilot$TotalTime))
## [1] 262.847
windowsFonts(A=windowsFont("Garamond"))
hist(TotalTime,family="A")
Comparison<-na.omit(Pilot$TotalTime)
Comparison1<-subset(Comparison,Comparison<158)
Comparison2<-subset(Comparison,Comparison>158&Comparison<446)
t.test(Comparison1,Comparison2)
##
## Welch Two Sample t-test
##
## data: Comparison1 and Comparison2
## t = -8.4959, df = 33.81, p-value = 6.661e-10
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -152.25532 -93.46583
## sample estimates:
## mean of x mean of y
## 139.2242 262.0848
wilcox.test(Comparison1,Comparison2)
##
## Wilcoxon rank sum test
##
## data: Comparison1 and Comparison2
## W = 0, p-value = 5.305e-06
## alternative hypothesis: true location shift is not equal to 0
Instr<-(na.omit(Pilot$T0_3)) # instructions block
Instr<-quantile(na.omit(Pilot$T0_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockA<-(na.omit(Pilot$T1_3)) # previous experience block - binary items
BlockA<-quantile(na.omit(Pilot$T1_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockB1<-(na.omit(Pilot$Stimuli_3)) # stimuli
BlockB1<-quantile(na.omit(Pilot$Stimuli_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockB2<-(na.omit(Pilot$T2_3)) # stimuli check
BlockB2<-quantile(na.omit(Pilot$T2_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockC<-(na.omit(Pilot$T3_3)) # controls
BlockC<-quantile(na.omit(Pilot$T3_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockD<-(na.omit(Pilot$T4_3)) # perceived quality - Likert scales items
BlockD<-quantile(na.omit(Pilot$T4_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockE<-(na.omit(Pilot$T5_3)) # perceived quality - Likert scales items
BlockE<-quantile(na.omit(Pilot$T5_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
BlockF<-(na.omit(Pilot$T6_3)) # demographics
BlockF<-quantile(na.omit(Pilot$T6_3), probs=c(0.10,0.15,0.20,0.50,0.80,0.85,0.90))
TimeTable<-rbind(TotalTime,Instr,BlockA,BlockB1,BlockB2,BlockC,BlockD,BlockE,BlockF)
TimeTable # Times of pilot study by block
## 10% 15% 20% 50% 80% 85% 90%
## TotalTime 157.5484 174.68920 179.3540 262.8470 445.8482 480.09020 660.0762
## Instr 3.8550 4.77100 6.4360 14.4130 34.5180 47.39875 89.6880
## BlockA 19.7440 22.14640 24.4494 33.0390 53.9866 59.45200 67.3800
## BlockB1 16.2027 22.09600 24.0842 37.4275 98.0652 114.84800 164.4059
## BlockB2 9.4806 10.39380 11.7858 18.9820 33.0770 43.06580 52.0820
## BlockC 17.2490 19.00200 19.8210 26.6240 40.6592 46.52760 49.5296
## BlockD 18.4511 21.54070 22.9198 34.1660 56.6454 64.61020 93.2817
## BlockE 17.9823 20.44955 21.4264 32.6900 58.0060 60.98540 72.4055
## BlockF 13.5543 14.82355 16.0764 26.6390 37.6654 43.32750 55.7354
Rates<-rbind(Binaries=BlockA/5,Scales=(BlockD+BlockE)/7,Demographics=BlockF/5)
Rates # Time rates by item type
## 10% 15% 20% 50% 80% 85%
## Binaries 3.948800 4.429280 4.889880 6.607800 10.79732 11.89040
## Scales 5.204771 5.998607 6.335171 9.550857 16.37877 17.94223
## Demographics 2.710860 2.964710 3.215280 5.327800 7.53308 8.66550
## 90%
## Binaries 13.47600
## Scales 23.66960
## Demographics 11.14708
TotalTimeIR<-Rates[1,]*5+Rates[2,]*30+Rates[3,]*8 # Expected time for the final questionnaire - Information Richness
TotalTimeSP<-Rates[1,]*5+Rates[2,]*34+Rates[3,]*8 # Expected time for the final questionnaire - Social Presence
TotalTimeTS<-Rates[1,]*5+Rates[2,]*32+Rates[3,]*8 # Expected time for the final questionnaire - Tie Strength
AvgTotalTime<-(TotalTimeIR+TotalTimeSP+TotalTimeTS)/3
ExpectedTimesFinal<-rbind(TotalTimeIR,TotalTimeSP,TotalTimeTS,AvgTotalTime)
ExpectedTimesFinal # Expected total time by questionnaire type, the avg. time is equal to time in Tie Strength
## 10% 15% 20% 50% 80% 85%
## TotalTimeIR 197.5740 225.8223 240.2268 362.1871 605.6144 667.0429
## TotalTimeSP 218.3931 249.8167 265.5675 400.3905 671.1295 738.8118
## TotalTimeTS 207.9836 237.8195 252.8971 381.2888 638.3719 702.9273
## AvgTotalTime 207.9836 237.8195 252.8971 381.2888 638.3719 702.9273
## 90%
## TotalTimeIR 866.6446
## TotalTimeSP 961.3230
## TotalTimeTS 913.9838
## AvgTotalTime 913.9838
ThresholdIR1<-Rates[1,]*4+Rates[2,]*21 # Expected time after stimuli validation - Information Richness
ThresholdIR2<-Rates[1,]*5+Rates[2,]*21 # Expected time after stimuli validation - Information Richness
ThresholdIR3<-Rates[1,]*5+Rates[2,]*32 # Expected time after stimuli validation - Information Richness
ThresholdSP1<-Rates[1,]*4+Rates[2,]*27 # Expected time after stimuli validation - Social Presence
ThresholdSP2<-Rates[1,]*5+Rates[2,]*27 # Expected time after stimuli validation - Social Presence
ThresholdSP3<-Rates[1,]*5+Rates[2,]*38 # Expected time after stimuli validation - Social Presence
ThresholdTS1<-Rates[1,]*4+Rates[2,]*24 # Expected time after stimuli validation - Tie Strength
ThresholdTS2<-Rates[1,]*5+Rates[2,]*24 # Expected time after stimuli validation - Tie Strength
ThresholdTS3<-Rates[1,]*5+Rates[2,]*35 # Expected time after stimuli validation - Tie Strength
ExpectedTimesThreshold<-rbind(ThresholdIR1,ThresholdIR2,ThresholdIR3,ThresholdSP1,ThresholdSP2,ThresholdSP3,ThresholdTS1,ThresholdTS2,ThresholdTS3)
ExpectedTimesThreshold # Expected accumulated time after stimuli validation by questionnaire type, the avg. time is equal to time in Tie Strength
## 10% 15% 20% 50% 80% 85%
## ThresholdIR1 125.0954 143.6879 152.5981 226.9992 387.1435 424.3484
## ThresholdIR2 129.0442 148.1172 157.4880 233.6070 397.9408 436.2388
## ThresholdIR3 186.2967 214.1018 227.1749 338.6664 578.1073 633.6033
## ThresholdSP1 156.3240 179.6795 190.6091 284.3043 485.4161 532.0018
## ThresholdSP2 160.2728 184.1088 195.4990 290.9121 496.2134 543.8922
## ThresholdSP3 217.5253 250.0935 265.1859 395.9716 676.3799 741.2567
## ThresholdTS1 140.7097 161.6837 171.6036 255.6518 436.2798 478.1751
## ThresholdTS2 144.6585 166.1130 176.4935 262.2596 447.0771 490.0655
## ThresholdTS3 201.9110 232.0977 246.1804 367.3190 627.2436 687.4300
## 90%
## ThresholdIR1 550.9656
## ThresholdIR2 564.4416
## ThresholdIR3 824.8072
## ThresholdSP1 692.9832
## ThresholdSP2 706.4592
## ThresholdSP3 966.8248
## ThresholdTS1 621.9744
## ThresholdTS2 635.4504
## ThresholdTS3 895.8160
MainStudyGeneral<-read.csv("Main_Study/MainStudyValidatedwithLocations559.csv", header=T) # Reads the previous file but it contains two new variables "State" and "City"
NamesandHeaders<-read.csv("Main_Study/MainStudyValidatedwithLocations559.csv") # assigns headers and names to data frame
names(MainStudyGeneral)<-names(NamesandHeaders)
summary(MainStudyGeneral$State)
## Alabama Alaska Arizona Arkansas California
## 10 1 17 3 58
## Colorado Connecticut Florida Georgia Hawaii
## 7 6 30 21 1
## Idaho Illinois Indiana Iowa Kansas
## 2 32 9 5 9
## Kentucky Louisiana Maine Maryland Massachusetts
## 11 12 2 10 16
## Michigan Minnesota Mississippi Missouri Nebraska
## 22 10 3 9 4
## Nevada New Hampshire New Jersey New Mexico New York
## 2 4 23 3 33
## North Carolina Ohio Oklahoma Oregon Pennsylvania
## 15 24 1 6 18
## Rhode Island South Carolina Tennessee Texas Unspecified
## 3 4 16 44 7
## Utah Vermont Virginia Washington West Virginia
## 4 1 17 14 3
## Wisconsin
## 7
summary(MainStudyGeneral$City)
## Glendale New York Unspecified Englewood
## 7 7 7 6
## Fort Worth Jacksonville Long Beach Towanda
## 6 6 6 6
## Athens Atlanta Chicago Dallas
## 5 5 5 5
## Smyrna Camden Evanston Nashville
## 5 4 4 4
## New Brunswick Peoria Vancouver Alexandria
## 4 4 4 3
## Brentwood Buffalo Carrollton Chandler
## 3 3 3 3
## Chesapeake Colorado Springs Dayton Denham Springs
## 3 3 3 3
## Frederick Freeport Greenville Houston
## 3 3 3 3
## Maple Grove Minneapolis Mobile Naperville
## 3 3 3 3
## Palo Alto Phoenix Portsmouth Richmond
## 3 3 3 3
## Riverside Roanoke San Antonio Santa Ana
## 3 3 3 3
## Sun Valley Tampa Worcester Arlington
## 3 3 3 2
## Austin Bartlett Baton Rouge Bay City
## 2 2 2 2
## Beaumont Beaverton Belleville Canton
## 2 2 2 2
## Cedar Rapids Chalmette Charlotte Clayton
## 2 2 2 2
## Clearwater Cleveland Columbus Coral Springs
## 2 2 2 2
## Denver Derry Everett Fall River
## 2 2 2 2
## Greensboro Harrisburg Hartford Haverhill
## 2 2 2 2
## Hinesville Irving Jackson Kent
## 2 2 2 2
## Lancaster Lexington Los Angeles Lubbock
## 2 2 2 2
## Massena Miami New Rochelle Northampton
## 2 2 2 2
## Oak Harbor Oak Park Oakland Ogden
## 2 2 2 2
## Orlando Papillion Poway Redding
## 2 2 2 2
## Richardson San Diego San Francisco Santa Monica
## 2 2 2 2
## Seattle South Orange Spring (Other)
## 2 2 2 271
Demographics<-cbind(MainStudyGeneral[32:36],MainStudyGeneral[64])
Demographics$AgeRange<-ifelse(Demographics$Age<21,1,ifelse(Demographics$Age>50,5,ifelse(Demographics$Age>20&Demographics$Age<29,2,ifelse(Demographics$Age>28&Demographics$Age<35,3,4))))
Demographics$IncomeRange<-ifelse(Demographics$Income<3,1,ifelse(Demographics$Income>7,5,ifelse(Demographics$Income>2&Demographics$Income<5,2,ifelse(Demographics$Income>4&Demographics$Income<7,3,4))))
Demographics$EducationRange<-ifelse(Demographics$Education<8,1,ifelse(Demographics$Education>12,5,ifelse(Demographics$Education==8,2,ifelse(Demographics$Education==12,4,3))))
nrow(Demographics)
## [1] 559
ftable(Demographics$AgeRange)
## 1 2 3 4 5
##
## 41 219 111 160 28
ftable(Demographics$AgeRange)/nrow(Demographics)
## 1 2 3 4 5
##
## 0.07334526 0.39177102 0.19856887 0.28622540 0.05008945
summary(Demographics$Age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 24.00 30.00 31.82 37.00 67.00
sd(Demographics$Age)
## [1] 9.799798
ftable(Demographics$Gender)
## Female Male
##
## 284 275
ftable(Demographics$Gender)/nrow(Demographics)
## Female Male
##
## 0.5080501 0.4919499
ftable(Demographics$IncomeRange)
## 1 2 3 4 5
##
## 124 171 170 68 26
ftable(Demographics$IncomeRange)/nrow(Demographics)
## 1 2 3 4 5
##
## 0.22182469 0.30590340 0.30411449 0.12164580 0.04651163
ftable(Demographics$Income)/nrow(Demographics)
## 1 2 3 4 5 6 7 8 9
##
## 0.10375671 0.11806798 0.11449016 0.19141324 0.18604651 0.11806798 0.12164580 0.03220036 0.01431127
ftable(Demographics$EducationRange)
## 1 2 3 4 5
##
## 6 62 240 174 77
ftable(Demographics$EducationRange)/nrow(Demographics)
## 1 2 3 4 5
##
## 0.01073345 0.11091234 0.42933810 0.31127013 0.13774597
ftable(Demographics$Education)/nrow(Demographics)
## 5 6 7 8 9 10 11 12 13 14 15
##
## 0.001788909 0.001788909 0.007155635 0.110912343 0.311270125 0.055456172 0.062611807 0.311270125 0.109123435 0.016100179 0.012522361
ftable(Demographics$RE)
## African American / Black Asian American Caucasian / White Hispanic / Latino Native American Other
##
## 64 39 402 41 3 10
ftable(Demographics$RE)/nrow(Demographics)
## African American / Black Asian American Caucasian / White Hispanic / Latino Native American Other
##
## 0.114490161 0.069767442 0.719141324 0.073345259 0.005366726 0.017889088
map(database="world",ylim=c(36,40),xlim=c(-99,-95),col="white",fill=TRUE,projection="gilbert",orientation= c(90,0,225))
lon<-MainStudyGeneral$LocationLongitude
lat<-MainStudyGeneral$LocationLatitude
coord<-mapproject(lon,lat,proj="gilbert",orientation=c(90,0,225))
points(coord,pch=20,cex=0.8,col="black")
nrow(MainStudyGeneral)
## [1] 559
MainStudySearch<-subset(MainStudyGeneral,MainStudyGeneral$Group==7|MainStudyGeneral$Group==9)
MainStudySearch<-MainStudySearch[which(MainStudySearch$copyt8_3==0&MainStudySearch$t12_3>0&nchar(MainStudySearch$WhyQ)+nchar(MainStudySearch$WhyP)+nchar(MainStudySearch$WhyW)==6),]
Demographics<-cbind(MainStudySearch[32:36],MainStudySearch[16])
Demographics$AgeRange<-ifelse(Demographics$Age<21,1,ifelse(Demographics$Age>50,5,ifelse(Demographics$Age>20&Demographics$Age<29,2,ifelse(Demographics$Age>28&Demographics$Age<35,3,4))))
Demographics$IncomeRange<-ifelse(Demographics$Income<3,1,ifelse(Demographics$Income>7,5,ifelse(Demographics$Income>2&Demographics$Income<5,2,ifelse(Demographics$Income>4&Demographics$Income<7,3,4))))
Demographics$EducationRange<-ifelse(Demographics$Education<8,1,ifelse(Demographics$Education>12,5,ifelse(Demographics$Education==8,2,ifelse(Demographics$Education==12,4,3))))
nrow(Demographics)
## [1] 213
ftable(Demographics$AgeRange~Demographics$SMP)
## Demographics$AgeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 8 38 23 35 6
## Twitter 12 39 14 30 8
## YouTube 0 0 0 0 0
ftable(Demographics$Gender~Demographics$SMP)
## Demographics$Gender Female Male
## Demographics$SMP
## Facebook 62 48
## Twitter 51 52
## YouTube 0 0
ftable(Demographics$IncomeRange~Demographics$SMP)
## Demographics$IncomeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 23 36 36 11 4
## Twitter 25 29 23 18 8
## YouTube 0 0 0 0 0
ftable(Demographics$EducationRange~Demographics$SMP)
## Demographics$EducationRange 1 2 3 4 5
## Demographics$SMP
## Facebook 1 16 45 33 15
## Twitter 1 8 52 28 14
## YouTube 0 0 0 0 0
ftable(Demographics$RE~Demographics$SMP)
## Demographics$RE African American / Black Asian American Caucasian / White Hispanic / Latino Native American Other
## Demographics$SMP
## Facebook 9 8 81 10 0 2
## Twitter 10 6 79 7 0 1
## YouTube 0 0 0 0 0 0
factanal(MainStudySearch[,3:13],3,rotation="varimax")
##
## Call:
## factanal(x = MainStudySearch[, 3:13], factors = 3, rotation = "varimax")
##
## Uniquenesses:
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.168 0.223 0.482 0.155 0.232 0.243 0.195 0.125 0.152 0.049 0.116
##
## Loadings:
## Factor1 Factor2 Factor3
## X5 0.867 0.209 0.190
## X6 0.840 0.146 0.224
## X7 0.653 0.216 0.213
## X8 0.872 0.173 0.234
## X9 0.823 0.205 0.219
## X10 0.211 0.781 0.319
## X11 0.204 0.832 0.267
## X12 0.217 0.860 0.296
## X13 0.344 0.474 0.711
## X14 0.326 0.356 0.847
## X15 0.319 0.413 0.782
##
## Factor1 Factor2 Factor3
## SS loadings 3.783 2.747 2.330
## Proportion Var 0.344 0.250 0.212
## Cumulative Var 0.344 0.594 0.805
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 63.44 on 25 degrees of freedom.
## The p-value is 3.45e-05
KMO(MainStudySearch[,3:13])
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = MainStudySearch[, 3:13])
## Overall MSA = 0.9
## MSA for each item =
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.90 0.89 0.95 0.89 0.90 0.93 0.86 0.87 0.94 0.86 0.89
screeplot(prcomp(MainStudySearch[,3:13]),type="lines")
biplot(prcomp(MainStudySearch[,3:13],scale.=T),cex=0.7,xlabs=rep(".",nrow(MainStudySearch[,3:13])))
cronbach(MainStudySearch[,3:7])
## $sample.size
## [1] 213
##
## $number.of.items
## [1] 5
##
## $alpha
## [1] 0.9343771
MainStudySearch$Quality<-(MainStudySearch[,3]+MainStudySearch[,4]+MainStudySearch[,5]+MainStudySearch[,6]+MainStudySearch[,7])/5
cronbach(MainStudySearch[,8:10])
## $sample.size
## [1] 213
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9273839
MainStudySearch$PurchInt<-(MainStudySearch[,8]+MainStudySearch[,9]+MainStudySearch[,10])/3
cronbach(MainStudySearch[,11:13])
## $sample.size
## [1] 213
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9586391
MainStudySearch$WOM<-(MainStudySearch[,11]+MainStudySearch[,12]+MainStudySearch[,13])/3
Age<-t.test(Age~SMP,data=MainStudySearch)
Gender<-chisq.test(MainStudySearch$SMP,MainStudySearch$Gender)
Income<-t.test(Income~SMP,data=MainStudySearch)
Education<-t.test(Education~SMP,data=MainStudySearch)
RE<-chisq.test(MainStudySearch$SMP,MainStudySearch$RE,simulate.p.value=T)
t1Stimuli<-t.test(t1Stimuli~SMP,data=MainStudySearch)
t2Stimuli<-t.test(t2Stimuli~SMP,data=MainStudySearch)
PageSubmitStimuli<-t.test(PageSubmitStimuli~SMP,data=MainStudySearch)
Threshold<-t.test(Threshold~SMP,data=MainStudySearch)
Longitude<-t.test(LocationLongitude~SMP,data=MainStudySearch)
Latitude<-t.test(LocationLatitude~SMP,data=MainStudySearch)
BrandFam<-t.test(BrandFam~SMP,data=MainStudySearch)
t(data.frame(Age$p.value,Gender$p.value,Income$p.value,Education$p.value,RE$p.value,t1Stimuli$p.value,t2Stimuli$p.value,PageSubmitStimuli$p.value,Threshold$p.value,Longitude$p.value,Latitude$p.value,BrandFam$p.value))
## [,1]
## Age.p.value 0.6177520
## Gender.p.value 0.3878365
## Income.p.value 0.4461329
## Education.p.value 0.5532965
## RE.p.value 0.9135432
## t1Stimuli.p.value 0.4251954
## t2Stimuli.p.value 0.2005082
## PageSubmitStimuli.p.value 0.3627479
## Threshold.p.value 0.5779087
## Longitude.p.value 0.8036001
## Latitude.p.value 0.3535894
## BrandFam.p.value 0.8071944
outliers<-as.data.frame(boxplot(Quality~SMP,data=MainStudySearch,range=3,ylab="Perceived quality of search goods")$out)
Quality.lda<-lda(SMP~Quality,data=MainStudySearch)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(Quality.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudySearch)
## [1] 0
outliers<-as.data.frame(boxplot(PurchInt~SMP,data=MainStudySearch,range=3,ylab="Purch Int of search goods")$out)
PurchInt.lda<-lda(SMP~PurchInt,data=MainStudySearch)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(PurchInt.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudySearch)
## [1] 0
outliers<-as.data.frame(boxplot(WOM~SMP,data=MainStudySearch,range=3,ylab="WOM of search goods")$out)
WOM.lda<-lda(SMP~WOM,data=MainStudySearch)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(WOM.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudySearch)
## [1] 0
ftable(MainStudySearch$SMP)
## Facebook Twitter YouTube
##
## 110 103 0
Facebook<-subset(MainStudySearch,MainStudySearch$SMP=="Facebook")
Twitter<-subset(MainStudySearch,MainStudySearch$SMP=="Twitter")
leveneTest(Quality~SMP,data=MainStudySearch,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 1.1447 0.2859
## 211
t.test(Quality~SMP,data=MainStudySearch,var.equal=T)
##
## Two Sample t-test
##
## data: Quality by SMP
## t = -3.631, df = 211, p-value = 0.0003544
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.089402 -0.322743
## sample estimates:
## mean in group Facebook mean in group Twitter
## 5.503636 6.209709
wilcox.test(Quality~SMP,data=MainStudySearch)
##
## Wilcoxon rank sum test with continuity correction
##
## data: Quality by SMP
## W = 4321.5, p-value = 0.002749
## alternative hypothesis: true location shift is not equal to 0
sd(Facebook$Quality)
## [1] 1.585423
sd(Twitter$Quality)
## [1] 1.214416
leveneTest(PurchInt~SMP,data=MainStudySearch,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 3.5618 0.0605 .
## 211
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
t.test(PurchInt~SMP,data=MainStudySearch,var.equal=T)
##
## Two Sample t-test
##
## data: PurchInt by SMP
## t = -1.6488, df = 211, p-value = 0.1007
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.98430708 0.08769043
## sample estimates:
## mean in group Facebook mean in group Twitter
## 3.072727 3.521036
wilcox.test(PurchInt~SMP,data=MainStudySearch)
##
## Wilcoxon rank sum test with continuity correction
##
## data: PurchInt by SMP
## W = 5009, p-value = 0.1431
## alternative hypothesis: true location shift is not equal to 0
sd(Facebook$PurchInt)
## [1] 1.823721
sd(Twitter$PurchInt)
## [1] 2.140322
leveneTest(WOM~SMP,data=MainStudySearch,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.0181 0.8931
## 211
t.test(WOM~SMP,data=MainStudySearch,var.equal=T)
##
## Two Sample t-test
##
## data: WOM by SMP
## t = -3.5628, df = 211, p-value = 0.0004536
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.6144394 -0.4642897
## sample estimates:
## mean in group Facebook mean in group Twitter
## 3.769697 4.809061
sd(Facebook$WOM)
## [1] 2.062107
sd(Twitter$WOM)
## [1] 2.19556
MainStudyExperience<-subset(MainStudyGeneral,MainStudyGeneral$Group==4|MainStudyGeneral$Group==6)
MainStudyExperience<-MainStudyExperience[which(MainStudyExperience$copyt8_3==0&MainStudyExperience$t12_3>0&nchar(MainStudyExperience$WhyQ)+nchar(MainStudyExperience$WhyP)+nchar(MainStudyExperience$WhyW)==6),]
Demographics<-cbind(MainStudyExperience[32:36],MainStudyExperience[16])
Demographics$AgeRange<-ifelse(Demographics$Age<21,1,ifelse(Demographics$Age>50,5,ifelse(Demographics$Age>20&Demographics$Age<29,2,ifelse(Demographics$Age>28&Demographics$Age<35,3,4))))
Demographics$IncomeRange<-ifelse(Demographics$Income<3,1,ifelse(Demographics$Income>7,5,ifelse(Demographics$Income>2&Demographics$Income<5,2,ifelse(Demographics$Income>4&Demographics$Income<7,3,4))))
Demographics$EducationRange<-ifelse(Demographics$Education<8,1,ifelse(Demographics$Education>12,5,ifelse(Demographics$Education==8,2,ifelse(Demographics$Education==12,4,3))))
nrow(Demographics)
## [1] 159
ftable(Demographics$AgeRange~Demographics$SMP)
## Demographics$AgeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 6 24 23 21 5
## Twitter 6 35 14 22 3
## YouTube 0 0 0 0 0
ftable(Demographics$Gender~Demographics$SMP)
## Demographics$Gender Female Male
## Demographics$SMP
## Facebook 36 43
## Twitter 38 42
## YouTube 0 0
ftable(Demographics$IncomeRange~Demographics$SMP)
## Demographics$IncomeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 17 22 27 12 1
## Twitter 15 23 28 9 5
## YouTube 0 0 0 0 0
ftable(Demographics$EducationRange~Demographics$SMP)
## Demographics$EducationRange 1 2 3 4 5
## Demographics$SMP
## Facebook 0 9 34 22 14
## Twitter 1 6 31 31 11
## YouTube 0 0 0 0 0
ftable(Demographics$RE~Demographics$SMP)
## Demographics$RE African American / Black Asian American Caucasian / White Hispanic / Latino Native American Other
## Demographics$SMP
## Facebook 9 6 59 4 0 1
## Twitter 13 9 50 4 1 3
## YouTube 0 0 0 0 0 0
factanal(MainStudyExperience[,3:13],3,rotation="varimax")
##
## Call:
## factanal(x = MainStudyExperience[, 3:13], factors = 3, rotation = "varimax")
##
## Uniquenesses:
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.165 0.313 0.525 0.271 0.521 0.197 0.079 0.126 0.193 0.174 0.096
##
## Loadings:
## Factor1 Factor2 Factor3
## X5 0.877 0.135 0.221
## X6 0.793 0.150 0.187
## X7 0.647 0.219
## X8 0.809 0.159 0.222
## X9 0.655 0.213
## X10 0.197 0.834 0.262
## X11 0.156 0.898 0.300
## X12 0.184 0.856 0.329
## X13 0.304 0.429 0.729
## X14 0.253 0.312 0.815
## X15 0.337 0.416 0.786
##
## Factor1 Factor2 Factor3
## SS loadings 3.266 2.808 2.268
## Proportion Var 0.297 0.255 0.206
## Cumulative Var 0.297 0.552 0.758
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 30.49 on 25 degrees of freedom.
## The p-value is 0.206
KMO(MainStudyExperience[,3:13])
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = MainStudyExperience[, 3:13])
## Overall MSA = 0.89
## MSA for each item =
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.87 0.90 0.90 0.88 0.94 0.91 0.84 0.88 0.92 0.89 0.88
screeplot(prcomp(MainStudyExperience[,3:13]),type="lines")
biplot(prcomp(MainStudyExperience[,3:13],scale.=T),cex=0.7,xlabs=rep(".",nrow(MainStudyExperience[,3:13])))
cronbach(MainStudyExperience[,3:7])
## $sample.size
## [1] 159
##
## $number.of.items
## [1] 5
##
## $alpha
## [1] 0.8922638
MainStudyExperience$Quality<-(MainStudyExperience[,3]+MainStudyExperience[,4]+MainStudyExperience[,5]+MainStudyExperience[,6]+MainStudyExperience[,7])/5
cronbach(MainStudyExperience[,8:10])
## $sample.size
## [1] 159
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9498869
MainStudyExperience$PurchInt<-(MainStudyExperience[,8]+MainStudyExperience[,9]+MainStudyExperience[,10])/3
cronbach(MainStudyExperience[,11:13])
## $sample.size
## [1] 159
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9392495
MainStudyExperience$WOM<-(MainStudyExperience[,11]+MainStudyExperience[,12]+MainStudyExperience[,13])/3
Age<-t.test(Age~SMP,data=MainStudyExperience)
Gender<-chisq.test(MainStudyExperience$SMP,MainStudyExperience$Gender)
Income<-t.test(Income~SMP,data=MainStudyExperience)
Education<-t.test(Education~SMP,data=MainStudyExperience)
RE<-chisq.test(MainStudyExperience$SMP,MainStudyExperience$RE,simulate.p.value=T)
t1Stimuli<-t.test(t1Stimuli~SMP,data=MainStudyExperience)
t2Stimuli<-t.test(t2Stimuli~SMP,data=MainStudyExperience)
PageSubmitStimuli<-t.test(PageSubmitStimuli~SMP,data=MainStudyExperience)
Threshold<-t.test(Threshold~SMP,data=MainStudyExperience)
Longitude<-t.test(LocationLongitude~SMP,data=MainStudyExperience)
Latitude<-t.test(LocationLatitude~SMP,data=MainStudyExperience)
BrandFam<-t.test(BrandFam~SMP,data=MainStudyExperience)
t(data.frame(Age$p.value,Gender$p.value,Income$p.value,Education$p.value,RE$p.value,t1Stimuli$p.value,t2Stimuli$p.value,PageSubmitStimuli$p.value,Threshold$p.value,Longitude$p.value,Latitude$p.value,BrandFam$p.value))
## [,1]
## Age.p.value 0.1121355
## Gender.p.value 0.9322638
## Income.p.value 0.6137525
## Education.p.value 0.8570711
## RE.p.value 0.5607196
## t1Stimuli.p.value 0.5350697
## t2Stimuli.p.value 0.6070462
## PageSubmitStimuli.p.value 0.7035987
## Threshold.p.value 0.3324466
## Longitude.p.value 0.6951031
## Latitude.p.value 0.4510984
## BrandFam.p.value 0.6173438
outliers<-as.data.frame(boxplot(Quality~SMP,data=MainStudyExperience,range=3,ylab="Perceived quality of search goods")$out)
Quality.lda<-lda(SMP~Quality,data=MainStudyExperience)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(Quality.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudyExperience)
## [1] 0
outliers<-as.data.frame(boxplot(PurchInt~SMP,data=MainStudyExperience,range=3,ylab="Purch Int of search goods")$out)
PurchInt.lda<-lda(SMP~PurchInt,data=MainStudyExperience)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(PurchInt.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudyExperience)
## [1] 0
outliers<-as.data.frame(boxplot(WOM~SMP,data=MainStudyExperience,range=3,ylab="WOM of search goods")$out)
WOM.lda<-lda(SMP~WOM,data=MainStudyExperience)
## Warning in lda.default(x, grouping, ...): group YouTube is empty
points(WOM.lda$means,col="black",pch=19)
nrow(outliers)/nrow(MainStudyExperience)
## [1] 0
ftable(MainStudyExperience$SMP)
## Facebook Twitter YouTube
##
## 79 80 0
Facebook<-subset(MainStudyExperience,MainStudyExperience$SMP=="Facebook")
Twitter<-subset(MainStudyExperience,MainStudyExperience$SMP=="Twitter")
leveneTest(Quality~SMP,data=MainStudyExperience,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.0924 0.7616
## 157
t.test(Quality~SMP,data=MainStudyExperience,var.equal=T)
##
## Two Sample t-test
##
## data: Quality by SMP
## t = 0.2682, df = 157, p-value = 0.7889
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.3209922 0.4218783
## sample estimates:
## mean in group Facebook mean in group Twitter
## 5.835443 5.785000
wilcox.test(Quality~SMP,data=MainStudyExperience)
##
## Wilcoxon rank sum test with continuity correction
##
## data: Quality by SMP
## W = 3228.5, p-value = 0.8141
## alternative hypothesis: true location shift is not equal to 0
sd(Facebook$Quality)
## [1] 1.147912
sd(Twitter$Quality)
## [1] 1.221651
leveneTest(PurchInt~SMP,data=MainStudyExperience,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.3867 0.535
## 157
t.test(PurchInt~SMP,data=MainStudyExperience,var.equal=T)
##
## Two Sample t-test
##
## data: PurchInt by SMP
## t = -0.0672, df = 157, p-value = 0.9465
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.6296764 0.5882207
## sample estimates:
## mean in group Facebook mean in group Twitter
## 3.008439 3.029167
wilcox.test(PurchInt~SMP,data=MainStudyExperience)
##
## Wilcoxon rank sum test with continuity correction
##
## data: PurchInt by SMP
## W = 3223, p-value = 0.8285
## alternative hypothesis: true location shift is not equal to 0
sd(Facebook$PurchInt)
## [1] 1.839713
sd(Twitter$PurchInt)
## [1] 2.041203
leveneTest(WOM~SMP,data=MainStudyExperience,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.8731 0.3515
## 157
t.test(WOM~SMP,data=MainStudyExperience,var.equal=T)
##
## Two Sample t-test
##
## data: WOM by SMP
## t = 0.5498, df = 157, p-value = 0.5833
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.4565932 0.8088084
## sample estimates:
## mean in group Facebook mean in group Twitter
## 4.421941 4.245833
sd(Facebook$WOM)
## [1] 1.936094
sd(Twitter$WOM)
## [1] 2.098653
MainStudyCredence<-subset(MainStudyGeneral,MainStudyGeneral$Group==1|MainStudyGeneral$Group==3)
MainStudyCredence<-MainStudyCredence[which(MainStudyCredence$copyt8_3==0&MainStudyCredence$t12_3>0&nchar(MainStudyCredence$WhyQ)+nchar(MainStudyCredence$WhyP)+nchar(MainStudyCredence$WhyW)==6),]
Demographics<-cbind(MainStudyCredence[32:36],MainStudyCredence[16])
Demographics$AgeRange<-ifelse(Demographics$Age<21,1,ifelse(Demographics$Age>50,5,ifelse(Demographics$Age>20&Demographics$Age<29,2,ifelse(Demographics$Age>28&Demographics$Age<35,3,4))))
Demographics$IncomeRange<-ifelse(Demographics$Income<3,1,ifelse(Demographics$Income>7,5,ifelse(Demographics$Income>2&Demographics$Income<5,2,ifelse(Demographics$Income>4&Demographics$Income<7,3,4))))
Demographics$EducationRange<-ifelse(Demographics$Education<8,1,ifelse(Demographics$Education>12,5,ifelse(Demographics$Education==8,2,ifelse(Demographics$Education==12,4,3))))
nrow(Demographics)
## [1] 187
ftable(Demographics$AgeRange~Demographics$SMP)
## Demographics$AgeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 0 0 0 0 0
## Twitter 5 43 15 27 4
## YouTube 4 40 22 25 2
ftable(Demographics$Gender~Demographics$SMP)
## Demographics$Gender Female Male
## Demographics$SMP
## Facebook 0 0
## Twitter 53 41
## YouTube 44 49
ftable(Demographics$IncomeRange~Demographics$SMP)
## Demographics$IncomeRange 1 2 3 4 5
## Demographics$SMP
## Facebook 0 0 0 0 0
## Twitter 22 30 29 8 5
## YouTube 22 31 27 10 3
ftable(Demographics$EducationRange~Demographics$SMP)
## Demographics$EducationRange 1 2 3 4 5
## Demographics$SMP
## Facebook 0 0 0 0 0
## Twitter 0 10 47 23 14
## YouTube 3 13 31 37 9
ftable(Demographics$RE~Demographics$SMP)
## Demographics$RE African American / Black Asian American Caucasian / White Hispanic / Latino Native American Other
## Demographics$SMP
## Facebook 0 0 0 0 0 0
## Twitter 9 8 68 8 0 1
## YouTube 14 2 65 8 2 2
factanal(MainStudyCredence[,3:13],3,rotation="varimax")
##
## Call:
## factanal(x = MainStudyCredence[, 3:13], factors = 3, rotation = "varimax")
##
## Uniquenesses:
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.260 0.361 0.409 0.141 0.209 0.146 0.100 0.117 0.167 0.199 0.103
##
## Loadings:
## Factor1 Factor2 Factor3
## X5 0.805 0.191 0.237
## X6 0.704 0.221 0.307
## X7 0.721 0.193 0.184
## X8 0.882 0.206 0.195
## X9 0.822 0.116 0.320
## X10 0.223 0.857 0.266
## X11 0.195 0.899 0.231
## X12 0.212 0.883 0.242
## X13 0.300 0.380 0.774
## X14 0.353 0.206 0.796
## X15 0.324 0.310 0.834
##
## Factor1 Factor2 Factor3
## SS loadings 3.569 2.784 2.435
## Proportion Var 0.324 0.253 0.221
## Cumulative Var 0.324 0.578 0.799
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 33.32 on 25 degrees of freedom.
## The p-value is 0.123
KMO(MainStudyCredence[,3:13])
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = MainStudyCredence[, 3:13])
## Overall MSA = 0.9
## MSA for each item =
## X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15
## 0.92 0.95 0.93 0.89 0.91 0.90 0.86 0.88 0.90 0.90 0.87
screeplot(prcomp(MainStudyCredence[,3:13]),type="lines")
biplot(prcomp(MainStudyCredence[,3:13],scale.=T),cex=0.7,xlabs=rep(".",nrow(MainStudyCredence[,3:13])))
cronbach(MainStudyCredence[,3:7])
## $sample.size
## [1] 187
##
## $number.of.items
## [1] 5
##
## $alpha
## [1] 0.9242667
MainStudyCredence$Quality<-(MainStudyCredence[,3]+MainStudyCredence[,4]+MainStudyCredence[,5]+MainStudyCredence[,6]+MainStudyCredence[,7])/5
cronbach(MainStudyCredence[,8:10])
## $sample.size
## [1] 187
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9555152
MainStudyCredence$PurchInt<-(MainStudyCredence[,8]+MainStudyCredence[,9]+MainStudyCredence[,10])/3
cronbach(MainStudyCredence[,11:13])
## $sample.size
## [1] 187
##
## $number.of.items
## [1] 3
##
## $alpha
## [1] 0.9375218
MainStudyCredence$WOM<-(MainStudyCredence[,11]+MainStudyCredence[,12]+MainStudyCredence[,13])/3
Age<-t.test(Age~SMP,data=MainStudyCredence)
Gender<-chisq.test(MainStudyCredence$SMP,MainStudyCredence$Gender)
Income<-t.test(Income~SMP,data=MainStudyCredence)
Education<-t.test(Education~SMP,data=MainStudyCredence)
RE<-chisq.test(MainStudyCredence$SMP,MainStudyCredence$RE,simulate.p.value=T)
t1Stimuli<-t.test(t1Stimuli~SMP,data=MainStudyCredence)
t2Stimuli<-t.test(t2Stimuli~SMP,data=MainStudyCredence)
PageSubmitStimuli<-t.test(PageSubmitStimuli~SMP,data=MainStudyCredence)
Threshold<-t.test(Threshold~SMP,data=MainStudyCredence)
Longitude<-t.test(LocationLongitude~SMP,data=MainStudyCredence)
Latitude<-t.test(LocationLatitude~SMP,data=MainStudyCredence)
BrandFam<-t.test(BrandFam~SMP,data=MainStudyCredence)
t(data.frame(Age$p.value,Gender$p.value,Income$p.value,Education$p.value,RE$p.value,t1Stimuli$p.value,t2Stimuli$p.value,PageSubmitStimuli$p.value,Threshold$p.value,Longitude$p.value,Latitude$p.value,BrandFam$p.value))
## [,1]
## Age.p.value 0.6357225
## Gender.p.value 0.2735367
## Income.p.value 0.9345731
## Education.p.value 0.9538606
## RE.p.value 0.2028986
## t1Stimuli.p.value 0.5057362
## t2Stimuli.p.value 0.3646295
## PageSubmitStimuli.p.value 0.1598728
## Threshold.p.value 0.6861754
## Longitude.p.value 0.2878775
## Latitude.p.value 0.3822546
## BrandFam.p.value 0.1517026
outliers<-as.data.frame(boxplot(Quality~SMP,data=MainStudyCredence,range=3,ylab="Perceived quality of credence goods")$out)
Quality.lda<-lda(SMP~Quality,data=MainStudyCredence)
## Warning in lda.default(x, grouping, ...): group Facebook is empty
points(c(0,Quality.lda$means),col="black",pch=19)
nrow(outliers)/nrow(MainStudyCredence)
## [1] 0.02139037
outliers<-as.data.frame(boxplot(PurchInt~SMP,data=MainStudyCredence,range=3,ylab="Purch Int of credence goods")$out)
PurchInt.lda<-lda(SMP~PurchInt,data=MainStudyCredence)
## Warning in lda.default(x, grouping, ...): group Facebook is empty
points(c(0,PurchInt.lda$means),col="black",pch=19)
nrow(outliers)/nrow(MainStudyCredence)
## [1] 0
outliers<-as.data.frame(boxplot(WOM~SMP,data=MainStudyCredence,range=3,ylab="WOM of credence goods")$out)
WOM.lda<-lda(SMP~WOM,data=MainStudyCredence)
## Warning in lda.default(x, grouping, ...): group Facebook is empty
points(c(0,WOM.lda$means),col="black",pch=19)
nrow(outliers)/nrow(MainStudyCredence)
## [1] 0
ftable(MainStudyCredence$SMP)
## Facebook Twitter YouTube
##
## 0 94 93
YouTube<-subset(MainStudyCredence,MainStudyCredence$SMP=="YouTube")
Twitter<-subset(MainStudyCredence,MainStudyCredence$SMP=="Twitter")
leveneTest(Quality~SMP,data=MainStudyCredence,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.4377 0.5091
## 185
t.test(Quality~SMP,data=MainStudyCredence,var.equal=T)
##
## Two Sample t-test
##
## data: Quality by SMP
## t = -2.3045, df = 185, p-value = 0.0223
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.8478307 -0.0657360
## sample estimates:
## mean in group Twitter mean in group YouTube
## 5.080851 5.537634
wilcox.test(Quality~SMP,data=MainStudyCredence)
##
## Wilcoxon rank sum test with continuity correction
##
## data: Quality by SMP
## W = 3528.5, p-value = 0.02217
## alternative hypothesis: true location shift is not equal to 0
sd(YouTube$Quality)
## [1] 1.231817
sd(Twitter$Quality)
## [1] 1.467151
leveneTest(PurchInt~SMP,data=MainStudyCredence,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 4.8156 0.02945 *
## 185
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
t.test(PurchInt~SMP,data=MainStudyCredence,var.equal=T)
##
## Two Sample t-test
##
## data: PurchInt by SMP
## t = -3.2168, df = 185, p-value = 0.00153
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.3888867 -0.3329161
## sample estimates:
## mean in group Twitter mean in group YouTube
## 2.397163 3.258065
wilcox.test(PurchInt~SMP,data=MainStudyCredence)
##
## Wilcoxon rank sum test with continuity correction
##
## data: PurchInt by SMP
## W = 3203.5, p-value = 0.001372
## alternative hypothesis: true location shift is not equal to 0
sd(YouTube$PurchInt)
## [1] 1.942488
sd(Twitter$PurchInt)
## [1] 1.711076
leveneTest(WOM~SMP,data=MainStudyCredence,center=mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.2849 0.5942
## 185
t.test(WOM~SMP,data=MainStudyCredence,var.equal=T)
##
## Two Sample t-test
##
## data: WOM by SMP
## t = -1.9015, df = 185, p-value = 0.05879
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -1.18059509 0.02174509
## sample estimates:
## mean in group Twitter mean in group YouTube
## 3.553191 4.132616
sd(YouTube$WOM)
## [1] 2.031241
sd(Twitter$WOM)
## [1] 2.133845