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

[Jim Lemon]

Hi Michael,
If you want to hardwire the title line, this may help. Very hacky, but...

print.scree.ca<-function(x,digits=5,...) {
 cat("Singular values and Principal inertias (eigenvalues)\n\n")
 cat(formatC(
  c("Singular","Principal","Percent","Cumulative","Scree plot"),
  width=10),"\n")
 cat(formatC(c("values","inertia"," ","percent"),width=10),"\n\n")
 for(row in 1:dim(x)[1])
  cat(unlist(format(x[row,],digits=digits,width=10,flag="-",format="f")),"\n")
}

Jim


On Sat, Feb 7, 2015 at 8:47 AM, Michael Friendly <friendly at yorku.ca> wrote:
> 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
>
> ______________________________________________
> R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.