Suggestion to improve the plot.histogram() function in R v1.6.2

Henrik Bengtsson, January 30, 2003

From R v2.0.0 the below code is not working. However, there is a fully functioning version in the R.basic package part of the R.classes bundle. See http://www.maths.lth.se/help/R/R.classes/ for installation instructions. /HB 2005-01-05

Introduction

The following improvement to base::plot.histogram() makes it possible to plot several histograms next to each other in the same plot by making them sharing space. You can set the width and the offset the bars should have.

Example

x1 <- rnorm(1000,  0.4, 0.8)
x2 <- rnorm(1000,  0.0, 1.0)
x3 <- rnorm(1000, -1.0, 1.0)
hist(x1, width=0.33, offset=0.00, col="blue", xlim=c(-4,4),
 main="Histogram of x1, x2 & x3", xlab="x1 - blue, x2 - red, x3 - green")
hist(x2, width=0.33, offset=0.33, col="red", add=TRUE)
hist(x3, width=0.33, offset=0.66, col="green", add=TRUE)

Download

For the code to be effective in R v1.6.x this function has to replace plot.histogram() in the base environment, i.e.
source("plot.histogram.R")
assign("plot.histogram", plot.histogram, pos=which(search()=="package:base"))

Code

#########################################################################/**
# \name{plot.histogram}
# \alias{plot.histogram}
#
# \title{Plots a histogram}
#
# \usage{
#   plot.histogram(x, freq=equidist, col=NULL, border=par("fg"), lty=NULL,
#      width=1.0, offset=(1.0-width)/2, main=paste("Histogram of", x$xname), 
#      xlim=range(x$breaks), ylim=NULL, xlab=x$xname, ylab, axes=TRUE, 
#      labels=FALSE, add=FALSE, ...)
# }
#
# \description{
#   This function redefines the \code{plot.histogram} function
#   in the \R base package by adding the two arguments \code{width} and
#   \code{offset}. The function is modified in such a way that it is 
#   backward compatible, i.e. if you do not use the arguments \code{width}
#   and \code{offset} the plot will look the same as the plot generated by
#   the original function. Note that \code{plot.histogram} is called by 
#   \code{hist}. 
# }
#
# \arguments{
#   \item{x}{a `histogram' object, or a list with components 
#       \code{intensities}, \code{mid}, etc, see \code{\link[base]{hist}}.}
#   \item{freq}{logical; if \code{TRUE}, the histogram graphic is to present
#       a representation of frequencies, i.e, \code{x$counts}; if
#       \code{FALSE}, relative frequencies ("probabilities"), i.e.,
#       \code{x$intensities}, are plotted. The default is true for
#       equidistant \code{breaks} and false otherwise.}
#   \item{col}{a colour to be used to fill the bars.  The default of 
#       \code{NULL} yields unfilled bars.}
#   \item{border}{the color of the border around the bars.}
#   \item{width}{The relative width of each bar compared to the full width.
#       \code{1.0} is full width. Default value is \code{1.0}.}
#   \item{offset}{The relative horisontal offset of each bar compared to the
#       full width. A value of \code{0.0} places each bar to the very left.
#       A value of \code{1.0-width} places each bar to the very right.
#       Default value is \code{(1.0-offset)/2}, i.e. the bars are centered.}
#   \item{lty}{the line type used for the bars, see also \code{lines}.}
#   \item{xlim, ylim}{the range of x and y values with sensible defaults.}
#   \item{main, xlab, ylab}{these arguments to \code{title} have useful
#       defaults here.}
#   \item{axes}{logical, indicating if axes should be drawn.}
#   \item{labels}{logical or character.  Additionally draw labels on top of
#       bars, if not \code{FALSE}; if \code{TRUE}, draw the counts or 
#       rounded intensities; if \code{labels} is a \code{character}, draw
#       itself.}
#   \item{add}{logical. If \code{TRUE}, only the bars are added to the
#       current plot. This is what \code{lines.histogram(*)} does.}
#   \item{...}{further graphical parameters to \code{title} and \code{axis}.}
# }
#
# \author{
#   Modified by Henrik Bengtsson, 
#   \url{http://www.braju.com/R/}, from the original \R plot.histogram.
# }
#
# \examples{
#   x1 <- rnorm(1000,  0.4, 0.8)
#   x2 <- rnorm(1000,  0.0, 1.0)
#   x3 <- rnorm(1000, -1.0, 1.0)
#   hist(x1, width=0.33, offset=0.00, col="blue", xlim=c(-4,4),
#    main="Histogram of x1, x2 & x3", xlab="x1 - blue, x2 - red, x3 - green")
#   hist(x2, width=0.33, offset=0.33, col="red", add=TRUE)
#   hist(x3, width=0.33, offset=0.66, col="green", add=TRUE)
# }
#
# \seealso{
#   See also the original \code{\link[base]{hist}/plot.histogram} function
#   in the \R base package. 
# }
#
# @visibility public
#*/#########################################################################
if (!exists("plot.histogram.default"))
  plot.histogram.default <- plot.histogram;

