对于多个对应分析包,单个nested.
函数会生成多个图。第一个图是plot
,其余的是active
。有没有办法在inactive
html输出中一个接一个地打印所有绘图。我正在尝试以下,这是行不通的。
knitr
答案 0 :(得分:0)
函数plot.CAvariant有几次调用dev.new(),knitr处理得不好。您可以做的是手动编辑该功能以删除这些调用,如下所示:
---
title: "Test"
ouptut: html_document
---
```{r fig.keep='all'}
library(CAvariants)
data(asbestos)
head(asbestos)
str(asbestos)
plot.CAvariants <-
function (x, firstaxis = 1, lastaxis = 2, cex = 0.8, cex.lab = 0.8,
prop = 1, plottype = "biplot", biptype = "row", scaleplot = 1,
posleg = "topleft", pos = 2, ell = FALSE, Mell = x$Mell,
alpha = 0.05, ...)
{
if ((firstaxis < 1) | (firstaxis > x$r))
stop(paste("incorrect first axis =", firstaxis, "\n\n"))
if (lastaxis > x$r)
stop(paste("incorrect last axis =", lastaxis, "\n\n"))
if (firstaxis >= lastaxis)
stop(paste("last axis must be greater than first axis\n\n"))
n <- sum(x$Xtable)
I <- nrow(x$Xtable)
rowgroup <- list(1:x$rows, rep(1, x$rows))
rowgrlab <- list(1, "", "*", "red", "T")
colgroup <- list(1:x$cols, rep(1, x$cols))
colgrlab <- list(1, "", "+", "blue", "T")
if ((plottype == "Classical") | (plottype == "classical") |
(plottype == "classic") | (plottype == "c")) {
nthings <- x$cols
nvars <- x$rows
cord1 <- x$Cprinccoord
cord2 <- x$Rprinccoord
dmu = diag(x$inertias[, 1])
inertiapc = x$inertias[, 2]
dimnames(cord1)[1] <- dimnames(x$Xtable)[2]
dimnames(cord2)[1] <- dimnames(x$Xtable)[1]
thinggroup <- colgroup
thinggrlab <- colgrlab
vargroup <- rowgroup
vargrlab <- rowgrlab
thinglabels <- x$collabels
varlabels <- x$rowlabels
main = "Classical plot"
if ((x$catype == "DONSCA") | (x$catype == "DOCA") | (x$catype ==
"SOCA") | (x$catype == "SONSCA")) {
cat("\n ERROR: NO CLASSICAL PLOT for ordered analysis. ONLY A BIPLOT can be constructed (Please change 'plottype' and specify 'biptype')\n")
stop()
}
}
if ((plottype == "Biplot") | (plottype == "biplot") | (plottype ==
"bip") | (plottype == "b")) {
if ((biptype == "rows") | (biptype == "Rows") | (biptype ==
"row") | (biptype == "r")) {
plottype <- "biplot"
cord1 <- x$Rprinccoord * scaleplot
cord2 <- x$Cstdcoord/scaleplot
nthings <- x$rows
nvars <- x$cols
thinglabels <- x$rowlabels
varlabels <- x$collabels
thinggroup <- rowgroup
thinggrlab <- rowgrlab
vargroup <- colgroup
vargrlab <- colgrlab
main <- "Row Isometric Biplot"
inertiapc = x$inertias[, 2]
dmu = diag(x$inertias[, 1])
dimnames(cord2)[1] <- dimnames(x$Xtable)[2]
dimnames(cord1)[1] <- dimnames(x$Xtable)[1]
if ((x$catype == "DONSCA") | (x$catype == "DOCA") |
(x$catype == "SOCA") | (x$catype == "SONSCA")) {
cord2 <- x$Rprinccoord * scaleplot
cord1 <- x$Cstdcoord/scaleplot
nthings <- x$cols
nvars <- x$rows
thinglabels <- x$collabels
varlabels <- x$rowlabels
thinggroup <- colgroup
thinggrlab <- colgrlab
vargroup <- rowgroup
vargrlab <- rowgrlab
inertiapc = x$inertias2[, 2]
dmu = diag(x$inertias2[, 1])
dimnames(cord2)[1] <- dimnames(x$Xtable)[1]
dimnames(cord1)[1] <- dimnames(x$Xtable)[2]
}
}
else {
plottype <- "biplot"
if (ell == TRUE) {
scaleplot <- 1
}
if ((x$catype == "CA") | (x$catype == "NSCA")) {
cord1 <- x$Cprinccoord * scaleplot
cord2 <- x$Rstdcoord/scaleplot
nthings <- x$cols
nvars <- x$rows
thinggroup <- colgroup
thinggrlab <- colgrlab
vargroup <- rowgroup
vargrlab <- rowgrlab
thinglabels <- x$collabels
varlabels <- x$rowlabels
main <- "Column Isometric Biplot"
inertiapc = x$inertias[, 2]
dmu = diag(x$inertias[, 1])
dimnames(cord1)[1] <- dimnames(x$Xtable)[2]
dimnames(cord2)[1] <- dimnames(x$Xtable)[1]
}
if ((x$catype == "DONSCA") | (x$catype == "DOCA") |
(x$catype == "SOCA") | (x$catype == "SONSCA")) {
if (ell == TRUE) {
scaleplot <- 1
}
cord2 <- x$Cprinccoord * scaleplot
cord1 <- x$Rstdcoord/scaleplot
nthings <- x$rows
nvars <- x$cols
thinggroup <- rowgroup
thinggrlab <- rowgrlab
vargroup <- colgroup
vargrlab <- colgrlab
thinglabels <- x$rowlabels
varlabels <- x$collabels
inertiapc = x$inertias[, 2]
dmu = diag(x$inertias[, 1])
dimnames(cord1)[1] <- dimnames(x$Xtable)[1]
dimnames(cord2)[1] <- dimnames(x$Xtable)[2]
}
}
}
if ((x$catype == "DOCA") | (x$catype == "SOCA") | (x$catype ==
"SONSCA") | (x$catype == "DONSCA")) {
cat("\n Looking at the Trends of rows and columns\n")
trendplot(x$mj, (x$Trend), posleg = posleg, main = "Reconstructed rows of the centred column profile",
xlab = "ordered scores", prop = prop)
trendplot(x$mi, t(x$Trend), posleg = posleg, main = "Reconstructed columns of the centred column profile",
xlab = "ordered scores", prop = prop)
}
picsize1 <- c(range(cord1[, c(firstaxis, lastaxis)], cord2[,
c(firstaxis, lastaxis)])/prop)
if (picsize1[1] >= picsize1[2])
stop(paste("incorrect axis scale picsize =", picsize1[1],
picsize1[2], "\n\n"))
if ((x$catype == "DONSCA") || (x$catype == "DOCA")) {
plotone(firstaxis, lastaxis, plottype = plottype, things = x$catype,
nthings, nvars, cord1, cord2, inertiapc = round(inertiapc,
digits = 1), thinggroup, thinggrlab, vargroup,
vargrlab, thinglabels, varlabels, picsize = picsize1,
cex = cex, cex.lab = cex.lab, type = "b", catype = x$catype,
pos = pos)
}
if ((x$catype == "SOCA") || (x$catype == "SONSCA")) {
if (biptype == "row") {
type = "b"
}
else {
type = "p"
}
plotone(firstaxis, lastaxis, plottype = plottype, things = x$catype,
nthings, nvars, cord1, cord2, inertiapc = round(inertiapc,
digits = 1), thinggroup, thinggrlab, vargroup,
vargrlab, thinglabels, varlabels, picsize = picsize1,
cex = cex, cex.lab = cex.lab, catype = x$catype,
type = type, pos = pos)
}
if ((x$catype == "CA") || (x$catype == "NSCA")) {
plotone(firstaxis, lastaxis, plottype = plottype, things = x$catype,
nthings, nvars, cord1, cord2, inertiapc = round(inertiapc,
digits = 1), thinggroup, thinggrlab, vargroup,
vargrlab, thinglabels, varlabels, picsize = picsize1,
cex = cex, cex.lab = cex.lab, type = "p", catype = x$catype,
pos = pos)
}
if (ell == TRUE) {
if (((x$catype == "NSCA") | (x$catype == "CA") | (x$catype ==
"DOCA") | (x$catype == "SOCA") | (x$catype == "SONSCA") |
(x$catype == "DONSCA")) & (plottype == "biplot") &
(biptype == "row") | (biptype == "r") | (biptype ==
"rows")) {
cordr <- cord2
cordc <- cord1
cord1 <- cordr
cord2 <- cordc
}
switch(x$catype, CA = caellipse(Xtable = x$Xtable, a1 = firstaxis,
a2 = lastaxis, alpha = alpha, M = Mell, cex = cex,
cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = x$Rstdcoord, b = x$Cstdcoord,
g = cord1, fr = cord2, dmu = dmu, inertiapc = round(inertiapc,
digits = 1), plottype = plottype, biptype = biptype,
pos = pos, arrow = TRUE, length = 0, graphy = TRUE,
ell = TRUE), SOCA = caellipse(Xtable = x$Xtable,
a1 = firstaxis, a2 = lastaxis, alpha = alpha, M = Mell,
cex = cex, cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = solve(x$Imass^0.5) %*% x$Rstdcoord,
b = solve(x$Jmass^0.5) %*% x$Cstdcoord, g = cord2,
fr = cord1, dmu = dmu, inertiapc = round(inertiapc,
digits = 1), plottype = plottype, biptype = biptype,
pos = pos, arrow = FALSE, length = 0, graphy = T,
ell = TRUE), DOCA = caellipse(Xtable = x$Xtable,
a1 = firstaxis, a2 = lastaxis, alpha = alpha, M = Mell,
cex = cex, cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = solve(x$Imass^0.5) %*% x$Rstdcoord,
b = solve(x$Jmass^0.5) %*% x$Cstdcoord, g = cord2,
fr = cord1, dmu = dmu, inertiapc = round(inertiapc,
digits = 1), plottype = plottype, biptype = biptype,
pos = pos, arrow = FALSE, length = 0, graphy = T,
ell = TRUE), NSCA = nscaellipse(Xtable = x$Xtable,
a1 = firstaxis, a2 = lastaxis, alpha = alpha, M = Mell,
cex = cex, cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = x$Rstdcoord, b = x$Cstdcoord,
g = cord1, fr = cord2, dmu = dmu, tauden = x$tauden,
inertiapc = round(inertiapc, digits = 1), plottype = plottype,
biptype = biptype, pos = pos, arrow = T, length = 0,
graphy = T, ell = TRUE), SONSCA = nscaellipse(Xtable = x$Xtable,
a1 = firstaxis, a2 = lastaxis, alpha = alpha, M = Mell,
cex = cex, cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = x$Rstdcoord, b = x$Cstdcoord,
g = cord2, fr = cord1, dmu = dmu, tauden = x$tauden,
inertiapc = round(inertiapc, digits = 1), plottype = plottype,
biptype = biptype, pos = pos, arrow = FALSE, length = 0,
graphy = T, ell = TRUE), DONSCA = nscaellipse(Xtable = x$Xtable,
a1 = firstaxis, a2 = lastaxis, alpha = alpha, M = Mell,
cex = cex, cex.lab = cex.lab, prop = prop, Imass = x$Imass,
Jmass = x$Jmass, a = x$Rstdcoord, b = x$Cstdcoord,
g = cord2, fr = cord1, dmu = dmu, tauden = x$tauden,
inertiapc = round(inertiapc, digits = 1), plottype = plottype,
biptype = biptype, pos = pos, arrow = FALSE, length = 0,
graphy = T, ell = TRUE))
}
}
plot(CAvariants(asbestos, catype = "CA", firstaxis = 1, lastaxis = 2))
plot(CAvariants(asbestos, catype = "DOCA", firstaxis = 1,lastaxis = 2))
plot(CAvariants(asbestos, catype = "DONSCA",firstaxis=1, lastaxis = 2, ellcomp = FALSE))
risasbestos<-CAvariants(asbestos, catype = "DOCA", firstaxis=1, lastaxis=2)
plot(risasbestos, plotype = "biplot", biptype = "row")
```