ellipse<-function(x0=0,y0=0,a=5,b=5,new=T,part="entire"){
if (new==T) {par(new=F)}
if (new==F) {par(new=T)}
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",axes=F)
if ((part=="entire")|(part=="NW")|(part=="top")|(part=="left")){
par(new=T)
curve((y0+sqrt(abs(b^2-((x-x0)*b/a)^2))),x0-a,x0,n=200,xlim=c(-10,10),ylim=c(-10,10),

xlab="",ylab="",axes=F)}
if ((part=="entire")|(part=="NE")|(part=="top")|(part=="right")){
par(new=T)
curve((y0+sqrt(abs(b^2-((x-x0)*b/a)^2))),x0,x0+a,n=200,xlim=c(-10,10),ylim=c(-10,10),

xlab="",ylab="",axes=F)}
if ((part=="entire")|(part=="SW")|(part=="bottom")|(part=="left")){
par(new=T)
curve((y0-sqrt(abs(b^2-((x-x0)*b/a)^2))),x0-a,x0,n=200,xlim=c(-10,10),ylim=c(-10,10),

xlab="",ylab="",axes=F)}
if ((part=="entire")|(part=="SE")|(part=="bottom")|(part=="right")){
par(new=T)
curve((y0-sqrt(abs(b^2-((x-x0)*b/a)^2))),x0,x0+a,n=200,xlim=c(-10,10),ylim=c(-10,10),

xlab="",ylab="",axes=F)}
}


cellipse<-function(x0=0,y0=0,a=5,b=5,color=NULL,new=T,part="entire"){
if (new==T) {par(new=F)}
if (new==F) {par(new=T)}
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",axes=F)
par(new=T)
xtop<-x0-a+(2*a/399)*(0:399)
xbot<-x0-a+(2*a/399)*(398:0)
x<-c(xtop,xbot)
ytop<-y0+sqrt(abs(b^2-((xtop-x0)*b/a)^2))
ybot<-y0-sqrt(abs(b^2-((xbot-x0)*b/a)^2))
if (part=="entire"){
  x<-c(xtop,xbot)
  y<-c(ytop,ybot)}
if (part=="bottom"){
  x<-c(x0-1,x0+a,xbot)
  y<-c(y0,y0,ybot)}
polygon(x,y,border="black",col=color)
}


mbbjw<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Martin, Bolin, Brown, Jackson, and Way#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
#variable 1 is head radius from 4 to 9#
##
headradius<-4+5*x[1]
ellipse(x0=0,y0=0,a=headradius,b=headradius,new=F)
##
#variable 2 is height of ears from 1 to 4 high (1 wide)#
##
earradius<-(1/2)*(1+3*x[2])
ellipse(x0=headradius,y0=0,a=1,b=earradius,part="right",new=F)
ellipse(x0=-headradius,y0=0,a=1,b=earradius,part="left",new=F)
##
#variable 3 is width of nose from 1/2 to 3 (1 high)#
##
noseradius<-(1/2)*(0.5+2.5*x[3])
ellipse(x0=0,y0=0,a=noseradius,b=0.5,new=F)
##
#variable 4 is color of eyes from yellow to purple#
##
ccode<-rgb(1,1-x[4],x[4])
cellipse(x0=2,y0=2,a=1.5,b=1.5,new=F,color=ccode)
cellipse(x0=-2,y0=2,a=1.5,b=1.5,new=F,color=ccode)
##
#variable 5 is the mouth which goes from a straight line to ellipse#
##
mouthradius<-2*x[5]
ellipse(x0=0,y0=-2,a=2,b=mouthradius,part="bottom",new=F)
}


