Question

我需要在我的UI的多个标签中重复使用用户在第一个标签中提供的输入。

似乎无法在服务器中使用renderUI并在我的不同选项卡中使用uiOutput调用其输出。这是一个可重现的代码

ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a", 
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),

mainPanel())

server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}

runApp(list(ui=ui,server=server))

还有另一种方法可以达到这个目的吗？

非常感谢任何建议。

Answer 1

你不能（不应该）在HTML文档中有两个具有相同ID的元素（无论是否使用Shiny）。当然，当使用具有相同ID的多个元素的Shiny时将会出现问题。我还会主观地投票通过使用有意义的变量名来大幅提高代码。

对于这个输入你想要做什么也不是很清楚。您是否希望输入框显示在多个选项卡上？或者textInput的值要显示在多个选项卡上？

如果是前者，在我看来，没有明显的方法可以做到这一点，而不会违反“具有相同ID的多个元素”条款。后者会更容易（只需使用renderText并将其发送到verbatimOutput），但我不认为这就是你所要求的。

所以你真正想要的是 synchronized 的多个文本输入（具有不同的ID）。您可以使用以下内容在服务器上的单独观察者中执行此操作：

ui <- pageWithSidebar(
  headerPanel("Hello !"),
  sidebarPanel(
    tabsetPanel(
      tabPanel("a", 
               textInput(inputId = "text1", label = "text1", value = "")),
      tabPanel("b", 
               textInput(inputId = "text2", label = "text2", value = ""))
    )
  ),

  mainPanel()
)

INITIAL_VAL <- "Initial text"

server <- function(input,output, session){  
  # Track the current value of the textInputs. Otherwise, we'll pick up that
  # the text inputs are initially empty and will start setting the other to be
  # empty too, rather than setting the initial value we wanted.
  cur_val <- ""

  observe({
    # This observer depends on text1 and updates text2 with any changes
    if (cur_val != input$text1){
      # Then we assume text2 hasn't yet been updated
      updateTextInput(session, "text2", NULL, input$text1)
      cur_val <<- input$text1
    }
  })

  observe({
    # This observer depends on text2 and updates text1 with any changes
    if (cur_val != input$text2){
      # Then we assume text2 hasn't yet been updated
      updateTextInput(session, "text1", NULL, input$text2)
      cur_val <<- input$text2
    }
  })

  # Define the initial state of the text boxes  
  updateTextInput(session, "text1", NULL, INITIAL_VAL)
  updateTextInput(session, "text2", NULL, INITIAL_VAL)

}

runApp(list(ui=ui,server=server))

设置初始状态可能比我跟踪的cur_val更清晰。但我无法想到一些不可思议的东西，所以就是这样。

Answer 2

Jeff Allen的示例仅在您将ui和server函数保留在同一文件中时才有效。只要将它们拆分为ui.R和server.R文件，就会出现错误，抱怨输入值不存在：

警告：观察者中的未处理错误：参数长度为零

Shiny中有一个event handler可以解决所有问题。它还可以处理许多输入小部件，因为扩展代码以观察多个输入小部件变得更容易。感谢杰夫的例子，我找到了以下解决方案：

<强> ui.R

pageWithSidebar(
  headerPanel("Minimal Event Handler example"),
  sidebarPanel(
    tabsetPanel(
      tabPanel("a", 
               textInput(inputId = "text1", label = "text1", value = "")),
      tabPanel("b", 
               textInput(inputId = "text2", label = "text2", value = ""))
    )
  ),

  mainPanel()
)

<强> server.R

function(input,output, session){  
# Observe the current value of the textInputs with the Shiny Event Handler. 

  observeEvent(input$text1, function(){
  # Observe changes in input$text1, and change text2 on event
      updateTextInput(session, "text2", NULL, input$text1)
  })

  observeEvent(input$text2, function(){
  # Observe changes in input$text2, and change text1 on event
      updateTextInput(session, "text1", NULL, input$text2)
  })
}

默认情况下请注意ignoreNULL=TRUE，因此启动时不会失败。

Answer 3

跟进FvD的回答，如果您恰好使用uiOutput和renderUI来创建UI元素，那么在选择相应的tabPanel之前，似乎闪亮不会创建这些元素，这可能会导致他的解决方案一开始就失败了。（一旦用户使用您希望同步的UI元素循环遍历所有tabPanel，一切正常，因为所有UI元素都已创建）。

为了解决这个问题，我创建了一个反应变量来存储用户选择或创建的输入值。然后，当第一次选择具有同步UI元素的另一个tabPanel时，将使用此反应变量的值呈现UI元素。

例如，我希望同步多个面板上有selectInput个元素，并且在应用加载时创建这些元素的choices（基于文件结构中存在的任何内容）：

ui <- navbarPage("Title",
  navbarMenu("Set of tabs",
    tabPanel("tab1",
      wellPanel(
        uiOutput("selectorBin1")
      )
    ),
    tabPanel("tab2",
      wellPanel(
        uiOutput("selectorBin2")
      )
    )
  )
)

server <- function(input, output, session) {

  rv <- reactiveValues()
  rv$selection <- " "

  getChoices <- function() {
    choices <- list.dirs(getwd())
    return(choices)
  }

  output$selectorBin1 <- renderUI({
    selectInput("selector1", 
                "Please select",
                choices=getChoices(),
                selected=rv$selection)
  })
  output$selectorBin2 <- renderUI({
    selectInput("selector2",
                "Please select",
                choices=getChoices(), 
                selected=rv$selection)
  })

  observeEvent(input$selector1, {
    rv$selection <- input$selector1 # In case this is the first tab loaded
    updateSelectInput(session,
                      "selector2",
                      choices=getChoices(),
                      selected=rv$selection)
  })
  observeEvent(input$selector2, {
    rv$selection <- input$selector2 # In case this is the first tab loaded
    updateSelectInput(session,
                      "selector1",
                      choices=getChoices(),
                      selected=rv$selection)
  })
}

shinyApp(ui = ui, server = server)

R有光泽：在服务器中使用相同的renderUI进行多次使用？

3 个答案: