updateTabsetPanel 和 updateSelectINput 与 htmlOutput

Question

我得到了这个带有 textInput 和 htmlOutput 的闪亮应用程序。用户想要查找一篇文章并将文章的名称写入文本字段。只要文章在我的数据集中，文章+一些信息就会在 htmlOutput 中显示为表格。

我想要实现的是，只要来自用户的 textInput 与数据集中的文章匹配，然后显示在 htmlOutput 中，该文章应该是可点击的。当用户点击该可点击文章时，第二个 tabPanel 将打开。

因此，我将文章列更改为带有链接属性的 html 输出，并将源代码中的#tab-6240-1 添加到该链接属性。但是什么也没发生，我意识到每当我重新启动我的应用程序时，源代码中的 id 都会改变。

library(tidyverse)
library(shiny)
library(kableExtra)
library(formattable)

data = tibble(article=c(rep("article one",3),  rep("article two",3),  rep("article three",3)), 
                sales=c(100,120,140,60,80,100,200,220,240))

ui = fluidPage(
        fluidRow(

            column(width = 6,
                       textInput(inputId = "text", label = "Suchfeld")),

            column(width = 6,
                   tabsetPanel(
                          
                   tabPanel(title = "one", 
                       htmlOutput(outputId = "table")),

                   tabPanel(title = "two",
                       selectInput(inputId = "article", label = "Look up articles", choices = data$article, multiple = F, selectize = T))))
    )
)

server = function(input, output, session){
    
    data_r = reactive({
        data %>%
        filter(str_detect(article, input$text))
    })
    
    output$table = function(){
        data_r() %>%
            mutate(article = cell_spec(article, "html", link = "#tab-6240-1")) %>%
            kable("html", escape=F, align="l", caption = "") %>%
            kable_styling(bootstrap_options=c("striped", "condensed", "bordered"), full_width=F)
    }
   
    #updateSelectInput()
}

shinyApp(ui = ui, server = server)

在下一步中，我想使用 updateSelectInput 更新第二个 tabPanel 中的 selectInput。所选文章应与用户在第一个 tabPanel 中单击的文章完全相同

任何帮助都非常apprichiated

Answer 1

这是一种方法，如果我理解正确的话。

确保为您的tabsetPanel 添加一个id，以便您可以在server 中动态更改选项卡。

尝试在表格中使用actionButton 代替超链接来选择不同的文章。您可以使用自定义函数动态创建它们（参见相关示例 here）。

然后，您可以添加observeEvent 来捕捉actionButton 上的点击，确定选择了哪个按钮，然后切换标签并相应地更改selectInput。

library(tidyverse)
library(shiny)
library(kableExtra)
library(formattable)

data = tibble(article=c(rep("article one",3),  rep("article two",3),  rep("article three",3)), 
              sales=c(100,120,140,60,80,100,200,220,240))

ui = fluidPage(
  fluidRow(
    
    column(width = 6,
           textInput(inputId = "text", label = "Suchfeld")),
    
    column(width = 6,
           tabsetPanel(id = "tabPanel",
             
             tabPanel(title = "one", 
                      htmlOutput(outputId = "table")),
             
             tabPanel(title = "two",
                      selectInput(inputId = "article", label = "Look up articles", choices = data$article, multiple = F, selectize = T))))
  )
)

server = function(input, output, session){
  
  shinyInput <- function(FUN, len, id, labels, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), label = labels[i], ...))
    }
    inputs
  }
  
  data_r = reactive({
    data %>%
      filter(str_detect(article, input$text)) %>%
      mutate(action = shinyInput(actionButton, n(), 'button_', labels = article, onclick = 'Shiny.onInputChange(\"select_button\", this.id)'))
  })
  
  output$table = function(){
    data_r() %>%
      #mutate(article = cell_spec(article, "html", link = "#tab-6240-1")) %>%
      select(action, sales) %>%
      kable("html", escape=F, align="l", caption = "") %>%
      kable_styling(bootstrap_options=c("striped", "condensed", "bordered"), full_width=F)
  }
  
  observeEvent(input$select_button, {
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    updateTabsetPanel(session, inputId = "tabPanel", selected = "two")
    updateSelectInput(session, inputId = "article", selected = data_r()[selectedRow,1])
  })
  
}

shinyApp(ui = ui, server = server)