# R for Hardy-Weinberg plot


p<-seq(0,1,0.001)
plot(NULL,xlim=c(0,1), ylim=c(0,1), xlab="p",ylab="Frequency")
lines(p,p^2,col="red",lwd=2)
lines(p,(1-p)^2,col="blue",lwd=2)
lines(p,2*p*(1-p),col="purple",lwd=2)
text(0.2,0.95,expression('q'^2*' Propn(aa)'),col="blue")
text(0.8,0.95,expression('p'^2*' Propn(AA)'),col="red")
text(0.5,0.68,"2pq Propn(Aa)",col="purple")
arrows(0.2,0.915,0.13,0.7569,code=2,col="blue",length=0.1)
arrows(0.8,0.915,0.87,0.7569,code=2,col="red",length=0.1)
arrows(0.5,0.66,0.5,0.5,code=2,col="purple",length=0.1)

#or using bquote
p<-seq(0,1,0.001)
plot(NULL,xlim=c(0,1), ylim=c(0,1), xlab="p",ylab="Frequency")
lines(p,p^2,col="red",lwd=2)
lines(p,(1-p)^2,col="blue",lwd=2)
lines(p,2*p*(1-p),col="purple",lwd=2)
text(0.2, 0.95, bquote('q'^2*' Propn(aa)'),col="blue")
text(0.8, 0.95, bquote("q"^2*" Propn(aa)"),col="red")
text(0.5, 0.68, '2pq Propn(Aa)',col="purple")
arrows(0.2,0.915,0.13,0.7569,code=2,col="blue",length=0.1)
arrows(0.8,0.915,0.87,0.7569,code=2,col="red",length=0.1)
arrows(0.5,0.66,0.5,0.5,code=2,col="purple",length=0.1)