Блог

Позвольте посмотреть следующее приложение.

Когда пользователь видит таблицу и нажимает на гиперссылку «B», я хотел бы перейти в раздел «Буквы» и выбрать там значение «B».

Как это можно сделать?

 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)
 

Спасибо

Пожалуйста, проверьте следующий подход:

1. navbarPage требуется идентификатор для программного выбора вкладки
2. suspendWhenHidden = FALSE чтобы ваш renderUI звонок был selectizeInput готов до того, как будет нажата первая ссылка
3. bindAll блестящие теги для получения ссылки-нажмите через observeEvent — Пожалуйста, ознакомьтесь с этим соответствующим ответом Джо Ченга.
4. updateNavbarPage и 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)