# clear everything
rm(list=ls())
 
# packages
requiredPackages   <- c("dplyr", "ez", "ggplot2", "grid", "reshape2", "pracma", "psych", "reshape", "lme4", "schoRsch", "tidyr")
isPackageInstalled <- requiredPackages %in% rownames(installed.packages())
if(any(!isPackageInstalled)) install.packages(requiredPackages[!isPackageInstalled])
lapply(requiredPackages, library, character.only=TRUE)

# read data
datDir <- "xxx"
datFiles <- list.files(datDir, pattern = "^pushPullEmp_\\d+_avg.txt$", full.names = TRUE)
dat      <- do.call(rbind, lapply(datFiles, read.table, header = TRUE, sep = ","))

# rename participants 5 and 6 to 19 and 20 (5 and 6 are available two times because of an input error)
dat$vpNum[dat$vpNum==5 & dat$age == 29] = 19
dat$vpNum[dat$vpNum==6 & dat$age == 20] = 20
dat <- dat[order(dat$vpNum), ]

# situational empathic responses: empathic concern and personal distress
dat$EC <- (dat$respKeyTender + dat$respKeyCompassionate + dat$respKeyMoved)/3
dat$PD <- (dat$respKeyWorried + dat$respKeyDistressed + dat$respKeyAlarmed)/3

# # exclude practice trials
data <- dat[dat$practice == 0 & dat$vpNum != 99, ]

# factors
str(data)
data$vpNum          <- factor(data$vpNum)
data$picName        <- factor(data$picName)
data$respDirection  <- factor(data$respDirection)
data$picType        <- factor(data$picType)

############ VP info ############
mean(data$age)
table(data$gender[!duplicated(data$vpNum)])
table(data$handedness[!duplicated(data$vpNum)])
table(data$pqQ1[!duplicated(data$vpNum)])
table(data$pqQ2[!duplicated(data$vpNum)])
table(data$correctMemTask[!duplicated(data$memRespTime)])
table(data$correct)
sum(data$isOutlier == 1)

############ Positive and negative affect ############

dataQ <- aggregate(panas1Pos ~ vpNum, data, mean)
dataQ$panas1Neg <- aggregate(panas1Neg ~ vpNum, data, mean)[,2]
dataQ$panas2Pos <- aggregate(panas2Pos ~ vpNum, data, mean)[,2]
dataQ$panas2Neg <- aggregate(panas2Neg ~ vpNum, data, mean)[,2]

t.test(dataQ$panas1Pos, dataQ$panas2Pos, paired = TRUE)
t.test(dataQ$panas1Neg, dataQ$panas2Neg, paired = TRUE)

############ Dispositional empathy ############
dataQ$fs<- aggregate(fs ~ vpNum, data, mean)$fs
dataQ$ec <- aggregate(ec ~ vpNum, data, mean)$ec
dataQ$pd <- aggregate(pd ~ vpNum, data, mean)$pd
dataQ$empathy <- aggregate(empathy ~ vpNum, data, mean)$empathy
dataQ$pt <- aggregate(pt ~ vpNum, data, mean)$pt
mean(dataQ$empathy)
sd(dataQ$empathy)
range(dataQ$empathy)
mean(dataQ$ec)
mean(dataQ$pd)
sd(dataQ$ec)
sd(dataQ$pd)

############ Situational empathy ############
dataQ$EC <- aggregate(EC ~ vpNum, data, mean)$EC
sd(dataQ$EC)
dataQ$PD <- aggregate(PD ~ vpNum, data, mean)$PD
sd(dataQ$PD)
cor.test(dataQ$EC, dataQ$PD, paired = TRUE)

############ Accuracy Tone and Memory Task ##############
data$correctMemTask[data$correctMemTask != 1] = 0
dataQ$accMem <- aggregate(correctMemTask ~ vpNum, data, mean)$correctMemTask
mean(dataQ$accMem)
range(dataQ$accMem)

data$correct[data$correct != 1] = 0
dataQ$acc <- aggregate(correct ~ vpNum, data, mean)$correct
mean(dataQ$acc)
range(dataQ$acc)

