DT 數據表中的多個子表

Question

我使用來自https://github.com/rstudio/shiny-examples/issues/9的信息在 DT 數據表中構建子表。 現在我正在嘗試擴展此代碼以獲取大子表。 不知何故，大子表不能很好地呈現。 當我點擊展開時，我認為錯誤的子表得到了解決。

您可以在下面找到我的代碼：

require(tibble)
require(tidyr)
require(dplyr)
require(DT)

bla = tibble(' '='⊕', name=c("N", "Unbefristet", "Befristet", "keine Angabe"),
         val = c(2001, "85.72 %", "14.19 %", "3 %"),
         bla = list(tibble(' '='⊕', name="test", val=190, bla = list(tibble(name="lol", val=120))), 
                    tibble(' '='⊕', name="lala", val="34 %", bla = list(tibble(name="lol", val=120))),
                    tibble(' '='⊕', name=c("N", "dumm", "tra", "ra"), val=c(283, "22.66 Monate", "4 %", "3 %"), bla = list(tibble(name="lol", val=120))),
                    tibble(' '='⊕', name=c("N", "dumm", "tra", "ra"), val=c(23,355,12,124), bla = list(tibble(name="lol", val=120)))))

nested_columns         <- which(sapply(bla,class)=="list") %>% setNames(NULL)
not_nested_columns     <- which(!(seq_along(bla) %in% c(1,nested_columns)))
not_nested_columns_str <- not_nested_columns %>% paste(collapse="].replace(' ', '_') + '_' + d[") %>% paste0("d[",.,"].replace(' ', '_').replace('.','_').replace('%', '_')")


callback <- paste0("
               table.column(1).nodes().to$().css({cursor: 'pointer'});
               var myid = 1
               // Format data object (the nested table) into another table
               var format = function(d, myid) {
               if(d[4] != null){
               var result = ('<table id=\"child_' + myid + '\">').replace('.','_') + '<thead style=display:none;><tr>'
               for (var col in d[",nested_columns,"]){
               result += '<th>' + col + '</th>'
               }
               result += '</tr></thead></table>'
               return result
               }else{
               return '';
               }
               }

               var format_datatable = function(d, myid) {
               var dataset = [];
               for (i = 0; i < + d[",nested_columns,"]['val'].length; i++) {
               var datarow = [];
               for (var col in d[",nested_columns,"]){
               datarow.push(d[",nested_columns,"][col][i])
               }
               dataset.push(datarow)
               }
               var subtable = $(('table#child_' + myid).replace('.','_')).DataTable({
               'data': dataset,
               'autoWidth': true, 
               'deferRender': true, 
               'info': false, 
               'lengthChange': false, 
               'ordering': false, 
               'paging': false, 
               'scrollX': false, 
               'scrollY': false, 
               'searching': false,
               'columnDefs': [{'targets': 0, 'orderable': false, 'className': 'details-control'},
               {'targets': 3, 'visible': false}] 
               });
               };
               table.on('click', 'td.details-control', function() {
               var td = $(this), row = table.row(td.closest('tr'));
               if (row.child.isShown()) {
               row.child.hide();
               td.html('&oplus;');
               } else if($(this).html().charCodeAt(0)==8853){
               myid++
               row.child(format(row.data(), myid)).show();
               td.html('&CircleMinus;');
               format_datatable(row.data(), myid)
               }
               });"
              )

datatable(
  bla,
  escape = -2, # raw HTML in column 2
  options = list(
columnDefs = list(
  list(visible = FALSE, targets = c(0,nested_columns) ), # Hide row numbers and nested columns
  list(orderable = FALSE, className = 'details-control', targets = 1) # turn first column into control column
    )
  ),
  callback = JS(callback)
)

知道我在這段代碼中的錯誤是什么嗎？ 提前致謝。

Answer 1

這是一個例子。 我希望這有幫助。

library(DT)

## data
dat <- data.frame(
  Sr = c(1.5, 2.3),
  Description = c("A - B", "X - Y")
)
## details of row 1
subsubdat1 <- data.frame(
  Ref = c("UVW", "PQR"),
  Case = c(99, 999),
  stringsAsFactors = FALSE
)
subdat1 <- data.frame(
  Chromosome = "chr18", 
  SNP = "rs2",
  details = I(list(purrr::transpose(subsubdat1))),
  stringsAsFactors = FALSE
)
subdat1 <- cbind(" " = "&oplus;", subdat1, stringsAsFactors = FALSE)
## details of row 2
subdat2 <- data.frame(
  Chromosome = c("chr19","chr20"), 
  SNP = c("rs3","rs4"), 
  stringsAsFactors = FALSE
)

