updateTabsetPanel and updateSelectINput with htmlOutput

Question

Ive got this shiny app with a textInput and a htmlOutput. A user would want to look up a article and writes the name of the article into the textField. Whenever the article is in my dataset, the article + some information would be displayed as table in the htmlOutput.

What i want to achive is that whenever a textInput from a user matches an article from the dataset which is then displayed in the htmlOutput, the article should be clickable. And when a user clicks on that clickable article the second tabPanel will open.

So i mutated the article column into an html output with an link attribute and added #tab-6240-1 from the source code to that link attribute. But nothing happens and i realised that whenever i restart my App the id from the source code will change.

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)

In a next step i would like to update the selectInput in the second tabPanel with updateSelectInput. The selected article should be exactly the same article a user clicked on in the first tabPanel

Any help is very apprichiated

Answer 1

Here is one approach, if I understand things correctly.

Make sure to include an id for your tabsetPanel so you can change tabs dynamically in server.

Instead of hyperlinks, try using actionButton in your table to select different articles. You can create them dynamically using a custom function (see related example here).

Then, you can add an observeEvent to catch the clicks on actionButton, determine which button was selected, and then switch tab and change the selectInput accordingly.

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)