bpt<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Bailey, Page, and Toma-Drane#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
#I had to guess that the head is centered at y=-2.5 with radius 7.5#
#variable 5 is the face color ranging from green to white#
##
ccode<-rgb(x[5],1,x[5])
cellipse(x0=0,y0=-2.5,a=7.5,b=7.5,new=F,color=ccode)
##
#variable 1 is the size of eyes from 0.5 to 2.5 radius#
##
eyeradius<-0.5+2*x[1]
ellipse(x0=-2.5,y0=0,a=eyeradius,b=eyeradius,new=F)
ellipse(x0=2.5,y0=0,a=eyeradius,b=eyeradius,new=F)
##
#variable 2 is the size of the nose from 0x0 to 2x3#
##
ellipse(x0=0,y0=-4,a=2*x[2],b=3*x[2],new=F)
##
#variable 3 is the radius of the mouth half ellipse from#
#(0.5,1/3) to (3,2)#
##
moutha<-0.5+2.5*x[3]
mouthb<-1/3+(5/3)*x[3]
ellipse(x0=0,y0=-7.5,a=moutha,b=mouthb,part="bottom",new=F)
lines(c(-moutha,moutha),c(-7.5,-7.5))
##
#variable 4 is hair length from 0.2 to 5#
##
hairlen<-0.2+4.8*x[4]
angles<-c(45,67.5,90,112.5,135)*2*pi/360
for (i in 1:5){
lines(c(0+7.5*cos(angles[i]),0+(7.5+hairlen)*cos(angles[i])),
  c(-2.5+7.5*sin(angles[i]),-2.5+(7.5+hairlen)*sin(angles[i])))
}
par(col="black")
}


wywmpd<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Wood, Yocum, Wan, Miao, Pakala, and Dong#
##
#I had to adjust this a little... how can I have hair go from 0 to 10#
#if the head already fills up the entire window?  So I used the #
#measurements I ended up having to use for bpt basically.  #
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
#variable 1 is the color of the face, ranging from white=low to red=high#
##
ccode<-rgb(1,1-x[1],1-x[1])
cellipse(x0=0,y0=-2.5,a=7.5,b=7.5,new=F,color=ccode)
##
#variable 2 is the color of the left eye#
##
ccode<-rgb(1-x[1],1-x[1],1)
cellipse(x0=-3.75,y0=1.25,a=1.5,b=1.5,new=F,color=ccode)
##
#variable 3 is the color of the right eye#
##
ccode<-rgb(1-x[1],1,1-x[1])
cellipse(x0=3.75,y0=1.25,a=1.5,b=1.5,new=F,color=ccode)
##
#variable 4 is a half elipse with height ranging from the max to#
#the min possible#
##
mouthb<-7.5*x[4]
ellipse(x0=0,y0=-2.5,a=3.75,b=mouthb,part="bottom",new=F)
##
#variable 5 is hair length ranging from nothing to the maximum 
##
hairlen<-5*x[5]
angles<-c(45,67.5,90,112.5,135)*2*pi/360
for (i in 1:5){
lines(c(0+7.5*cos(angles[i]),0+(7.5+hairlen)*cos(angles[i])),
  c(-2.5+7.5*sin(angles[i]),-2.5+(7.5+hairlen)*sin(angles[i])))
}
}

bhsm<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Brezaie, Hang, Suh, and Morris#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
#variable 1 is head radius from 3 to 5#
##
headradius<-3+2*x[1]
ellipse(x0=0,y0=0,a=headradius,b=headradius,new=F)
##
#variable 2 is the radius of the eyes from 0.5 to 1.5#
##
eyeradius<-0.5+x[2]
ellipse(x0=headradius/2,y0=headradius/2,a=eyeradius,b=eyeradius,new=F)
ellipse(x0=-headradius/2,y0=headradius/2,a=eyeradius,b=eyeradius,new=F)
##
#variable 3 is height of nose from 0.5 to 1.5 center#
##
noseheight<-0.5+x[3]
lines(c(0,0),c(-noseheight/2,noseheight/2))
##
#variable 4 is the width of the mouth from 0.5 to 1.5 center at (0,-2)
##
mouthwidth<-0.5+x[4]
lines(c(-mouthwidth/2,mouthwidth/2),c(-2,-2))
##
#variable 5 is the hair length  from 1.5 to 2.5#
#a picture would have been nice here!!!#
##
hairlength<-1.5+x[5]
lines(c(-hairlength,hairlength),c(headradius,headradius))
}

