Родительские / дочерние строки в Shiny R с одним фреймом данных, который имеет переменное количество строк - PullRequest
0 голосов
/ 10 июля 2020

У меня есть вопрос, который в основном является своего рода продолжением или упрощенным примером того, что обсуждалось здесь: Родительские / дочерние строки в R Для полной прозрачности, я скорее буду честен и скажу, что знаю близко до нуля JS, поэтому прошу прощения, если мой вопрос прост.

У меня есть следующий фрейм данных:

df <- data.frame(COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
                 NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
                 AGE = c(20, 21, 18, 35, 40, 33, , 27),
                 DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27")   )

(мой фактический фрейм данных df в действительности составляет около 2000 строк).

Эта таблица отображается в приложении R Shiny:

output $ Population_table <- renderDataTable ({</p>

df <- datatable(df, 
              filter = 'top',
              options = list(scrollX = TRUE
                             , pageLength = 5))
 })

Учитывая большой (и переменный) размер фрейма данных , Мне нужно было бы сгруппировать данные по странам, чтобы, если пользователь хочет просмотреть данные для определенной c «СТРАНЫ», он / она просто щелкнет по ней и увидит все дочерние строки. Две проблемы, с которыми я сталкиваюсь решение Родительские / дочерние строки в R :

  1. У меня нет df1 и df2
  2. Количество строк в моем фрейме данных 'df' является переменным . По этой причине я не знаю, как адаптировать этот c ода моему конкретному примеру c. Спасибо за помощь.

ОБНОВЛЕНИЕ Я попробовал решение, опубликованное на Collapsible Datatable в Shiny с отношением Parent / Child Это вроде работает, но проблемы, с которыми я сталкиваюсь с этим решением:

  1. горизонтальная полоса прокрутки полностью исчезает (мой реальный фрейм данных имеет около 60 столбцов)
  2. Столбец дат, такой как «date_of_birth», преобразован в числа
  3. Фильтры столбцов исчезают как хорошо. Можно ли исправить эти проблемы? Спасибо

1 Ответ

1 голос
/ 10 июля 2020

Это то, что вы хотите?

enter image description here

Here is the code:

NestedData <- function(dat, children){
  stopifnot(length(children) == nrow(dat))
  g <- function(d){
    if(is.data.frame(d)){
      purrr::transpose(d)
    }else{
      purrr::transpose(NestedData(d[[1]], children = d$children))
    }
  }
  subdats <- lapply(children, g)
  oplus <- ifelse(lengths(subdats), "⊕", "") 
  cbind(" " = oplus, dat, "_details" = I(subdats), 
        stringsAsFactors = FALSE)
}

df <- data.frame(
  COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
  NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
  AGE = c(20, 21, 18, 35, 40, 33, 27),
  DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27")
)

children <- lapply(split(df, df$COUNTRY), "[", -1)
dat0 <- data.frame(COUNTRY = names(children))

Dat <- NestedData(dat = dat0, children = unname(children))

library(DT)
## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)
## the callback
parentRows <- which(Dat[,1] != "")
callback <- JS(
  sprintf("var parentRows = [%s];", toString(parentRows-1)),
  sprintf("var j0 = %d;", colIdx),
  "var nrows = table.rows().count();",
  "for(let i = 0; i < nrows; ++i){",
  "  var $cell = table.cell(i,j0).nodes().to$();",
  "  if(parentRows.indexOf(i) > -1){",
  "    $cell.css({cursor: 'pointer'});",
  "  }else{",
  "    $cell.removeClass('details-control');",
  "  }",
  "}",
  "",
  "// --- make the table header of the nested table --- //",
  "var formatHeader = function(d, childId){",
  "  if(d !== null){",
  "    var html = ", 
  "      ' '; "," var data = d [d.length-1] || d._details; "," for (введите данные [0]) {"," html + = '' + key + ''; ","} "," html + = '' "," return html; ","} else {"," return ''; ","} ","}; "," "," // - - обратный вызов строки для стиля строк дочерних таблиц --- // "," var rowCallback = function (row, dat, displayNum, index) {"," if ($ (row) .hasClass ('odd')) { "," $ (row). css ('background-color', 'papayawhip'); "," $ (row) .hover (function () {"," $ (this). css ('' background-color ',' # E6FF99 '); ","}, function () {"," $ (это). css (' background-color ',' papayawhip '); ","}); " , "} else {", "$ (строка). css ('цвет фона', 'лимонный шифон');", "$ (строка) .hover (function () {", "$ (this). css ('цвет фона', '# DDFF75'); ","}, function () {"," $ (this). css ('цвет фона', 'лимонный шифон'); ", "});", "}", "};", "", "// --- обратный вызов заголовка для стиля header дочерних таблиц --- //", "var headerCallback = function (thead, data, start , end, display) {"," $ ('th', thead). css ({"," 'border-top': '3px solid indi go', "," 'color': 'indi go', "," 'background-color': '#fadadd' ","}); ","}; "," "," // --- сделаем the datatable --- // "," var formatDatatable = function (d, childId) {"," var data = d [d.length-1] || d._details; "," var colNames = Object.keys (data [0]); "," var columns = colNames.map (function (x) {"," return {data: x.replace (/ \\. / g, '\\\\\\.'), title: x}; ","}); "," var id = 'table #' + childId; "," if (colNames.indexOf ('_ details' ) === -1) {"," var subtable = $ (id) .DataTable ({"," 'data': data, "," 'columns': columns, "," 'autoWidth': true, " , "'deferRender': true,", "'info': false,", "'lengthChange': false,", "'ordering': data.length> 1,", "'order': []," , "'paging': false,", "'scrollX': false,", "'scrollY': false,", "'search': false,", "'sortClasses': false,", "'rowCallback' : rowCallback, "," 'headerCallback': headerCallback, "," 'columnDefs': [{target: '_all', className: 'dt-center'}] ","}); ","} else {", "var subtable = $ (id) .DataTable ({", "'data': data,", "'columns': columns,", "'autoWidth': true,", "'deferRender': true,", "'info': false,", "'lengthChange': false,", "'ordering': data.length> 1,", "'order': [],", "'paging': false,", "'scrollX': false,", "'scrollY': false,", "'search': false,", "'sortClasses': false,", "'rowCallback': rowCallback,", "'headerCallback': headerCallback,", "'columnDefs': ["," {target: -1, visible: false}, "," {target: 0, orderable: false, className: 'details-control'}, "," {target: '_all', className: 'dt -center '} ","] ","}). column (0) .nodes (). to $ (). css ({курсор:' указатель '}); ","} ","}; "," "," // --- отобразим дочернюю таблицу при нажатии --- // "," // массив для хранения идентификаторов уже созданных дочерних таблиц "," var children = []; "," table. on ('click', 'td.details-control', function () {"," var tbl = $ (this) .closest ('table'), "," tblId = tbl.attr ('id'), "," td = $ (this), "," row = $ (tbl) .DataTable (). row (td.closest ('tr')), "," rowIdx = row.index (); "," if (row.child.isShown ()) {"," row.child.hide (); "," td. html ('⊕'); ","} else {"," var childId = tblId + '-child-' + rowIdx; "," if (children.indexOf (childId) === -1) {"," // этот дочерний элемент еще не создан "," children.pu sh (childId) ; "," row.child ( formatHeader (row.data (), childId)). show (); "," td. html ('⊖'); "," formatDatatable (row. data (), childId, rowIdx); ","} else {"," // этот дочерний элемент уже был создан "," row.child (true); "," td. html ('⊖'); ","} ","} ","}); ") datatable (Dat, callback = callback, rownames = rowNames, escape = -colIdx-1, options = list (paging = FALSE, search = FALSE, columnDefs = list (список (visible = FALSE, target = ncol (Dat) -1 + colIdx), list (orderable = FALSE, className = "details-control", target = colIdx), list (className = "dt-center", target = "_все")))) 

РЕДАКТИРОВАТЬ

Вы должны использовать символьные столбцы, а не факторы:

df <- data.frame(
  COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
  NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
  AGE = c(20, 21, 18, 35, 40, 33, 27),
  DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
  stringsAsFactors = FALSE
)

EDIT

Вот фильтры. Благодаря плагину jQuery yadcf .

enter image description here

NestedData <- function(dat, children){
  stopifnot(length(children) == nrow(dat))
  g <- function(d){
    if(is.data.frame(d)){
      purrr::transpose(d)
    }else{
      purrr::transpose(NestedData(d[[1]], children = d$children))
    }
  }
  subdats <- lapply(children, g)
  oplus <- ifelse(lengths(subdats), "⊕", "")
  cbind(" " = oplus, dat, "_details" = I(subdats),
        stringsAsFactors = FALSE)
}

df <- data.frame(
  COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
  NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
  AGE = c(20, 21, 18, 35, 40, 33, 27),
  DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
  stringsAsFactors = FALSE
)

children <- lapply(split(df, df$COUNTRY), "[", -1)
dat0 <- data.frame(COUNTRY = names(children))

Dat <- NestedData(dat = dat0, children = unname(children))

library(DT)

## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)

## the callback
parentRows <- which(Dat[,1] != "")
callback <- JS(
  "function df2list(df){",
  "  var list = {};",
  "  var colnames = Object.keys(df[0]);",
  "  for(let i=0; i < colnames.length; i++){",
  "    var column = [], colname = colnames[i];",
  "    for(let j=0; j < df.length; j++){",
  "      column.push(df[j][colname]);",
  "    }",
  "    list[colname] = column;",
  "  }",
  "  return list;",
  "}",
  "function isNumeric(column){",
  "  return column.every($.isNumeric);",
  "}",
  "function isDate(column){",
  "  return column.every(function(x){return moment(x, 'yyyy-mm-dd').isValid();});",
  "}",
  sprintf("var parentRows = [%s];", toString(parentRows-1)),
  sprintf("var j0 = %d;", colIdx),
  "var nrows = table.rows().count();",
  "for(let i = 0; i < nrows; ++i){",
  "  var $cell = table.cell(i,j0).nodes().to$();",
  "  if(parentRows.indexOf(i) > -1){",
  "    $cell.css({cursor: 'pointer'});",
  "  }else{",
  "    $cell.removeClass('details-control');",
  "  }",
  "}",
  "",
  "// --- make the table header of the nested table --- //",
  "var formatHeader = function(d, childId){",
  "  if(d !== null){",
  "    var html = ",
  "      ' '; "," var data = d [d.length-1] | | d._details; "," for (введите данные [0]) {"," html + = '' + key + ''; ","} "," html + = '' "," return html; ","} else {"," return ''; ","} ","}; "," "," // - - обратный вызов строки для стиля строк дочерних таблиц --- // "," var rowCallback = function (row, dat, displayNum, index) {"," if ($ (row) .hasClass ('odd')) { "," $ (row). css ('background-color', 'papayawhip'); "," $ (row) .hover (function () {"," $ (this). css ('' background-color ',' # E6FF99 '); ","}, function () {"," $ (это). css (' background-color ',' papayawhip '); ","}); " , "} else {", "$ (строка). css ('цвет фона', 'лимонный шифон');", "$ (строка) .hover (function () {", "$ (this). css ('цвет фона', '# DDFF75'); ","}, function () {"," $ (this). css ('цвет фона', 'лимонно-шифон'); ", "});", "}", "};", "", "// --- обратный вызов заголовка для стиля заголовка дочерних таблиц --- //", "var headerCallback = function (thead, data, start , end, display) {"," $ ('th', thead). css ({"," 'border-top': '3px solid indi go', "," 'color': 'indi go', "," 'background-color': '#fadadd' ","}); ","}; "," "," // --- сделаем the datatable --- // "," var formatDatatable = function (d, childId) {"," var data = d [d.length-1] || d._details; "," var colNames = Object.keys (data [0]); "," var columns = colNames.map (function (x) {"," return {data: x.replace (/ \\. / g, '\\\\\\.'), title: x}; ","}); "," var dataColumns = df2list (data); "," var yadcfOptions = Object.entries (dataColumns) .map ("," function (x, index) {"," var type = 'multi_select'; "," if (isNumeri c (x [1])) {"," type = 'range_number_slider'; "," } else if (isDate (x [1])) {"," type = 'range_date'; ","} "," return {"," column_number: index, "," filter_type: type, "," date_format: 'yyyy-mm-dd', "," datepicker_type: 'jquery -ui' ","}; ","} ","); "," var id = 'table #' + childId; "," if (colNames.indexOf ('_ details') === -1) {"," var subtable = $ (id) .DataTable ({"," 'dom': 't', "," 'data': data , "," 'columns': columns, "," 'fixedHeader': true, "," 'autoWidth': true, "," 'deferRender': true, "," 'info': false, "," ' lengthChange ': false, ","' ordering ': data.length> 1, ","' order ': [], ","' paging ': false, ","' scrollX ': false, ","' scrollY ': false, ","' searchi ng ': true, ","' sortClasses ': false, ","' rowCallback ': rowCallback, ","' headerCallback ': headerCallback, ","' columnDefs ': [{цели:' _all ', className:' dt-center '}] ","}); "," yadcf.init (subtable, yadcfOptions); ","} else {"," var subtable = $ (id) .DataTable ({","' data ') : data, "," 'columns': columns, "," 'autoWidth': true, "," 'deferRender': true, "," 'info': false, ", "'lengthChange': false,", "'ordering': data.length> 1,", "'order': [],", "'paging': false,", "'scrollX': false,", "'scrollY': false,", "'search': false,", "'sortClasses': false,", "'rowCallback': rowCallback,", "'headerCallback': headerCallback,", "'columnDefs': ["," {target: -1, visible: false}, "," {target: 0, orderable: false, className: 'details-control'}, "," {target: '_all', className: 'dt -center '} ","] ","}). column (0) .nodes (). to $ (). css ({cursor:' pointer '}); ","} ","}; "," "," // --- отобразим дочернюю таблицу при нажатии --- // "," // массив для хранения идентификаторов уже созданных дочерних таблиц "," var children = []; "," table. on ('click', 'td.details-control', function () {"," var tbl = $ (this) .closest ('table'), "," tblId = tbl.attr ('id'), "," td = $ (this), "," row = $ (tbl) .DataTable (). row (td.closest ('tr')), "," rowIdx = row.index (); "," if (row.child.isShown ()) {"," row.child.hide (); "," td. html ('⊕'); ","} else {"," var childId = tblId + '-child-' + rowIdx; "," если (ребенок ren.indexOf (childId) === -1) {"," // этот дочерний элемент еще не создан »,« children.pu sh (childId); »,« row.child (formatHeader (row.data (), childId)). show (); "," td. html ('⊖'); "," formatDatatable (row.data (), childId, rowIdx); ","} else {"," // этот дочерний элемент уже был создан "," row.child (true); "," td. html ('⊖'); ","} ","} ","}); ") dtable < - datatable (Dat, callback = callback, rownames = rowNames, escape = -colIdx-1, extensions = "FixedHeader", options = list (paging = FALSE, search = FALSE, columnDefs = list (list (visible = FALSE, target = ncol (Dat) -1 + colIdx), list (orderable = FALSE, className = "details-control", target = colIdx), list (className = "dt-center", target = "_all")))) dep < - htmltools :: htmlDependency ("yadcf", "0.9.3", c (href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"), script = "jquery .dataTables.yadcf.min. js", stylesheet = " jquery .dataTables.yadcf.min. css ") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dep <- htmltools :: htmlDependency (" jquery - ui "," 1.12.1 ", sr c =" www/shared/jqueryui/ ", script =" jquery -ui. js ", stylesheet =" jquery -ui. css ", package = "блестящий") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dep <- htmltools :: htmlDependency ("moment", "2.27.0", c (href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/ "), script =" moment.min. js ") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dtable </code>

РЕДАКТИРОВАТЬ

Ползунок имеет не ожидаемый вид. Это потому, что jquery -ui загружается после yadcf . Для правильного внешнего вида измените порядок зависимостей:

dep <- htmltools::htmlDependency(
  "jquery-ui", "1.12.1",
  src = "www/shared/jqueryui/",
  script = "jquery-ui.js",
  stylesheet = "jquery-ui.css",
  package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
  "yadcf", "0.9.3",
  c(href =  "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
  script = "jquery.dataTables.yadcf.min.js",
  stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
  "moment", "2.27.0",
  c(href =  "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
  script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))

РЕДАКТИРОВАТЬ

Вот способ иметь фильтры только для столбцов NAME и AGE:

NestedData <- function(dat, children){
  stopifnot(length(children) == nrow(dat))
  g <- function(d){
    if(is.data.frame(d$data)){
      list(data = purrr::transpose(d$data), filters = as.list(d$filters))
    }else{
      purrr::transpose(NestedData(d[[1]], children = d$children))
    }
  }
  subdats <- lapply(children, g)
  oplus <- ifelse(lengths(subdats), "&oplus;", "")
  cbind(" " = oplus, dat, "_details" = I(subdats),
        stringsAsFactors = FALSE)
}

df <- data.frame(
  COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
  NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
  AGE = c(20, 21, 18, 35, 40, 33, 27),
  DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
  stringsAsFactors = FALSE
)

children <- lapply(split(df, df$COUNTRY), function(d){
  list(data = d[-1], filters = c("NAME", "AGE"))
})
dat0 <- data.frame(COUNTRY = names(children))

Dat <- NestedData(dat = dat0, children = unname(children))

library(DT)

## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)

## the callback
parentRows <- which(Dat[,1] != "")
callback <- JS(
  "function df2list(df){",
  "  var list = {};",
  "  var colnames = Object.keys(df[0]);",
  "  for(let i=0; i < colnames.length; i++){",
  "    var column = [], colname = colnames[i];",
  "    for(let j=0; j < df.length; j++){",
  "      column.push(df[j][colname]);",
  "    }",
  "    list[colname] = column;",
  "  }",
  "  return list;",
  "}",
  "function isNumeric(column){",
  "  return column.every($.isNumeric);",
  "}",
  "function isDate(column){",
  "  return column.every(function(x){return moment(x, 'yyyy-mm-dd').isValid();});",
  "}",
  sprintf("var parentRows = [%s];", toString(parentRows-1)),
  sprintf("var j0 = %d;", colIdx),
  "var nrows = table.rows().count();",
  "for(let i = 0; i < nrows; ++i){",
  "  var $cell = table.cell(i,j0).nodes().to$();",
  "  if(parentRows.indexOf(i) > -1){",
  "    $cell.css({cursor: 'pointer'});",
  "  }else{",
  "    $cell.removeClass('details-control');",
  "  }",
  "}",
  "",
  "// --- make the table header of the nested table --- //",
  "var formatHeader = function(d, childId){",
  "  if(d !== null){",
  "    var html = ",
  "      '<table class=\"display compact hover\" ' + ",
  "      'style=\"padding-left: 30px;\" id=\"' + childId + ",
  "      '\"><thead><tr>';",
  "    var children = d[d.length-1] || d._details;",
  "    var data = children.data;",
  "    for(let key in data[0]){",
  "      html += '<th>' + key + '</th>';",
  "    }",
  "    html += '</tr></thead></table>'",
  "    return html;",
  "  } else {",
  "    return '';",
  "  }",
  "};",
  "",
  "// --- row callback to style rows of child tables --- //",
  "var rowCallback = function(row, dat, displayNum, index){",
  "  if($(row).hasClass('odd')){",
  "    $(row).css('background-color', 'papayawhip');",
  "    $(row).hover(function(){",
  "      $(this).css('background-color', '#E6FF99');",
  "    }, function(){",
  "      $(this).css('background-color', 'papayawhip');",
  "    });",
  "  } else {",
  "    $(row).css('background-color', 'lemonchiffon');",
  "    $(row).hover(function(){",
  "      $(this).css('background-color', '#DDFF75');",
  "    }, function(){",
  "      $(this).css('background-color', 'lemonchiffon');",
  "    });",
  "  }",
  "};",
  "",
  "// --- header callback to style header of child tables --- //",
  "var headerCallback = function(thead, data, start, end, display){",
  "  $('th', thead).css({",
  "    'border-top': '3px solid indigo',",
  "    'color': 'indigo',",
  "    'background-color': '#fadadd'",
  "  });",
  "};",
  "",
  "// --- make the datatable --- //",
  "var formatDatatable = function(d, childId){",
  "  var children = d[d.length-1] || d._details;",
  "  var data = children.data;",
  "  var colNames = Object.keys(data[0]);",
  "  var columns = colNames.map(function(x){",
  "    return {data: x.replace(/\\./g, '\\\\\\.'), title: x};",
  "  });",
  "  var dataColumns = df2list(data);",
  "  var hasChild = colNames.indexOf('_details') > -1;",
  "  var filters = children.filters;",
  "  var yadcfOptions = Object.entries(dataColumns).map(",
  "    function(x, index){",
  "      if($.inArray(x[0], filters) === -1 || (hasChild && (index === 0 || x[0] === '_details'))) return null;",
  "      var type = 'multi_select';",
  "      if(isNumeric(x[1])){",
  "        type = 'range_number_slider';",
  "      }else if(isDate(x[1])){",
  "        type = 'range_date';",
  "      }",
  "      return {",
  "        column_number: index,",
  "        filter_type: type,",
  "        date_format: 'yyyy-mm-dd',",
  "        datepicker_type: 'bootstrap-datepicker'",
  "      };",
  "    }",
  "  ).filter(function(x){return x !== null;});",
  "  var id = 'table#' + childId;",
  "  var options = {",
  "    'dom': 't',",
  "    'data': data,",
  "    'columns': columns,",
  "    'autoWidth': true,",
  "    'deferRender': true,",
  "    'info': false,",
  "    'lengthChange': false,",
  "    'ordering': data.length > 1,",
  "    'order': [],",
  "    'paging': false,",
  "    'scrollX': false,",
  "    'scrollY': false,",
  "    'searching': true,",
  "    'sortClasses': false,",
  "    'rowCallback': rowCallback,",
  "    'headerCallback': headerCallback",
  "  };",
  "  if(!hasChild){",
  "    var columnDefs = ",
  "      {'columnDefs': [{targets: '_all', className: 'dt-center'}]};",
  "    var subtable = $(id).DataTable(",
  "      $.extend(options, columnDefs)",
  "    );",
  "    yadcf.init(subtable, yadcfOptions);",
  "  } else {",
  "    var columnDefs = {",
  "      'columnDefs': [",
  "        {targets: -1, visible: false},",
  "        {targets: 0, orderable: false, className: 'details-control'},",
  "        {targets: '_all', className: 'dt-center'}",
  "      ]};",
  "    var subtable = $(id).DataTable(",
  "      $.extend(options, columnDefs)",
  "    ).column(0).nodes().to$().css({cursor: 'pointer'});",
  "  }",
  "};",
  "",
  "// --- display the child table on click --- //",
  "// array to store id's of already created child tables",
  "var children = [];",
  "table.on('click', 'td.details-control', function(){",
  "  var tbl = $(this).closest('table'),",
  "      tblId = tbl.attr('id'),",
  "      td = $(this),",
  "      row = $(tbl).DataTable().row(td.closest('tr')),",
  "      rowIdx = row.index();",
  "  if(row.child.isShown()){",
  "    row.child.hide();",
  "    td.html('&oplus;');",
  "  } else {",
  "    var childId = tblId + '-child-' + rowIdx;",
  "    if(children.indexOf(childId) === -1){",
  "      // this child has not been created yet",
  "      children.push(childId);",
  "      row.child(formatHeader(row.data(), childId)).show();",
  "      td.html('&CircleMinus;');",
  "      formatDatatable(row.data(), childId, rowIdx);",
  "    }else{",
  "      // this child has already been created",
  "      row.child(true);",
  "      td.html('&CircleMinus;');",
  "    }",
  "  }",
  "});")

dtable <- datatable(
  Dat,
  callback = callback, rownames = rowNames, escape = -colIdx-1,
  options = list(
    paging = FALSE,
    searching = FALSE,
    columnDefs = list(
      list(
        visible = FALSE,
        targets = ncol(Dat)-1+colIdx
      ),
      list(
        orderable = FALSE,
        className = "details-control",
        targets = colIdx
      ),
      list(
        className = "dt-center",
        targets = "_all"
      )
    )
  )
)

dep <- htmltools::htmlDependency(
  "jquery-ui", "1.12.1",
  src = "www/shared/jqueryui/",
  script = "jquery-ui.js",
  stylesheet = "jquery-ui.css",
  package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
  "yadcf", "0.9.3",
  c(href =  "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
  script = "jquery.dataTables.yadcf.min.js",
  stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
  "moment", "2.27.0",
  c(href =  "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
  script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))

dtable
...