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@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.
