updateTabsetPanel and updateSelectINput with htmlOutput

[anon73295571]

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

[nirgrahamuk]

this is not the complete solution but a reprex of I think the piece you are missing the most.
DT datatable provide a nice way to work with clickable tables. I show how to switch tab based on click, and if you know the article you can also populate relevant items into the tab.

library(tidyverse)
library(shiny)
library(DT)

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)
)

article1 <- "This is the text of article 1"
article2 <- "articles 2's text this is "
article3 <- "text 3 article "

ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      textInput(inputId = "text", label = "Suchfeld")
    ),

    column(
      width = 6,
      tabsetPanel(id = "mypanel",
        tabPanel(
          title = "one",
          dataTableOutput(outputId = "table")
        ),
          tabPanel(
            title = "two",
            verbatimTextOutput("articletext"),
            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 <- renderDataTable({
    x <- data_r() %>%
      select(
        article,
        sales
      )

    print(x)
    
    DT::datatable(
      data = x,
       rownames = FALSE,
      options = list(
        dom = 't',
        autoWidth = TRUE,
        columnDefs = list(list(width = '50px', targets = c(1)),
                          list(width = '100px', targets = c(0)))
      ), selection = "single", escape = F
    ) %>% formatStyle(names(x), `font-size` = "8px")

    # updateSelectInput()
  })
  
  observe({
   tcc<- req(input$table_cell_clicked)
  
   if(!isTruthy(tcc$value)) return(NULL)
   article_to_get <- tcc$value
   print(tcc$value)
   updateTabsetPanel(session=session,
                     inputId = "mypanel",
                     selected = "two")
    })
}


shinyApp(ui, server)