R Shiny DT 回調在多個表中未按預期工作

Question

我一直在為來自 DT ZEFE970A8E603AE7F6 的 R Shiny 數據表處理回調 function。 預期的功能是，當您使用列過濾器更改表中存在的行時，其他過濾器應僅顯示表中實際存在的選項，而不是原始數據集中的選項。

在下面的示例中，您可以查看此行為。 在第一個表中，將 N 列設置為 0，將 P 列設置為 1，將 K 列設置為 0，然后單擊塊列中的過濾器，您會看到它只顯示了預期的 2、3 和 4。

當我嘗試將這個相同的回調 function 傳遞給它下面的表格時，就會出現問題。 我似乎無法弄清楚發生了什么。 回調 function（據我所知）正在執行與提供給回調 function 的表參數相關的所有操作。

我將不勝感激這方面的任何幫助。 謝謝！

    library(shiny)
    library(DT)
    library(dplyr)
    
    callback <- c(
      "function onlyUnique(value, index, self) {",
      "   return self.indexOf(value) === index;",
      "};",
      "table_header = table.table().header();",
      "column_nodes = $(table_header).find('tr:nth-child(2) > td');",
      "input_nodes = $(column_nodes).find('input.form-control');",
      "for (let i = 0; i < input_nodes.length; i++){",
      "  data_type_attr = $(input_nodes[i]).closest('td').attr('data-type');",
      "  if (data_type_attr == 'factor'){",
      "     $(input_nodes[i]).on('input propertychange', function(){",
      "        if (typeof unique_values !== 'undefined'){",
      "          selection_content = $(input_nodes[i]).closest('td').find('div.selectize-dropdown-content');",
      "          var content_str = '';",
      "          for (let j = 0; j < unique_values.length; j++){",
      "             content_str = content_str.concat('<div data-value=\"', unique_values[j],'\" data-selectable=\"\" class=\"option\">', unique_values[j], '</div>')",
      "          }",
      "          selection_content[0].innerHTML = content_str;",
      "        }",
      "     })",
      "  }",
      "}",
      "column_nodes.on('click', function(){",
      "setTimeout(function(){",
      "  for (let i = 0; i < column_nodes.length; i++){",
      "    data_type_attr = $(column_nodes[i]).attr('data-type');",
      "    if (data_type_attr == 'factor'){",
      "       selection_div = $(column_nodes[i]).find('div.selectize-input');",
      "       if($(selection_div).hasClass('dropdown-active')){",
      "          values = table.column(i, {pages: 'all', search: 'applied'}).data();",
      "          unique_values = Array.from(values.filter(onlyUnique));",
      "          selection_content = $(column_nodes[i]).find('div.selectize-dropdown-content');",
      "          var content_str = '';",
      "          for (let j = 0; j < unique_values.length; j++){",
      "             content_str = content_str.concat('<div data-value=\"', unique_values[j],'\" data-selectable=\"\" class=\"option\">', unique_values[j], '</div>')",
      "          }",
      "          selection_content[0].innerHTML = content_str;",
      "       }",
      "    }",
      "  }",
      "}, 50);",
      "})"
    )
    # <div data-value="DEO" data-selectable="" class="option">DEO</div>
    #summary_table <- read.csv("summary")[, c("GSN", "Category", "Study.Level", "Planned.Maximum.Age.of.Subjects")] %>% 
    #  mutate_at(c("GSN", "Category", "Study.Level"), as.factor) %>% mutate_at(c("Planned.Maximum.Age.of.Subjects"), as.numeric);
    #summary_table_2 <- summary_table;
    
    ui <- fluidPage(
      DT::dataTableOutput("table_1"),
      DT::dataTableOutput("table_2")
    )
    
    server <- function(input, output){
        output[["table_1"]] <- DT::renderDataTable(
           npk,
           filter = "top",
           server = FALSE, 
           callback = JS(callback));
        
        output[["table_2"]] <- DT::renderDataTable(
          npk,
          filter = "top",
          server = FALSE, 
          callback = JS(callback));
        
        dep <- htmltools::htmlDependency("jqueryui", "1.12.1",
                                         "www/shared/jqueryui",
                                         script = "jquery-ui.min.js",
                                         package = "shiny")
    }
    shinyApp(ui, server)

Answer 1

查看關於https 的反饋：//github.com/rstudio/DT/issues/952#issuecomment-1024909574

---

它與 DT 的回調功能無關。 問題的原因是您應該在 JS 中使用var x =...定義局部變量。 定義沒有var前綴的變量會導致全局變量。 所以這兩個回調將共享同一個變量。

通過在table_header 、 column_nodes和input_nodes之前添加三個var可以解決這種情況。

但這還不夠，因為unique_values也應該小心處理，否則在其他情況下您會面臨其他問題。

library(shiny)
library(DT)

callback <- r"{
function onlyUnique(value, index, self) {
  return self.indexOf(value) === index;
};
var table_header = table.table().header();
var column_nodes = $(table_header).find('tr:nth-child(2) > td');
var input_nodes = $(column_nodes).find('input.form-control');
for (let i = 0; i < input_nodes.length; i++){
  data_type_attr = $(input_nodes[i]).closest('td').attr('data-type');
  if (data_type_attr == 'factor'){
    $(input_nodes[i]).on('input propertychange', function(){
      if (typeof unique_values !== 'undefined'){
        selection_content = $(input_nodes[i]).closest('td').find('div.selectize-dropdown-content');
        var content_str = '';
        for (let j = 0; j < unique_values.length; j++){
          content_str = content_str.concat('<div data-value="', unique_values[j],'" data-selectable="" class="option">', unique_values[j], '</div>')
        }
        selection_content[0].innerHTML = content_str;
      }
    })
  }
}
column_nodes.on('click', function(){
  setTimeout(function(){
    for (let i = 0; i < column_nodes.length; i++){
      data_type_attr = $(column_nodes[i]).attr('data-type');
      if (data_type_attr == 'factor'){
        selection_div = $(column_nodes[i]).find('div.selectize-input');
        if($(selection_div).hasClass('dropdown-active')){
          values = table.column(i, {pages: 'all', search: 'applied'}).data();
          unique_values = Array.from(values.filter(onlyUnique));
          selection_content = $(column_nodes[i]).find('div.selectize-dropdown-content');
          var content_str = '';
          for (let j = 0; j < unique_values.length; j++){
            content_str = content_str.concat('<div data-value="', unique_values[j],'" data-selectable="" class="option">', unique_values[j], '</div>')
          }
          selection_content[0].innerHTML = content_str;
        }
      }
    }
  }, 50);
})
}"

ui <- fluidPage(
  DT::dataTableOutput("table_1"),
  DT::dataTableOutput("table_2")
)

server <- function(input, output){
  output[["table_1"]] <- DT::renderDataTable(
    npk,
    filter = "top",
    server = FALSE, 
    callback = JS(callback))
  
  output[["table_2"]] <- DT::renderDataTable(
    npk,
    filter = "top",
    server = FALSE, 
    callback = JS(callback))

}
shinyApp(ui, server)