Parent/Child Rows in Shiny R with a single dataframe that has a variable number of rows

Question

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:

I don't have df1 and df2
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:

the horizontal scroll bar disappears completely (my real dataframe has about 60 columns)
Dates column like "date_of_birth" are converted to numbers
Columns filters disappear as well. Could these issues be fixed? Thank you

Stéphane Laurent Stéphane Laurent · Accepted Answer · 2020-07-10T14:10:10

Is it what you want?

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.

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

Parent/Child Rows in Shiny R with a single dataframe that has a variable number of rows

1 Answers

EDIT

EDIT

EDIT

EDIT