abbreviate or wrap dimname labels

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 

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