dlbj<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#DeVeaux, Lockett, Breuer, and Johnson#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
ellipse(x0=0,y0=0,a=6,b=6,new=F)
##
#variable 1 is the ear size from 0 to 3 centered, but I'm not#
#sure how it would work centered at (0,-6)?!?!, and I'm not sure#
#a full oval would work very well#
##
earradius<-3*x[1]
ellipse(x0=6,y0=0,a=earradius,b=earradius,part="right",new=F)
ellipse(x0=-6,y0=0,a=earradius,b=earradius,part="left",new=F)
##
#variable 2 is the width of the mouth... not sure what you mean#
#by range -3 to 3 though... I'm guessing radius from 0 to 3?...#
#but that only makes sense if the height is smaller than that#
##
mouthradius<-3*x[2]
ellipse(x0=0,y0=-4,a=mouthradius,b=mouthradius/2,new=F)
##
#variable 3 is height of the hair from 0 to 3#
##
hairheight<-3*x[3]
hairradius<-6+hairheight
hairradius2<-6+hairheight/2
ellipse(x0=0,y0=0,a=hairradius,b=hairradius,part="top",new=F)
ellipse(x0=0,y0=0,a=hairradius2,b=hairradius2,part="top",new=F)
lines(c(6,hairradius),c(0,0))
lines(c(-6,-hairradius),c(0,0))
lines(c(0,0),c(6,hairradius))
##
#variable 4 is the radius of the eyes from 0 to 0.5 at (+/-3,3)#
##
eyeradius<-0.5*x[5]
ellipse(x0=3,y0=3,a=eyeradius,b=eyeradius,new=F)
ellipse(x0=-3,y0=3,a=eyeradius,b=eyeradius,new=F)
##
#variable 5 height of the nose from 0 to 2 (from (0,0) up)#
##
noseheight<-2*x[5]
lines(c(0,0),c(0,noseheight))
}


bbwb<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Bonkowski, Borkowski, Wood, and Barnes#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
ellipse(x0=0,y0=0,a=7,b=7,new=F)
##
#variable 1 is the radius of the eyes from 0.1 to 2#
##
eyeradius<-0.1+1.9*x[1]
ellipse(x0=-3.5,y0=3.5,a=eyeradius,b=eyeradius,new=F)
ellipse(x0=3.5,y0=3.5,a=eyeradius,b=eyeradius,new=F)
##
#variable 2 is radius of the nose from 0.1 to 2#
##
noseradius<-0.1+1.9*x[2]
ellipse(x0=0,y0=0,a=noseradius,b=noseradius,new=F)
##
#variable 3 is the mouth, ranging from a -3.5 frown to a +3.5 smile#
##
mouthradius<--3.5+7*x[3]
if (mouthradius<0){
   ellipse(x0=0,y0=-3.5,a=3.5,b=abs(mouthradius),part="top",new=F)}
if (mouthradius>=0){
   ellipse(x0=0,y0=-3.5,a=3.5,b=abs(mouthradius),part="bottom",new=F)}
##
#variable 4 is the radius of the ear from 1 to 2#
##
earradius<-1+x[4]
ellipse(x0=7,y0=2,a=earradius,b=earradius,part="right",new=F)
ellipse(x0=-7,y0=2,a=earradius,b=earradius,part="left",new=F)
##
#variable 5 is the length of the hair... I have no idea#
#what your description really means!!  (straight line length 1,#
#add 1 piece of hair as variable increases?#
##
nhair<-2*round(44*x[5])+2
angles<-((90-nhair/2):(90+nhair/2))*2*pi/360
for (i in 1:nhair){
lines(c(7*cos(angles[i]),8*cos(angles[i])),
  c(7*sin(angles[i]),8*sin(angles[i])))
}
}


