updateTabsetPanel 和 updateSelectINput 与 htmlOutput

Question

我得到了这个带有文本输入和 html输出的闪亮应用程序。用户想要查找一篇文章并将文章的名称写入文本字段。每当文章在我的数据集中时，文章 + 一些信息将在 html 输出中显示为 table。

我想要实现的是，每当来自用户的 textInput 与数据集中的一篇文章相匹配，然后显示在 htmlOutput 中时，该文章应该是可点击的。当用户点击该可点击文章时，第二个选项卡面板将打开。

所以我将文章列突变为具有 link 属性的 html 输出，并将源代码中的 #tab-6240-1 添加到 link 属性。但是没有任何反应，我意识到每当我重新启动我的应用程序时，源代码中的 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。所选文章应与用户在第一个选项卡面板中单击的文章完全相同

非常感谢任何帮助

Answer 1

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

确保为您的 tabsetPanel 添加一个 id，这样您就可以在 server 中动态更改标签页。

尝试在 table 到 select 不同的文章中使用 actionButton 而不是超链接。您可以使用自定义函数动态创建它们（参见相关示例）。

然后，您可以添加一个 observeEvent 来捕获 actionButton 上的点击，确定哪个按钮被 selected，然后切换标签并更改 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)

updateTabsetPanel 和 updateSelectINput 与 htmlOutput

updateTabsetPanel and updateSelectINput with htmlOutput

r

shiny

formattable

shinyapps

kableextra