Skip to content

Fill pattern for Boxplots?

9 messages · suse, Susanne Meyfarth, John Kane +4 more

suse
# 
Is it possible to fill the boxes of  a boxplot with filling patterns/texture
instead of colours? Or both mixed? (for example white, grey, left diagonal
striped, right diagonal striped) How can I do that? I searched here, but
didn't find an answer.
Thank you!



--
View this message in context: http://r.789695.n4.nabble.com/Fill-pattern-for-Boxplots-tp4639698.html
Sent from the R help mailing list archive at Nabble.com.
John Kane
# 
Probably not. See http://r.789695.n4.nabble.com/Boxplot-Fill-Pattern-td4457209.html on this topic.

What exactly are you doing?  There may be a workaround or alternative.

John Kane
Kingston ON Canada
____________________________________________________________
FREE ONLINE PHOTOSHARING - Share your photos online with your friends and family!
Visit http://www.inbox.com/photosharing to find out more!
Susanne Meyfarth
# 
Thank you. I saw these postings, but I don't want to learn lattice for 
this reason (was afraid to have to change then everything else in my 
graph). Anyway, I now tried with different shades of greyscale (4 
shades). I'm not fully satisfied with it, but it's ok. It's for a 
publication and depending on whether I have to change the graph, I 
decide to either put texture in some boxes manually or still look for a 
solution in R.


--------Original Message----------
From: John Kane <jrkrideau at inbox.com>
To: suse <meyfarth at uni-potsdam.de>, r-help at r-project.org
Date: 09.08.2012 16:52
Subject: Re: [R] Fill pattern for Boxplots?
John Kane
# 
You might want to have a look at  RColorBrewer.  If I remember correctly some of their palettes should work better than a standard R greyscale but I must admit I have not tried them.
 http://www.decisionstats.com/color-palettes-in-r-using-rcolorbrewer-rstats/  for a start.
John Kane
Kingston ON Canada
____________________________________________________________
FREE 3D EARTH SCREENSAVER - Watch the Earth right on your desktop!
David L Carlson
# 
It's not too hard to use rect() to add shading to the boxplots. The boxes
are centered on consecutive integers and the width is +/- .4. The boxplot()
function returns the quartiles of each box. 

set.seed(42)
DF <- data.frame(val=rnorm(150), grp=rep(letters[1:6], 25))
outstat <- boxplot(val~grp, DF)           # save the boxplot stats
ngroups <- length(levels(DF$grp))         # get number of groups
dval <- c(6, 6, 6, 12, 12, 12)            # density vals for each group
aval <- c(0, 30, 60, 90, 120, 150)        # angle vals for each group
rect((1:ngroups)-.4, outstat$stats[2,], (1:ngroups)+.4, outstat$stats[4,], 
     density=dval, angle=aval)            # draw the rectangles

You can also play with lty= and lwd= but that will affect the box border as
well.

----------------------------------------------
David L Carlson
Associate Professor of Anthropology
Texas A&M University
College Station, TX 77843-4352
meyfarth at uni-potsdam.de
# 
Thank you! This sounds good and easy to do (if I can as well make 
stripes to the legend)

--------Original Message----------
From: David L Carlson <dcarlson at tamu.edu>
To: <meyfarth at uni-potsdam.de>, 'John Kane' <jrkrideau at inbox.com>
Date: 09.08.2012 22:10
Subject: Re: [R] Fill pattern for Boxplots?

  
    

      
      
    

  


  


      

    

    

      
      

        


  

        

      S Ellison
    

    

      
      #
    

  


  

          

      
      
      
    

        
You could create your own boxplot functions from the existing code. In this instance, you'd need a at least a modest modification to bxp()

