[R] abbreviate or wrap dimname labels

[Marc Schwartz]

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\nmanual\nFarm"
> 
> $OccSon
> [1] "Upper\nnonmanual\nLower\nnonmanual\nUpper\nmanual\nLower\nmanual\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