> How can I create a legend that is fully outside of the plot, similar to
> what excel does by default, for example?
The common solution with traditional plots (pre-modifying the margin) works
well for a one-shot plot, where you calculate the legend size by
trial-and-error.
The problem arises when you need to automate this process for different legend
texts/sizes. The best solution in this case is to use lattice or ggplot, as
others have pointed. If still you want to stick to traditional plots, I have
developed the functions below that may help. The idea is to estimate the legend
size in an absolute measure unit like inches prior to plotting.
This code is preliminary and not very well tested, so you may need to modify
it. The legend size estimation algorithm is very simple, it can be improved by
matching what the legend() function really works, but it works well with most
of my plots. A basic drawback is that the legend is not redrawn correctly when
the plot window is resized....
Run this example client code to see how it works:
x <- 0:64/64;
legendText <- paste("sin(", 1:5, "pi * x)");
oldPar <- par(ask=FALSE, mai=c(1.02, 0.82, 0.82, 0.42));
for (location in c("outright", "outbottom", "outleft", "outtop")) {
if (!identical(location, "outright"))
par(ask=TRUE, mai=c(1.02, 0.82, 0.82, 0.42));
estimate.legend.size(location, legendText, col=1:5, lty=1:5,
pch="*", cex=0.8);
matplot(x, outer(x, 1:5, function(x, k) sin(k * pi * x)),
type="o", col=1:5, ylim= c(-1, 1.5), pch="*",
main="TITLE");
legend(0, 1.5, legendText, col=1:5, lty=1:5, pch="*", ncol=3,
cex=0.8);
place.legend(location, legendText, col=1:5, lty=1:5, pch="*",
cex=0.8);
}
par(oldPar);
Suggestions for improvement welcomed!
Best,
Enrique
#
----------------------------------------------------------------------------------------
#' Converts distances between margin units. Possible units are inches, columns
of text, or user coordinates.
#'
#' @param width numeric with the distance width in the \code{input} units.
#' @param height numeric with the distance height in the \code{input} units.
#' @param input string with the input units. The valid values are
\code{"inches"}, \code{"mlines"} (margin lines),
#' and \code{"user"} (user plot coordinates).
#'
#' @returns A list with elements \code{"inches"}, \code{"mlines"}, and
\code{"user"}, each of which is a list with
#' elements \code{width} and \code{height}.
#'
#' @seealso \link{\codegrconvertX}}, \link{\codegrconvertY}}.
cnvrt.plot.distance <- function(width=NA, height=NA, input=c("inches",
"mlines", "user")) {
n <- max(length(width), length(height));
width <- rep(as.numeric(width), length.out=n);
height <- rep(as.numeric(height), length.out=n);
input <- match.arg(input);
cusr <- par('usr'); # Extremes c(x1, x2, y1, y2) of the user
coordinates of the plotting region.
cpin <- par('pin'); # The current plot dimensions (width, height),
in inches.
ccin <- par('cin'); # Character size (width, height) in inches.
cmex <- par('mex'); # A character size expansion factor which is
used to describe coordinates in the
# margins of plots. Note that this does
not change the font size, rather specifies
# the size of font (as a multiple of
csi) used to convert between mar and mai, and between oma and omi.
if (input == "inches") {
inches <- list(width = width , height = height);
user <- list(width = width / cpin[1] * (cusr[2] - cusr[1]),
height = height / cpin[2] * (cusr[4] - cusr[3]));
mlines <- list(width = width / ccin[2] / cmex,
height = height / ccin[2] / cmex );
} else if (input == "mlines") {
mlines <- list(width = width , height = height);
inches <- list(width = width * ccin[2] * cmex,
height = height * ccin[2] * cmex );
user <- list(width = inches$width / cpin[1] * (cusr[2] -
cusr[1]),
height = inches$height / cpin[2] * (cusr[4] - cusr[3]));
} else if (input == "user") {
user <- list(width = width , height = height);
inches <- list(width = width * cpin[1] / (cusr[2] - cusr[1]),
height = height * cpin[2] / (cusr[4] - cusr[3]));
mlines <- list(width = inches$width / ccin[2] / cmex,
height = inches$height / ccin[2] / cmex );
}
list(inches=inches, mlines=mlines, user=user);
}
#
----------------------------------------------------------------------------------------
#' Modifies plot margins.
#'
#' @param side a number in 1:4 or a string specifying the margin side to
modify. The allowed values for strings
#' are \code{"bottom"} (the default), \code{"left"}, \code{"top"},
and \code{"right"}.
#' @param by the amount to add/substract to the current margin. It can be one
of the following three types:
#' 1) a number; 2) a list at least two numeric items named
\code{width} and \code{height} (only one of them will be
#' used, depending on the margin side being set); or 3) a
character vector, whose width as computed by
#' \link{\code{strwidth}} will be \code{by}.
#' @param input string defining the unit of measure of the input (when
\code{by} is numeric of a list with numeric elements).
#' The allowed values are \code{"inches"} (the default),
\code{"mlines"}, and \code{"user"}.
#' @param which string defining which plot margin should be set. The valid
values are \code{"mai"} (the default), \code{"omi"},
#' and \code{"mar"}.
#' @param current numeric vector of length 4 that defines the current value of
the margins that should be modified.
#' Defaults to the corresponding graphical parameter
\code{par(which)}.
#' @param set.par logical. Whether the corresponding graphical parameter should
be automatically modified using \code{par}.
#' @param ... additional arguments to be passed to function \code{strwidth}
when \code{by} is a character vector.
#'
#' @returns A numeric vector of length 4 with the new margin values. Note that
when \code{set.par} is \code{TRUE}, also
#' modifies \code{par(which)} as a side effect.
modify.margin <- function(side=c("bottom", "left", "top", "right"), by,
input=c("inches", "mlines", "user"),
which=c("mai", "omi", "mar"), current=par(which),
set.par=FALSE, ...) {
defaultSides <- c("bottom", "left", "top", "right");
if (is.numeric(side)) {
nSide <- side;
side <- defaultSides[nSide];
} else {
side <- match.arg(side, defaultSides);
nSide <- match(side, defaultSides);
}
input <- match.arg(input);
which <- match.arg(which);
# Compute size if 'by' is a character vector
targetUnit <- c("inches", "inches", "mlines")[match(which, c("mai",
"omi", "mar"))];
isVertical <- (side %in% c("bottom", "top"));
if (is.character(by)) {
by <- max(strwidth(by, units="inches", ...), na.rm=TRUE);
input <- "inches";
} else if (is.list(by) && all(c("width", "height") %in% names(by))) {
by <- if (isVertical) by$height else by$width;
} else if (!is.numeric(by) && length(by) == 1)
stop(gettextf("'%s' must be either a number, a list with
'width' and 'height' components, or a character vector", "by"));
# Convert input distance to target unit depending on which margin we're
setting.
if (input != targetUnit) {
by <- if (isVertical) {
cnvrt.plot.distance(width=by,
input=input)[[targetUnit]]$width;
} else cnvrt.plot.distance(height=by,
input=input)[[targetUnit]]$height;
}
# Modify the margin value
result <- current;
result[nSide] <- result[nSide] + by;
# Set the plot parameter
if (set.par) {
parValue <- list(result);
names(parValue) <- which;
do.call("par", parValue);
}
result;
}
#
----------------------------------------------------------------------------------------
#' A wrapper for \link{\code{legend}} that provides new location options for
positioning the legend outside the plot area.
#'
#' @param location where the legend will be located. This can be a numeric
vector of length 2 defining the \code{x} and
#' \code{y} user coordinates, or a string with allowed values
\code{"outtop"}, \code{"outbottom"}, \code{"outleft"},
#' \code{"outright"}, \code{"bottomright"}, \code{"bottom"},
\code{"bottomleft"}, \code{"left"}, \code{"topleft"},
#' \code{"top"}, \code{"topright"}, \code{"right"}, and
\code{"center"}.
#' @param ... further parameters passed to the \link{\code{legend}} function.
#'
#' @returns The same list as \code{legend} (invisibly).
#'
#' @details For positioning outside the plot area, client code should ensure
that enough space is available on the corresponding
#' margin, which can be done using \code{estimate.legend.size(...,
adjust.margin="mai")} before the actual plotting is done.
#'
#' Note that some aesthetic defaults have been changed to adapt to corporate
guidelines, e.g. not drawing the box around the legend,
#' or outtop/outbottom legend positioning close to the edge.
#'
#' @seealso \link{\code{legend}}, \link{\code{estimate.legend.size}}.
#' @notes ToDo: Add also positioning options for smart inside, and interactive.
#' For smart inside positioning see \code{plotrix::emptyspace(x.index, x,
bar=TRUE)}.
place.legend <- function(location, ...) {
dots <- list(...);
if (is.null(dots$bty)) dots$bty <- "n";
if (is.numeric(location))
if (length(location) == 2)
return(do.call("legend", c(list(x=location[1],
y=location[2]), dots)))
else stop(gettextf("Format of '%s' not recognized",
"location"));
location <- match.arg(location, c("outtop", "outbottom", "outleft",
"outright",
"bottomright", "bottom", "bottomleft", "left", "topleft",
"top", "topright", "right", "center"));
if (substr(location, 1, 3) == "out") {
if (is.null(dots$horiz)) dots$horiz <- (location %in%
c("outtop", "outbottom"));
dots$xjust <- switch(location, outleft=0, outright=1, outtop=,
outbottom=0.5);
dots$yjust <- switch(location, outleft=, outright=0.5,
outtop=1, outbottom=0);
dots$x <- switch(location,
outtop = , outbottom = grconvertX(0.5, from="ndc",
to="user"),
outleft = grconvertX(0, from="ndc", to="user"),
outright = grconvertX(1, from="ndc", to="user") )
dots$y <- switch(location,
outleft = , outright = grconvertY(0.5, from="ndc",
to="user"),
outtop = grconvertY(1, from="ndc", to="user"),
outbottom = grconvertY(0, from="ndc", to="user") )
oxpd <- par(xpd=NA);
on.exit(par(oxpd));
do.call("legend", dots);
} else do.call("legend", c(list(x=location, y=NULL), dots));
}
#
----------------------------------------------------------------------------------------
#' Legend Size
#'
#' Estimates the plot space required for the specified legend, in inches.
#'
#' @param location a string defining where the legend will be located
#' @param legend a character or expression vector of length >= 1 to appear in
the legend. See \link{legend}.
#' @param cex character expansion factor \bold{relative} to current
\code{par("cex")}. See \link{legend}.
#' @param x.intersp character interspacing factor for horizontal (x) spacing.
See \link{legend}.
#' @param y.intersp character interspacing factor for vertical (y) spacing. See
\link{legend}.
#' @param ncol the number of columns in which to set the legend items (default
is 1, a vertical legend). See \link{legend}.
#' @param horiz logical; if \code{TRUE}, set the legend horizontally rather
than vertically. Specifying \code{horiz} overrides
#' the \code{ncol} specification. If \code{location} is defined,
\code{horiz} defaults to \code{TRUE} for legends on the
#' left or right margins, and to \code{FALSE} for legends on the
top or bottom margins.
#' @param title a character string or length-one expression giving a title to
be placed at the top of the legend. See \link{legend}.
#' @param direct logical; If \code{TRUE}, the estimation is done directly using
the \code{legend} function with \code{plot=FALSE}
#' argument, otherwise using an approximation. \code{TRUE}
produces an exact measure but can only be computed
#' if the graphics device is open and user coordinates have been
set. Otherwise, use indirect estimation.
#' @param adjust.margin a string defining which margin should be automatically
resized, if any. Use \code{NULL} for no
#' adjustment. The allowed values are \code{"mar"}, \code{"mai"},
and \code{"omi"}.
#'
#' @return A list with components \code{width} and \code{height} giving the
legend estimated size in inches.
#'
#' @details This is to be used by traditional plots functions with legends
outside the plot area to leave enough space in the
#' corresponding margin before plotting the data.
#'
#' ToDo: Not all possible legend cases have been handled in indirect
estimation, just some basic ones. This needs
#' further development and testing.
#'
#' @seealso \link{\code{place.legend}}, \link{\code{legend}}.
estimate.legend.size <- function(location=c("outright", "outleft", "outtop",
"outbottom"), legend=NULL, cex=1, x.intersp=1, y.intersp=1,
ncol=1, horiz=(location %in% c("outtop", "outbottom")),
title=NULL, direct=FALSE, adjust.margin=c("mai", "omi", "mar"), ...) {
location <- match.arg(location);
result <- list(width=0, height=0);
if (is.null(legend)) return(result) else legend <- as.character(legend);
if (direct) {
# Note: Can this really be done? If then we use this measures
to modify 'mai', won't the new user coordinates change
# their mapping to inches?
legendSize <- legend(x=par("usr")[1], y=par("usr")[4],
legend=legend, cex=cex, x.intersp=x.intersp, y.intersp=y.intersp,
ncol=ncol, horiz=horiz, title=title, plot=FALSE, ...);
result <- cnvrt.plot.distance(legendSize$rect$w,
legendSize$rect$h, input="user")$inches;
} else {
labelWidth <- max(strwidth(legend, units="inches", cex=cex),
na.rm=TRUE);
labelHeight <- max(strheight(legend, units="inches", cex=cex),
na.rm=TRUE);
interspWidth <- strwidth(paste(rep(" ", times=x.intersp),
collapse=""), units="inches", cex=cex);
interspHeight <- strheight(paste(rep(" ", times=y.intersp),
collapse=""), units="inches", cex=cex);
symbolWidth <- strwidth(" ", units="inches", cex=cex);
titleHeight <- if (is.null(title)) 0 else strheight(title,
units="inches", cex=cex);
if (horiz) {
if (ncol == 1) {
ncol <- length(legend);
nrow <- 1;
} else nrow <- ceiling(length(legend) / ncol);
} else {
if (ncol == 1) {
nrow <- length(legend);
} else nrow <- ceiling(length(legend) / ncol);
}
result$width <- ncol * (labelWidth + symbolWidth) + (ncol - 1)
* interspWidth;
result$height <- nrow * labelHeight + (nrow - 1) *
interspHeight + titleHeight;
}
if (!is.null(adjust.margin))
modify.margin(match(location, c("outbottom", "outleft",
"outtop", "outright")), by=result, input="inches",
which=adjust.margin, set.par=TRUE);
result;
}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
