Dear Mark and Mike,
I had a chance to speak with Mike this afternoon, and he explained to me, so
politely that I almost missed it, that I hadn't read his posting very
carefully. Sorry for that.
Anyway, here's an alternative solution, which I think will meet Mike's
needs:
abbrev <- function(text, width=10, split=" "){
if (is.list(text)) return(lapply(text, abbrev, width=width,
split=split))
if (length(text) > 1)
return(as.vector(sapply(text, abbrev, width=width, split=split)))
words <- strsplit(text, split=split)[[1]]
words <- ifelse(nchar(words) <= width, words,
abbreviate(words, minlength=width))
words <- paste(words, collapse=" ")
paste(strwrap(words, width=width), collapse="\n")
}
abbrev(lab) # Mike's example
$OccFather
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual" "Lower\nmanual"
[5] "Farm"
$OccSon
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual" "Lower\nmanual"
[5] "Farm"
abbrev(labels) # Mark's example
[1] "This is\na long\nlabel 1" "This is\na long\nlabel 2"
[3] "This is\na long\nlabel 3" "This is\na long\nlabel 4"
[5] "This is\na long\nlabel 5" "This is\na long\nlabel 6"
[7] "This is\na long\nlabel 7" "This is\na long\nlabel 8"
[9] "This is\na long\nlabel 9" "This is\na long\nlabel 10"
I hope that this is more helpful than my original response.
John
--------------------------------
John Fox
Department of Sociology
McMaster University
Hamilton, Ontario
Canada L8S 4M4
905-525-9140x23604
http://socserv.mcmaster.ca/jfox
--------------------------------
-----Original Message-----
From: r-help-bounces at stat.math.ethz.ch
[mailto:r-help-bounces at stat.math.ethz.ch] On Behalf Of Marc Schwartz
Sent: Friday, April 15, 2005 12:30 PM
To: Michael Friendly
Cc: R-Help
Subject: Re: [R] abbreviate or wrap dimname labels
On Fri, 2005-04-15 at 12:12 -0400, Michael Friendly wrote:
For a variety of displays (mosaicplots, barplots, ...) one
to either abbreviate or wrap long labels, particularly when
made up of several words.
In general, it would be nice to have a function,
abbreviate.or.wrap <-
function(x, maxlength=10, maxlines=2, split=" ") { }
that would take a character vector or a list of vectors, x,
abbreviate or wrap them to fit approximately the maxlength and
maxlines constraints, using the split argument to specify allowable
characters to wrap to multiple lines.
For example, this two-way table has dimnames too long to be
library(catspec)
library(vcd)
data(FHtab)
FHtab<-as.data.frame(FHtab)
xtable <- xtabs(Freq ~ .,FHtab)
lab <- dimnames(xtable)
lab
$OccFather
[1] "Upper nonmanual" "Lower nonmanual" "Upper manual"
[5] "Farm"
$OccSon
[1] "Upper nonmanual" "Lower nonmanual" "Upper manual"
[5] "Farm"
abbreviate works here, but gives results that aren't very readable:
lapply(lab, abbreviate, 8)
$OccFather
Upper nonmanual Lower nonmanual Upper manual Lower
"Upprnnmn" "Lwrnnmnl" "Uppermnl" "Lowermnl"
"Farm"
$OccSon
Upper nonmanual Lower nonmanual Upper manual Lower manual
Farm
"Upprnnmn" "Lwrnnmnl" "Uppermnl" "Lowermnl"
"Farm"
In a related thread, Marc Schwartz proposed a solution for wrapping
labels, based on
short.labels <- sapply(labels, function(x) paste(strwrap(x,
10), collapse = "\n"), USE.NAMES = FALSE)
But, my attempt to use strwrap in my context gives a single
each set of dimension names:
stack.lab <-function(x) { paste(strwrap(x,10), collapse
lapply(lab, stack.lab) $OccFather [1]
"Upper\nnonmanual\nLower\nnonmanual\nUpper\nmanual\nLower\nman
ual\nFarm"
"Upper\nnonmanual\nLower\nnonmanual\nUpper\nmanual\nLower\nman
ual\nFarm"
For my particular example, I can do what I want with gsub,
lab[[1]] <- gsub(" ","\n", lab[[1]])
lab[[2]] <- lab[[1]] # cheating: I know it's a square table
lab
$OccFather
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual"
"Lower\nmanual"
[5] "Farm"
$OccSon
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual"
"Lower\nmanual"
[5] "Farm"
Then,
mosaicplot(xtable, shade=TRUE)
gives a nice display!
Can anyone help with a more general solution for wrapping labels or
abbreviate.or.wrap()?
thanks,
-Michael
Michael,
This is not completely generic (I have not used abbreviate()
here) and it could take some further fine tuning and perhaps
even consideration of creating a generic method. However, a
possible solution to the problem of using my previous
approach on a list object and giving some flexibility to also
handle vectors:
# Core wrapping function
wrap.it <- function(x, len)
{
sapply(x, function(y) paste(strwrap(y, len),
collapse = "\n"),
USE.NAMES = FALSE)
}
# Call this function with a list or vector
wrap.labels <- function(x, len)
{
if (is.list(x))
{
lapply(x, wrap.it, len)
} else {
wrap.it(x, len)
}
}
Thus, for your labels in a list:
$OccFather
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual"
[4] "Lower\nmanual" "Farm"
$OccSon
[1] "Upper\nnonmanual" "Lower\nnonmanual" "Upper\nmanual"
[4] "Lower\nmanual" "Farm"
and for the example vector in my prior post:
labels <- factor(paste("This is a long label ", 1:10))
wrap.labels(labels, 10)
[1] "This is\na long\nlabel 1" "This is\na long\nlabel 2"
[3] "This is\na long\nlabel 3" "This is\na long\nlabel 4"
[5] "This is\na long\nlabel 5" "This is\na long\nlabel 6"
[7] "This is\na long\nlabel 7" "This is\na long\nlabel 8"
[9] "This is\na long\nlabel 9" "This is\na long\nlabel 10"
To incorporate abbreviate() here, you could perhaps modify the
wrap.labels() syntax to use a "wrap = TRUE/FALSE" argument to
explicitly
indicate which approach you want, or perhaps develop some
decision tree
approach to automate the process.
HTH,
Marc Schwartz