0

我有一个复杂的 R 闪亮应用程序，它利用了多个模块。我有两个不同的模块（我将其称为直方图模块和散点图模块），每个模块都输出一个反应图。根据用户输入，任何时候都应该只显示这些图之一。我可以通过单选按钮选择来管理它 - 用户只需选择直方图或散点图。

我很难以吸引人的方式安排这两个反应式绘图输出。我希望直方图和散点图与页面的左上角对齐。如果我的直方图在我的 UI 中首先列出，当用户选择散点图时，该散点图会呈现在一个大的空白区域下方。当用户选择直方图时，这个大空白空间被填充，但我希望这个“底部”图仍然显示在闪亮应用程序的顶部。

在我使用模块之前的光辉岁月里，我只是将我的绘图输出放在 UI 的条件面板中（例如，conditionalPanel("input.displayPlot", plotOutput("plot1"))但是，现在我有一个复杂的模块，我没有输入逻辑可以放在条件面板中（至少我不认为我这样做）。

我创建了一个简单的可重现示例，因为我可以设法重新创建这个问题。当用户选择散点图时，它会显示在一个大的空白区域下。我真的更愿意在我的模块中保留直方图与散点图的单选按钮选择（因为它也是基于其他复杂逻辑的反应性显示），但这可能是不可能的。

histogramPlotOutput <- function(id) {
  tagList(
    plotOutput(NS(id, "histogram"))
  )
}

histogramUIOutput <- function(id) {
  tagList(
    uiOutput(NS(id, "buttons"))
  )
}

histogramServer <- function(id
) {
  moduleServer(id, function(input, output, session) {

    output$histogram <- renderPlot({
      req(input$radiobuttons)

      if(input$radiobuttons){
        p <- hist(mtcars[["mpg"]])
        p
      }

    })


    output$buttons <- renderUI({
      radioButtons(NS(id, "radiobuttons"),
                   label = "Display Histogram?",
                   choices = c(TRUE, FALSE),
                   selected = TRUE)
    })

    # export the reactive button selection out of histogram server
    # this will be used as an input by scatterPlotServer to
    # determine if an alternate plot should be displayed

    reactive(
      input$radiobuttons
    )

  })
}


scatterPlotOutput <- function(id) {
  tagList(
    plotOutput(NS(id, "scatterplot"))
  )
}

scatterPlotServer <- function(id,
                              display_histogram = TRUE
)
  {

  moduleServer(id, function(input, output, session) {

    output$scatterplot <- renderPlot({
      if(display_histogram() == FALSE){
        p <- plot(mtcars$mpg, mtcars$hp)
        p
      }

    })

  })
}


myApp <- function(){
  ui <- fluidPage(
    histogramPlotOutput("hist1"),
    scatterPlotOutput("scat1"),
    histogramUIOutput("hist1")
    )

  server <- function(input, output, session) {
    display_hist <- histogramServer("hist1")

    scatterPlotServer("scat1",
                      display_histogram = reactive(display_hist()))
  }
  shinyApp(ui, server)
}

myApp()

提前感谢您的任何帮助！

4

1 回答 1

1

您可能希望用于renderUI()/uiOutput()显示您的任一图：

myApp <- function(){
  ui <- fluidPage(
    uiOutput("plot"),
    histogramUIOutput("hist1")
  )
  
  server <- function(input, output, session) {
    display_hist <- histogramServer("hist1")
    
    scatterPlotServer("scat1",
                      display_histogram = reactive(display_hist()))

    output$plot <- renderUI({
      if(req(display_hist()))
        histogramPlotOutput("hist1")
      else
        scatterPlotOutput("scat1")
      })
  }
  shinyApp(ui, server)
}
于 2021-03-03T00:49:50.467 回答