tiks<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Tanis, Im, Kelly, and Stocker#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
#variable 5 is the face color from nearly white to nearly black#
##
ccode<-gray(.8-.6*x[5])
##
#variable 1 is thehead from 0 to 10#
##
headradius<-10*x[1]
cellipse(x0=0,y0=1,a=headradius,b=headradius,new=F,color=ccode)
##
#variable 2 is the eye size, centered at 1/2 the radius out#
#with a radius from 0 to 5#
##
eyeradius<-5*x[2]
cellipse(x0=headradius/2,y0=headradius/2,a=eyeradius,b=eyeradius,new=F,color="white")
cellipse(x0=-headradius/2,y0=headradius/2,a=eyeradius,b=eyeradius,new=F,color="white"

)
##
#variable 3 is the mouth length ranging from 1 wide to 20 wide#
##
mw<-1+19*x[3]
yval<--headradius/2
polygon(c(-mw/2,mw/2,mw/2,-mw/2,-mw/2),c(yval,yval,yval-0.25,yval-0.25,yval),
  border="black",col="white")
##
#variable 4 is the tongue length from 0 to 5, 1 wide#
##
tonguelength<-5*x[4]
cellipse(x0=0,y0=-headradius/2,a=0.5,b=tonguelength,part="bottom",new=F,color="white"

)
}

ypa<-function(x=c(.5,.5,.5,.5,.5),label=""){
##
#Yoon, Patel, and Anderson#
##
##
plot(c(0,0),xlim=c(-10,10),ylim=c(-10,10),xlab="",ylab="",type="n",
  axes=F,main=label)
##
lines(c(-5,5,5,-5,-5),c(-10,-10,5,5,-10))
##
#variable 1 is the hair height from 0 to 5#
##
hairheight<-5*x[1]
lines(c(-5,5,5,-5,-5),c(5,5,5+hairheight,5+hairheight,5))
##
#variable 2 is the eye radius from 0 to 1#
##
eyeradius<-x[2]
ellipse(x0=-2.5,y0=2.5,a=eyeradius,b=eyeradius,new=F)
ellipse(x0=2.5,y0=2.5,a=eyeradius,b=eyeradius,new=F)
##
#variable 3 is the nose height from 0 to 2# is the eye size, centered at 1/2 
##
noseheight<-2*x[3]
lines(c(-0.5,0.5,0.5,-0.5,-0.5),c(-noseheight,-noseheight,0,0,-noseheight))
##
#variable 4 is the mouth location from -3 to -9#
##
mouthlocation<-(-3)-6*x[4]
lines(c(-4,4),c(mouthlocation,mouthlocation))
##
#variable 5 is the earwidth from 5 to 10#
##
earwidth<-5+5*x[5]
lines(c(-earwidth,-5,-5,-earwidth,-earwidth),c(-2,-2,3,3,-2))
lines(c(earwidth,5,5,earwidth,earwidth),c(-2,-2,3,3,-2))
}

faces<-function(x,label=rep("",length(x[,1])),facetype="bpt"){
j<-length(x[1,])
par(pty="s")
par(mai=c(0.01,0.01,0.1,0.01))
par(cex.main=0.8)
par(mfrow=c(1,1))
par(mfrow=c(ceiling(sqrt(length(x[,1]))),ceiling(sqrt(length(x[,1])))))
for (i in 1:j){
x[,i]<-(x[,i]-min(x[,i]))/(max(x[,i])-min(x[,i]))
}
if (length(x[1,]) < 5) {
for (i in (j+1):5){
x[,i]<-0.5
}
}
for (i in 1:length(x[,1])){
if (facetype=="mbbjw"){
	mbbjw(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="bpt"){
	bpt(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="wywmpd"){
	wywmpd(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="bhsm"){
	bhsm(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="dlbj"){
	dlbj(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="bbwb"){
	bbwb(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="tiks"){
	tiks(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
if (facetype=="ypa"){
	ypa(c(x[i,1],x[i,2],x[i,3],x[i,4],x[i,5]),
    	label=as.character(label[i]))}
}
}