R闪亮的双向响应式小部件

8
我正在努力理解如何使 2 个 R Shiny 小部件相互更新。例如,一个滑块小部件可以更新文本框小部件,反之亦然,最终用户可以选择使用任一小部件。
这个问题类似,但没有答案,所以我将提供一个(希望)更简单的例子。 shiny :: reactive()推断的反应依赖项的检索。如果此问题已在其他地方得到回答,则我无法找到这样的答案。
我想知道是否可以将 slider1 移动到 slider2 并将 slider2 移动到 slider1。现在我只能完成第一部分(我可以移动 slider1 以移动 slider2)。如果我可以做到这一点,我认为我可以将 widget 1 设为滑块,并将 widget 2 设为数字输入,其代码基本相同。
以下示例是从 http://shiny.rstudio.com/gallery/update-input-demo.html 修改而来的,这是我能做到的最简化的示例。这也是我能找到的唯一一个接近我所需求的应用程序,尽管我意识到可能需要一种非常不同的方法...

Server.R 代码

shinyServer(
  function(input, output, clientData, session) {

#### one way interaction between slider 1 and 2 ####
    observe({![enter image description here][1]   
      c_label <- input$control_label
      c_num <- input$control_num  # <- input$inSlider

      # Slider input =============================================
      updateSliderInput(session, "inSlider",
                        label = paste("Slider2", c_label),
                        value = c_num)
      updateSliderInput(session, "control_num",
                        label = paste("Slider1", c_label),
                        value = c_num)
    })
})

Ui.r 代码

shinyUI(fluidPage(
  titlePanel("One Way Reactive Slider"),
  fluidRow(
    column(3,
           wellPanel(
             h4("Slider Inputs"),
             sliderInput("control_num",
                         "This controls values:",
                          min = 1, max = 20, value = 15),
             sliderInput("inSlider", "Slider input:",
                          min = 1, max = 20, value = 15)
    ))

  )
))

Below is a picture of the app while running. Moving slider 1 moves slider 2, but the opposite is not true (which is what I would like to do).

2个回答

8

关键是创建一个动态的UI。这样,您可以在其他UI元素更改时更新滑块绘制表达式,并使用不同的默认值重建滑块小部件:

server.R

shinyServer(
    function(input, output, clientData, session) {

    output$slider1 <- renderUI({
       slider2.value <- input$inSlider
       default.slider1 <- if (is.null(slider2.value)) 15 else slider2.value
       sliderInput("control_num",
                   "This controls values:",
                    min = 1, max = 20, value = default.slider1)
    })

    output$slider2 <- renderUI({
       slider1.value <- input$control_num
       default.slider2 <- if (is.null(slider1.value)) 15 else slider1.value
       sliderInput("inSlider", "Slider input:",
                    min = 1, max = 20, value = default.slider2)
    })

  })

ui.R

    shinyUI(fluidPage(
      titlePanel("One Way Reactive Slider"),
      fluidRow(
        column(3,
               wellPanel(
                 h4("Slider Inputs"),
                 uiOutput('slider1'),
                 uiOutput('slider2')
        ))

      )
    ))

1
这也可以作为任何两个小部件的模板,正如我所怀疑的那样,现在得到了证实。 - greenbooks
如果你有8个输入,想要更新selectInput而不让事情变得重复或循环,你会怎么做? - nate

0

如果您将每个输入滑块都包含在一个reactive observe中,就可以实现您的目标。这不仅适用于两个输入,还适用于多个输入。让我通过一个例子来解释:

observe({
# Create a reactive relationship with slider1
input$slider1
# Update the second slider - slider2
updateTextInput(session, "slider2", NULL, input$slider1)
)}

同样地,对于第二个输入,您需要通过以下方式重复代码:

observe({
# Create a reactive relationship with slider2
input$slider2
# Update the second slider - slider1
updateTextInput(session, "slider1", NULL, input$slider2)
)}

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接