Dynamically using expression in legend labels

[Crump, Ron]

Hi,

I'm trying to set up legend labels dynamically from a list of values.

Here's a small example:

DF <- structure(list(x = 1:5, y = 3:7), .Names = c("x", "y"), row.names =
c(NA,
-5L), class = "data.frame")

emy <- c(1995L, 2000L, 2005L, 2010L)
so I want to plot a bar chart of DF (I don't really, it is just a silly
example) with the legend labels defined by emy. I can do this manually:

lbls <- expression(
italic(d)<=1995,{1995<italic(d)}<=2000,{2000<italic(d)}<=2005,{2005<italic(
d)}<=2010,italic(d)>2010)

ggplot(DF)+geom_bar(aes(x=x,y=y,fill=as.factor(x)),stat="identity")+scale_f
ill_manual(values=c("red","green","blue","cyan","magenta"),name=expression(
"Year ("*italic(d)*")"),labels=lbls)

but I can't figure out how to create it automatically from emy. I tried
various things, but ended up here before I cracked and thought I'd just
ask:

lbls<-c(expression(italic(d)<=emy[1]),sapply(2:length(emy),function(i){expr
ession(paste0("{",emy[i-1],"<")*italic(d)*paste0("}<=",emy[i]))}),expressio
n(italic(d)>emy[length(emy)]))

Any suggestions?

Thanks,
Ron.

[Brian]

Hi Ron,
here you go:

emy <- c(1995L, 2000L, 2005L, 2010L)

times <- c(1994L, 2003L, 2008L, 2011L)

cut3 <- function (x, breaks, labels = NULL, include.lowest = FALSE,
right = TRUE, var = "italic(d)",
dig.lab = 3L, ordered_result = FALSE, ...)
{
if (!is.numeric(x))
stop("'x' must be numeric")
if (length(breaks) == 1L) {
if (is.na(breaks) || breaks < 2L)
stop("invalid number of intervals")
nb <- as.integer(breaks + 1)
dx <- diff(rx <- range(x, na.rm = TRUE))
if (dx == 0) {
dx <- abs(rx[1L])
breaks <- seq.int(rx[1L] - dx/1000, rx[2L] + dx/1000,
length.out = nb)
} else {
breaks <- seq.int(rx[1L], rx[2L], length.out = nb)
breaks[c(1L, nb)] <- c(rx[1L] - dx/1000, rx[2L] +
dx/1000)
}
} else nb <- length(breaks <- sort.int(as.double(breaks)))
if (anyDuplicated(breaks))
stop("'breaks' are not unique")
codes.only <- FALSE
if (is.null(labels)) {
for (dig in dig.lab:max(12L, dig.lab)) {
ch.br <- formatC(0 + breaks, digits = dig, width = 1L)
if (ok <- all(ch.br[-1L] != ch.br[-nb]))
break
}
labels <- if (ok)
paste0("{", ch.br[-nb], ifelse (right, "<", "<="), var,
"}",
ifelse(right, "<=", "<"), ch.br[-1L])
else paste("Range", seq_len(nb - 1L), sep = "_")
if (ok && include.lowest) {
if (right)
substr(labels[1L], 1L, 1L) <- "["
else substring(labels[nb - 1L], nchar(labels[nb -
1L], "c")) <- "]"
}
} else if (is.logical(labels) && !labels)
codes.only <- TRUE
else if (length(labels) != nb - 1L)
stop("lengths of 'breaks' and 'labels' differ")
code <- .bincode(x, breaks, right, include.lowest)
res <- if (codes.only)
code else factor(code, seq_along(labels), labels, ordered =
ordered_result)
res <- as.character(res)
int <- findInterval(x, breaks, right)
if (length(ind <- which(int == 0L)) != 0L)
res[ind] <- paste0(breaks[1], "<", var)
if (length(ind <- which(int == length(breaks))) != 0L)
res[ind] <- paste0(var, ">", breaks[length(breaks)])
factor(res)

}

lbls <- expression(
italic(d)<=1995,{1995<italic(d)}<=2000,{2000<italic(d)}<=2005,
{2005<italic(d)}<=2010,italic(d)>2010)

lbls
parse(text=as.character(cut3(times, emy)))

I took cut.default and modified it. It's not pretty, but works fine.

Cheers
Brian

[Crump, Ron]

Hi Brian,

>I took cut.default and modified it. It's not pretty, but works fine.

You're a star. That's great.

Thanks for doing that. I'm not sure that I'd ever have come up with that.

Ron.

[Brian]

Hi Ron,

glad I could help ^^.

I have a few more ideas/strategies to do that, but I guess this list
isn't the right place to write a function interval_to_set_notation.

Best
Brian