Shiny模块动态生成多幅ggplot时所有图表均显示最后一个的问题

问题场景 #

开发适配多类模型的Shiny Module对接现有应用，需要模块支持动态适配不同数量的待绘图变量，变量名称作为模块传入参数。参考动态插入UI的示例编写代码后，可正常生成对应数量的box容器，但所有容器内渲染的ggplot图表完全一致，均为循环最后一次生成的图表。
可复现问题的完整代码如下：

modeleServer <- function(id,variables){
  moduleServer(id,function(input, output,session){
    ns <- session$ns
    # 向页面插入对应数量的绘图输出对象
    output$plots <- renderUI({
      plot_output_list <- lapply(1:length(variables), function(i) {
        ns <- session$ns
        box(title=paste("graphe de ",variables[i],sep=" "),status="info",width=6,
            plotOutput(ns(paste("plot", variables[i], sep=""))))
      })
      
      # 转为tagList才能正常渲染列表元素
      do.call(tagList, plot_output_list)
    }) 
    
    observe({
      
      for (i in (1:length(variables))) {
        # 官方注释说明需要local捕获每次循环的索引，避免所有实例拿到同一个i值
        local({
          my_i <- i
          plotname <- paste("plot", variables[my_i], sep="")
          
          output[[plotname]] <- renderPlot({
            ggplot(airquality)+
              geom_line(aes(x=Day,y=airquality[[paste0(variables[i])]]),col='blue',size=0.4)+
              theme_classic()+
              scale_x_continuous(expand = c(0, 0), limits = c(0,NA)) +
              scale_y_continuous(expand = c(0, 0), limits = c(0, NA))+
              theme(legend.position = "none") +
              ggtitle(paste0("graphe de ",variables[i]))
          })
        })
      }
    })
  })
}

modeleUI <-function(id){
  ns <-NS(id)
  tagList(
    uiOutput(ns("plots"))
  )
}

library(shiny)
library(shinydashboard)
library(tidyverse)
# 应用UI
ui <- fluidPage(
    titlePanel("App using module"),
    modeleUI("test")
)

# 应用服务端逻辑
server <- function(input, output) {
  modeleServer(id="test",variables=c("Ozone","Wind"))
}

# 启动应用
shinyApp(ui = ui, server = server)

问题根因 #

这是Shiny循环渲染输出的经典闭包惰性求值问题：

• 你在local({})块中定义my_i <- i捕获每次循环的当前索引、生成对应独立的plotname，这部分逻辑是正确的
• 但renderPlot({})内部的ggplot绘图逻辑中，提取数据列、拼接图表标题时，使用的仍然是外层for循环的变量i，没有使用已经捕获到当前索引值的my_i
• renderPlot是惰性执行的，只有页面真正触发渲染时才会运行内部代码，此时for循环早已执行完毕，i的值固定为循环结束时的最后一个索引（即length(variables)），所有绘图输出都会读取最后一个变量的数据绘图，最终呈现所有图表完全一致的现象。

修复方法 #

将renderPlot内部所有引用循环变量i的位置，全部替换为已经捕获当前索引的my_i即可，修复后的observe块代码如下：

observe({
  for (i in (1:length(variables))) {
    local({
      my_i <- i
      plotname <- paste("plot", variables[my_i], sep="")
      
      output[[plotname]] <- renderPlot({
        ggplot(airquality)+
          # 把原来的variables[i]替换为variables[my_i]
          geom_line(aes(x=Day,y=airquality[[paste0(variables[my_i])]]),col='blue',size=0.4)+
          theme_classic()+
          scale_x_continuous(expand = c(0, 0), limits = c(0,NA)) +
          scale_y_continuous(expand = c(0, 0), limits = c(0, NA))+
          theme(legend.position = "none") +
          # 这里同样替换为variables[my_i]
          ggtitle(paste0("graphe de ",variables[my_i]))
      })
    })
  }
})

如果需要更稳妥地避免闭包问题，也可以直接用lapply替代for循环，不需要手动写local捕获索引：

observe({
  lapply(1:length(variables), function(my_i) {
    plotname <- paste("plot", variables[my_i], sep="")
    output[[plotname]] <- renderPlot({
      ggplot(airquality)+
        geom_line(aes(x=Day,y=airquality[[variables[my_i]]]),col='blue',size=0.4)+
        theme_classic()+
        scale_x_continuous(expand = c(0, 0), limits = c(0,NA)) +
        scale_y_continuous(expand = c(0, 0), limits = c(0, NA))+
        theme(legend.position = "none") +
        ggtitle(paste0("graphe de ",variables[my_i]))
    })
  })
})

额外优化点：airquality[[paste0(variables[my_i])]]里的paste0是多余的，variables本身已经是字符串，直接索引即可。

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