## merge the row details
subdats <- lapply(list(subdat1, subdat2), purrr::transpose)
## dataframe for the datatable
Dat <- cbind(" " = "&oplus;", dat, details = I(subdats))

## the callback
callback = JS(
  "table.column(1).nodes().to$().css({cursor: 'pointer'});",
  "// Format the nested table into another table",
  "var childId = function(d){",
  "  var tail = d.slice(2, d.length - 1);",
  "  return 'child_' + tail.join('_').replace(/[\\s|\\.]/g, '_');",
  "};",
  "var format = function (d) {",
  "  if (d != null) {",
  "    var id = childId(d);",
  "    var html = ", 
  "          '<table class=\"display compact\" id=\"' + id + '\"><thead><tr>';",
  "    for (var key in d[d.length-1][0]) {",
  "      html += '<th>' + key + '</th>';",
  "    }",
  "    html += '</tr></thead></table>'",
  "    return html;",
  "  } else {",
  "    return '';",
  "  }",
  "};",
  "var rowCallback = function(row, dat, displayNum, index){",
  "  if($(row).hasClass('odd')){",
  "    for(var j=0; j<dat.length; j++){",
  "      $('td:eq('+j+')', row).css('background-color', 'papayawhip');",
  "    }",
  "  } else {",
  "    for(var j=0; j<dat.length; j++){",
  "      $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');",
  "    }",
  "  }",
  "};",
  "var headerCallback = function(thead, data, start, end, display){",
  "  $('th', thead).css({",
  "    'border-top': '3px solid indigo',", 
  "    'color': 'indigo',",
  "    'background-color': '#fadadd'",
  "  });",
  "};",
  "var format_datatable = function (d) {",
  "  var dataset = [];",
  "  var n = d.length - 1;",
  "  for (var i = 0; i < d[n].length; i++) {",
  "    var datarow = $.map(d[n][i], function (value, index) {",
  "      return [value];",
  "    });",
  "    dataset.push(datarow);",
  "  }",
  "  var id = 'table#' + childId(d);",
  "console.log(d);",
  "  if (Object.keys(d[n][0]).indexOf('details') === -1) {",
  "    var subtable = $(id).DataTable({",
  "                     'data': dataset,",
  "                     'autoWidth': true,",
  "                     'deferRender': true,",
  "                     'info': false,",
  "                     'lengthChange': false,",
  "                     'ordering': d[n].length > 1,",
  "                     'paging': false,",
  "                     'scrollX': false,",
  "                     'scrollY': false,",
  "                     'searching': false,",
  "                     'sortClasses': false,",
  "                     'rowCallback': rowCallback,",
  "                     'headerCallback': headerCallback,",
  "                     'columnDefs': [{targets: '_all', className: 'dt-center'}]",
  "                   });",
  "  } else {",
  "    var subtable = $(id).DataTable({",
  "                     'data': dataset,",
  "                     'autoWidth': true,",
  "                     'deferRender': true,",
  "                     'info': false,",
  "                     'lengthChange': false,",
  "                     'ordering': d[n].length > 1,",
  "                     'paging': false,",
  "                     'scrollX': false,",
  "                     'scrollY': false,",
  "                     'searching': false,",
  "                     'sortClasses': false,",
  "                     'rowCallback': rowCallback,",
  "                     'headerCallback': headerCallback,",
  "                     'columnDefs': [{targets: -1, visible: false}, {targets: 0, orderable: false, className: 'details-control'}, {targets: '_all', className: 'dt-center'}]",
  "                   }).column(0).nodes().to$().css({cursor: 'pointer'});",
  "  }",
  "};",
  "table.on('click', 'td.details-control', function () {",
  "  var tbl = $(this).closest('table');",
  "  var td = $(this),",
  "      row = $(tbl).DataTable().row(td.closest('tr'));",
  "  if (row.child.isShown()) {",
  "    row.child.hide();",
  "    td.html('&oplus;');",
  "  } else {",
  "    row.child(format(row.data())).show();",
  "    td.html('&CircleMinus;');",
  "    format_datatable(row.data());",
  "  }",
  "});")

## datatable
datatable(Dat, callback = callback, escape = -2,
          options = list(
            columnDefs = list(
              list(visible = FALSE, targets = ncol(Dat)),
              list(orderable = FALSE, className = 'details-control', targets = 1),
              list(className = "dt-center", targets = "_all")
            )
          ))

Answer 2

我們經典使用的方法是 data.frame，但這是一種糟糕的方法。

您應該使用庫庫 (data.table) 而不是 data.frame。 還需要打開瀏覽器才能看到結果。