Michael Friendly
2015-Feb-06 21:47 UTC
[R] poor man's scree plot for SVD: multiline labels and total lines
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
Jim Lemon
2015-Feb-07 06:00 UTC
[R] poor man's scree plot for SVD: multiline labels and total lines
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.