Andrii
Andrii

Reputation: 3043

How to create hyperlink on element of R Shiny application?

Let see the following application.

When a user sees a table and clicks on the hyperlink "B" I would like to go into "Letters" and have selected the value "B" there.

How it can be done?

library(shiny)
library(DT)
library(data.table)

server <- function(input, output, session) {
  
  output$uo_selector <- renderUI({
    selectizeInput(
      'si_letters', 'Letters', 
      choices = c("A", "B", "C"),
      multiple = FALSE, selected = "A")
  })
  
  df_table <- reactive({
    data.table(
      letters = c(
        paste0("<a href='Go to selector with value A'>", "A", "</a>"),
        paste0("<a href='Go to selector with value B'>", "B", "</a>"),
        paste0("<a href='Go to selector with value C'>", "C", "</a>")),
      numbers = c(1, 2, 3)
    )
    
  })
  
  output$dt_table <- renderDataTable(
    df_table(), escape = FALSE, options = list(pageLength = 5))
  
}

ui <- fluidPage(
  navbarPage('TEST', 
             tabPanel("Table",
                      fluidPage(
                        fluidRow(dataTableOutput("dt_table")))),
             
             tabPanel("Letters",
                      fluidPage(
                        fluidRow(uiOutput("uo_selector"))))
             
  )
)

# Run the application 
shinyApp(ui, server)

Thanks

Upvotes: 1

Views: 469

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33417

Please check the following approach:

  1. navbarPage needs an id to select a tab programatically
  2. suspendWhenHidden = FALSEfor your renderUI call to have the selectizeInput ready before the first link is clicked
  3. bindAll shiny tags to receive the link-click via observeEvent - Please see this related answer from Joe Cheng.
  4. updateNavbarPage and updateSelectizeInput

library(shiny)
library(DT)
library(data.table)

ui <- fluidPage(
  navbarPage('TEST', id = "navbarID",
             tabPanel("Table",
                      fluidPage(
                        fluidRow(dataTableOutput("dt_table")))),
             tabPanel("Letters",
                      fluidPage(
                        fluidRow(uiOutput("uo_selector"))))
  )
)

server <- function(input, output, session) {
  
  output$uo_selector <- renderUI({
    selectizeInput(
      'si_letters', 'Letters', 
      choices = c("A", "B", "C"),
      multiple = FALSE, selected = "A")
  })
  
  outputOptions(output, "uo_selector", suspendWhenHidden = FALSE)
  
  df_table <- reactive({
    data.table(
      letters = lapply(seq_len(3), function(i){as.character(actionLink(inputId = paste0("link_", LETTERS[i]), label = LETTERS[i]))}),
      numbers = c(1, 2, 3)
    )
  })
  
  lapply(seq_len(nrow(isolate(df_table()))), function(i){
    observeEvent(input[[paste0("link_", LETTERS[i])]], {
      updateNavbarPage(inputId = "navbarID", selected = 'Letters')
      updateSelectizeInput(inputId = "si_letters", selected = LETTERS[i])
    })
  })
  
  output$dt_table <- renderDataTable({
    DT::datatable(
      df_table(), escape = FALSE,
      options = list(pageLength = 5,
                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
  
}

# Run the application 
shinyApp(ui, server)

result

Upvotes: 1

Related Questions