plot.histogram <-
function (x, freq = equidist, density = NULL, angle = 45, col = NULL, 
    border = par("fg"), lty = NULL, main = paste("Histogram of", 
        x$xname), xlim = range(x$breaks), ylim = NULL, xlab = x$xname, 
    ylab, axes = TRUE, labels = FALSE, add = FALSE, width=1.0, offset=(1.0-width)/2, ...) 
{
    equidist <- if (is.logical(x$equidist)) 
        x$equidist
    else {
        h <- diff(x$breaks)
        diff(range(h)) < 1e-07 * mean(h)
    }
    if (freq && !equidist) 
        warning("the AREAS in the plot are wrong -- rather use `freq=FALSE'!")
    y <- if (freq) 
        x$counts
    else x$intensities
    nB <- length(x$breaks)
    if (is.null(y) || 0 == nB) 
        stop("`x' is wrongly structured")
    if (!add) {
        if (is.null(ylim)) 
            ylim <- range(y, 0)
        if (missing(ylab)) 
            ylab <- if (!freq) 
                "Density"
            else "Frequency"
        plot.new()
        plot.window(xlim, ylim, "")
        title(main = main, xlab = xlab, ylab = ylab, ...)
        if (axes) {
            axis(1, ...)
            axis(2, ...)
        }
    }

    if (width != 1.0 || offset != 0) {
      # Calculates the width of each bar in the histogram
      delta.breaks <- x$breaks[-1] - x$breaks[-nB];
      x.offset <- offset * delta.breaks;
      x.width <- width * delta.breaks;
      x <- x$breaks[-nB]+x.offset;
      rect(x, 0, x+x.width, y, col=col, border=border, angle = angle, density = density, lty=lty);
    } else {
      rect(x$breaks[-nB], 0, x$breaks[-1], y, col = col, border = border, 
          angle = angle, density = density, lty = lty)
    }
    
    if ((logl <- is.logical(labels) && labels) || is.character(labels)) 
        text(x$mids, y, labels = if (logl) {
            if (freq) 
                x$counts
            else round(x$density, 3)
        }
        else labels, adj = c(0.5, -0.5))
    invisible()
} # plot.histogram


############################################################################
# HISTORY:
# 2002-10-25
# o Updated the example to include one more color.
# 2002-01-18
# * Updated to be the same as the [R] v1.4.0 version.
# 2001-07-27
# * Moved into R.base.
# 2001-06-18
# * Created.
############################################################################

Difference from code in R v1.6.2

Running Unix diff these are the differences from the default base code (in other words, as few as possible):
4,5c4
<     ylab, axes = TRUE, labels = FALSE, add = FALSE, width = 1,
<     offset = (1 - width)/2, ...)
---
>     ylab, axes = TRUE, labels = FALSE, add = FALSE, ...)
36,47c35,36
<     if (width != 1 || offset != 0) {
<         delta.breaks <- x$breaks[-1] - x$breaks[-nB]
<         x.offset <- offset * delta.breaks
<         x.width <- width * delta.breaks
<         x <- x$breaks[-nB] + x.offset
<         rect(x, 0, x + x.width, y, col = col, border = border,
<             angle = angle, density = density, lty = lty)
<     }
<     else {
<         rect(x$breaks[-nB], 0, x$breaks[-1], y, col = col, border = border,
<             angle = angle, density = density, lty = lty)
<     }
---
>     rect(x$breaks[-nB], 0, x$breaks[-1], y, col = col, border = border,
>         angle = angle, density = density, lty = lty)