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