#####Chapter 13: Analysis of Covariance (ANCOVA)

###Section 13.1.1: Mechanics of an ANCOVA
grp <-c(1,1,1,1,2,2,2,2,3,3,3,3)
age <-c(12,8,9,7,13,8,11,8,12,10,7,9)
y <-c(7,5,5,4,6,2,5,3,4,4,1,2)
eff1 <-c(rep(1,4),rep(0,4),rep(-1,4))
eff2 <-c(rep(0,4),rep(1,4),rep(-1,4))

#Compute all 5 models
summary(mod.a <-lm(y~age))
summary(mod.b <-lm(age~eff1+eff2))
summary(mod.c <-lm(y~eff1+eff2))
summary(mod.d <-lm(y~age+eff1+eff2+age*eff1+age*eff2))
summary(mod.e <-lm(y~age+eff1+eff2))

#Homogeneity of regression lines
anova(mod.e,mod.d)

#Plot Regression Lines Using Separate Coefficients for Each Group
p0 <-c(rep(1,3))
p1 <-c(rep(0,3))
p2 <-c(1,0,-1)
p3 <-c(0,1,-1)
p4 <-c(rep(0,3))
p5 <-c(rep(0,3))
P <-round(rbind(p0,p1,p2,p3,p4,p5),digits=5)
intercept <-t(P)%*%coef(mod.d)

s0 <-c(rep(0,3))
s1 <-c(rep(1,3))
s2 <-c(rep(0,3))
s3 <-c(rep(0,3))
s4 <-c(1,0,-1)
s5 <-c(0,1,-1)
SS <-round(rbind(s0,s1,s2,s3,s4,s5),digits=5)
slope <-t(SS)%*%coef(mod.d)

#Predicted values one sd above and below age for each group
new.young <-(intercept[1]+(slope[1]*-(sd(age))))
new.old <-(intercept[1]+(slope[1]*(sd(age))))
trad.young <-(intercept[2]+(slope[2]*-(sd(age))))
trad.old <-(intercept[2]+(slope[2]*(sd(age))))
cont.young <-(intercept[3]+(slope[3]*-(sd(age))))
cont.old <-(intercept[3]+(slope[3]*(sd(age))))
preds<-cbind(c(new.young,new.old),c(trad.young,trad.old),c(cont.young,cont.old))
matplot((preds), main = "Homogeneity of Regression Lines", type="l",lwd=3,ylab = 'Reasoning Ability', xlab = "Age")
legend("topleft",legend=c("New","Traditional","Control"),
lty=c(1,3,5),lwd=2,pch=21,col=c("black","red","darkgreen"),
ncol=1,bty="n",cex=1,
text.col=c("black","red","darkgreen"),
inset=0.01)

#ANCOVA by comparing two models
ancova <-anova(mod.a,mod.e)

###Section 13.1.2:  Adjusted Means and Simple Slopes
grp <-c(1,1,1,1,2,2,2,2,3,3,3,3)
age <-c(12,8,9,7,13,8,11,8,12,10,7,9)
y <-c(7,5,5,4,6,2,5,3,4,4,1,2)
eff1 <-c(rep(1,4),rep(0,4),rep(-1,4));eff2 <-c(rep(0,4),rep(1,4),rep(-1,4))
summary(mod.e <-lm(y~age+eff1+eff2))

#Compute Adjusted Means
b.common <-mod.e$coef[2]
grp.y <-tapply(y, factor(grp), mean)   
grp.age <-tapply(age, factor(grp), mean)   
mean.age <-mean(age)
adj.new <-(grp.y[1]-(b.common*(grp.age[1]-mean.age)))
adj.trad <-(grp.y[2]-(b.common*(grp.age[2]-mean.age)))
adj.cont <-(grp.y[3]-(b.common*(grp.age[3]-mean.age)))

#Graph Adjusted Means
barplot(c(adj.new,adj.trad,adj.cont),
main="Adjusted Means",col=c("black","gray","black"),density=c(20,15,10), angle=c(30,20,0),xlab= "Conditions", names = c("New","Traditional","Control"), ylim = c(0, 6), ylab = "Reasoning Ability")

#Intercepts Using Common Regression Coefficient
int.1 <-(1*mod.e$coef[3])+(0*mod.e$coef[4])+mod.e$coef[1]
int.2 <-(0*mod.e$coef[3])+(1*mod.e$coef[4])+mod.e$coef[1]
int.3 <-(-1*mod.e$coef[3])+(-1*mod.e$coef[4])+mod.e$coef[1]
intercepts <-cbind(int.1,int.2,int.3)

#Augmented Coefficients and Covariance Matrix
BB <-c(mod.e$coef[3],mod.e$coef[4],-(mod.e$coef[3]+mod.e$coef[4]));BB
covar <-vcov(mod.e)
cov <- covar[3:  length(mod.e$coef),3:  length(mod.e$coef)]
rows<-function(cov,i,j)cbind(cov[i,1],cov[i,2],-(cov[i,1]+cov[i,2]))
aug <-rows(cov)
CC<-rbind(aug[1,],aug[2,],-(aug[1,]+aug[2,]));CC

