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)