############ Prior experience of similar situation ############
groupA <- subset(data, data$pqQ1 =="ja"  )
groupB <- subset(data, data$pqQ1 =="nein" )

groupa <- aggregate(PD ~ vpNum, groupA, mean)
groupa$EC <- aggregate(EC ~ vpNum, groupA, mean)[,2]
groupb <- aggregate(PD ~ vpNum, groupB, mean)
groupb$EC <- aggregate(EC ~ vpNum, groupB, mean)[,2]

t.test(groupa$EC, groupb$EC)
t.test(groupa$PD, groupb$PD)   #*

#Confidence intervals
t.test(groupa$PD)
t.test(groupb$PD)
t.test(groupa$EC)
t.test(groupb$EC)

#eta squared
2.0908*2.0908/((2.0908*2.0908)+(45+13-2))
1.0224*1.0224/((1.0224*1.0224)+(45+13-2))


# ############ Linear mixed-effects modelling   #####################
# # for EC:
# # fixed effects: picType, panas1Pos, panas1Neg, ec, pd
# # random effects: intercepts for subjects and items and by-subject random slopes for picType 
# # Not: by-item random slopes for picType, ec, panas1Pos because model is not convergable

lmer0 <- lmer(EC ~  picType+ ec +pd +panas1Pos + panas1Neg+  (1+picType |vpNum)+ (1|picName), data, REML= F)    
summary(lmer0)

lmer01 <- lmer(EC ~  picType+ ec +panas1Pos + panas1Neg+  (1+picType |vpNum)+ (1|picName), data, REML= F)    
summary(lmer01)

lmer1 <- lmer(EC ~  picType+ ec +panas1Pos +  (1+picType |vpNum)+ (1|picName), data, REML= F)    
summary(lmer1)

lmer1a <- lmer(EC ~  picType+ panas1Neg +panas1Pos +  (1+picType |vpNum)+ (1|picName) , data, REML= F)    
summary(lmer1a)

lmer1b <- lmer(EC ~  picType+ panas1Neg +ec +  (1+picType |vpNum)+ (1|picName), data, REML= F)    
summary(lmer1b)

lmer2 <- lmer(EC ~  picType+ panas1Pos +  (1+picType|vpNum)+ (1|picName), data, REML= F)    
summary(lmer2)

lmer2a <- lmer(EC ~  picType+ panas1Neg +  (1+picType|vpNum)+ (1|picName), data, REML= F)    
summary(lmer2a)

lmer2b <- lmer(EC ~  panas1Pos + panas1Neg +  (1+picType|vpNum)+ (1|picName), data, REML= F)

anova(lmer01, lmer1b)


# # for PD:
# # fixed effects: picType, pd, ec, panas1Pos, panas1Neg 
# # random effects: intercepts for subjects and items and by-subject random slopes for picType 
# # Not: by-item random slopes for picType, pd, panas1Neg because model is not convergable
# # likelihood ratio test: comparing model with and without the fixed effect term of interest
lmer8 <- lmer(PD ~  picType + panas1Neg + panas1Pos + pd +ec +  (1+picType|vpNum)+ (1|picName), data, REML= F)   
summary(lmer8)

lmer9 <- lmer(PD ~  picType + panas1Neg + panas1Pos + pd +  (1+picType|vpNum)+ (1|picName), data, REML= F)   
summary(lmer9)

lmer9a <- lmer(PD ~  picType + panas1Neg + pd +ec +  (1+picType|vpNum)+ (1|picName), data, REML= F)   
summary(lmer9a)

lmer10 <- lmer(PD ~  picType + panas1Neg + panas1Pos +  (1+picType|vpNum)+ (1|picName), data, REML= F)   
summary(lmer10)

lmer11 <- lmer(PD ~  picType + panas1Neg +  (1+picType|vpNum)+ (1|picName), data, REML= F)   
summary(lmer11)

lmer12 <- lmer(PD ~  panas1Neg +  (1+picType|vpNum)+ (1|picName), data, REML= F)
summary(lmer12)

lmer13 <- lmer(PD ~  picType +  (1+picType|vpNum)+ (1|picName), data, REML= F)
summary(lmer13)

anova(lmer8, lmer9)
anova(lmer11, lmer12)
anova(lmer11, lmer13)



