Boxplot with eyes

boxplot with eyes

boxplot_eyes <- function(formula, data, col="yellow", boxwex=0.8){
  if (boxwex > 1) boxwex <- 1
  bw <- boxwex/2
  # Ellipsen plot Funktion
  eli <- function(r,e){
    theta <- seq(0,2*pi,len=1000)
    matrix(c(r*cos(theta),e*r*sin(theta)),ncol=2)
  }
  # Boxplot
  bp <- boxplot(formula, data=data, col=col, boxwex=boxwex)
  # Boxplot stats
  bps <- bp$stats
  bpu <- cbind(bps[c(4,3),])
  ### x-Koordinaten
  xm <- 1:ncol(bps)
  if (length(xm) == 1) bw <- boxwex/4
  
  for (i in 1:ncol(bps)){
    ll <- xm[i]-bw
    rl <- xm[i]
    upl <- bpu[1,i]
    lol <- bpu[2,i]
    dh <- upl-lol
    
    xl <- runif(1,ll+0.25*bw,ll+0.375*bw)
    xr <- runif(1,rl-0.375*bw,rl-0.125*bw)
    dx <- xr-xl
    yu <- runif(1,upl-0.3*dh,upl-0.2*dh)
    yl <- runif(1,lol+0.1*dh,lol+0.2*dh)
    dy <- yu-yl
    
    ## Augen
    # links
    r <- dx/2
    e <- (dy/2)/r
    xyell <- eli(r,e)
    xcoor1 <- xyell[,1]+xl+dx/2
    ycoor1 <- xyell[,2]+yl+dy/2
    polygon(xcoor1,ycoor1,col="white")
    # rechts
    xcoor2 <- xyell[,1]+rl+(rl-xr)+dx/2
    polygon(xcoor2,ycoor1,col="white")
    
    # Lid dist
    Ldf <- runif(1,0,0.6)
    
    # Pupillen
    #links
    pmx <- runif(1,xl+0.2*dx,xr-0.2*dx)
    pmy <- if (Ldf > 0.2) runif(1,yl+0.2*dy,yl+(1-Ldf)*dy) else runif(1,yl+0.2*dy,yl+0.8*dy)
    rp <- runif(1,0.3*r,0.6*r)
    ep <- runif(1,0.3*e,0.6*e)
    xypell <- eli(rp,ep)
    xcoorp1 <- xypell[,1]+pmx
    ycoorp1 <- xypell[,2]+pmy
    
    xcoorp1in <- xcoorp1[((((xl+dx/2)-xcoorp1)^2)/(r^2)) + ((((yl+dy/2)-ycoorp1)^2)/((e*r)^2)) <= 1]
    ycoorp1in <- ycoorp1[((((xl+dx/2)-xcoorp1)^2)/(r^2)) + ((((yl+dy/2)-ycoorp1)^2)/((e*r)^2)) <= 1]
    
    polygon(xcoorp1in,ycoorp1in,col="blue")
    # rechts
    if (pmx < xl+r) schiel <- FALSE else schiel <- rbinom(1,1,0.5)
    if (schiel) xcoorp2 <- xypell[,1]+rl+(rl-pmx) else xcoorp2 <- xypell[,1]+rl+bw-(xl-ll)-(xr-pmx)
    xcoorp2in <- xcoorp2[((((rl+(rl-xr)+dx/2)-xcoorp2)^2)/(r^2)) + ((((yl+dy/2)-ycoorp1)^2)/((e*r)^2)) <= 1]
    ycoorp1in <- ycoorp1[((((rl+(rl-xr)+dx/2)-xcoorp2)^2)/(r^2)) + ((((yl+dy/2)-ycoorp1)^2)/((e*r)^2)) <= 1]
    polygon(xcoorp2in,ycoorp1in,col="blue")
    
    ## Lids
    # links
    ycoorL <- ycoor1[ycoor1 > (yu-Ldf*dy)]
    xcoorL1 <- xcoor1[ycoor1 > (yu-Ldf*dy)]
    #ycoorL[ycoor1 < (yu-Ldf*dy)] <- (yu-Ldf*dy)
    polygon(xcoorL1,ycoorL,col=col)
    # rechts
    xcoorL2 <- xcoor2[ycoor1 > (yu-Ldf*dy)]
    polygon(xcoorL2,ycoorL,col=col)
    
    # Brows
    lup <- runif(1,yu,yu+0.1*dh)
    llo <- runif(1,yu,yu+0.1*dh)
    segments(xl,lup,xr,llo,lwd=3)
    segments(rl+rl-xl,lup,rl+rl-xr,llo,lwd=3)
  }  
}

data <- data.frame(y=rnorm(40, 10, 2), grp=rep(LETTERS[1:4], each=10))
boxplot_eyes(y ~ grp, data=data)