5

I am trying to navigate to the next tab by clicking on a link nested in a datatable.

This works fine at first using Shiny.bindAll. Here you can find an explanation from Joe Cheng regarding the use of the function.

However, when the datatable is re-rendered by filtering the input data via the selectInput the binding is lost when switching back from 2 to 1:

result

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  DF <- data.frame(a = c(1,2),
                   b = c(HTML('<a id="goToTabPanelB1" class="action-button" href="#">goToTabPanelB1</a>'),
                         HTML('<a id="goToTabPanelB2" class="action-button" href="#">goToTabPanelB2</a>')))
  
  output$tab <- renderDataTable({
    datatable(
      DF %>% filter(a %in% input$sel),
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
  
  observeEvent(c(input$goToTabPanelB1, input$goToTabPanelB2), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
manu p
  • 952
  • 4
  • 10
  • 1
    Instead of adding a load of full stops to your question in order to meet the minimum amount of text, perhaps consider expanding your question to make it clearer to help people help you. – David Buck Nov 17 '21 at 14:27

1 Answers1

3

Edit:

Another cleaner approach (as it keeps using the same id's for the links) is to avoid re-rendering the datatable by using dataTableProxy along with replaceData:

library(shiny)
library(DT)
library(dplyr)

DF <- data.frame(id = paste0(c("goToTabPanelB1", "goToTabPanelB2")),
                 a = c(1,2),
                 b = c(HTML('<a id="goToTabPanelB1" class="action-button" href="#">goToTabPanelB1</a>'),
                       HTML('<a id="goToTabPanelB2" class="action-button" href="#">goToTabPanelB2</a>')))

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  
  output$tab <- renderDataTable({
    datatable(
      DF,
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = TRUE)
  
  tabProxy <- dataTableProxy("tab", session)
  
  observeEvent(input$sel, {
    replaceData(tabProxy, data = DF[input$sel,])
  })
  
  observeEvent(c(input$goToTabPanelB1, input$goToTabPanelB2), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)

Initial answer:

A possible workaround is providing the links (a-tags) with new id's on re-rendering the datatable (see the code below).

Still I'd like to understand what is going on if the id's are static and the datatable get's re-rendered (therefore I offered the bounty).

The problem seems similar to the one described here.

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  DF <- reactive({
    # force id to update
    tmpId <- as.integer(Sys.time())
    tmpDF <- data.frame(id = paste0(c("goToTabPanelB1", "goToTabPanelB2"), tmpId),
               a = c(1,2),
               b = c(HTML(sprintf('<a id="goToTabPanelB1%s" class="action-button" href="#">goToTabPanelB1</a>', tmpId)),
                     HTML(sprintf('<a id="goToTabPanelB2%s" class="action-button" href="#">goToTabPanelB2</a>', tmpId))))
    
    tmpDF[input$sel,]
    })
  
  output$tab <- renderDataTable({
    datatable(
      DF(),
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = FALSE)
  
  observeEvent(lapply(DF()$id, function(x){input[[x]]}), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)

Related links:

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78