0

複数のモジュールを利用する複雑な R 光沢のあるアプリケーションがあります。それぞれがリアクティブ プロットを出力する 2 つの異なるモジュール (ヒストグラム モジュールと散布図モジュールと呼びます) があります。ユーザー入力に基づいて、これらのプロットの 1 つだけを一度に表示する必要があります。これは、ラジオ ボタンを選択して管理できます。ユーザーは、ヒストグラムまたは散布図を選択するだけです。

これら 2 つのリアクティブ プロット出力を魅力的な方法で配置するのに苦労しています。ヒストグラムと散布図をページの左上部分に揃えたいと思います。ヒストグラムが 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