在闪亮的 R 中的 tabsetPanels 中动态绘图

Question

我正在开发一个 Shiny 应用程序，我需要在 tabsetPanel 的 tabPanel 中动态绘制数据。我一直在尝试改编这个 StackOverflow 答案 中的示例，该示例演示了如何使用反应数据动态生成多个绘图。但是，当我修改代码以在 tabPanel 中绘图时，绘图不会在 mainPanel 中呈现。

这是我正在使用的代码：

library(shiny)
library(tidyverse)

# Load data
data("iris")

# Add row id
test <- iris %>% mutate(ID = 1:n())

UI_plot <- function(id) {
  ns <- NS(id)
  tabPanel("Plot",
           sidebarPanel(
             helpText("PLOT X:")
           ),
           mainPanel(
             helpText("PLOT:"),
             uiOutput(ns("plots"))
           )
  )
}

# server
server_plot <- function(input, output, session){
  
  # Select columns based on the condition
  sel <- c("Sepal.Length", "Sepal.Width")
  
  # Dynamically generate the plots based on the selected parameters
  observe({
    lapply(sel, function(par){
      p <- ggplot(test, aes_string(x = "Species", y = par)) +
        geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
        ggtitle(paste("Plot: ", par)) 
      output[[paste("plot", par, sep = "_")]] <- renderPlot({
        print(p) # Add print() function here
      },
      width = 380,
      height = 350)
    })
  })
  
  # Create plot tag list
  output$plots <- renderUI({
    plot_output_list <- lapply(sel, function(par) {
      plotname <- paste("plot", par, sep = "_")
      print(plotname)
      plotOutput(plotname, height = '450px', inline=TRUE)
    })
    
    do.call(tagList, plot_output_list)
    
  })
}

shinyApp(
  ui = fluidPage(
    titlePanel('TestX'),
    tabsetPanel(
      UI_plot('Plot')
    )
  ),
  server = function(input, output, session) {
    callModule(server_plot, 'Plot')
  }
)

在我的实际应用程序中，我有多个 tabPanel，我可以在其中过滤数据并选择列，因此代码中有 sel 变量。对于这个简化的示例，我使用 iris 数据集并选择 Sepal.Length 和 Sepal.Width 列。

我添加了一个

print

语句来检查图是否可能具有相同的 ID，但 ID 似乎是唯一的。

尽管如此，绘图并未按预期出现在主面板中。我不确定我做错了什么。可能是观察函数的范围有问题，或者可能是其他问题？

任何见解或建议将不胜感激。如果您需要有关我的目标或问题的具体情况的任何其他信息，请随时询问。

Answer 1

这与使用 tabsetPanel 没有任何关系 - 这是因为您正在使用模块。您走在正确的轨道上，命名空间是问题的根源。在模块中使用的

renderUI

中，您需要使用

session$ns

命名 *Output 对象，但是当您创建

output$

时，您只需使用普通 ID。我还做了一些其他更改，因为您自始至终使用 Plot 使事情变得非常混乱。

library(shiny)
library(tidyverse)

# Load data
data("iris")

# Add row id
test <- iris %>% mutate(ID = 1:n())

UI_plot <- function(id) {
  ns <- NS(id)
  tabPanel("Plot",
           sidebarPanel(
             helpText("PLOT X:")
           ),
           mainPanel(
             helpText("PLOT:"),
             uiOutput(ns("plots"))
           )
  )
}

# server
server_plot <- function(id){
  moduleServer(id, function(input, output, session) {
  # Select columns based on the condition
  sel <- c("Sepal.Length", "Sepal.Width")

  # Dynamically generate the plots based on the selected parameters
  observe({
    lapply(sel, function(par){
      output[[par]] <- renderPlot({
        ggplot(test, aes_string(x = "Species", y = par)) +
          geom_boxplot(aes(fill = Species, group=Species, color=Species)) +
          ggtitle(paste("Plot: ", par))
      })
    })
  })

  # Create plot tag list
  output$plots <- renderUI({
    tagList(lapply(sel, function(par) {
      plotname <- session$ns(par)
      print(plotname)
      plotOutput(plotname)
    }))
    })

})
}

shinyApp(
  ui = fluidPage(
    titlePanel('TestX'),
    tabsetPanel(
      UI_plot('test')
    )
  ),
  server = function(input, output, session) {
    do.call(server_plot, args = list(id = 'test'))
  }
)