rm(list=ls())

################################################################################
# LOADING RELEVANT PACKAGES
################################################################################

library(nlme)
library(lme4)
#library (lattice)

################################################################################
# READ AND EDIT RAW DATA 
################################################################################

dat<-read.table("Schmoll_ProcB_ESM_Data.txt",header=TRUE)
str(dat);nrow(dat);length(unique(dat$VideoTakeID));length(unique(dat$VideoRecordingID));length(unique(dat$EjaculateID))
# 10908 sperm tracks from 582 video takes for 28*3=84 video recordings from 28 experimental ejaculates

dat$CelluloseConcentrationCentered<-dat$CelluloseConcentration-1 # Mean-centering of the covariate for random regression
dat$CelluloseConcentrationFactor<-as.factor(dat$CelluloseConcentration)
dat$MeasurementOrderFactor<-as.factor(dat$MeasurementOrder)
dat$MeasurementOrderOrderedFactor<-as.ordered(dat$MeasurementOrderFactor)
MeanVCL<-aggregate(dat$VCL,list(Sample=dat$VideoRecordingID),mean)
dat$MeanVCL<-MeanVCL$x[(match(dat$VideoRecordingID,MeanVCL$Sample))]
dat<-dat[with(dat,order(dat$EjaculateID,CelluloseConcentration)), ]
unikdat<-dat[!duplicated(dat$VideoRecordingID),];str(unikdat) # Data frame with one entry per recording for plotting
table(unikdat$EjaculateID,unikdat$CelluloseConcentration)

################################################################################
# FIGURE 1
################################################################################

boxplot(MeanVCL~MeasurementOrderOrderedFactor+CelluloseConcentrationFactor,xlab="Methyl cellulose concentration (m/v) by measurement order",ylab="Mean curvilinear sperm velocity per video recording (µm/s)",cex.lab=1.2,xaxt="n",data=unikdat)
axis(1,at=c(1,2,3,4,5,6,7,8,9),labels=c("0% First","0% Second","0% Third","1% First","1% Second","1% Third","2% First","2% Second","2% Third"))

################################################################################
# FIGURE 2
################################################################################

groupdat<-groupedData(MeanVCL~CelluloseConcentration|EjaculateID,data=unikdat)
plot(groupdat,xlab="Methyl cellulose concentration (% m/v)",ylab="Mean curvilinear sperm velocity per video recording (µm/s)",cex.lab=1.2,pch=16)

################################################################################
# Mixed effects model REML fits to test for random effects
################################################################################

# Random intercept plus random slope model
Model1<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(CelluloseConcentrationCentered|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),data=dat)
summary(Model1)

# Random intercept model
Model2<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(1|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),data=dat)
summary(Model2)
Chisq<-(logLik(Model1)-logLik(Model2))*2;Chisq;1-pchisq(Chisq,2);anova(Model1,Model2,refit=FALSE)
# Chisq=0.13 and p=0.94 thus no evidence for ejaculate-by-cellulose random slope variance

# Random intercept model dismissing between-video take variance
Model2a<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(1|EjaculateID)+(1|VideoRecordingID),data=dat)
summary(Model2a)
Chisq<-(logLik(Model2)-logLik(Model2a))*2;Chisq;1-pchisq(Chisq,1);anova(Model2,Model2a,refit=FALSE)
# Chisq=47.92 and p<0.001 thus substantial between-video take variance

# Random intercept model dismissing between-video recording variance
Model2b<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(1|EjaculateID)+(1|VideoTakeID),data=dat)
summary(Model2b)
Chisq<-(logLik(Model2)-logLik(Model2b))*2;Chisq;1-pchisq(Chisq,1);anova(Model2,Model2b,refit=FALSE)
# --> Chisq=33.75 and p<0.001 thus substantial between-video recording variance

# Random intercept model dismissing between-ejaculate variance
Model2c<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(1|VideoRecordingID)+(1|VideoTakeID),data=dat)
summary(Model2c)
Chisq<-(logLik(Model2)-logLik(Model2c))*2;Chisq;1-pchisq(Chisq,1);anova(Model2,Model2c,refit=FALSE)
# --> Chisq=9.51 and p=0.002 thus some between-ejaculate variance

# Random intercept plus random slope model without covariance between intercept and slope
Model2d<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(0+CelluloseConcentrationCentered|EjaculateID)+(1|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),data=dat) 
summary(Model2d)
Chisq<-(logLik(Model1)-logLik(Model2d))*2;Chisq;1-pchisq(Chisq,1);anova(Model1,Model2d,refit=FALSE)
# --> Chisq=0.08 and p=0.77 thus no evidence for covariance between intercept and slope

################################################################################
# Mixed effect model ML fits to test for fixed effects
################################################################################

# Random intercept ML model
Model2<-lmer(log(VCL)~CelluloseConcentrationCentered+MeasurementOrderOrderedFactor+(1|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),REML=FALSE,data=dat)
summary(Model2)

# Random intercept ML model dismissing cellulose concentration
Model2A<-lmer(log(VCL)~MeasurementOrderOrderedFactor+(1|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),REML=FALSE,data=dat)
summary(Model2A)
anova(Model2,Model2A)
# --> Chisq=183.1 and p<0.001 effect of cellulose concentration

# Random intercept ML model dismissing measurement order 
Model2B<-lmer(log(VCL)~CelluloseConcentrationCentered+(1|EjaculateID)+(1|VideoRecordingID)+(1|VideoTakeID),REML=FALSE,data=dat)
summary(Model2B)
anova(Model2,Model2B)
# --> Chisq=3.33 and p=0.19 effect of measurement order

################################################################################
################################################################################