I have included a shaded.bxp function that does the (basic) job below (see between #=============). bxp is normally called by boxplot, so you'd need to have a modified boxplot as werll if you wanted to work most simply. However, bxp will plot a boxplot object produced with plot=FALSE, so a modified bxp does the job for a one-off.
To use it, do something like this:


x<-rnorm(150)
g <- gl(5,30)

b.x <- boxplot(x~g, plot=FALSE) #creates the boxplot object bxp expects.


shaded.bxp(b.x, density=10, boxfill=1)

#For different shadings in the same set of boxes, this variant accepts vector density and angle: use
shaded.bxp(b.x, density=5*1:5, boxfill=1 , angle=seq(45, 135, length=5))


#If you need to build a complicated boxplot as in the ?boxplot example, with one fill for each set of boxes, you'll need to create the boxplot objects and add them separately:
y<-rnorm(150)
b.y <- boxplot(y~g, plot=FALSE)

shaded.bxp(b.x, density=10, boxfill=1, at=1:5-0.2, boxwex=0.3, axes=FALSE, ylim=range(pretty(c(x,y)))) #note the ylim allowance for all data
shaded.bxp(b.y, density=5, angle=135, boxfill=1, at=1:5+0.2, boxwex=0.3, add=TRUE, axes=FALSE)
box()
axis(2)
axis(1, at=1:5, labels=paste("Group", 1:5))


Steve Ellison

#================================

#bxp including shading


shaded.bxp <- function (z, notch = FALSE, width = NULL, varwidth = FALSE, outline = TRUE, 
    notch.frac = 0.5, log = "", border = par("fg"), pars = NULL, 
    frame.plot = axes, horizontal = FALSE, add = FALSE, at = NULL, 
    show.names = NULL, density=NULL, angle=45,  ...) 
{
    pars <- c(list(...), pars)
    pars <- pars[unique(names(pars))]
    bplt <- function(x, wid, stats, out, conf, notch, xlog, i, density, angle=45, boxfill) {
        ok <- TRUE
        if (!any(is.na(stats))) {
            xP <- if (xlog) 
                function(x, w) x * exp(w)
            else function(x, w) x + w
            wid <- wid/2
            if (notch) {
                ok <- stats[2L] <= conf[1L] && conf[2L] <= stats[4L]
                xx <- xP(x, wid * c(-1, 1, 1, notch.frac, 1, 
                  1, -1, -1, -notch.frac, -1))
                yy <- c(stats[c(2, 2)], conf[1L], stats[3L], 
                  conf[2L], stats[c(4, 4)], conf[2L], stats[3L], 
                  conf[1L])
            }
            else {
                xx <- xP(x, wid * c(-1, 1, 1, -1))
                yy <- stats[c(2, 2, 4, 4)]
            }
            if (!notch) 
                notch.frac <- 1
            wntch <- notch.frac * wid
            xypolygon(xx, yy, lty = "blank", col = boxfill[i], density=density[i], angle=angle[i])
            xysegments(xP(x, -wntch), stats[3L], xP(x, +wntch), 
                stats[3L], lty = medlty[i], lwd = medlwd[i], 
                col = medcol[i], lend = 1)
            xypoints(x, stats[3L], pch = medpch[i], cex = medcex[i], 
                col = medcol[i], bg = medbg[i])
            xysegments(rep.int(x, 2), stats[c(1, 5)], rep.int(x, 
                2), stats[c(2, 4)], lty = whisklty[i], lwd = whisklwd[i], 
                col = whiskcol[i])
            xysegments(rep.int(xP(x, -wid * staplewex[i]), 2), 
                stats[c(1, 5)], rep.int(xP(x, +wid * staplewex[i]), 
                  2), stats[c(1, 5)], lty = staplelty[i], lwd = staplelwd[i], 
                col = staplecol[i])
            xypolygon(xx, yy, lty = boxlty[i], lwd = boxlwd[i], 
                border = boxcol[i], density=density[i], angle=angle[i], col=boxfill[i])
            if ((nout <- length(out))) {
                xysegments(rep(x - wid * outwex, nout), out, 
                  rep(x + wid * outwex, nout), out, lty = outlty[i], 
                  lwd = outlwd[i], col = outcol[i])
                xypoints(rep.int(x, nout), out, pch = outpch[i], 
                  lwd = outlwd[i], cex = outcex[i], col = outcol[i], 
                  bg = outbg[i])
            }
            if (any(inf <- !is.finite(out))) {
                warning(sprintf(ngettext(length(unique(out[inf])), 
                  "Outlier (%s) in boxplot %d is not drawn", 
                  "Outliers (%s) in boxplot %d are not drawn"), 
                  paste(unique(out[inf]), collapse = ", "), x), 
                  domain = NA)
            }
        }
        return(ok)
    }
    if (!is.list(z) || 0L == (n <- length(z$n))) 
        stop("invalid first argument")
    if (is.null(at)) 
        at <- 1L:n
    else if (length(at) != n) 
        stop("'at' must have same length as 'z$n', i.e. ", n)
    if (is.null(z$out)) 
        z$out <- numeric()
    if (is.null(z$group) || !outline) 
        z$group <- integer()
    if (is.null(pars$ylim)) 
        ylim <- range(z$stats[is.finite(z$stats)], if (outline) z$out[is.finite(z$out)], 
            if (notch) z$conf[is.finite(z$conf)])
    else {
        ylim <- pars$ylim
        pars$ylim <- NULL
    }
    if (is.null(pars$xlim)) 
        xlim <- c(0.5, n + 0.5)
    else {
        xlim <- pars$xlim
        pars$xlim <- NULL
    }
    if (length(border) == 0L) 
        border <- par("fg")
    dev.hold()
    on.exit(dev.flush())
    if (!add) {
        plot.new()
        if (horizontal) 
            plot.window(ylim = xlim, xlim = ylim, log = log, 
                xaxs = pars$yaxs)
        else plot.window(xlim = xlim, ylim = ylim, log = log, 
            yaxs = pars$yaxs)
    }
    xlog <- (par("ylog") && horizontal) || (par("xlog") && !horizontal)
    pcycle <- function(p, def1, def2 = NULL) rep(if (length(p)) p else if (length(def1)) def1 else def2, 
        length.out = n)
    p <- function(sym) pars[[sym, exact = TRUE]]
    boxlty <- pcycle(pars$boxlty, p("lty"), par("lty"))
    boxlwd <- pcycle(pars$boxlwd, p("lwd"), par("lwd"))
    boxcol <- pcycle(pars$boxcol, border)
    boxfill <- pcycle(pars$boxfill, par("bg"))
    density <- rep(density, length.out=n)
    density <- rep(density, length.out=n)
    angle <- rep(angle, length.out=n)
    boxwex <- pcycle(pars$boxwex, 0.8 * {
        if (n <= 1) 
            1
        else stats::quantile(diff(sort(if (xlog) 
            log(at)
        else at)), 0.1)
    })
    medlty <- pcycle(pars$medlty, p("lty"), par("lty"))
    medlwd <- pcycle(pars$medlwd, 3 * p("lwd"), 3 * par("lwd"))
    medpch <- pcycle(pars$medpch, NA_integer_)
    medcex <- pcycle(pars$medcex, p("cex"), par("cex"))
    medcol <- pcycle(pars$medcol, border)
    medbg <- pcycle(pars$medbg, p("bg"), par("bg"))
    whisklty <- pcycle(pars$whisklty, p("lty"), "dashed")
    whisklwd <- pcycle(pars$whisklwd, p("lwd"), par("lwd"))
    whiskcol <- pcycle(pars$whiskcol, border)
    staplelty <- pcycle(pars$staplelty, p("lty"), par("lty"))
    staplelwd <- pcycle(pars$staplelwd, p("lwd"), par("lwd"))
    staplecol <- pcycle(pars$staplecol, border)
    staplewex <- pcycle(pars$staplewex, 0.5)
    outlty <- pcycle(pars$outlty, "blank")
    outlwd <- pcycle(pars$outlwd, p("lwd"), par("lwd"))
    outpch <- pcycle(pars$outpch, p("pch"), par("pch"))
    outcex <- pcycle(pars$outcex, p("cex"), par("cex"))
    outcol <- pcycle(pars$outcol, border)
    outbg <- pcycle(pars$outbg, p("bg"), par("bg"))
    outwex <- pcycle(pars$outwex, 0.5)
    width <- if (!is.null(width)) {
        if (length(width) != n | any(is.na(width)) | any(width <= 
            0)) 
            stop("invalid boxplot widths")
        boxwex * width/max(width)
    }
    else if (varwidth) 
        boxwex * sqrt(z$n/max(z$n))
    else if (n == 1) 
        0.5 * boxwex
    else rep.int(boxwex, n)
    if (horizontal) {
        xypoints <- function(x, y, ...) points(y, x, ...)
        xypolygon <- function(x, y, ...) polygon(y, x, ...)
        xysegments <- function(x0, y0, x1, y1, ...) segments(y0, 
            x0, y1, x1, ...)
    }
    else {
        xypoints <- points
        xypolygon <- polygon
        xysegments <- segments
    }
    ok <- TRUE
    for (i in 1L:n) ok <- ok & bplt(at[i], wid = width[i], stats = z$stats[, 
        i], out = z$out[z$group == i], conf = z$conf[, i], notch = notch, 
        xlog = xlog, i = i, density=density, angle=angle, boxfill=boxfill)
    if (!ok) 
        warning("some notches went outside hinges ('box'): maybe set notch=FALSE")
    axes <- is.null(pars$axes)
    if (!axes) {
        axes <- pars$axes
        pars$axes <- NULL
    }
    if (axes) {
        ax.pars <- pars[names(pars) %in% c("xaxt", "yaxt", "xaxp", 
            "yaxp", "las", "cex.axis", "col.axis", "format")]
        if (is.null(show.names)) 
            show.names <- n > 1
        if (show.names) 
            do.call("axis", c(list(side = 1 + horizontal, at = at, 
                labels = z$names), ax.pars))
        do.call("Axis", c(list(x = z$stats, side = 2 - horizontal), 
            ax.pars))
    }
    do.call("title", pars[names(pars) %in% c("main", "cex.main", 
        "col.main", "sub", "cex.sub", "col.sub", "xlab", "ylab", 
        "cex.lab", "col.lab")])
    if (frame.plot) 
        box()
    invisible(at)
}
#================================

*******************************************************************
This email and any attachments are confidential. Any use...{{dropped:8}}

  
  


  


      

    

    

      
      

        


  

        

      David L Carlson
    

    

      
      #
    

  


  

      
legend() supports density= and angle= arguments. For example, 

plot(1, 1, type="n")
legend("topright", c("Slant Left", "Slant Right"), density=c(20, 20),
     angle=c(135, 45))

You may want to use larger density values than I used in my earlier post
since the legend boxes are pretty small.

-------
David

            

      
      
      
    

        

      
      
    

            

      
      
      
    

  
  


  


      

    

    
1 day later

    

      
      

        


  

        

      Greg Snow
    

    

      
      #
    

  


  

      
The fill patterns date back to when the main way to get quality graphs
was using a pen plotter.  Filling a rectangle with color using a pen
plotter took a long time and often resulted a soggy hole in the paper,
so the fill lines were preferred back then.  Now with high resolution
screens and printers it is easy to do the flood fill rather than the
patterns.

You need to be careful with the fill patterns, they can end up causing
moire effects (http://en.wikipedia.org/wiki/Moir%C3%A9_pattern) which
can cause false impressions of movement or distortions of size.

        
On Wed, Aug 8, 2012 at 5:56 PM, suse <meyfarth at uni-potsdam.de> wrote: