Age <- c(15,20,7,10,10,26,18,9,12,10,11,10,42,9,8,11,17,15,20,11,11) Score <- c(95,87,113,100,100,71,93,96,105,83,100,83,57,91,104,84,121,102,94,102,86) Gesell <- data.frame(Age,Score) with(Gesell,plot(Age,Score,xlab="Age (months)",main="Gesell Data")) #load lattice and mvtnorm yrange <- seq(-3,3,by=.1) #ny <-length(yrange) #y1 <- rep(yrange,each=ny) #y2 <- rep(yrange,ny) #gridy <- cbind(y1,y2) #More efficient grid gridy <- expand.grid(yrange,yrange) par(mfrow=c(2,2)) f1 <- matrix(dmvnorm(gridy,mean=c(0,0),sigma=diag(c(1,1.5))),ncol=ny) contour(yrange,yrange,f1,drawlabels=F) f2 <- matrix(dmvnorm(gridy,mean=c(1,1),sigma=diag(2)),ncol=ny) contour(yrange,yrange,f2,drawlabels=F) f3 <- matrix(dmvnorm(gridy,mean=c(0,0),sigma=matrix(c(1,.5,.5,.5),ncol=2)),ncol=ny) contour(yrange,yrange,f3,drawlabels=F) f4 <- matrix(dmvnorm(gridy,mean=c(-1,1),sigma=matrix(c(.7,-.5,-.5,.5),ncol=2)),ncol=ny) contour(yrange,yrange,f4,drawlabels=F) wireframe(f3, drape = TRUE, colorkey = TRUE, screen = list(x=-60, z = -60, y = -60), zlab="Density" ) xbar=c(14.38,93.67) smat=matrix(c(60.14,-67.78,-67.78,186.32),ncol=2) xrange=seq(0,40,by=1) nx <- length(xrange) yrange=seq(60,120,by=1) ny <- length(yrange) y1 <- rep(xrange,each=ny) y2 <- rep(yrange,nx) gridy <- cbind(y1,y2) f5 <- dmvnorm(gridy,mean=xbar,sigma=smat) f5mat <-matrix(dmvnorm(gridy,mean=xbar,sigma=smat),byrow=T,ncol=ny) #These commands create a plot that can't be saved contourplot(f5~y1*y2,labels=F,xlab="Age (months)",ylab="Gesell Score") points(Age,Score) contour(xrange,yrange,f5mat,drawlabels=F) points(Age,Score) wireframe(f5~y1*y2, drape = TRUE, colorkey = TRUE, screen = list(x=-80, z = -40, y = -80), scales=list(arrows=F), zlab="", xlab="Age", ylab="Score" ) dy <- dnorm(30:150,mean=93.67,sd=sqrt(186.32)) plot(30:150,dy,type="l",lwd=2,col="red",ylim=c(0,0.042),xlab="",ylab="") lines(30:150,dnorm(30:150,mean=98.6,sd=sqrt(110.15)),lwd=2,lty=2) lines(30:150,dnorm(30:150,mean=81.72,sd=sqrt(110.15)),lwd=2,lty=2)