0

I have a question that is basically a sort of follow-up or simplified example of what was discussed here: Parent/Child Rows in R For full transparency, I rather be honest and say I know close to zero of JS, so my apologizes if my question is simple.

I have the following dataframe:

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")   )

(My actual df dataframe is in reality around 2000 rows).

This table is displayed within an R Shiny app:

output$population_table <- renderDataTable({

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

Given the big (and variable) dimension of the dataframe, I would need to group the data by Country so that if the user wants to review data for a specific 'COUNTRY', he/she would just click on it and see all the children rows. The two problems I face with solution Parent/Child Rows in R are:

  1. I don't have df1 and df2
  2. The number of rows of my 'df' dataframe is variable. For this reason, I have no idea of how to adapt that code to my specific example. Thank you for the help.

UPDATE I tried solution shared on Collapsible Datatable in Shiny with Parent/Child relation It kind of works but the problems I face with that solution are:

  1. the horizontal scroll bar disappears completely (my real dataframe has about 60 columns)
  2. Dates column like "date_of_birth" are converted to numbers
  3. Columns filters disappear as well. Could these issues be fixed? Thank you
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
Angelo
  • 1,594
  • 5
  • 17
  • 50

1 Answers1

2

Is it what you want?

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), "&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")
)

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 = ", 
  "      '<table class=\"display compact hover\" ' + ",
  "      'style=\"padding-left: 30px;\" id=\"' + childId + ", 
  "      '\"><thead><tr>';",
  "    var data = d[d.length-1] || d._details;",
  "    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 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,",
  "      'searching': false,",
  "      'sortClasses': false,",
  "      'rowCallback': rowCallback,",
  "      'headerCallback': headerCallback,",
  "      'columnDefs': [{targets: '_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,",
  "      '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'});",
  "  }",
  "};",
  "",
  "// --- 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;');",
  "    }",
  "  }",
  "});")

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"
      )
    )
  )
)

EDIT

You have to use character columns, not factors:

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

Here are the filters. Thanks to the jQuery plugin 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), "&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), "[", -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 = ",
  "      '<table class=\"display compact hover\" ' + ",
  "      'style=\"padding-left: 30px;\" id=\"' + childId + ",
  "      '\"><thead><tr>';",
  "    var data = d[d.length-1] || d._details;",
  "    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 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(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: '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,",
  "      'searching': true,",
  "      'sortClasses': false,",
  "      'rowCallback': rowCallback,",
  "      'headerCallback': headerCallback,",
  "      'columnDefs': [{targets: '_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,",
  "      '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'});",
  "  }",
  "};",
  "",
  "// --- 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,
  extensions = "FixedHeader",
  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(
  "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",
  src = "www/shared/jqueryui/",
  script = "jquery-ui.js",
  stylesheet = "jquery-ui.css",
  package = "shiny")
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

EDIT

The slider has not the expected appearance. This is because jquery-ui is loaded after yadcf. To get the correct appearance, change the orders of the dependencies:

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))

EDIT

Here is a way to have the filters only for columns NAME and 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
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225
  • It's close to what I need but this solution has some issues Stephan. The data in the Date of Birth column shows some numbers and not dates. Also, is there a way to keep the filters at the top of each column ? – Angelo Jul 10 '20 at 15:20
  • @Angelo Set `stringsAsFactors = FALSE` in the `data.frame` statement defining `df`. Then the dates will be correctly rendered. For the filters I don't know right now. I will investigate. – Stéphane Laurent Jul 10 '20 at 15:34
  • Stephane, the problem I see on my end is that the data in the DATE_OF_BIRTH column is completely no sense. It's showing things like 1, 4, ... It seems it's random integer data. I actually see the same problem in the image you shared. Do you see the content of that column ? – Angelo Jul 10 '20 at 15:47
  • @Angelo This works if you do `df <- data.frame(COUNTRY = ..., ..., stringsAsFactors = FALSE)`. – Stéphane Laurent Jul 10 '20 at 15:52
  • I have even added "df <- data.frame(df, check.rows = F, check.names = F, stringsAsFactors = F)" but there's something wrong in the code. Please, review the screenshot you attached above. Data inside columns get completely screwed up Stephane. – Angelo Jul 10 '20 at 16:14
  • @Angelo I know the rendering is not correct on my screenshot. See my edit and copy-paste this code. I swear I get a correct rendering with this code. – Stéphane Laurent Jul 10 '20 at 16:41
  • you're actually right, it works! If we could have the filters available for each column that would be awesome. Thank you Stéphane Laurent – Angelo Jul 10 '20 at 18:17
  • @Angelo See my edit to get a better appearance of the sliders. – Stéphane Laurent Jul 11 '20 at 11:25
  • you are an absolute genius! Thank you! Please, one very high level question, that perhaps should be treated in a separate thread. Do you think with Shiny it's possible to have something like a pivot table where given a table with numbers, if you click on a number you go to another page that shows the rows behind that number? Same way you can basically click on any number in an excel table. – Angelo Jul 13 '20 at 14:31
  • And one question about your most recent edit. Would it be possible to specific the subest of columns for which we want to have the filter? For example, given the dataframe above, have the filter only for the Name and Age columns? – Angelo Jul 13 '20 at 14:36
  • @Angelo I don't understand your first question. For the second one, see my latest edit. – Stéphane Laurent Jul 13 '20 at 20:16
  • Thank you Stepahne! My first question is basically if you think it's possible to replicate the way Excel Pivot table works. Meaning, if you create a pivot table in excel, you can for example aggregate data to get stats like sum by or average by. The beauty of Excel pivot tables is that if you click on any sum or average value, excel will open a new sheet and show you all the rows of the original table used to compute such sum or average. – Angelo Jul 13 '20 at 21:46