R閃亮的鏈接標籤與DT包

Question

解決方案之間創建鏈接之間的標籤找到這裏R shiny build links between tabs是非常好的，但它不適用於DT包（對我來說）。 任何人都可以告訴我，我的示例代碼中使用DT庫與沒有DT包的解決方案相比，我做錯了什麼？

library(shiny) 
library(DT) 

server <- function(input, output) { 
    output$iris_type <- DT::renderDataTable({ 
     datatable(data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>")), 
        escape = FALSE, 
        options = list(initComplete = JS(
'function(table) { 
    table.on("click.dt", "tr", function() { 
    Shiny.onInputChange("rows", table.row(this).index()); 
    tabs = $(".tabbable .nav.nav-tabs li a"); 
    $(tabs[1]).click(); 
    }); 
}'))) 
    }) 

    output$filtered_data <- DT::renderDataTable({ 
     if(is.null(input$rows)){ 
      iris 
     }else{ 
      iris[iris$Species %in% unique(iris$Species)[as.integer(input$rows)+1], ] 
     } 
     }) 
    } 

ui <- shinyUI(fluidPage(
    mainPanel(
     tabsetPanel(
      tabPanel("Iris Type", DT::dataTableOutput("iris_type")), 
      tabPanel("Filtered Data", DT::dataTableOutput("filtered_data")) 
     ) 
    ) 
)) 

shinyApp(ui = ui, server = server) 

Answer 1

你可以試試下面的代碼。我改變了功能切換標籤的回調（其表作爲參數），並在你的output$filtered_data，取而代之的datable(iris)iris因爲你與DT::renderDataTable

library(shiny) 
library(DT) 

server <- function(input, output) { 
    output$iris_type <- DT::renderDataTable({ 
    datatable(data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>")), 
       escape = FALSE, 
       callback = JS(
       'table.on("click.dt", "tr", function() { 
    tabs = $(".tabbable .nav.nav-tabs li a"); 
    $(tabs[1]).click();})')) 
    }) 

    output$filtered_data <- DT::renderDataTable({ 
    selected <- input$iris_type_rows_selected 
    if(is.null(selected)){ 
     datatable(iris) 
    } else { 
     datatable(iris[iris$Species %in% unique(iris$Species)[selected], ]) 
    } 
    }) 
} 

ui <- shinyUI(fluidPage(
    mainPanel(
    tabsetPanel(
     tabPanel("Iris Type", DT::dataTableOutput("iris_type")), 
     tabPanel("Filtered Data", DT::dataTableOutput("filtered_data")) 
    ) 
) 
)) 

shinyApp(ui = ui, server = server) 

呈現請注意，這需要DT >= 0.0.62。

Answer 2

最後我在onclick事件上使用了一點小技巧。你認爲哪種方式更清楚？ （NicE's還是這個？）

library(shiny) 
library(DT) 

server <- function(input, output) { 
    output$iris_type <- DT::renderDataTable({ 
     datatable(data.frame(Species=paste0("<a href='#filtered_data'", 
              "alt='",unique(iris$Species),"'",             
              "onclick=\"", 
              "tabs = $('.tabbable .nav.nav-tabs li');", 
              "tabs.each(function() {", 
              "$(this).removeClass('active')", 
              "});", 
              "$(tabs[1]).addClass('active');", 
              "tabsContents = $('.tabbable .tab-content .tab-pane');", 
              "tabsContents.each(function() {", 
              "$(this).removeClass('active')", 
              "});", 
              "$(tabsContents[1]).addClass('active');", 
              "$('#filtered_data').trigger('change').trigger('shown');", 
              "Shiny.onInputChange('species', getAttribute('alt'));", 
              "\">", 
              unique(iris$Species), 
              "</a>")), 
        escape = FALSE) 
    }) 

    output$filtered_data <- DT::renderDataTable({ 
     if(is.null(input$species)){ 
      datatable(iris) 
     }else{ 
      datatable(iris[iris$Species %in% input$species, ]) 
     } 
    }) 
    } 

ui <- shinyUI(fluidPage(
    mainPanel(
     tabsetPanel(
      tabPanel("Iris Type", DT::dataTableOutput("iris_type")), 
      tabPanel("Filtered Data", DT::dataTableOutput("filtered_data")) 
     ) 
    ) 
)) 

shinyApp(ui = ui, server = server)