############ ANOVA: picType -> diff (EC-PD) ############
### definition of new DV ######
dataEC_neutral <- subset(dataEC, picType == "neutral")
dataEC_sad     <- subset(dataEC, picType == "sad")
dataEC_stroke  <- subset(dataEC, picType == "stroke")
dataPD_neutral <- subset(dataPD, picType == "neutral")
dataPD_sad     <- subset(dataPD, picType == "sad")
dataPD_stroke  <- subset(dataPD, picType == "stroke")

data_diffEC <- cbind(dataEC_neutral, dataEC_sad, dataEC_stroke)
names(data_diffEC)[c(3,6,9)] <- c("Eneu", "Esad", "Estr")

## Differences Neutral EC #####
data_diffEC$dEsad <- data_diffEC$Esad-data_diffEC$Eneu
data_diffEC$dEstr <- data_diffEC$Estr-data_diffEC$Eneu

data_diffPD <- cbind(dataPD_neutral, dataPD_sad, dataPD_stroke)
names(data_diffPD)[c(3,6,9)] <- c("Pneu", "Psad", "Pstr")

## Differences Neutral PD #####
data_diffPD$dPsad <- data_diffPD$Psad-data_diffPD$Pneu
data_diffPD$dPstr <- data_diffPD$Pstr-data_diffPD$Pneu

data_diffsadEC <- subset(data_diffEC, select = c(2,4,10)) #  only columns needed
data_diffstrEC <- subset(data_diffEC, select = c(2,7,11)) #  only columns needed
data_diffsadPD <- subset(data_diffPD, select = c(2,4,10)) #  only columns needed
data_diffstrPD <- subset(data_diffPD, select = c(2,7,11)) #  only columns needed

data_diff_sad_EC_PD <- cbind(data_diffsadEC, data_diffsadPD)
data_diff_str_EC_PD <- cbind(data_diffstrEC, data_diffstrPD)

## Differences EC minus PD #####
data_diff_sad_EC_PD$Diff <- data_diff_sad_EC_PD$dEsad - data_diff_sad_EC_PD$dPsad
data_diff_str_EC_PD$Diff <- data_diff_str_EC_PD$dEstr - data_diff_str_EC_PD$dPstr

data_diff <- rbind(subset(data_diff_sad_EC_PD, select = c(1,2,7)), subset(data_diff_str_EC_PD, select = c(1,2,7)))
data_diff$picType <- factor(data_diff$picType, levels = c("sad", "stroke"), labels = c("sad", "stroke"))

# ANOVA 
ANOVA_diff <- ezANOVA(data = data_diff, dv = .(Diff), wid = .(vpNum), within = .(picType), type = 2, detailed = TRUE, return_aov = TRUE)
anova_out(ANOVA_diff)

ANOVA_Means <- aov(Diff ~ picType+ Error(vpNum/(picType)), data_diff)
model.tables(ANOVA_Means, "means")

#CIs
t.test(data_diff$Diff[data_diff$picType == "sad"])
t.test(data_diff$Diff[data_diff$picType == "stroke"])


############ RT results  #####################

# only trials with correct responses
data <- data[data$correct == 1, ]
# data without reversals
data <- subset(data, data$isReversalAdj==0)
data <- subset(data, data$isOutlier == 0)

# define RT, MT
data$RT <- data$movementOnsetAdj

# no hypothesis for neutral pictures
data <- data[data$picType != "neutral", ]

lmer1 <- lmer(RT ~ EC +PD + respDirection * picType + (1+picType|vpNum)+ (1|picName), data, REML= F)
summary(lmer1)

lmer2 <- lmer(RT ~ EC  +PD  + picType + (1+picType|vpNum)+ (1|picName), data, REML= F)

lmer3 <- lmer(RT ~ EC  + PD + (1+picType|vpNum) + (1|picName), data, REML= F)
summary(lmer3)

lmer4 <- lmer(RT ~   PD  + (1+picType|vpNum) + (1|picName), data, REML= F)

lmer5 <- lmer(RT ~   EC  + (1+picType|vpNum) + (1|picName), data, REML= F)

anova(lmer5, lmer4) # model 3 is best one