64 kids could be used as further analysis No.5 is not a good item
library(reshape);library(ggplot2);library(dplyr)
##
## Attaching package: 'dplyr'
##
## The following object is masked from 'package:reshape':
##
## rename
##
## The following objects are masked from 'package:stats':
##
## filter, lag
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(corrplot);library(Hmisc);library(candisc);library(lm.beta)
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
##
## Attaching package: 'Hmisc'
##
## The following objects are masked from 'package:dplyr':
##
## combine, src, summarize
##
## The following objects are masked from 'package:base':
##
## format.pval, round.POSIXt, trunc.POSIXt, units
##
## Loading required package: car
## Loading required package: heplots
##
## Attaching package: 'candisc'
##
## The following object is masked from 'package:stats':
##
## cancor
dta <- read.csv("data/infantexp2.csv",h=T)
head(dta);tail(dta);dim(dta)
dta <- dta[1:100,1:29]
dta <- dta[,-10] #delete No.5
newdata <- na.omit(dta);attach(newdata)
newdata$affective <- No1+No2+No3+No4+No6
newdata$cognitive <- No7+No8+No9+No10+No11
newdata$behavioral <- No12+No13+No14+No15+No16+No17+
No18+No19+No20+No21+No22+No23+No24
newdata <- newdata[,-(6:28)]
newdata$Age <- newdata$Age/365
show the data
## Sex Class Age ToM_Neutral ToM_Emapthy affective cognitive
## 1 1 Big 6.268493 5 9 12 14
## 2 2 Big 6.136986 7 4 12 15
## 3 2 Big 6.095890 6 0 13 15
## 5 1 Big 6.084932 5 3 13 15
## 6 1 Big 5.958904 9 10 13 15
## 7 2 Big 5.898630 8 7 12 15
## behavioral
## 1 37
## 2 36
## 3 39
## 5 39
## 6 41
## 7 40
## [1] 64 8
describitive statistic
summary(newdata)
## Sex Class Age ToM_Neutral
## Min. :1.000 : 0 Min. :3.362 Min. :1.000
## 1st Qu.:1.000 Big :25 1st Qu.:4.083 1st Qu.:3.000
## Median :2.000 Middle:17 Median :4.762 Median :4.000
## Mean :1.547 Small :22 Mean :4.841 Mean :4.562
## 3rd Qu.:2.000 3rd Qu.:5.647 3rd Qu.:6.000
## Max. :2.000 Max. :6.268 Max. :9.000
## ToM_Emapthy affective cognitive behavioral
## Min. : 0.000 Min. : 8.00 Min. : 5.00 Min. :25.00
## 1st Qu.: 3.000 1st Qu.:12.00 1st Qu.:10.00 1st Qu.:33.75
## Median : 4.000 Median :12.00 Median :11.00 Median :38.00
## Mean : 4.734 Mean :12.73 Mean :12.17 Mean :37.31
## 3rd Qu.: 6.000 3rd Qu.:14.00 3rd Qu.:15.00 3rd Qu.:40.00
## Max. :11.000 Max. :18.00 Max. :20.00 Max. :49.00
sd(newdata$ToM_Neutral);sd(newdata$ToM_Emapthy);sd(newdata$Age)
## [1] 1.983063
## [1] 2.311065
## [1] 0.8971403
sd(newdata$affective);sd(newdata$cognitive);sd(newdata$behavioral)
## [1] 1.887656
## [1] 3.392591
## [1] 5.673315
aggregate(newdata[,4:8], by=list(Sex), FUN=mean)
## Group.1 ToM_Neutral ToM_Emapthy affective cognitive behavioral
## 1 1 4.482759 5.068966 12.34483 11.65517 35.89655
## 2 2 4.628571 4.457143 13.05714 12.60000 38.48571
aggregate(newdata[,4:8], by=list(Sex), FUN=sd)
## Group.1 ToM_Neutral ToM_Emapthy affective cognitive behavioral
## 1 1 2.063643 2.404327 2.040236 2.819269 5.440226
## 2 2 1.941584 2.227408 1.714006 3.790080 5.669171
standardize data
newdata[,4:8]<-scale(newdata[,4:8])
cor(newdata[,3:8]);rcorr(as.matrix(newdata[,3:8]))
## Age ToM_Neutral ToM_Emapthy affective cognitive
## Age 1.0000000 0.5049168 0.4244492 0.3987312 0.7370684
## ToM_Neutral 0.5049168 1.0000000 0.5041505 0.2822473 0.5374882
## ToM_Emapthy 0.4244492 0.5041505 1.0000000 0.1691342 0.4816706
## affective 0.3987312 0.2822473 0.1691342 1.0000000 0.6021044
## cognitive 0.7370684 0.5374882 0.4816706 0.6021044 1.0000000
## behavioral 0.5366794 0.4468920 0.4071490 0.6674423 0.7674261
## behavioral
## Age 0.5366794
## ToM_Neutral 0.4468920
## ToM_Emapthy 0.4071490
## affective 0.6674423
## cognitive 0.7674261
## behavioral 1.0000000
## Age ToM_Neutral ToM_Emapthy affective cognitive behavioral
## Age 1.00 0.50 0.42 0.40 0.74 0.54
## ToM_Neutral 0.50 1.00 0.50 0.28 0.54 0.45
## ToM_Emapthy 0.42 0.50 1.00 0.17 0.48 0.41
## affective 0.40 0.28 0.17 1.00 0.60 0.67
## cognitive 0.74 0.54 0.48 0.60 1.00 0.77
## behavioral 0.54 0.45 0.41 0.67 0.77 1.00
##
## n= 64
##
##
## P
## Age ToM_Neutral ToM_Emapthy affective cognitive behavioral
## Age 0.0000 0.0005 0.0011 0.0000 0.0000
## ToM_Neutral 0.0000 0.0000 0.0238 0.0000 0.0002
## ToM_Emapthy 0.0005 0.0000 0.1815 0.0000 0.0008
## affective 0.0011 0.0238 0.1815 0.0000 0.0000
## cognitive 0.0000 0.0000 0.0000 0.0000 0.0000
## behavioral 0.0000 0.0002 0.0008 0.0000 0.0000
for ToM analysis
summary(lm.beta(lm(ToM_Neutral~Sex+Age,data=newdata)))
##
## Call:
## lm(formula = ToM_Neutral ~ Sex + Age, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.68115 -0.58052 -0.07797 0.55717 2.10595
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -2.75560 0.00000 0.68122 -4.045 0.000149 ***
## Sex 0.02193 0.01101 0.22054 0.099 0.921103
## Age 0.56218 0.50435 0.12334 4.558 2.54e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8771 on 61 degrees of freedom
## Multiple R-squared: 0.2551, Adjusted R-squared: 0.2306
## F-statistic: 10.44 on 2 and 61 DF, p-value: 0.0001258
summary(lm.beta(lm(ToM_Emapthy~Sex+Age,data=newdata)))
##
## Call:
## lm(formula = ToM_Emapthy ~ Sex + Age, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5133 -0.5561 -0.1020 0.3256 2.5132
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -1.8555 0.0000 0.7041 -2.635 0.010647 *
## Sex -0.3090 -0.1550 0.2280 -1.355 0.180295
## Age 0.4820 0.4324 0.1275 3.781 0.000358 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9066 on 61 degrees of freedom
## Multiple R-squared: 0.2041, Adjusted R-squared: 0.178
## F-statistic: 7.823 on 2 and 61 DF, p-value: 0.0009457
tomdata <- melt(newdata[,1:5],id=c("Sex","Class","Age"))
tomdata <- rename(tomdata,Condition=variable,Score = value)
ggplot(tomdata,aes(x=Age,y=Score,col=Condition))+
geom_point()+
facet_grid(.~Sex)+
geom_smooth(method="lm")+
scale_colour_brewer(palette="Spectral")
test for moderation effect
summary(lm.beta(lm(ToM_Neutral~Sex+Age+Sex:Age,data=newdata)))
##
## Call:
## lm(formula = ToM_Neutral ~ Sex + Age + Sex:Age, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6936 -0.5717 -0.1734 0.5675 2.0507
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -1.2708 0.0000 1.8581 -0.684 0.497
## Sex -1.0152 -0.5093 1.2271 -0.827 0.411
## Age 0.2546 0.2284 0.3787 0.672 0.504
## Sex:Age 0.2142 0.6089 0.2492 0.859 0.394
##
## Residual standard error: 0.879 on 60 degrees of freedom
## Multiple R-squared: 0.2641, Adjusted R-squared: 0.2273
## F-statistic: 7.178 on 3 and 60 DF, p-value: 0.0003388
summary(lm.beta(lm(ToM_Emapthy~Sex+Age+Sex:Age,data=newdata)))
##
## Call:
## lm(formula = ToM_Emapthy ~ Sex + Age + Sex:Age, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3040 -0.4868 -0.1228 0.3024 2.6270
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -3.9773 0.0000 1.9098 -2.083 0.0416 *
## Sex 1.1730 0.5885 1.2612 0.930 0.3561
## Age 0.9215 0.8267 0.3893 2.367 0.0212 *
## Sex:Age -0.3060 -0.8700 0.2562 -1.195 0.2370
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9035 on 60 degrees of freedom
## Multiple R-squared: 0.2226, Adjusted R-squared: 0.1837
## F-statistic: 5.727 on 3 and 60 DF, p-value: 0.001629
anova(lm(ToM_Neutral~Sex+Age+Sex:Age,data=newdata),
lm(ToM_Neutral~Sex+Age,data=newdata))
## Analysis of Variance Table
##
## Model 1: ToM_Neutral ~ Sex + Age + Sex:Age
## Model 2: ToM_Neutral ~ Sex + Age
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 60 46.361
## 2 61 46.931 -1 -0.57045 0.7383 0.3936
anova(lm(ToM_Emapthy~Sex+Age+Sex:Age,data=newdata),
lm(ToM_Emapthy~Sex+Age,data=newdata))
## Analysis of Variance Table
##
## Model 1: ToM_Emapthy ~ Sex + Age + Sex:Age
## Model 2: ToM_Emapthy ~ Sex + Age
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 60 48.975
## 2 61 50.140 -1 -1.1648 1.427 0.237
final plot
ggplot(tomdata,aes(x=Age,y=Score,col=Condition))+
geom_point()+
#facet_grid(.~Sex)+
geom_smooth(method="lm")+
scale_colour_brewer(palette="Spectral")
ToM_N v.s ToM_Em
ggplot(tomdata,aes(x=Score,fill=Condition,group=Condition))+
#facet_grid(.~Sex)+
geom_density(alpha = 0.5)+
scale_fill_brewer(palette="Spectral")
summary(lm.beta(lm(Score~Condition+Age+Sex,data=tomdata)))
##
## Call:
## lm(formula = Score ~ Condition + Age + Sex, data = tomdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6385 -0.5544 -0.1184 0.4889 2.4101
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -2.306e+00 0.000e+00 4.949e-01 -4.659 8.06e-06
## ConditionToM_Emapthy -2.026e-17 -1.021e-17 1.573e-01 0.000 1.000
## Age 5.221e-01 4.684e-01 8.846e-02 5.902 3.21e-08
## Sex -1.435e-01 -7.201e-02 1.582e-01 -0.907 0.366
##
## (Intercept) ***
## ConditionToM_Emapthy
## Age ***
## Sex
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8896 on 124 degrees of freedom
## Multiple R-squared: 0.2211, Adjusted R-squared: 0.2023
## F-statistic: 11.73 on 3 and 124 DF, p-value: 8.073e-07
Empathy Scale
cor(newdata[,-(1:2)]);corrplot.mixed(cor(newdata[,-(1:2)]))
## Age ToM_Neutral ToM_Emapthy affective cognitive
## Age 1.0000000 0.5049168 0.4244492 0.3987312 0.7370684
## ToM_Neutral 0.5049168 1.0000000 0.5041505 0.2822473 0.5374882
## ToM_Emapthy 0.4244492 0.5041505 1.0000000 0.1691342 0.4816706
## affective 0.3987312 0.2822473 0.1691342 1.0000000 0.6021044
## cognitive 0.7370684 0.5374882 0.4816706 0.6021044 1.0000000
## behavioral 0.5366794 0.4468920 0.4071490 0.6674423 0.7674261
## behavioral
## Age 0.5366794
## ToM_Neutral 0.4468920
## ToM_Emapthy 0.4071490
## affective 0.6674423
## cognitive 0.7674261
## behavioral 1.0000000
scaledata<- melt(newdata,id=c("Sex","Class","Age","ToM_Neutral","ToM_Emapthy"))
scaledata <- rename(scaledata,Factor = variable,Score=value)
plot for three factors
ggplot(scaledata,aes(x=Age,y=Score,group=Factor,col=Factor))+
facet_grid(.~Factor)+
geom_point()+
geom_smooth(method="lm")+
scale_colour_brewer(palette="Spectral")
t.test for factors
summary(lm.beta(lm(affective~Age+Sex,data=newdata)))
##
## Call:
## lm(formula = affective ~ Age + Sex, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.8023 -0.6341 -0.1426 0.4274 2.7383
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -2.6268 0.0000 0.7114 -3.692 0.000476 ***
## Age 0.4348 0.3900 0.1288 3.375 0.001287 **
## Sex 0.3375 0.1693 0.2303 1.465 0.148010
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.916 on 61 degrees of freedom
## Multiple R-squared: 0.1876, Adjusted R-squared: 0.1609
## F-statistic: 7.042 on 2 and 61 DF, p-value: 0.001772
summary(lm.beta(lm(cognitive~Age+Sex,data=newdata)))
##
## Call:
## lm(formula = cognitive ~ Age + Sex, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.53881 -0.39568 -0.04678 0.36450 1.87339
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -4.26420 0.00000 0.52729 -8.087 3.12e-11 ***
## Age 0.81573 0.73182 0.09547 8.544 5.12e-12 ***
## Sex 0.20363 0.10217 0.17071 1.193 0.238
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6789 on 61 degrees of freedom
## Multiple R-squared: 0.5537, Adjusted R-squared: 0.539
## F-statistic: 37.84 on 2 and 61 DF, p-value: 2.062e-11
summary(lm.beta(lm(behavioral~Age+Sex,data=newdata)))
##
## Call:
## lm(formula = behavioral ~ Age + Sex, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.63496 -0.66377 -0.06556 0.59378 1.63190
##
## Coefficients:
## Estimate Standardized Std. Error t value Pr(>|t|)
## (Intercept) -3.4629 0.0000 0.6467 -5.355 1.37e-06 ***
## Age 0.5867 0.5263 0.1171 5.010 4.94e-06 ***
## Sex 0.4025 0.2020 0.2094 1.923 0.0592 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8326 on 61 degrees of freedom
## Multiple R-squared: 0.3287, Adjusted R-squared: 0.3067
## F-statistic: 14.93 on 2 and 61 DF, p-value: 5.258e-06
canonical correlation for ToM and Empathy
#cancor
ToM <- newdata[,4:5];Empathy <- newdata[,6:8]
cc1 <- cancor(ToM,Empathy)
cc1
##
## Canonical correlation analysis of:
## 2 X variables: ToM_Neutral, ToM_Emapthy
## with 3 Y variables: affective, cognitive, behavioral
##
## CanR CanRSQ Eigen percent cum scree
## 1 0.6120 0.3745 0.59875 97.536 97.54 ******************************
## 2 0.1221 0.0149 0.01513 2.464 100.00 *
##
## Test of H0: The canonical correlations in the
## current row and all that follow are zero
##
## CanR WilksL F df1 df2 p.value
## 1 0.61197 0.61617 5.3876 6 118 5.9736e-05
## 2 0.12208 0.98510 2
coef(cc1,type="both",standardize = T)
## [[1]]
## Xcan1 Xcan2
## ToM_Neutral -0.6186142 0.9788261
## ToM_Emapthy -0.5334550 -1.0277207
##
## [[2]]
## Ycan1 Ycan2
## affective 0.3382339 1.31954876
## cognitive -0.9111864 0.04040218
## behavioral -0.3331341 -0.75613983
In order to aviod confounding from age and sex use residual to analyse
#USE residual
newdata$ToM_Neutral_Re <- lm.beta(lm(ToM_Neutral~Age+Sex,data=newdata))$residuals
newdata$ToM_Emapthy_Re <- lm.beta(lm(ToM_Emapthy~Age+Sex,data=newdata))$residuals
newdata$affective_Re <- lm.beta(lm(affective~Age+Sex,data=newdata))$residuals
newdata$cognitive_Re <- lm.beta(lm(cognitive~Age+Sex,data=newdata))$residuals
newdata$behavioral_Re <- lm.beta(lm(behavioral~Age+Sex,data=newdata))$residuals
ToM_Re <- newdata[,9:10];Empathy_Re <- newdata[,11:13]
cc2 <- cancor(ToM_Re,Empathy_Re)
cc2
##
## Canonical correlation analysis of:
## 2 X variables: ToM_Neutral_Re, ToM_Emapthy_Re
## with 3 Y variables: affective_Re, cognitive_Re, behavioral_Re
##
## CanR CanRSQ Eigen percent cum scree
## 1 0.41756 0.174359 0.211180 96.753 96.75 ******************************
## 2 0.08388 0.007036 0.007086 3.247 100.00 *
##
## Test of H0: The canonical correlations in the
## current row and all that follow are zero
##
## CanR WilksL F df1 df2 p.value
## 1 0.41756 0.81983 2.0538 6 118 0.063855
## 2 0.08388 0.99296 2
coef(cc2,type="both",standardize = T)
## [[1]]
## Xcan1 Xcan2
## ToM_Neutral_Re -0.4373948 0.9879471
## ToM_Emapthy_Re -0.7487808 -0.7788973
##
## [[2]]
## Ycan1 Ycan2
## affective_Re 0.5309051 1.0771660
## cognitive_Re -0.7144014 0.3571658
## behavioral_Re -0.6169153 -0.6231146
compare cc1 and cc2
#cc1
coef(cc1,type="both",standardize = T)
## [[1]]
## Xcan1 Xcan2
## ToM_Neutral -0.6186142 0.9788261
## ToM_Emapthy -0.5334550 -1.0277207
##
## [[2]]
## Ycan1 Ycan2
## affective 0.3382339 1.31954876
## cognitive -0.9111864 0.04040218
## behavioral -0.3331341 -0.75613983
#cc2
coef(cc2,type="both",standardize = T)
## [[1]]
## Xcan1 Xcan2
## ToM_Neutral_Re -0.4373948 0.9879471
## ToM_Emapthy_Re -0.7487808 -0.7788973
##
## [[2]]
## Ycan1 Ycan2
## affective_Re 0.5309051 1.0771660
## cognitive_Re -0.7144014 0.3571658
## behavioral_Re -0.6169153 -0.6231146