library(dplyr)
## Warning: package 'dplyr' was built under R version 3.6.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(mapproj) # map
## Warning: package 'mapproj' was built under R version 3.6.3
## Loading required package: maps
## Warning: package 'maps' was built under R version 3.6.1
library(reshape2) # melt
## Warning: package 'reshape2' was built under R version 3.6.3
library(nparcomp) # gao_cs
## Warning: package 'nparcomp' was built under R version 3.6.1
## Loading required package: multcomp
## Warning: package 'multcomp' was built under R version 3.6.3
## Loading required package: mvtnorm
## Warning: package 'mvtnorm' was built under R version 3.6.2
## Loading required package: survival
## Warning: package 'survival' was built under R version 3.6.3
## Loading required package: TH.data
## Loading required package: MASS
## Warning: package 'MASS' was built under R version 3.6.3
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
##
## Attaching package: 'TH.data'
## The following object is masked from 'package:MASS':
##
## geyser
library(car) # leveneTest
## Warning: package 'car' was built under R version 3.6.3
## Loading required package: carData
## Warning: package 'carData' was built under R version 3.6.1
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
library(MASS) # lda
library(psy) # cronbach
library(psych) # KMO
## Warning: package 'psych' was built under R version 3.6.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.6.3
## Loading required package: lattice
## Warning: package 'lattice' was built under R version 3.6.3
## Loading required package: Formula
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 3.6.3
##
## Attaching package: 'ggplot2'
## The following objects are masked from 'package:psych':
##
## %+%, alpha
##
## Attaching package: 'Hmisc'
## The following object is masked from 'package:psych':
##
## describe
## The following objects are masked from 'package:dplyr':
##
## src, summarize
## The following objects are masked from 'package:base':
##
## format.pval, units
library(bda)
## Warning: package 'bda' was built under R version 3.6.3
## bda v14 (Bin Wang, 2020)
library(latexpdf)
library(rockchalk)
## Warning: package 'rockchalk' was built under R version 3.6.1
## Registered S3 methods overwritten by 'lme4':
## method from
## cooks.distance.influence.merMod car
## influence.merMod car
## dfbeta.influence.merMod car
## dfbetas.influence.merMod car
##
## Attaching package: 'rockchalk'
## The following object is masked from 'package:Hmisc':
##
## summarize
## The following object is masked from 'package:MASS':
##
## mvrnorm
## The following object is masked from 'package:dplyr':
##
## summarize
library(sjPlot)
## Warning: package 'sjPlot' was built under R version 3.6.3
## Learn more about sjPlot with 'browseVignettes("sjPlot")'.
library(sjmisc)
## Warning: package 'sjmisc' was built under R version 3.6.3
##
## Attaching package: 'sjmisc'
## The following object is masked from 'package:Hmisc':
##
## %nin%
library(ggplot2)
library(Matrix)
## Warning: package 'Matrix' was built under R version 3.6.3
library(sandwich)
## Warning: package 'sandwich' was built under R version 3.6.1
library(mediation)
## Warning: package 'mediation' was built under R version 3.6.3
## mediation: Causal Mediation Analysis
## Version: 4.5.0
##
## Attaching package: 'mediation'
## The following object is masked from 'package:psych':
##
## mediate
library(readxl)
## Warning: package 'readxl' was built under R version 3.6.3
library(knitr)
## Warning: package 'knitr' was built under R version 3.6.3
library(boot)
##
## Attaching package: 'boot'
## The following object is masked from 'package:lattice':
##
## melanoma
## The following object is masked from 'package:psych':
##
## logit
## The following object is masked from 'package:car':
##
## logit
## The following object is masked from 'package:survival':
##
## aml
## MAIN STUDY ##
cat("\014") # cleans screen
rm(list=ls(all=T)) # remove variables in working memory
getwd()
## [1] "C:/Users/ev193805/Downloads/Papers Pipeline 2/In-Progress/Journal of Business Research/Minor review - Round 2"
setwd("C:/Users/ev193805/Downloads/Papers Pipeline 2/In-Progress/Journal of Business Research/")
dir()
## [1] "~$nuscript file (Review EV 23-Jul-2019).docx"
## [2] "2.bmp"
## [3] "2011Cai-Websiteaesthetics-IJEC hedonic utilitarian product.PDF"
## [4] "Apparel-Paper-Main-Study-and-Pretest.pdf"
## [5] "Exploring human images in websites MIS Quarterly.pdf"
## [6] "FR_NEW-Scent_December 2 2019_06.59.xlsx"
## [7] "GR participants GR.XLSX"
## [8] "GR_SCENT LAB STUDY.xlsx"
## [9] "GR_Scent_Recruitment.xlsx"
## [10] "Images, Human Avatar and Product Category Knowledge.pdf"
## [11] "MainStudy.csv"
## [12] "Manuscript file (Erik Review 04-Dec-2019).docx"
## [13] "Manuscript file (Erik Review 05-Nov-2019).docx"
## [14] "Manuscript file (Erik Review 06-Nov-2019).docx"
## [15] "Manuscript file (Erik Review 10-Sep-2019).docx"
## [16] "Manuscript file (Erik Review 11-Oct-2019).docx"
## [17] "Manuscript file (Erik Review 18-Nov-2019).docx"
## [18] "Manuscript file (Erik Review 24-Oct-2019).docx"
## [19] "Manuscript file (Erik Review 25-Jul-2019).pdf"
## [20] "Manuscript file (Erik Review 26-Nov-2019).docx"
## [21] "Manuscript file (SA Review 31-Oct-2019).docx"
## [22] "Manuscript file(Chava review 18-Jul-2019).docx"
## [23] "Manuscript file(Chava review 18-Jul-2019).pdf"
## [24] "Manuscript file.docx"
## [25] "Mediated Moderation.docx"
## [26] "Minor review - Round 1"
## [27] "Minor review - Round 2"
## [28] "Minor Revisions.docx"
## [29] "Minor Revisions.pdf"
## [30] "Outline for Journal of Business Research.docx"
## [31] "Papers to read interesting.docx"
## [32] "pdf2png"
## [33] "pdf2png.zip"
## [34] "pdftoimage"
## [35] "pdftoimage.zip"
## [36] "Political-Analysis-2016-Santoso-pan-mpw016.pdf"
## [37] "Popularity_of_Brand_Posts_on_Brand_Fan_P.pdf"
## [38] "Research Methodology - Journal of Business Research.docx"
## [39] "Revisar Paper de JBR para preparar Mediation Model.pdf"
## [40] "Social Presence IJEC color version.pdf"
## [41] "Social Presence IJEC.pdf"
## [42] "Social presence scales.docx"
## [43] "Statistical_Analyses.pdf"
## [44] "Stimuli Oct 2019"
## [45] "Stimuli ver 1.pdf"
## [46] "Stimuli ver1.docx"
## [47] "study 1 - NO FRAGRANCE- answer from home.pdf"
## [48] "study 2 - YES FRAGRANCE - LAB STUDY.pdf"
## [49] "Submission files Chava"
## [50] "Submission files Elena (cancelled)"
## [51] "Submission Questions.docx"
## [52] "Summary Elena's Data.xlsx"
## [53] "Supplemental material.docx"
## [54] "survey_experiments_with_google_consumer_surveys_promise_and_pitfalls_for_academic_research_in_social_science.pdf"
## [55] "UK Experiment Participants ID.xlsx"
## [56] "UK RECRUITMENT.xlsx"
## [57] "UK survey data collection Qualtrics.pdf"
## [58] "UK_SCENT LAB STUDY 2019_08.10.xlsx"
## [59] "V3_Manuscript file (SA Review 31-Oct-2019).docx"
## [60] "Variables.xlsx"
## [61] "Vividness.pdf"
## [62] "websiteselements.pdf"
MainStudy<-read.csv("MainStudy.csv",header=T)
## H1 regressing purch intention on vividness
fit<-lm(PI.Avg~ImgVIV.Avg,MainStudy)
shapiro.test(fit$res) ## Shapiro p > 0.1 normal distribution
##
## Shapiro-Wilk normality test
##
## data: fit$res
## W = 0.99679, p-value = 0.2647
summary(fit)
##
## Call:
## lm(formula = PI.Avg ~ ImgVIV.Avg, data = MainStudy)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5304 -0.9598 0.0301 0.9645 4.8962
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.81852 0.16270 5.031 6.43e-07 ***
## ImgVIV.Avg 0.61864 0.03546 17.447 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.408 on 611 degrees of freedom
## Multiple R-squared: 0.3325, Adjusted R-squared: 0.3314
## F-statistic: 304.4 on 1 and 611 DF, p-value: < 2.2e-16
regression.boot<-Boot(fit,R=5000)
regression.boot
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot::boot(data = dd, statistic = boot.f, R = R, .fn = f, parallel = p_type,
## ncpus = ncores, cl = cl2)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.8185225 0.0001518672 0.15751982
## t2* 0.6186421 -0.0001511001 0.03548476
summary(regression.boot) # default summary
##
## Number of bootstrap replications R = 5000
## original bootBias bootSE bootMed
## (Intercept) 0.81852 0.00015187 0.157520 0.81898
## ImgVIV.Avg 0.61864 -0.00015110 0.035485 0.61851
confint(regression.boot)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## (Intercept) 0.5233129 1.1384920
## ImgVIV.Avg 0.5464972 0.6864014
boot.ci(regression.boot,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 1)
##
## Intervals :
## Level Normal
## 95% ( 0.5096, 1.1271 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=1) # plot Intercept
boot.ci(regression.boot,conf=.95,type="norm",index=2) ## ImgViv.Avg
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 2)
##
## Intervals :
## Level Normal
## 95% ( 0.5492, 0.6883 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=2) # plot ImgViv.Avg
hist(regression.boot)
##H2-H3 regressing purchase intention on vividness as moderated by time (with attenton to low vividness)
summary(MainStudy$Time)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 20.70 23.63 29.72 35.19 39.65 175.92
MainStudy$Moment<-ifelse(MainStudy$Time<29.49,1,2) ## 2 groups with equal number of subjects, divided by the median
fit<-lm(PI.Avg~ImgVIV.Avg*Moment,MainStudy)
shapiro.test(fit$res) ## Shapiro p > 0.1 normal distribution
##
## Shapiro-Wilk normality test
##
## data: fit$res
## W = 0.99696, p-value = 0.3071
summary(fit)
##
## Call:
## lm(formula = PI.Avg ~ ImgVIV.Avg * Moment, data = MainStudy)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7066 -0.9555 0.0485 1.0526 4.7050
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.02060 0.50973 0.040 0.968
## ImgVIV.Avg 0.83389 0.11327 7.362 5.89e-13 ***
## Moment 0.52776 0.32580 1.620 0.106
## ImgVIV.Avg:Moment -0.14086 0.07109 -1.981 0.048 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.406 on 609 degrees of freedom
## Multiple R-squared: 0.3373, Adjusted R-squared: 0.334
## F-statistic: 103.3 on 3 and 609 DF, p-value: < 2.2e-16
regression.boot<-Boot(fit,R=5000)
regression.boot
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot::boot(data = dd, statistic = boot.f, R = R, .fn = f, parallel = p_type,
## ncpus = ncores, cl = cl2)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.0205978 0.0101358230 0.46656921
## t2* 0.8338922 -0.0015308369 0.10588679
## t3* 0.5277626 -0.0070964720 0.31357478
## t4* -0.1408604 0.0009884514 0.06956371
summary(regression.boot) # default summary
##
## Number of bootstrap replications R = 5000
## original bootBias bootSE bootMed
## (Intercept) 0.020598 0.01013582 0.466569 0.035399
## ImgVIV.Avg 0.833892 -0.00153084 0.105887 0.831417
## Moment 0.527763 -0.00709647 0.313575 0.515652
## ImgVIV.Avg:Moment -0.140860 0.00098845 0.069564 -0.139034
confint(regression.boot)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## (Intercept) -0.91000106 0.91169605
## ImgVIV.Avg 0.63065554 1.03965611
## Moment -0.06261308 1.17696599
## ImgVIV.Avg:Moment -0.28196951 -0.01005912
boot.ci(regression.boot,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 1)
##
## Intervals :
## Level Normal
## 95% (-0.9040, 0.9249 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=1) # plot Intercept
boot.ci(regression.boot,conf=.95,type="norm",index=2) ## ImgViv.Avg
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 2)
##
## Intervals :
## Level Normal
## 95% ( 0.6279, 1.0430 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=2) # plot ImgViv.Avg
boot.ci(regression.boot,conf=.95,type="norm",index=3) ## Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 3)
##
## Intervals :
## Level Normal
## 95% (-0.0797, 1.1495 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=3) # plot Moment
boot.ci(regression.boot,conf=.95,type="norm",index=4) ## Interaction ImgViv.Avg and Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 4)
##
## Intervals :
## Level Normal
## 95% (-0.2782, -0.0055 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=4) # plot Interaction ImgViv.Avg and Moment
hist(regression.boot)
summary(MainStudy$ImgVIV.Avg)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.200 4.400 4.299 5.400 7.000
fit<-lm(PI.Avg~ImgVIV.Avg*Moment,subset(MainStudy,MainStudy$ImgVIV.Avg>4.4)) ## High Vividness, divided by median
shapiro.test(fit$res) ## Shapiro p < 0.1 non-normal distribution
##
## Shapiro-Wilk normality test
##
## data: fit$res
## W = 0.95169, p-value = 2.42e-08
summary(fit)
##
## Call:
## lm(formula = PI.Avg ~ ImgVIV.Avg * Moment, data = subset(MainStudy,
## MainStudy$ImgVIV.Avg > 4.4))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8006 -0.9505 0.2470 1.1330 2.9677
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.1488 1.9891 -1.080 0.280906
## ImgVIV.Avg 1.2175 0.3524 3.455 0.000631 ***
## Moment 1.2332 1.2153 1.015 0.311066
## ImgVIV.Avg:Moment -0.2648 0.2136 -1.239 0.216197
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.457 on 294 degrees of freedom
## Multiple R-squared: 0.1686, Adjusted R-squared: 0.1601
## F-statistic: 19.87 on 3 and 294 DF, p-value: 9.388e-12
regression.boot <- Boot(fit,R=5000)
regression.boot
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot::boot(data = dd, statistic = boot.f, R = R, .fn = f, parallel = p_type,
## ncpus = ncores, cl = cl2)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* -2.1487771 0.035306811 1.9555123
## t2* 1.2174775 -0.006395573 0.3435059
## t3* 1.2332098 -0.027983804 1.2065880
## t4* -0.2647908 0.004858837 0.2114223
summary(regression.boot) # default summary
##
## Number of bootstrap replications R = 5000
## original bootBias bootSE bootMed
## (Intercept) -2.14878 0.0353068 1.95551 -2.08646
## ImgVIV.Avg 1.21748 -0.0063956 0.34351 1.20600
## Moment 1.23321 -0.0279838 1.20659 1.18760
## ImgVIV.Avg:Moment -0.26479 0.0048588 0.21142 -0.25543
confint(regression.boot)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## (Intercept) -6.1024882 1.5776271
## ImgVIV.Avg 0.5632034 1.9081524
## Moment -1.0334858 3.7224918
## ImgVIV.Avg:Moment -0.7070380 0.1341872
boot.ci(regression.boot,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 1)
##
## Intervals :
## Level Normal
## 95% (-6.017, 1.649 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=1) # plot Intercept
boot.ci(regression.boot,conf=.95,type="norm",index=2) ## ImgViv.Avg
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 2)
##
## Intervals :
## Level Normal
## 95% ( 0.551, 1.897 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=2) # plot ImgViv.Avg
boot.ci(regression.boot,conf=.95,type="norm",index=3) ## Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 3)
##
## Intervals :
## Level Normal
## 95% (-1.104, 3.626 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=3) # plot Moment
boot.ci(regression.boot,conf=.95,type="norm",index=4) ## Interaction ImgViv.Avg and Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 4)
##
## Intervals :
## Level Normal
## 95% (-0.6840, 0.1447 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=4) # plot Interaction ImgViv.Avg and Moment
hist(regression.boot)
fit<-lm(PI.Avg~ImgVIV.Avg*Moment,subset(MainStudy,MainStudy$ImgVIV.Avg<4.4)) ## Low Vividness, divided by median
shapiro.test(fit$res) ## Shapiro p < 0.1 non-normal distribution
##
## Shapiro-Wilk normality test
##
## data: fit$res
## W = 0.95223, p-value = 5.243e-08
summary(fit)
##
## Call:
## lm(formula = PI.Avg ~ ImgVIV.Avg * Moment, data = subset(MainStudy,
## MainStudy$ImgVIV.Avg < 4.4))
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2022 -1.0044 -0.2333 0.6756 4.4022
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.3380 0.7711 0.438 0.66142
## ImgVIV.Avg 0.7062 0.2567 2.751 0.00633 **
## Moment 0.5979 0.5094 1.174 0.24147
## ImgVIV.Avg:Moment -0.1545 0.1680 -0.920 0.35856
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.346 on 280 degrees of freedom
## Multiple R-squared: 0.114, Adjusted R-squared: 0.1046
## F-statistic: 12.01 on 3 and 280 DF, p-value: 2.015e-07
regression.boot <- Boot(fit,R=5000)
regression.boot
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot::boot(data = dd, statistic = boot.f, R = R, .fn = f, parallel = p_type,
## ncpus = ncores, cl = cl2)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.3380478 -0.012153784 0.7464221
## t2* 0.7062106 0.004237218 0.2545488
## t3* 0.5979260 0.002121580 0.5245797
## t4* -0.1544968 -0.001067993 0.1761058
summary(regression.boot) # default summary
##
## Number of bootstrap replications R = 5000
## original bootBias bootSE bootMed
## (Intercept) 0.33805 -0.0121538 0.74642 0.33139
## ImgVIV.Avg 0.70621 0.0042372 0.25455 0.70991
## Moment 0.59793 0.0021216 0.52458 0.59568
## ImgVIV.Avg:Moment -0.15450 -0.0010680 0.17611 -0.15446
confint(regression.boot)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## (Intercept) -1.1124343 1.8523054
## ImgVIV.Avg 0.1991050 1.1986468
## Moment -0.3738287 1.7039553
## ImgVIV.Avg:Moment -0.5183293 0.1779532
boot.ci(regression.boot,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 1)
##
## Intervals :
## Level Normal
## 95% (-1.1128, 1.8132 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=1) # plot Intercept
boot.ci(regression.boot,conf=.95,type="norm",index=2) ## ImgViv.Avg
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 2)
##
## Intervals :
## Level Normal
## 95% ( 0.2031, 1.2009 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=2) # plot ImgViv.Avg
boot.ci(regression.boot,conf=.95,type="norm",index=3) ## Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 3)
##
## Intervals :
## Level Normal
## 95% (-0.4324, 1.6240 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=3) # plot Moment
boot.ci(regression.boot,conf=.95,type="norm",index=4) ## Interaction ImgViv.Avg and Moment
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = regression.boot, conf = 0.95, type = "norm",
## index = 4)
##
## Intervals :
## Level Normal
## 95% (-0.4986, 0.1917 )
## Calculations and Intervals on Original Scale
plot(regression.boot, index=4) # plot Interaction ImgViv.Avg and Moment
hist(regression.boot)
##H4. Regressing purchase intention on vividness as mediated by social presence
master<-data.frame(cbind(MainStudy$PI.Avg,MainStudy$Moment,MainStudy$SP.Avg,MainStudy$ImgVIV.Avg))
colnames(master)<-c("y","w","m","x")
summary(master)
## y w m x
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:4.250 1st Qu.:3.200
## Median :3.333 Median :2.000 Median :5.000 Median :4.400
## Mean :3.478 Mean :1.507 Mean :4.911 Mean :4.299
## 3rd Qu.:5.000 3rd Qu.:2.000 3rd Qu.:5.750 3rd Qu.:5.400
## Max. :7.000 Max. :2.000 Max. :7.000 Max. :7.000
mahal<-mahalanobis(master,colMeans(master),cov(master))
cutoff<-qchisq(1-.001,ncol(master))
table(mahal<cutoff) ## there are no outliers
##
## TRUE
## 613
noout<-subset(master,mahal<cutoff)
correl<-cor(noout)
correl
## y w m x
## y 1.00000000 0.02973361 0.41970374 0.57664732
## w 0.02973361 1.00000000 0.02019753 0.09001753
## m 0.41970374 0.02019753 1.00000000 0.50269806
## x 0.57664732 0.09001753 0.50269806 1.00000000
symnum(correl)
## y w m x
## y 1
## w 1
## m . 1
## x . . 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1
random=rchisq(nrow(noout),7)
fake=lm(random ~ .,noout)
standardized=rstudent(fake)
fitted=scale(fake$fitted.values)
qqnorm(standardized)
abline(0,1)
hist(standardized)
plot(fitted,standardized)
abline(0,0)
abline(v=0)
cpath=lm(y~x,noout)
summary(cpath)
##
## Call:
## lm(formula = y ~ x, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5304 -0.9598 0.0301 0.9645 4.8962
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.81852 0.16270 5.031 6.43e-07 ***
## x 0.61864 0.03546 17.447 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.408 on 611 degrees of freedom
## Multiple R-squared: 0.3325, Adjusted R-squared: 0.3314
## F-statistic: 304.4 on 1 and 611 DF, p-value: < 2.2e-16
apath=lm(m~x,noout)
summary(apath)
##
## Call:
## lm(formula = m ~ x, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7968 -0.6351 0.0508 0.7032 3.3464
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.27258 0.12164 26.90 <2e-16 ***
## x 0.38106 0.02651 14.37 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.053 on 611 degrees of freedom
## Multiple R-squared: 0.2527, Adjusted R-squared: 0.2515
## F-statistic: 206.6 on 1 and 611 DF, p-value: < 2.2e-16
bpath=lm(y~x+m,noout)
summary(bpath)
##
## Call:
## lm(formula = y ~ x + m, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6388 -0.8880 -0.0038 1.0006 4.6266
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.01388 0.23658 0.059 0.953
## x 0.52495 0.04035 13.009 < 2e-16 ***
## m 0.24587 0.05323 4.619 4.71e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.385 on 610 degrees of freedom
## Multiple R-squared: 0.3551, Adjusted R-squared: 0.353
## F-statistic: 167.9 on 2 and 610 DF, p-value: < 2.2e-16
a=apath$coefficients[2]
b=bpath$coefficients[3]
SEa=coef(summary(apath))[,"Std. Error"][2]
SEb=coef(summary(bpath))[,"Std. Error"][3]
zscore=(a*b)/sqrt((b^2*SEa^2)+(a^2*SEb^2)+(SEa^2*SEb^2))
zscore
## x
## 4.387666
pnorm(abs(zscore),lower.tail=F)*2
## x
## 1.145733e-05
mediation.test(MainStudy$SP.Avg,MainStudy$ImgVIV.Avg,MainStudy$PI.Avg)
## Sobel Aroian Goodman
## z.value 4.397280e+00 4.387666e+00 4.406957e+00
## p.value 1.096158e-05 1.145733e-05 1.048328e-05
total=cpath$coefficients[2]
direct=bpath$coefficients[3]
indirect=a*b ## indirect effect computation
total;direct;indirect ## total effect (x); mediation effect (m); indirect effect (cx)
## x
## 0.6186421
## m
## 0.2458731
## x
## 0.09369153
indirectsaved=function(dataset,random){
d=dataset[random, ]
apath=lm(m~x,data=d)
bpath=lm(y~x+m,data=d)
indirect=apath$coefficients[2]*bpath$coefficients[3]
return(indirect)
}
bootresults=boot(data=noout,
statistic=indirectsaved,
R=5000)
bootresults
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = noout, statistic = indirectsaved, R = 5000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.09369153 -9.754256e-05 0.02071212
summary(bootresults) # default summary
## R original bootBias bootSE bootMed
## 1 5000 0.093692 -9.7543e-05 0.020712 0.092808
confint(bootresults)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## 1 0.05558337 0.1378112
boot.ci(bootresults,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = bootresults, conf = 0.95, type = "norm", index = 1)
##
## Intervals :
## Level Normal
## 95% ( 0.0532, 0.1344 )
## Calculations and Intervals on Original Scale
plot(bootresults, index=1) # plot Intercept
hist(bootresults)
## Moderated mediation Hayes - Model 5
noout$cx=scale(noout$x,scale=F)
noout$cw=scale(noout$w,scale=F)
cpath=lm(y~cx*cw,noout)
summary(cpath)
##
## Call:
## lm(formula = y ~ cx * cw, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7066 -0.9555 0.0485 1.0526 4.7050
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.48815 0.05700 61.192 <2e-16 ***
## cx 0.62157 0.03554 17.491 <2e-16 ***
## cw -0.07778 0.11402 -0.682 0.495
## cx:cw -0.14086 0.07109 -1.981 0.048 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.406 on 609 degrees of freedom
## Multiple R-squared: 0.3373, Adjusted R-squared: 0.334
## F-statistic: 103.3 on 3 and 609 DF, p-value: < 2.2e-16
apath=lm(m~cx,noout)
summary(apath)
##
## Call:
## lm(formula = m ~ cx, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7968 -0.6351 0.0508 0.7032 3.3464
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.91069 0.04253 115.47 <2e-16 ***
## cx 0.38106 0.02651 14.37 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.053 on 611 degrees of freedom
## Multiple R-squared: 0.2527, Adjusted R-squared: 0.2515
## F-statistic: 206.6 on 1 and 611 DF, p-value: < 2.2e-16
bpath=lm(y~cx*cw+m,noout)
summary(bpath)
##
## Call:
## lm(formula = y ~ cx * cw + m, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6839 -0.9099 0.0144 1.0241 4.4413
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.29500 0.26722 8.588 <2e-16 ***
## cx 0.52856 0.04047 13.061 <2e-16 ***
## cw -0.06282 0.11225 -0.560 0.5760
## m 0.24287 0.05318 4.567 6e-06 ***
## cx:cw -0.13412 0.06998 -1.917 0.0557 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.383 on 608 degrees of freedom
## Multiple R-squared: 0.3593, Adjusted R-squared: 0.3551
## F-statistic: 85.23 on 4 and 608 DF, p-value: < 2.2e-16
noout$lowcx=noout$cx+sd(noout$cx)
noout$highcx=noout$cx-sd(noout$cx)
bpathlowx=lm(y~lowcx*cw+m,noout)
summary(bpathlowx)
##
## Call:
## lm(formula = y ~ lowcx * cw + m, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6839 -0.9099 0.0144 1.0241 4.4413
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.44639 0.24195 5.978 3.85e-09 ***
## lowcx 0.52856 0.04047 13.061 < 2e-16 ***
## cw 0.15252 0.15848 0.962 0.3362
## m 0.24287 0.05318 4.567 6.00e-06 ***
## lowcx:cw -0.13412 0.06998 -1.917 0.0557 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.383 on 608 degrees of freedom
## Multiple R-squared: 0.3593, Adjusted R-squared: 0.3551
## F-statistic: 85.23 on 4 and 608 DF, p-value: < 2.2e-16
bpathhighx=lm(y~highcx*cw+m,noout)
summary(bpathhighx)
##
## Call:
## lm(formula = y ~ highcx * cw + m, data = noout)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6839 -0.9099 0.0144 1.0241 4.4413
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.14360 0.30450 10.324 <2e-16 ***
## highcx 0.52856 0.04047 13.061 <2e-16 ***
## cw -0.27815 0.15915 -1.748 0.0810 .
## m 0.24287 0.05318 4.567 6e-06 ***
## highcx:cw -0.13412 0.06998 -1.917 0.0557 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.383 on 608 degrees of freedom
## Multiple R-squared: 0.3593, Adjusted R-squared: 0.3551
## F-statistic: 85.23 on 4 and 608 DF, p-value: < 2.2e-16
a=apath$coefficients[2]
b=bpath$coefficients[4]
SEa=coef(summary(apath))[,"Std. Error"][2]
SEb=coef(summary(bpath))[,"Std. Error"][4]
zscore=(a*b)/sqrt((b^2*SEa^2)+(a^2*SEb^2)+(SEa^2*SEb^2))
zscore
## cx
## 4.342845
pnorm(abs(zscore),lower.tail=F)*2
## cx
## 1.406493e-05
indirect=a*b ## indirect effect computation
indirect
## cx
## 0.09254768
indirectsaved=function(dataset,random){
d=dataset[random, ]
apath=lm(m~cx,data=d)
bpath=lm(y~cx*cw+m,data=d)
indirect=apath$coefficients[2]*bpath$coefficients[4]
return(indirect)
}
bootresults=boot(data=noout,
statistic=indirectsaved,
R=5000)
bootresults
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = noout, statistic = indirectsaved, R = 5000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 0.09254768 -0.0002195436 0.02104546
summary(bootresults) # default summary
## R original bootBias bootSE bootMed
## 1 5000 0.092548 -0.00021954 0.021045 0.092327
confint(bootresults)
## Bootstrap bca confidence intervals
##
## 2.5 % 97.5 %
## 1 0.05209069 0.1340439
boot.ci(bootresults,conf=.95,type="norm",index=1) ## Intercept
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 5000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = bootresults, conf = 0.95, type = "norm", index = 1)
##
## Intervals :
## Level Normal
## 95% ( 0.0515, 0.1340 )
## Calculations and Intervals on Original Scale
plot(bootresults, index=1) # plot Intercept
hist(bootresults)
