What a lovely example of recursion, function mapping, and vectorization! Thanks, John.
-Michael
John Fox wrote:
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: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] 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
often wants
to either abbreviate or wrap long labels, particularly when
these are
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,
and try to
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
displayed
nicely in a mosaicplot:
> 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"
"Lower manual"
[5] "Farm"
$OccSon
[1] "Upper nonmanual" "Lower nonmanual" "Upper manual"
"Lower 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
manual Farm
"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
string for
each set of dimension names:
> stack.lab <-function(x) { paste(strwrap(x,10), collapse
= "\n") }
lapply(lab, stack.lab) $OccFather [1]
"Upper\nnonmanual\nLower\nnonmanual\nUpper\nmanual\nLower\nman ual\nFarm"
$OccSon
[1]
"Upper\nnonmanual\nLower\nnonmanual\nUpper\nmanual\nLower\nman ual\nFarm"
For my particular example, I can do what I want with gsub,
but it is
hardly general:
> 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"
> dimnames(xtable) <- lab
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:
wrap.labels(lab, 10)
$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
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
-- Michael Friendly Email: [EMAIL PROTECTED] Professor, Psychology Dept. York University Voice: 416 736-5115 x66249 Fax: 416 736-5814 4700 Keele Street http://www.math.yorku.ca/SCS/friendly.html Toronto, ONT M3J 1P3 CANADA
______________________________________________ [email protected] mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html
