# Social Bonding at Sunday Assembly Rituals -------------------------- rm(list=ls()) library("MASS",character.only=TRUE) library(lme4) library(MBESS) library(dplyr) library(MASS) library(apaTables) library(psychometric) require(foreign) require(magrittr) require(ggplot2) require(ggpubr) require(lattice) require(reshape2) require(nlme) require(MuMIn) require(PairedData) require(gridExtra) require(ggfortify) require(multilevel) require(robumeta) require(psych) require(GPArotation) require(lm.beta) require(lmtest) require(car) require(nparLD) require(WRS2) require(npsm) require(exactRankTests) ## Can't recall which of these libraries are needed as I've used different ones at different times, so just load all## ### Import Data ### data <- read.csv("Church and SA data - Wide.csv", header = TRUE) # includes participants otherwise excluded by cuff. length(data$SB6_Pre) # N = 99 SB_CV <- read.csv("Social Bonding Factor Analysis.csv", header=TRUE) # Social Bonding construct validity (Sunday Assembly participants only) data_Chr <- data[data$SA_Ctrl==0,] # Churches Only data_SA <- data[data$SA_Ctrl==1,] # SA Only # Basic Information #Participants ages/gender: mean(data$Age) #48.2 sd(data$Age) #18.21 count(data, "Gender") #32 Male, 66 Female, 1 Non-Binary # Churches mean(data_Chr$Age) #57.8 sd(data_Chr$Age) #18.08 count(data_Chr, "Gender") #16 Male, 34 Female #Sunday Assemblies mean(data_SA$Age) #38.4 sd(data_SA$Age) #12.21 count(data_SA, Gender) #16 Male, 32 Female, 1 Non-Binary #Participants' overall Religiosity: mean(data$Religiosity) #3.56 (out of 7) sd(data$Religiosity) # 2.25 #Church mean(data_Chr$Religiosity) #5.41 (out of 7) sd(data_Chr$Religiosity) # 1.36 #SA mean(data_SA$Religiosity) #1.63 (out of 7) sd(data_SA$Religiosity) # 1.05 ### Social Bonding Measure (SB6) - Factor Analysis and Reliability ------------------------------------ # Here we conducted a factor analysis first of the 5 verbal social bonding questions. (lines 87-123) # We then saught to see if it had some construct by correlating it with the IOS (Aron et al., 1992) (lines 124-165) # It did have validity, and we incorporated IOS into the measure, and did a second factor analysis. (lines 166-249) # For factor diagrams, see lines 203-207. For reliability see lines 208-247 # First only Sunday Assembly (SA) social bonding was measured, then Church data, then a combination, for completeness. {## Factor Analysis of SB5 #### #Factor Analysis: SB5_Cor_Prea <- SB_CV[,2:6] SB5_Cor_Pre <- round(cor(SB5_Cor_Prea),2) SB5_Cor_Pre SB5_Cor_Posta <- SB_CV[,10:14] SB5_Cor_Post <- round(cor(SB5_Cor_Posta),2) SB5_Cor_Post #Factor analysis of the pre-service SB5 data factors_SB5_Pre <- fa(r = SB5_Cor_Pre, fm = "pa") #Getting the factor loadings and model analysis factors_SB5_Pre scree(SB5_Cor_Pre) # scree plot suggests 1 factor # Factor Analysis using method = principal axis (pa) # Default is oblimin - an oblique rotation # factor analysis shows that 1 factor is sufficient. # Mean item complexity = 1 # Variance explained = .72 # RMSR = 0.04 # df corrected RMSR = 0.06 #Factor analysis of the post-service SB5 data factors_SB5_Post <- fa(r = SB5_Cor_Post, fm = "pa") #Getting the factor loadings and model analysis factors_SB5_Post scree(SB5_Cor_Post) # scree plot suggests 1 factor #Factor Analysis using method = principal axis (pa) #Default is oblimin - an oblique rotation # factor analysis shows that 1 factor is sufficient. #Mean item complexity = 1 # Variance explained = .75 # RMSR = 0.06 # df corrected RMSR = 0.08 } {## Validity check of SB5 and IOS (similar Constructs?) #### IOS_Pre <- SB_CV$IOS_Pre SB5_Pre <- SB_CV$SB5_Pre IOS_Post <- SB_CV$IOS_Post SB5_Post <- SB_CV$SB5_Post ggdensity(SB5_Pre, main = "Density plot of Pre-Service SB5", xlab = "Pre-Service SB5") ggdensity(SB5_Post, main = "Density plot of Post-Service SB5", xlab = "Post-Service SB5") ggdensity(IOS_Pre, main = "Density plot of Pre-Service IOS", xlab = "Pre-Service IOS") ggdensity(IOS_Post, main = "Density plot of Post-Service IOS", xlab = "Post-Service IOS") shapiro.test(SB5_Pre) # W = .967 - Not stat. sig. dif. from normal(p = .189) shapiro.test(IOS_Pre) # W = .918 - stat. sig. dif. from normal (p = .002) shapiro.test(SB5_Post) # W = .951 - stat. sig. dif. from normal (p = .039) shapiro.test(IOS_Post) # W = .939 - stat. sig. dif. from normal (p = .013) # Non-parametric tests needed for construct validity ## non-parametric ## Pre_CVSR <- cor.test(IOS_Pre,SB5_Pre, method = "spearman", conf.level = 0.95) # Pre-service construct validity Pre_CVSR # rho = .774, p < .001 Post_CVSR <- cor.test(IOS_Post,SB5_Post, method = "spearman", conf.level = 0.95) # post-service construct validity Post_CVSR # rho = .722, p < .001 # (Parametric versions, For completeness) Pre_CV <- cor.test(IOS_Pre,SB5_Pre, method = "pearson", conf.level = 0.95) # Pre-service construct validity Pre_CV # r = .760, p < .001 Post_CV <- cor.test(IOS_Post,SB5_Post, method = "pearson", conf.level = 0.95) # post-service construct validity Post_CV # r = .733, p < .001 } {## Factor Analysis of SB6 #### #Factor Analysis: SB6_Cor_Prea <- select(SB_CV, Connected_Pre, Emo_Close_Pre, Trust_Pre, Like_Pre, Common_Pre, IOS_Pre) head(SB6_Cor_Prea) SB6_Cor_Pre <- round(cor(SB6_Cor_Prea),2) SB6_Cor_Pre SB6_Cor_Posta <- select(SB_CV, Connected_Post, Emo_Close_Post, Trust_Post, Like_Post, Common_Post, IOS_Post) SB6_Cor_Post <- round(cor(SB6_Cor_Posta),2) SB6_Cor_Post #Factor analysis of the pre-service SB5 data factors_SB6_Pre <- fa(r = SB6_Cor_Pre, fm = "pa") #Getting the factor loadings and model analysis factors_SB6_Pre scree(SB6_Cor_Pre) # scree plot suggests 1 factor #Factor Analysis using method = principal axis (pa) #Default is oblimin - an oblique rotation # factor analysis shows that 1 factor is sufficient. #Mean item complexity = 1 # Var explained 0.7 # RMSR = 0.05 # df corrected RMSR = 0.06 #Factor analysis of the post-service SB5 data factors_SB6_Post <- fa(r = SB6_Cor_Post, fm = "pa") #Getting the factor loadings and model analysis factors_SB6_Post scree(SB6_Cor_Post) # scree plot suggests 1 factor # Factor Analysis using method = principal axis (pa) # Default is oblimin - an oblique rotation # factor analysis shows that 1 factor is sufficient. # Mean item complexity = 1 # RMSR = 0.05 # df corrected RMSR = 0.07 # Factor Diagrams, showing loadings for the single factor. fa.diagram(factors_SB5_Pre, sort = TRUE) # factor loadings average > .7, Likely essentially tau-equivalent (alpha ~ omega) fa.diagram(factors_SB5_Post, sort = TRUE) # factor loadings average > .7, Likely essentially tau-equivalent (alpha ~ omega) fa.diagram(factors_SB6_Pre, sort = TRUE) # factor loadings average > .7, Likely essentially tau-equivalent (alpha ~ omega) fa.diagram(factors_SB6_Post, sort = TRUE) # factor loadings average > .7, Likely essentially tau-equivalent (alpha ~ omega) } {## Scale Reliability #### SASB5_pre_omega <- ci.reliability(SB5_Cor_Prea, type = "omega", conf.level = 0.95, B=1000) SASB5_pre_omega # SB5_Pre omega = .93[.90, .96] SASB5_post_omega <- ci.reliability(SB5_Cor_Posta, type = "omega", conf.level = 0.95, B=1000) SASB5_post_omega# SB5_post omega = .94[.90, .97] SASB6_pre_omega <- ci.reliability(SB6_Cor_Prea, type = "omega", conf.level = 0.95, B=1000) SASB6_pre_omega # SB6_Pre omega = .93[.91, .96] SASB6_post_omega <- ci.reliability(SB6_Cor_Posta, type = "omega", conf.level = 0.95, B=1000) sASB6_post_omega# SB6_post omega = .93[.90, .96] SASB6_Pre_Alpha <- alpha(SB6_Cor_Prea) SASB6_Pre_Alpha # SB6_Pre alpha = .93[.90, .96] SASB6_Post_Alpha <- alpha(SB6_Cor_Posta) SASB6_Post_Alpha # SB6_Post alpha = .93[.90, .96] # (as can be seen here, alpha ~ omega, so either value is fine to use) Chr_SB6_Cor_Pre <- select(data_Chr, SBpre_Connected, SBpre_Emo_close, SBpre_trust, SBpre_like, SBpre_common, SBpre_IOS) Chr_SB6_Cor_Post <- select(data_Chr, SBpost_Connected, SBpost_Emo_close, SBpost_trust, SBpost_like, SBpost_common, SBpost_IOS) ChrSB6_pre_omega <- ci.reliability(Chr_SB6_Cor_Pre, type = "omega", conf.level = 0.95, B=1000) ChrSB6_pre_omega # Church SB6 Pre omega = .94[.90, .97] ChrSB6_pre_alpha <- alpha(Chr_SB6_Cor_Pre) ChrSB6_pre_alpha # Church SB6 Pre alpha = .94[.91, .96] ChrSB6_post_omega <- ci.reliability(Chr_SB6_Cor_Post, type = "omega", conf.level = 0.95, B=1000) ChrSB6_post_omega# Church SB6 Post omega = .88[.81, .95] ChrSB6_post_alpha <- alpha(Chr_SB6_Cor_Post) ChrSB6_post_alpha # Church SB6 Post alpha = .89[.84, .93] All_SB6_Cor_Pre <- select(data, SBpre_Connected, SBpre_Emo_close, SBpre_trust, SBpre_like, SBpre_common, SBpre_IOS) All_SB6_Cor_Post <- select(data, SBpost_Connected, SBpost_Emo_close, SBpost_trust, SBpost_like, SBpost_common, SBpost_IOS) All_SB6_Pre_Alpha <- alpha(All_SB6_Cor_Pre) All_SB6_Pre_Alpha # All SB6 Pre alpha = .93 [.91, .95] All_SB6_Post_Alpha <- alpha(All_SB6_Cor_Post) All_SB6_Post_Alpha # All SB6 Pre alpha = .91 [.88, .94] AllSB6_pre_omega <- ci.reliability(All_SB6_Cor_Pre, type = "omega", interval.type = "perc", conf.level = 0.95, B=500) AllSB6_pre_omega # SB6_Pre omega = .93 [.91, .96] AllSB6_post_omega <- ci.reliability(All_SB6_Cor_Post, type = "omega", interval.type = "perc", conf.level = 0.95, B=1000) AllSB6_post_omega# SB6_post omega = .90 [.87, .94] } ### ----------------------------- ### ### Main Hypothesis Tests #### ### ----------------------------- ### ### ----------------------------------- ### ### Hypothesis 1 - Data Assumptions #### ### ----------------------------------- ### ## ------------- ## {## Density Plots ==== ## ------------- ## ggdensity(data_SA$SB6_Pre, main = "Density plot of Pre-Service Social Bonding Measure", xlab = "Pre-Service Social Bonding") # Doesn't look very normal ggdensity(data_SA$SB6_Post, main = "Density plot of Post-Service Social Bonding Measure", xlab = "Post-Service Social Bonding") # Looks somewhat normal ggdensity(data_SA$SB6_Change, main = "Density plot of change in Social Bonding Measure", xlab = "Social Bonding Change") # Does not look normal } ## --------- ## {## Q-Q Plots ==== ## --------- ## ggqqplot(data_SA$SB6_Pre) ggqqplot(data_SA$SB6_Post) ggqqplot(data_SA$SB6_Change) } ## ----------------- ## {## Shaprio-Wilk Test ==== ## ----------------- ## shapiro.test(data_SA$SB6_Pre) # W = .977, p = .433 - Not stat. sig. dif. from normal shapiro.test(data_SA$SB6_Post) # W = .952, p = .047 - stat. sig. dif. from normal shapiro.test(data_SA$SB6_Change) # W = .816, p = < .001 - stat. sig. dif. from normal } ### ---------------------------------------------------------------------------------- ### ### Hypothesis 1: Change from Before to After Sunday Assembly ----------------------- #### ### ---------------------------------------------------------------------------------- ### {## Wilcoxon Signed Ranks ==== {# Social Bonding #### # descriptives # length(data_SA$SB6_Pre) # 49 mean(data_SA$SB6_Pre) # 4.27 sd(data_SA$SB6_Pre) # 1.26 median(data_SA$SB6_Pre) # 4.33 length(data_SA$SB6_Post) #49 mean(data_SA$SB6_Post) # 4.96 sd(data_SA$SB6_Post) # 1.16 median(data_SA$SB6_Post) # 5.17 # non-parametric test # Wilcox_SB <- wilcox.test(data_SA$SB6_Pre, data$SB6_Post, paired = TRUE, exact = TRUE, alternative = "less") Wilcox_SB #output result # V = 89.5, p = < .001 SB_diff <- c(data_SA$SB6_Pre- data_SA$SB6_Post) #create the differences SB_diff <- SB_diff[ SB_diff!=0 ] #delete all differences equal to zero SB_diff_rank <- rank(abs(SB_diff)) #check the ranks of the differences, taken in absolute SB_diff_rank_sign <- SB_diff_rank * sign(SB_diff) #check the sign to the ranks, recalling the signs of the values of the differences SB_ranks_P <- sum(SB_diff_rank_sign[SB_diff_rank_sign > 0]) #calculating the sum of ranks assigned to the differences as a positive, ie greater than zero SB_ranks_N <- -sum(SB_diff_rank_sign[SB_diff_rank_sign < 0]) #calculating the sum of ranks assigned to the differences as a negative, ie less than zero SB_ranks_P # used in effect size calculation (Kerby) SB_ranks_N # used in effect size calculation (Kerby) # effect size # Zstat_SB<-qnorm(Wilcox_SB$p.value/2) #Z score Zstat_SB #print the Z-score = -5.02 SB_Bf_pval <- Wilcox_SB$p.value * 3 # Bonferroni correction (should it be needed) SB_Bf_pval SB_rR <- abs(Zstat_SB)/sqrt(49*2) # Effect size (Rosenthal, 1994) - more conservative effect size. SB_rR # r = 0.51 SB_rK <- ((SB_ranks_P/(SB_ranks_P+SB_ranks_N))-(SB_ranks_N/(SB_ranks_P+SB_ranks_N))) # Effect size (Kerby, 2014) - Less conservative. abs(SB_rK) # r= 0.84 # two-tailed Wilcox_SB <- wilcox.test(data_SA$SB6_Pre, data_SA$SB6_Post, paired = TRUE, exact = TRUE) Wilcox_SB # V = 89.5, p = < .001 } } ### --------------------------------- ### ### Hypothesis 2 - Power Analysis #### ### --------------------------------- ### #based on Charles et . (2020) effect_size_rR <- .34 effect_size_rK <- .62 #convert r -> f #f = sqrt(R^2/ (1-R^2)) conservative_f <-sqrt(.34^2/ (1-.34^2)) # f = .3615... simpledif_to_f <- sqrt(.62^2/ (1-.62^2)) # f = .7902... cor(data$SB6_Pre,data$SB6_Post, method = "pearson") # 0.753... #though, data may not be normally distributed. shapiro.test(data$SB6_Pre) #W = 0.96781, p-value = 0.01506 shapiro.test(data$SB6_Post) #W = 0.94679, p-value = 0.0005132 cor(data$SB6_Pre,data$SB6_Post, method = "spearman") # 0.799... ### ----------------------------------- ### ### Hypothesis 2 - Data assumptions #### ### ----------------------------------- ### shapiro.test(data_SA$SB6_Pre) #W = 0.97663, p-value = 0.4334 shapiro.test(data_SA$SB6_Post) #W = 0.95264, p-value = 0.04727 shapiro.test(data_Chr$SB6_Pre) #W = 0.92674, p-value = 0.003742 shapiro.test(data_Chr$SB6_Post) #W = 0.93877, p-value = 0.01097 # Assumption of normality not met. Non-parametric ANOVA required. data_long <- read.csv("Church and SA data - LONG.csv", header = TRUE) data_long$FactRT <- factor(data_long$SA_Ctrl) # Ritual type - SA or Control (churches) as a factor data_long$FactPP <- factor(data_long$Pre_Post) # Measurement Occasion as a factor require(plyr) data_long$FactPP <- revalue(data_long$FactPP, c("Pre"="Pre-Ritual","Post"="Post-Ritual")) require(car) leveneTest(SB6 ~ FactRT,data_long) # Levene's Test for Homogeneity of Variance (center = median) # Df F value Pr(>F) # group 1 2.7988 0.09593 # 196 # Homogeneity of Variances assumtion not violated ### ---------------------------------------------------- ### ### Hypothesis 2 - Difference Between SA and Church #### ### ---------------------------------------------------- ### require(nparLD) # non-parametric ANOVA package ex.f1f1np <- nparLD(SB6 ~ FactRT * FactPP, data = data_long, subject = "Participant_Code", description = FALSE) plot(ex.f1f1np) summary(ex.f1f1np) nonpar_ANOVA <- f1.ld.f1(data_long$SB6, data_long$FactPP, data_long$FactRT, data_long$Participant_Code) nonpar_ANOVA$RTE # RTE < .5 means there is less than 50% chance of randomly choosing a participant from this sample with a higher than average SB6. # RTE > .5 means there is greater than 50% chance of randomly choosing a participant from this sample with a higher than average SB6. nonpar_ANOVA$case2x2 # Statistic p-value(N) df p-value(T) # Group 2.093185 3.633265e-02 95.98559 3.896964e-02 # Time -7.215408 5.377263e-13 94.83816 1.312904e-10 # Group:Time 1.942023 5.213437e-02 94.83816 5.510160e-02 nonpar_ANOVA$ANOVA.test # Statistic df p-value # Group 4.381423 1 3.633265e-02 # Time 52.062108 1 5.377263e-13 # Group:Time 3.771452 1 5.213437e-02 # Significant Main Effect Measurement Occasion (p < .001) and Group (p = .036) # No Significant interaction effect (p = .052) nonpar_ANOVA$ANOVA.test.mod.Box # Whole model. # Statistic df1 df2 p-value # Group 4.381423 1 95.98559 0.03896964 ## Feys (2016) suggest that in a non-parametric, Mixed-ANOVA design with only 2 time points (pre-post test), ## a non-parametric ANCOVA could be used instead (p. 373-374). reccomends a few options: ##Feys (2016) non-parametric ANOVA Follow-Up #### # The onecovahomog function from npsm # 'yuen', 'Kruskal-Wallis' and ' Exact Wilcoxon-Mann-Whitney'from WRS2 ## NPSM ANCOVA results: ### library("npsm") ANCOVAdata=data[,c('SB6_Post','SA_Ctrl')] ## Data for ANOVA - Post-SB6 column 1 and Group in column 2 xcov<-cbind(data['SB6_Pre']) # Covariate - in this case pre-SB6 onecovahomog(2,ANCOVAdata,xcov,print.table=TRUE) # 2 levels, Post-SB6 by Group, with Pre-SB6 as Covariates # There is not a significant effect of group on post-SB6 response after controlling for pre-SB6 response. F(1,98) = 1.81, p = .18 (i.e. no interaction effect) ## WRS2 Yuen library("WRS2") yuen(SB6_Change ~ SA_Ctrl, data = data) # Two-tailed Yuen-Welch Test (timmed-mean difference) t(58.3) = 2.20, p = .0317, # TMD = -.32312 95%CI [-.617, -.0293], d = 0.33 # significant effect of group, where those at SA had a greater change in social bonding score by .323 compared to Sunday Assembly. ## KW Test kruskal.test(SB6_Change ~ SA_Ctrl, data = data) # chi-squared = 4.90, p = .027 - significant difference between the groups, where SB change is higher in SA than in Church. ## Exact Wilcoxon-Mann-Whitney library("exactRankTests") wilcox.exact(SB6_Change ~ SA_Ctrl, data = data, conf.int = TRUE, conf.level = 0.95) ## W=910, p = .027. Estimated difference of Church v.s. Sunday Assembly = -.333 95% CI [-,500, -.000] # Majority of tests suggest a significant effect. ## Feys (2016). Nonparametric Tests for the Interaction in Two-way Factorial Designs Using R, ## The R Journal Volume 8(1):367-378 ## DOI: 10.32614/RJ-2016-027 # Figure 2 - Social Bonding Interaction Plot #### # Interaction Box Plot (Figure 2 in paper) SB6Int <- ddply(data_long,.(FactPP,SA_Ctrl),summarise, val = mean(SB6)) ggplot(data_long, aes(x = FactPP, y = SB6, colour = SA_Ctrl)) + geom_boxplot(position=position_dodge(1), notch = "TRUE", outlier.shape = NA) + geom_point(data = SB6Int, aes(y = val)) + geom_line(data = SB6Int, aes(y = val, group = SA_Ctrl)) + theme_bw() + scale_x_discrete(limits=c("Pre-Ritual", "Post-Ritual")) + xlab("Measurement Occasion") + ylab("Social Bonding score") + labs(colour = "Ritual Group") + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ theme(axis.text=element_text(size=12), axis.title=element_text(size=12), legend.text = element_text(size=12), legend.title = element_text(size=12)) # Interaction Violin Plot - for those who prefer violin plots to notched box plots SB6Int <- ddply(data_long,.(Pre_Post,SA_Ctrl),summarise, val = mean(SB6)) ggplot(data_long, aes(x = factor(Pre_Post), y = SB6, colour = SA_Ctrl)) + geom_violin(position=position_dodge(1)) + geom_point(data = SB6Int, aes(y = val)) + geom_line(data = SB6Int, aes(y = val, group = SA_Ctrl)) + theme_bw() + scale_x_discrete(limits=c("Pre", "Post"))+ xlab("Measurement Occasion (pre- v.s. post- ritual)") + ylab("Social Bonding Score (SB6, 0-7)") + labs(title ="Social Bonding Change from before to after ritual for both Sunday Assembly and Church groups", colour = "Ritual Group") ### Exploratory Analysis Data assumptions ---- dataPANAS <- data[complete.cases(data), ] # Exclude NAs length(dataPANAS$PANASP_Pre) # N = 95 dataPANAS_Chr <- dataPANAS[dataPANAS$SA_Ctrl==0,] # Churches Only, only participants who have no NA in PANAS dataPANAS_SA <- dataPANAS[dataPANAS$SA_Ctrl==1,] # SA Only, only participants who have no NA in PANAS {# PANAS+ #### shapiro.test(dataPANAS_SA$PANASP_Pre) # W = .976, p = .445 - Not stat. sig. dif. from normal shapiro.test(dataPANAS_SA$PANASP_Post) # W = .939, p = .017 - stat. sig. dif. from normal shapiro.test(dataPANAS_SA$PANASP_Change) # W = .972, p = .323 - stat. sig. dif. from normal # Non-parametric test to be carried out. # descriptives # mean(dataPANAS_SA$PANASP_Pre) #26.21 sd(dataPANAS_SA$PANASP_Pre) #9.23 median(dataPANAS_SA$PANASP_Pre) #24.0 mean(dataPANAS_SA$PANASP_Post) #31.68 sd(dataPANAS_SA$PANASP_Post) #11.57 median(dataPANAS_SA$PANASP_Post) #32.0 # test # Wilcox_PANASP <- wilcox.test(dataPANAS_SA$PANASP_Pre, dataPANAS_SA$PANASP_Post, paired = TRUE) Wilcox_PANASP #output result PANASP_diff <- c(dataPANAS_SA$PANASP_Pre - dataPANAS_SA$PANASP_Post) #create the differences PANASP_diff <- PANASP_diff[ PANASP_diff!=0 ] #delete all differences equal to zero PANASP_diff_rank <- rank(abs(PANASP_diff)) # create difference ranks PANASP_diff_rank_sign <- PANASP_diff_rank * sign(PANASP_diff) # give difference correct sign PANASP_ranks_P <- sum(PANASP_diff_rank_sign[PANASP_diff_rank_sign > 0]) # sum positive ranks PANASP_ranks_N <- -sum(PANASP_diff_rank_sign[PANASP_diff_rank_sign < 0]) # sum negative ranks PANASP_ranks_P # used in effect size calculation (Kerby) PANASP_ranks_N # used in effect size calculation (Kerby) # effect size # Zstat_PANASP<-qnorm(Wilcox_PANASP$p.value/2) #Z score Zstat_PANASP # Z = -3.90 PANASP_Bf_pval <- Wilcox_PANASP$p.value * 3 # Bonferroni correction PANASP_Bf_pval # p < .001 PANASP_rR <- abs(Zstat_PANASP)/sqrt(47*2) # Effect size (Rosenthal) - more conservative effect size. PANASP_rR # .40 PANASP_rK <- ((PANASP_ranks_P/(PANASP_ranks_P+PANASP_ranks_N))-(PANASP_ranks_N/(PANASP_ranks_P+PANASP_ranks_N))) # Effect size (Kerby) - Less conservative. abs(PANASP_rK) # .68 } {# PANAS- #### shapiro.test(dataPANAS_SA$PANASN_Pre) # W = .861, p < .001 - stat. sig. dif. from normal shapiro.test(dataPANAS_SA$PANASN_Post) # W = .738, p < .001 - stat. sig. dif. from normal shapiro.test(dataPANAS_SA$PANASN_Change) # W = .976, p = = .435 - stat. sig. dif. from normal # non parametric test to be carried out. # descriptives # mean(dataPANAS_SA$PANASN_Pre) # 5.00 sd(dataPANAS_SA$PANASN_Pre) # 4.10 median(dataPANAS_SA$PANASN_Pre) # 4.0 mean(dataPANAS_SA$PANASN_Post) # 3.30 sd(dataPANAS_SA$PANASN_Post) # 4.23 median(dataPANAS_SA$PANASN_Post) # 2.0 # test # Wilcox_PANASN <- wilcox.test(dataPANAS_SA$PANASN_Pre, dataPANAS_SA$PANASN_Post, paired = TRUE) Wilcox_PANASN #output result PANASN_diff <- c(dataPANAS_SA$PANASN_Pre - dataPANAS_SA$PANASN_Post) #create the differences PANASN_diff <- PANASN_diff[ PANASN_diff!=0 ] #delete all differences equal to zero PANASN_diff_rank <- rank(abs(PANASN_diff)) # create difference ranks PANASN_diff_rank_sign <- PANASN_diff_rank * sign(PANASN_diff) # give difference correct sign PANASN_ranks_P <- sum(PANASN_diff_rank_sign[PANASN_diff_rank_sign > 0]) # sum positive ranks PANASN_ranks_N <- -sum(PANASN_diff_rank_sign[PANASN_diff_rank_sign < 0]) # sum negative ranks PANASN_ranks_P # used in effect size calculation (Kerby) PANASN_ranks_N # used in effect size calculation (Kerby) # effect size # Zstat_PANASN<-qnorm(Wilcox_PANASN$p.value/2) #Z score Zstat_PANASN #print the Z-score PANASN_Bf_pval <- Wilcox_PANASN$p.value * 3 # Bonferroni correction PANASN_Bf_pval # p = .047 PANASN_rR <- abs(Zstat_PANASN)/sqrt(47*2) # Effect size (Rosenthal) - more conservative effect size. PANASN_rR # .25 PANASN_rK <- ((PANASN_ranks_P/(PANASN_ranks_P+PANASN_ranks_N))-(PANASN_ranks_N/(PANASN_ranks_P+PANASN_ranks_N))) # Effect size (Kerby) - Less conservative. abs(PANASN_rK) # .44 } # PANAS ANOVA #### # PANAS+ require(nparLD) PANASdata_long <- data_long[complete.cases(data_long),] ANOVAPANASdata_long <- subset(PANASdata_long, ave(Participant_Code, Participant_Code, FUN = length) > 1) PANASP.f1f1np <- nparLD(PANASP ~ FactRT * FactPP, data = ANOVAPANASdata_long, subject = "Participant_Code", description = FALSE) plot(PANASP.f1f1np) summary(PANASP.f1f1np) PANASP_ANOVA <- f1.ld.f1(ANOVAPANASdata_long$PANASP, ANOVAPANASdata_long$FactPP, ANOVAPANASdata_long$FactRT, ANOVAPANASdata_long$Participant_Code) PANASP_ANOVA$RTE # RTE < .5 means there is less than 50% chance of randomly choosing a participant from this sample with a higher than average PANAS+. # RTE > .5 means there is greater than 50% chance of randomly choosing a participant from this sample with a higher than average PANAS+. PANASP_ANOVA$case2x2 # Statistic p-value(N) df p-value(T) # Group -0.3869925 6.987618e-01 93.92600 6.996372e-01 No sig effect of group # Time -6.0316593 1.622846e-09 92.42517 3.311585e-08 Sig effect of time # Group:Time 1.942023 5.213437e-02 94.83816 5.510160e-02 No sig interaction effect PANASP_ANOVA$ANOVA.test # Statistic df p-value # Group 0.1497632 1 6.987618e-01 # Time 36.3809140 1 1.622846e-09 # Group:Time 1.3027492 1 2.537117e-01 # Significant Main Effect Measurement Occasion (p < .001) but not group Group (p = .700) # No Significant interaction effect (p = .055) PANASP_ANOVA$ANOVA.test.mod.Box # Whole model. # Statistic df1 df2 p-value # Group 0.1497632 1 95.98559 0.6996372 # The onecovahomog function from npsm # 'yuen', 'Kruskal-Wallis' and ' Exact Wilcoxon-Mann-Whitney'from WRS2 ## NPSM ANCOVA results: ### library("npsm") ANCOVAdata=data[,c('SB6_Post','SA_Ctrl')] ## Data for ANOVA - Post-SB6 column 1 and Group in column 2 xcov<-cbind(data['SB6_Pre']) # Covariate - in this case pre-SB6 onecovahomog(2,ANCOVAdata,xcov,print.table=TRUE) # 2 levels, Post-SB6 by Group, with Pre-SB6 as Covariates # There is not a significant effect of group on post-SB6 response after controlling for pre-SB6 response. F(1,98) = 1.81, p = .18 (i.e. no interaction effect) ## WRS2 Yuen library("WRS2") yuen(PANASP_Change ~ SA_Ctrl, data = data) # Two-tailed Yuen-Welch Test (timmed-mean difference) t(58.3) = 2.20, p = .606, # TMD = -.5199 95%CI [-4.0417, 2.3819], d = 0.09 # No significant effect of group. ## KW Test kruskal.test(PANASP_Change ~ SA_Ctrl, data = data) # chi-squared = 0.433, p = .511 - No significant difference between the groups, ## Exact Wilcoxon-Mann-Whitney library("exactRankTests") wilcox.exact(PANASP_Change ~ SA_Ctrl, data = data, conf.int = TRUE, conf.level = 0.95) ## W=1084, p = .511. Estimated difference of Church v.s. Sunday Assembly = -1.000 95% CI [-4,000, 2.000] # None of the tests suggest a significant effect of group. ## Feys (2016). Nonparametric Tests for the Interaction in Two-way Factorial Designs Using R, ## The R Journal Volume 8(1):367-378 ## DOI: 10.32614/RJ-2016-027 # PANAS- PANASN.f1f1np <- nparLD(PANASN ~ FactRT * FactPP, data = ANOVAPANASdata_long, subject = "Participant_Code", description = FALSE) plot(PANASN.f1f1np) summary(PANASN.f1f1np) PANASN_ANOVA <- f1.ld.f1(ANOVAPANASdata_long$PANASN, ANOVAPANASdata_long$FactPP, ANOVAPANASdata_long$FactRT, ANOVAPANASdata_long$Participant_Code) PANASN_ANOVA$RTE # RTE < .5 means there is less than 50% chance of randomly choosing a participant from this sample with a higher than average PANAS-. # RTE > .5 means there is greater than 50% chance of randomly choosing a participant from this sample with a higher than average PANAS-. PANASN_ANOVA$case2x2 # Statistic p-value(N) df p-value(T) # Group -5.1280163 2.928111e-07 91.74162 1.621034e-06 Sig effect of group # Time 5.5051584 3.688364e-08 75.77492 4.829054e-07 Sig effect of time # Group:Time -0.7249341 4.684925e-01 75.77492 4.707252e-01 No sig interaction effect PANASN_ANOVA$ANOVA.test # Statistic df p-value # Group 26.2965513 1 2.928111e-07 # Time 30.3067695 1 3.688364e-08 # Group:Time 0.5255294 1 4.684925e-01 # Significant Main Effect Measurement Occasion (p < .001) and Group (p < .001) # No Significant interaction effect (p = .468) PANASN_ANOVA$ANOVA.test.mod.Box # Whole model. # Statistic df1 df2 p-value # Group 26.29655 1 91.74162 1.621034e-06 ## Figure 3 - PANAS GRAPHS #### # PANAS+ Interaction box plot (Figure 3a) PANASPInt <- ddply(ANOVAPANASdata_long,.(FactPP,FactRT),summarise, val = mean(PANASP)) Fig3a<- ggplot(ANOVAPANASdata_long, aes(x = FactPP, y = PANASP, colour = FactRT)) + geom_boxplot(position=position_dodge(1), notch = "TRUE", outlier.shape = NA) + geom_point(data = PANASPInt, aes(y = val)) + geom_line(data = PANASPInt, aes(y = val, group = FactRT)) + theme_bw() + scale_x_discrete(limits=c("Pre-Ritual", "Post-Ritual")) + xlab("Measurement Occasion") + ylab("PANAS+") + labs(colour = "Ritual Group") + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ theme(axis.text=element_text(size=12), axis.title=element_text(size=12), legend.text = element_text(size=12), legend.title = element_text(size=12)) # PANAS- Interaction box plot (Figure 3b) PANASNInt <- ddply(ANOVAPANASdata_long,.(FactPP,FactRT),summarise, val = mean(PANASN)) Fig3b <- ggplot(ANOVAPANASdata_long, aes(x = FactPP, y = PANASN, colour = FactRT)) + geom_boxplot(position=position_dodge(1), notch = "TRUE", outlier.shape = NA) + geom_point(data = PANASNInt, aes(y = val)) + geom_line(data = PANASNInt, aes(y = val, group = FactRT)) + theme_bw() + scale_y_continuous(limits = c(0,13)) + scale_x_discrete(limits=c("Pre-Ritual", "Post-Ritual")) + xlab("Measurement Occasion") + ylab("PANAS-") + labs(colour = "Ritual Group") + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ theme(axis.text=element_text(size=12), axis.title=element_text(size=12), legend.text = element_text(size=12), legend.title = element_text(size=12)) require(patchwork) # plot grouping tool (Figure 3) Fig3 <- Fig3a / Fig3b # put plot 3a above 3b Fig3 + plot_annotation(tag_levels = 'a') # label them a and b. ### Hypothesis 3 - Relationship between SB6 and Affect ---- SA_only_data <- read.csv("SA data only - WIDE.csv", header = TRUE) # SA_reg_data <- SA_DUREL_data[complete.cases(SA_only_data), ] # Exclude NAs so addition of extra variables leads to same number of participants # differing number of missing values across variables leads to issues with regression comparisons in the stepmodel. length(SA_reg_data$PANASP_Pre) # N = 47 # Standardising variables SA_reg_data <- SA_reg_data %>% mutate(PANASPZ = (PANASP_Change - mean(PANASP_Change, na.rm=T))/sd(PANASP_Change, na.rm=T)) %>% #grand-mean centred and standardised mutate(PANASNZ = (PANASN_Change - mean(PANASN_Change, na.rm=T))/sd(PANASN_Change, na.rm=T)) %>% mutate(SB6Z = (SB6_Change - mean(SB6_Change, na.rm=T))/sd(SB6_Change, na.rm=T)) %>% mutate(SB6PreZ = (SB6_Pre - mean(SB6_Pre, na.rm=T))/sd(SB6_Pre, na.rm=T)) %>% mutate(SB6PostZ = (SB6_Post - mean(SB6_Post, na.rm=T))/sd(SB6_Post, na.rm=T)) %>% mutate(AgeC = (Age - mean(Age, na.rm=T))) %>% # Just grand-mean centred mutate(EducationZ = (Education - mean(Education, na.rm=T))/sd(Education, na.rm=T)) %>% mutate(BiggerZ = (Connected_Bigger - mean(Connected_Bigger, na.rm=T))/sd(Connected_Bigger, na.rm=T)) %>% mutate(MonthsC = (Months - mean(Months, na.rm=T))) %>% mutate(MeetingZ = (SecDUREL_Meetings - mean(SecDUREL_Meetings, na.rm=T))/sd(SecDUREL_Meetings, na.rm=T)) %>% mutate(OtherZ = (SecDUREL_Other - mean(SecDUREL_Other, na.rm=T))/sd(SecDUREL_Other, na.rm=T)) %>% mutate(PrivateZ = (SecDUREL_Private - mean(SecDUREL_Private, na.rm=T))/sd(SecDUREL_Private, na.rm=T)) %>% mutate(RelZ = (Religiosity - mean(Religiosity, na.rm=T))/sd(Religiosity, na.rm=T)) %>% mutate(SpiritZ = (Spirituality - mean(Spirituality, na.rm=T))/sd(Spirituality, na.rm=T)) # Key: # ___Z = Standardised # ___C = Mean-Centred {# Figure 4 - SA Correlation Plot #### BondingChangeZ <- as.numeric(SA_reg_data$SB6Z) PosAffectChangeZ <- as.numeric(SA_reg_data$PANASPZ) NegAffectChangeZ <- as.numeric(SA_reg_data$PANASNZ) MonthAttend <- as.numeric(SA_reg_data$MonthsC) ConnectSomethBiggerZ <- as.numeric(SA_reg_data$BiggerZ) ReligiosityZ <- as.numeric(SA_reg_data$RelZ) SpiritualityZ <- as.numeric(SA_reg_data$SpiritZ) correlationplot <- data.frame(BondingChangeZ, PosAffectChangeZ, NegAffectChangeZ, MonthAttend, ConnectSomethBiggerZ, ReligiosityZ, SpiritualityZ) colnames(correlationplot) = c('BondingChange' ,'PosAffectChange' ,'NegAffectChange' ,'MonthAttend','ConnectSomethBigger' ,'Religiosity','Spirituality') # Visualize List of factors to determine which columns to include in analysis grouping = list(BondingChange =c(1), PosAffectChange = c(2), NegAffectChange = c(3), MonthAttend = c(4), ConnectSomethBigger = c(5), Religiosity = c(6), Spirituality = c(7)) require(qgraph) CorBubblePlot <- qgraph(cor(correlationplot, use = 'na.or.complete') , minimum="sig" # only show connections which are significant , groups = grouping # group nodes in an appropriate manner , legend = TRUE # provide a legend , legend.cex = 0.53 , layoutOffset = c(-0.12,0) # move graph so legend is not covering it , layout="spring" # colour scheme , graph = "cor" # correlation plot , vTrans = 180 # give nodes some transparency, so labels are clearer (out of 255) , sampleSize = 49 #number of participants , edge.labels = T # Provide the r-value in the connection , edge.label.bg =T # Give a background to the r-value, so it is more easily read. , edge.label.margin = 0.02 # give the background some margin , edge.label.position = 0.5) # Give a background to the r-value, so it is more easily read. } # Basic moodel for PANAS predicting SB6 model = lm(SB6Z ~ PANASPZ + PANASNZ, data = SA_reg_data) summary(model) confint(model) apa.reg.table(model) # basis for Table 1 # PANAS+ is the only significant predictor R^2 = .432 [.19, .58] lm.beta(model) # get the beta values to more than 2.d.p. ## Assumptions of Model ## ## A:Mean of residuals is close to 0 mean(model$residuals) # this assumption holds ## A: Homoscedacisity and Normality autoplot(model) # Resid v.s. Fitted shows assumption holds # Q-Q Plot (top right) appears close to Normal. ## A: The X variable and residuals are uncorrelated cor.test (SA_reg_data$PANASPZ, model$residuals) # assumption holds cor.test (SA_reg_data$PANASNZ, model$residuals) # assumption holds ## A: Durbin Watson (Autocorrelation) dwtest(model) # DW = 2.25, p = 0.798. Data not auto-correlated. Assumption holds ## A: Positive variability var(SA_reg_data$PANASPZ) #assumption holds var(SA_reg_data$PANASNZ) #assumption holds ## A: No multicolineatrity require(car) vif(model) # low VIF. Little multi-colinearity. ### Exploratory Analysis - Stepwise Regression ---- #stepwise regression analysis for exploratory variables # There are 2 main ways to run a stepwise regression, using the MASS package or olsrr package. library(MASS) stepwisedata <- select(SA_reg_data, SB6Z, SB6PreZ, PANASPZ, PANASNZ, BiggerZ, MonthsC, AgeC, EducationZ, RelZ, SpiritZ) #choose which variables to include full.model <- lm(SB6Z ~., data = stepwisedata) #create the full model with all variables #stepAIC function uses low AIC as criteron for best model. step.model <- stepAIC(full.model, # the model. direction = "both", #use both forward- and backward-selection for the stepwise regression trace = T) # put F to no longer show the steps. step.model$anova # shows how the predictors were removed (right column shows how much lower AIC is without predictor) summary(step.model) # show the final step model # SB6 baseline, Positive affect change, connection to something bigger and age should be included in the model # While improving the model, Age is not significant predictor. Other 3 variables are significant #F(4,42) = 23.67, p <.001 apa.reg.table(step.model) # basis for Table 2 # R2 = .693 95% CI = [.48, .77] ## Assumptions of step.model require(olsrr) # Assumption: Heteroskedasticity (check of constant variance) ols_test_breusch_pagan(step.model) # test heteroskedasticity of dependent variable. Not significant (assumption holds) ols_test_breusch_pagan(step.model, # model rhs= T, # use independent variables multiple = T) # perform multiple tests (not corrected for multiple comparisons) # the variance is constant (assumption holds) # # Assumption: Check for multivariate normality ols_plot_resid_qq(step.model) # looks mostly normal, some skewness at the low end (assumption may hold) ols_plot_resid_lev (step.model) # 2 possible outliers, and 1 value providing leverage ols_plot_resid_fit_spread(step.model) # Spread of residuals is not wider than centred fit. Assumption not violated. ols_correlations(step.model) ols_plot_obs_fit(step.model) # black line shows R2 = 1. Red line shows actual R2. ols_plot_diagnostics(step.model) # plots all diagnositc graphs. ## A: Mean of residuals is close to 0 mean(step.model$residuals) # this assumption holds ## A: The X variable and residuals are uncorrelated cor.test (stepwisedata$PANASPZ, step.model$residuals) # assumption holds cor.test (stepwisedata$BiggerZ, step.model$residuals) # assumption holds cor.test (stepwisedata$AgeC, step.model$residuals) # assumption holds cor.test (stepwisedata$SB6PreZ, step.model$residuals) # assumption holds ## A: Durbin Watson (Autocorrelation) dwtest(step.model) # DW = 1.97, p = 0.471. Data not significantly auto-correlated. Assumption holds ## A: Positive variability var(stepwisedata$SB6PreZ) #assumption holds var(stepwisedata$PANASPZ) #assumption holds var(stepwisedata$BiggerZ) #assumption holds var(stepwisedata$AgeC) #assumption holds ## A: No multicolineatrity vif(step.model) # low multicolinearity, assumption holds ### What about the 4 churches? #### Chr_only_data <- read.csv("Church data only - WIDE.csv", header = TRUE) # Chr_reg_data <- Chr_only_data[complete.cases(Chr_only_data), ] # Exclude NAs so addition of extra variables leads to same number of participants # differing number of missing values across variables leads to issues with regression comparisons in the stepmodel. Chr_reg_data <- Chr_reg_data[Chr_reg_data$Participant_ID != "AG06", ] # upon inspection, AG06 has no SB6 pre score length(Chr_reg_data$PANASP_Pre) # N = 47 Chr_reg_data <- Chr_reg_data %>% mutate(PANASPZ = (PANASP_Change - mean(PANASP_Change, na.rm=T))/sd(PANASP_Change, na.rm=T)) %>% #grand-mean centred and standardised mutate(PANASNZ = (PANASN_Change - mean(PANASN_Change, na.rm=T))/sd(PANASN_Change, na.rm=T)) %>% mutate(SB6Z = (SB6_Change - mean(SB6_Change, na.rm=T))/sd(SB6_Change, na.rm=T)) %>% mutate(SB6PreZ = (SB6_Pre - mean(SB6_Pre, na.rm=T))/sd(SB6_Pre, na.rm=T)) %>% mutate(AgeC = (Age - mean(Age, na.rm=T))) %>% # Just grand-mean centred mutate(EducationZ = (Education - mean(Education, na.rm=T))/sd(Education, na.rm=T)) %>% mutate(BiggerZ = (Connected_Bigger - mean(Connected_Bigger, na.rm=T))/sd(Connected_Bigger, na.rm=T)) %>% mutate(MonthsC = (Months - mean(Months, na.rm=T))) %>% mutate(DUREL_ORAZ = (DUREL_Church - mean(DUREL_Church, na.rm=T))/sd(DUREL_Church, na.rm=T)) %>% mutate(DUREL_IRZ = (DUREL_3 - mean(DUREL_3, na.rm=T))/sd(DUREL_3, na.rm=T)) %>% mutate(DUREL_NORAZ = (DUREL_Private - mean(DUREL_Private, na.rm=T))/sd(DUREL_Private, na.rm=T)) %>% mutate(RelZ = (Religiosity - mean(Religiosity, na.rm=T))/sd(Religiosity, na.rm=T)) # Key: # ___Z = Standardised # ___C = Mean-Centred {# Figure 5 - Chruch Correlation plot #### Chr_BondingChangeZ <- as.numeric(Chr_reg_data$SB6Z) Chr_PosAffectChangeZ <- as.numeric(Chr_reg_data$PANASPZ) Chr_NegAffectChangeZ <- as.numeric(Chr_reg_data$PANASNZ) Chr_MonthAttend <- as.numeric(Chr_reg_data$MonthsC) Chr_ConnectSomethBiggerZ <- as.numeric(Chr_reg_data$BiggerZ) Chr_ReligiosityZ <- as.numeric(Chr_reg_data$RelZ) Chr_correlationplot <- data.frame(Chr_BondingChangeZ, Chr_PosAffectChangeZ, Chr_NegAffectChangeZ, Chr_MonthAttend, Chr_ConnectSomethBiggerZ, Chr_ReligiosityZ) colnames(Chr_correlationplot) = c('BondingChange' ,'PosAffectChange' ,'NegAffectChange' ,'MonthAttend','ConnectSomethBigger' ,'Religiosity') # Visualize List of factors to determine which columns to include in analysis grouping = list(BondingChange =c(1), PosAffectChange = c(2), NegAffectChange = c(3), MonthAttend = c(4), ConnectSomethBigger = c(5), Religiosity = c(6)) Chr_CorBubblePlot <- qgraph(cor(Chr_correlationplot, use = 'na.or.complete') , minimum="sig" # only show connections which are significant , groups = grouping # group nodes in an appropriate manner , legend = TRUE # provide a legend , legend.cex = 0.7 , layoutOffset = c(-0.1,-0.1) # move graph so legend is not covering it , layout="spring" # colour scheme , graph = "cor" # correlation plot , vTrans = 180 # give nodes some transparency, so labels are clearer (out of 255) , sampleSize = 49 #number of participants , edge.labels = T # Provide the r-value in the connection , edge.label.bg =T # Give a background to the r-value, so it is more easily read. , edge.label.margin = 0.02 # give the background some margin , edge.label.position = 0.5) # Give a background to the r-value, so it is more easily read. } library(MASS) Chr_stepwisedata <- select(Chr_reg_data, SB6Z, SB6PreZ, PANASPZ, PANASNZ, BiggerZ, MonthsC, AgeC, EducationZ, RelZ) #choose which variables to include Chr_full.model <- lm(SB6Z ~., data = Chr_stepwisedata) #create the full model with all variables #stepAIC function uses low AIC as criteron for best model. Chr_step.model <- stepAIC(Chr_full.model, # the model. direction = "both", #use both forward- and backward-selection for the stepwise regression trace = T) # put F to no longer show the steps. Chr_step.model$anova # shows how the predictors were removed (right column shows how much lower AIC is without predictor) summary(Chr_step.model) # show the final step model # SB6 baseline, Positive affect change, connection to something bigger and age should be included in the model # While improving the model, Age is not significant predictor. Other 3 variables are significant #(F(5,41) = 6.90, p <.001, R2 = .457, R2Adj = .391) apa.reg.table(Chr_step.model) # R2 = .457**, 95% CI [.16,.57] ## Assumptions Church Stepwise Model ## ## A:Mean of residuals is close to 0 mean(Chr_step.model$residuals) # this assumption holds # Assumption: Heteroskedasticity (check of constant variance) ols_test_breusch_pagan(step.model) # test heteroskedasticity of dependent variable. Not significant (assumption holds) ols_test_breusch_pagan(step.model, # model rhs= T, # use independent variables multiple = T) # perform multiple tests (not corrected for multiple comparisons) # the variance is constant (assumption holds) # # Assumption: Check for multivariate normality ols_plot_resid_qq(Chr_step.model) # looks mostly normal, some deviation from diagonal at the top end (assumption may hold) ols_plot_resid_lev (Chr_step.model) # 2 possible outliers, and 5 values providing some leverage ols_plot_resid_fit_spread(Chr_step.model) # Spread of residuals is not wider than centred fit. Assumption not violated. ols_correlations(Chr_step.model) ols_plot_obs_fit(Chr_step.model) # black line shows R2 = 1. Red line shows actual R2. ols_plot_diagnostics(Chr_step.model) # plots all diagnositc graphs. ## A: The X variable and residuals are uncorrelated cor.test (Chr_stepwisedata$PANASPZ, Chr_step.model$residuals) # assumption holds cor.test (Chr_stepwisedata$PANASNZ, Chr_step.model$residuals) # assumption holds cor.test (Chr_stepwisedata$BiggerZ, Chr_step.model$residuals) # assumption holds cor.test (Chr_stepwisedata$MonthsC, Chr_step.model$residuals) # assumption holds cor.test (Chr_stepwisedata$SB6PreZ, Chr_step.model$residuals) # assumption holds ## A: Durbin Watson (Autocorrelation) dwtest(Chr_step.model) # DW = 2.06, p = 0.561. Data not significantly auto-correlated. Assumption holds ## A: Positive variability var(Chr_stepwisedata$SB6PreZ) #assumption holds var(Chr_stepwisedata$PANASPZ) #assumption holds var(Chr_stepwisedata$PANASNZ) #assumption holds var(Chr_stepwisedata$BiggerZ) #assumption holds var(Chr_stepwisedata$MonthsC) #assumption holds ## A: No multicolineatrity vif(Chr_step.model) # low multicolinearity, assumption holds