[R] poor man's scree plot for SVD: multiline labels and total lines

[Michael Friendly]

In the ca package, the summary method gives the following output, as a 
"poor man's scree plot",
showing eigenvalues, their percents, and a character-based scree plot:

# install.packages("ca")
haireye <- margin.table(HairEyeColor, 1:2)
library(ca)
haireye.ca <- ca(haireye)

summary(haireye.ca, rows=FALSE, columns=FALSE)

Principal inertias (eigenvalues):

  dim    value      %   cum%   scree plot
  1      0.208773  89.4  89.4  **********************
  2      0.022227   9.5  98.9  **
  3      0.002598   1.1 100.0
         -------- -----
  Total: 0.233598 100.0

I'd like to enhance this, to something like the following, using 
multiline column labels and also showing the totals,
but the code in ca::print.summary.ca is too obtuse to try to reuse or 
modify.

Singular values and Principal inertias (eigenvalues)

   Singular  Principal  Percents   Cum  Scree plot
   values    inertias

1 0.456916  0.208773     89.4    89.4 ******************************
2 0.149086  0.022227      9.5    98.9 ***
3 0.050975  0.002598      1.1   100.0
             --------     ----
             0.233598    100.0

I made a start, defining a scree.ca function, and an associated print 
method, but I can't figure out how to
print multiline labels and the totals for relevant columns.  Can someone 
help?

Here are my functions:

scree.ca <- function (obj, scree.width=30) {
     values <- obj$sv
     inertia <- values^2
     pct <- 100*inertia/sum(inertia)
     scree <- character(length(pct))
     stars <- round(scree.width * pct / max(pct), 0)
     for (q in 1:length(pct)) {
       s1 <- paste(rep("*", stars[q]), collapse = "")
       s2 <- paste(rep(" ", scree.width - stars[q]), collapse = "")
       scree[q] <- paste(" ", s1, s2, sep = "")
       }
     dat <- data.frame(values, inertia, pct=round(pct,1), 
Cum=round(cumsum(pct),1), scree, stringsAsFactors=FALSE)
     heading <- "Singular values and Principal inertias (eigenvalues)"
     attr(dat,"heading") <- heading
     attr(dat$values, "label") <- "Singular\nvalues"
     attr(dat$inertia, "label") <- "Principal\ninertias"
     attr(dat$pct, "label") <- "Percents"
     class(dat) <- c("scree.ca", "data.frame")
     dat
}

print.scree.ca <- function(x, digits=5, ...) {
   if (!is.null(heading <- attr(x, "heading")))
     {cat(heading, sep = "\n"); cat("\n")}
     print.data.frame(x, digits=digits, ...)
}

And, a test use:

 > sc <- scree.ca(haireye.ca)
 > str(sc)
Classes ‘scree.ca’ and 'data.frame':    3 obs. of  5 variables:
  $ values : atomic  0.457 0.149 0.051
   ..- attr(*, "label")= chr "Singular\nvalues"
  $ inertia: atomic  0.2088 0.0222 0.0026
   ..- attr(*, "label")= chr "Principal\ninertias"
  $ pct    : atomic  89.4 9.5 1.1
   ..- attr(*, "label")= chr "Percents"
  $ Cum    : num  89.4 98.9 100
  $ scree  : chr  " ******************************" " 
***                           " "                               "
  - attr(*, "heading")= chr "Singular values and Principal inertias 
(eigenvalues)"
 > sc
Singular values and Principal inertias (eigenvalues)

     values   inertia  pct   Cum                           scree
1 0.456916 0.2087727 89.4  89.4  ******************************
2 0.149086 0.0222266  9.5  98.9  ***
3 0.050975 0.0025984  1.1 100.0
 >


-- 
Michael Friendly     Email: friendly AT yorku DOT ca
Professor, Psychology Dept. & Chair, Quantitative Methods
York University      Voice: 416 736-2100 x66249 Fax: 416 736-5814
4700 Keele Street    Web:http://www.datavis.ca
Toronto, ONT  M3J 1P3 CANADA