修复VisCollin包tableplot函数的grid视口调用，仅生成单图

问题 #

我有VisCollin包中的遗留函数tableplot，它用grid graphics生成表格的半图形展示，每个单元格用与值成比例的符号（带形状、填充色等属性）表示。函数通过grid视口（viewport）和布局绘制单元格标记，在R/RStudio控制台运行正常，但在.Rmd文档中，knitr会为表格的每个单元格生成一张图，必须用块选项fig.keep = "last"才能只保留最终图形。

简化后的函数代码如下：

tableplot.default <- function( ... ) {

    grid.newpage()

    #---Create Layout 1 and write main title.

    L1 <- grid.layout(2,1,heights=unit(c(3,1),c("lines","null")))
    pushViewport(viewport(layout=L1, width=0.95, height=0.98))

    pushViewport(viewport(layout.pos.row=1))            ## Push row 1 of Layout 1.
    grid.text(title, x=0.02, just=c("left", "bottom"))
    upViewport()

    #---Create Layout 2.

    L2 <- grid.layout(1,2,widths=unit(c(1,1),c("char","null")))
    pushViewport(viewport(layout.pos.row=2, layout=L2)) ## Push row 2 of Layout 1.

    #---Create Layout 3.

    L3 <- grid.layout(dim(values)[1],dim(values)[2],respect=T,just=c("left","top"))
    pushViewport(viewport(layout.pos.col=2))            ## Push col 2 of Layout 2;

    #---Push Layout 3, but with adjustments to accommodate possible partitions.

    pushViewport(viewport(layout=L3, x=0, y=1,
                    just=c(0,1),
                    width =unit(1,"npc")-unit(gap,"mm")*(length(v.parts)-1),
                    height=unit(1,"npc")-unit(gap,"mm")*(length(h.parts)-1)))

    #---Draw cellgrams.

    for (i in 1:dim(values)[1]){
        for (j in 1:dim(values)[2]){

            pushViewport(viewport(layout.pos.row=i, layout.pos.col=j))
            pushViewport(viewport(just=c(0,1), height=1, width=1,
                            x=unit(gap,"mm")*v.gaps[j],
                            y=unit(1,"npc")-unit(gap,"mm")*h.gaps[i]))

            cellgram(cell  = values[i,j,], ... )   # draw values in cell(i,j)
            if ((j==1) && (table.label == TRUE)) {
                if (side.rot==0) {grid.text(side.label[i], x=-0.04, just=1, gp=gpar(cex=label.size))}
                            else {grid.text(side.label[i], x=-0.1, just=c("center"), rot=side.rot, gp=gpar(cex=label.size))}
                }
            if ((i==1) && (table.label == TRUE)) {grid.text(top.label[j],  y=1.05, vjust=0, gp=gpar(cex=label.size))}
            upViewport()
            upViewport()
            }
        }
    popViewport(0)
    }

}

我不太理解grid视口，不知道该修改哪里，希望得到帮助。

解决方案 #

问题核心在于cellgram函数可能每次调用都执行了grid.newpage()，导致knitr将每个单元格的绘制识别为独立图形；同时原函数的视口管理也可优化，确保所有绘图操作在同一个grid页面完成。

1. 修改cellgram函数 #

打开cellgram的代码，删除其中的grid.newpage()语句。tableplot开头已调用grid.newpage()初始化绘图页面，后续所有单元格绘制都应在该页面完成，无需每次新建页面。

2. 优化tableplot的视口与绘图流程 #

调整视口管理逻辑，确保所有绘图操作在同一页面完成，并在函数末尾返回不可见对象避免knitr误判：

tableplot.default <- function( ... ) {
    # 初始化单个绘图页面
    grid.newpage()

    #---Create Layout 1 and write main title.
    L1 <- grid.layout(2,1,heights=unit(c(3,1),c("lines","null")))
    root_vp <- viewport(layout=L1, width=0.95, height=0.98)
    pushViewport(root_vp)

    pushViewport(viewport(layout.pos.row=1))
    grid.text(title, x=0.02, just=c("left", "bottom"))
    upViewport()

    #---Create Layout 2.
    L2 <- grid.layout(1,2,widths=unit(c(1,1),c("char","null")))
    pushViewport(viewport(layout.pos.row=2, layout=L2))

    #---Create Layout 3.
    L3 <- grid.layout(dim(values)[1],dim(values)[2],respect=T,just=c("left","top"))
    pushViewport(viewport(layout.pos.col=2))

    #---Push Layout 3 with adjustments
    plot_vp <- viewport(layout=L3, x=0, y=1,
                    just=c(0,1),
                    width =unit(1,"npc")-unit(gap,"mm")*(length(v.parts)-1),
                    height=unit(1,"npc")-unit(gap,"mm")*(length(h.parts)-1))
    pushViewport(plot_vp)

    #---Draw cellgrams.
    for (i in 1:dim(values)[1]){
        for (j in 1:dim(values)[2]){
            cell_vp <- viewport(layout.pos.row=i, layout.pos.col=j)
            pushViewport(cell_vp)
            inner_vp <- viewport(just=c(0,1), height=1, width=1,
                            x=unit(gap,"mm")*v.gaps[j],
                            y=unit(1,"npc")-unit(gap,"mm")*h.gaps[i])
            pushViewport(inner_vp)

            # 在当前视口绘图，不新建页面
            cellgram(cell  = values[i,j,], ... )

            if ((j==1) && (table.label == TRUE)) {
                if (side.rot==0) {
                    grid.text(side.label[i], x=-0.04, just=1, gp=gpar(cex=label.size))
                } else {
                    grid.text(side.label[i], x=-0.1, just=c("center"), rot=side.rot, gp=gpar(cex=label.size))
                }
            }
            if ((i==1) && (table.label == TRUE)) {
                grid.text(top.label[j],  y=1.05, vjust=0, gp=gpar(cex=label.size))
            }

            upViewport(2) # 一次性退出两个视口，简化代码
        }
    }

    # 退出所有视口
    popViewport(0)

    # 返回不可见对象，避免knitr额外输出
    invisible(NULL)
}

3. 可选：优化knitr代码块选项 #

若不想修改函数，可在Rmd代码块中设置fig.show = "hold"，让knitr等待所有绘图操作完成后统一输出图形，替代fig.keep = "last"：

```{r, fig.show = "hold"}
tableplot(your_data)

内容的提问来源于stack exchange，提问作者user101089