【问题标题】:Show both 'active' and 'inactive' plots in knitr html output在 knitr html 输出中显示“活动”和“非活动”图
【发布时间】:2018-06-09 12:26:26
【问题描述】:

对于多个对应分析包,单个plot 函数会生成多个图。第一个地块是active,其余的是inactive。有没有办法在knitr html 输出中依次打印所有图。我正在尝试以下方法,但不起作用。

```{r fig.keep='all'}
library(CAvariants)

data(asbestos)
head(asbestos)
str(asbestos)
CAvariants(asbestos, catype = "CA", firstaxis = 1, lastaxis = 2)
CAvariants(asbestos, catype = "DOCA", firstaxis = 1,lastaxis = 2)
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") 

```

【问题讨论】:

    标签: r plot knitr


    【解决方案1】:

    函数 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") 
    
    ```
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2016-10-29
      • 2021-04-17
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2013-12-12
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多