#Simple Slopes
s1 <-c(-1,-1,0,-2,1,1);s2 <-c(1,0,-1,1,-2,1);s3 <-c(0,1,1,1,1,-2)
S <-rbind(s1,s2,s3);S
simp.slope <-t(S)%*%BB;simp.err <-sqrt(diag(t(S)%*%CC%*%S))
ttests <-simp.slope/simp.err;pvalues <-2*pt(-abs(ttests),(df=(length(y)-length(coef(mod.e)))))
crit <-abs(qt(0.025,(df=(length(y)-length(coef(mod.e))))))
CI.low <-simp.slope-(crit*simp.err);CI.high <-simp.slope+(crit*simp.err)
simp.table<-round(matrix(c(simp.slope,simp.err,ttests,pvalues,CI.low,CI.high),nrow=ncol(S),ncol=6),digits=5)
dimnames(simp.table)=list(c(),c("slope","stderr","t","p","CI.low","CI.high"))
simp.table

###Section 13.2:  Multiple Covariates
grp <-c(rep(1,4),rep(2,4),rep(3,4))
age <-c(9,8,11,7,12,8,11,8,13,10,7,7)
IQ <-c(130,85,105,100,110,80,90,100,105,110,85,100)
y <-c(9,3,7,4,6,1,5,3,5,4,1,2)
eff1 <-c(rep(1,4),rep(0,4),rep(-1,4))
eff2 <-c(rep(0,4),rep(1,4),rep(-1,4))

#Compute all 5 models
summary(mod.a <-lm(y~age+IQ))
anova(mod.b1 <-lm(age~eff1+eff2))
anova(mod.b2 <-lm(IQ~eff1+eff2))
summary(mod.c <-lm(y~eff1+eff2))
summary(mod.d <-lm(y~age+IQ+eff1+eff2+age*eff1+age*eff2+IQ*eff1+IQ*eff2))
summary(mod.e <-lm(y~age+IQ+eff1+eff2))
ancova <-anova(mod.e,mod.a)
ancova

#Compute Adjusted Means
b.com1 <-mod.e$coef[2]
b.com2 <-mod.e$coef[3]
grp.y <-tapply(y, factor(grp), mean)   
grp.age <-tapply(age, factor(grp), mean)   
mean.age <-mean(age)
grp.IQ <-tapply(IQ, factor(grp), mean)   
mean.IQ <-mean(IQ)
adj.new<-(grp.y[1]-(b.com1*(grp.age[1]-mean.age))-(b.com2*(grp.IQ[1]-mean.IQ)))
adj.trad<-(grp.y[2]-(b.com1*(grp.age[2]-mean.age))-(b.com2*(grp.IQ[2]-mean.IQ)))
adj.cont<-(grp.y[3]-(b.com1*(grp.age[3]-mean.age))-(b.com2*(grp.IQ[3]-mean.IQ)))
adj.means <-cbind(adj.new,adj.trad,adj.cont);adj.means

#Graph Adjusted Means
barplot(c(adj.new,adj.trad,adj.cont),
main="Adjusted Means",col=c("black","gray","black"),density=c(20,15,10), angle=c(30,20,0),xlab= "Condition", names = c("New","Traditional","Control"), ylim = c(0, 6), ylab = "Reasoning Ability")

#Generate Augmented Coefficients and Covariance Matrix
BB <-c(mod.e$coef[4],mod.e$coef[5],-(mod.e$coef[4]+mod.e$coef[5]))
BB

covar <-vcov(mod.e)
cov <- covar[4:  length(mod.e$coef),4:  length(mod.e$coef)]
rows<-function(cov,i,j)cbind(cov[i,1],cov[i,2],-(cov[i,1]+cov[i,2]))
aug <-rows(cov)
CC<-rbind(aug[1,],aug[2,],-(aug[1,]+aug[2,]))
CC

#Simple Effects
simple <-function(S){
simp.slope <-t(S)%*%BB;simp.err <-sqrt(diag(t(S)%*%CC%*%S))
ttests <-simp.slope/simp.err;pvalues <-2*pt(-abs(ttests),(df=(length(y)-length(coef(mod.e)))))
crit <-abs(qt(0.025,(df=(length(y)-length(coef(mod.e))))))
CI.low <-simp.slope-(crit*simp.err);CI.high <-simp.slope+(crit*simp.err)
simp.table<-round(matrix(c(simp.slope,simp.err,ttests,pvalues,CI.low,CI.high),nrow=ncol(S),ncol=6),digits=5)
dimnames(simp.table)=list(c(),c("slope","stderr","t","p","CI.low","CI.high"))
return(list(S,simp.table))
}
s1 <-c(-1,-1,0,-2,1,1);s2 <-c(1,0,-1,1,-2,1);s3 <-c(0,1,1,1,1,-2)
S <-rbind(s1,s2,s3)

simple(S)
