javascript - Parent/Child Rows in R

Question

I'm trying to use some JavaScript to create a nice table layout with parents/child nesting. I only need one child per parent. I have two data frames. The goal here is to make a table that combines these two data frames. So far I am able to do that. However, the problem here is that I can only get the code to work for one row in df1. When I go to add in another row to df1 I get Error in data.frame: arguments imply differing number of rows: 1, 2. For example, the desired result is achieved when I have only one row in df1 but when there is more than one row I can the error above.

df #1

structure(list(Market = c("ALBANY-SCHENECTADY-TROY, NY", "ALBANY, GA", 
"ALBUQUERQUE-SANTA FE"), Gross = c("$0", "$0", "$0"), Net = c("$0", 
"$0", "$0"), GRP = c(100, 100, 100), `Demo Impressions` = c("957,776", 
"238,792", "1,259,307"), `Gross CPP` = c("$0", "$0", "$0"), `Gross CPM` = c("$0", 
"$0", "$0")), .Names = c("Market", "Gross", "Net", "GRP", "Demo Impressions", 
"Gross CPP", "Gross CPM"), row.names = c(NA, -3L), class = "data.frame")
                       Market Gross Net GRP Demo Impressions Gross CPP Gross CPM
1 ALBANY-SCHENECTADY-TROY, NY    $0  $0 100          957,776        $0        $0
2                  ALBANY, GA    $0  $0 100          238,792        $0        $0
3        ALBUQUERQUE-SANTA FE    $0  $0 100        1,259,307        $0        $0

df #2

structure(list(Daypart = c("Daytime", "Early Fringe", "Early Morning", 
"Early News", "Late Fringe", "Late News", "Prime Access", "Prime Time", 
"Total"), `Share (%)` = c(15L, 10L, 15L, 10L, 10L, 10L, 15L, 
15L, 100L), `Spot:30 (%)` = c(0, 0, 0, 0, 0, 0, 0, 0, 0), `Spot:15 (%)` = c(0, 
0, 0, 0, 0, 0, 0, 0, 0), `Demo Impressions` = c("368,381", "245,588", 
"368,381", "245,588", "245,588", "245,588", "368,381", "368,381", 
"2,455,876"), Gross = c("$0", "$0", "$0", "$0", "$0", "$0", "$0", 
"$0", "$0"), Net = c("$0", "$0", "$0", "$0", "$0", "$0", "$0", 
"$0", "$0"), `Gross CPM` = c("$0", "$0", "$0", "$0", "$0", "$0", 
"$0", "$0", "$-")), .Names = c("Daypart", "Share (%)", "Spot:30 (%)", 
"Spot:15 (%)", "Demo Impressions", "Gross", "Net", "Gross CPM"
), row.names = c(NA, -9L), class = "data.frame")
        Daypart Share (%) Spot:30 (%) Spot:15 (%) Demo Impressions Gross Net Gross CPM
1       Daytime        15           0           0          368,381    $0  $0        $0
2  Early Fringe        10           0           0          245,588    $0  $0        $0
3 Early Morning        15           0           0          368,381    $0  $0        $0
4    Early News        10           0           0          245,588    $0  $0        $0
5   Late Fringe        10           0           0          245,588    $0  $0        $0
6     Late News        10           0           0          245,588    $0  $0        $0
7  Prime Access        15           0           0          368,381    $0  $0        $0
8    Prime Time        15           0           0          368,381    $0  $0        $0
9         Total       100           0           0        2,455,876    $0  $0        $-




# Merge the row details
subdats <- lapply(
  list(df2),
  purrr::transpose
)

# Dataframe for the datatable
Dat <- cbind(
  " " = "&oplus;",
  df1,
  details = I(subdats)
)

callback_js = JS(
  "table.column(1).nodes().to$().css({cursor: 'pointer'});",
  "",
  "// make the table header of the nested table",
  "var format = function(d, childId){",
  "  if(d != null){",
  "    var html = ",
  "      '<table class="display compact hover" id="' + childId + '"><thead><tr>';",
  "    for (var key in d[d.length-1][0]) {",
  "      html += '<th>' + key + '</th>';",
  "    }",
  "    html += '</tr></thead></table>'",
  "    return html;",
  "  } else {",
  "    return '';",
  "  }",
  "};",
  "",
  "// row callback to style the rows of the child tables",
  "var rowCallback = function(row, dat, displayNum, index){",
  "  if($(row).hasClass('odd')){",
  "    $(row).css('background-color', 'white');",
  "    $(row).hover(function(){",
  "      $(this).css('background-color', 'white');",
  "    }, function() {",
  "      $(this).css('background-color', 'white');",
  "    });",
  "  } else {",
  "    $(row).css('background-color', 'white');",
  "    $(row).hover(function(){",
  "      $(this).css('background-color', 'white');",
  "    }, function() {",
  "      $(this).css('background-color', 'white');",
  "    });",
  "  }",
  "};",
  "",
  "// header callback to style the header of the child tables",
  "var headerCallback = function(thead, data, start, end, display){",
  "  $('th', thead).css({",
  "    'border-top': '3px solid indigo',",
  "    'color': 'white',",
  "    'background-color': 'white'",
  "  });",
  "};",
  "",
  "// make the datatable",
  "var format_datatable = function(d, childId){",
  "  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;",
  "    var subtable = $(id).DataTable({",
  "            'data': dataset,",
  "            'autoWidth': true,",
  "            'deferRender': true,",
  "            'info': false,",
  "            'lengthChange': false,",
  "            'ordering': d[n].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",
  "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;",
  "    row.child(format(row.data(), childId)).show();",
  "    td.html('&CircleMinus;');",
  "    format_datatable(row.data(), childId);",
  "  }",
  "});")

# Render the table
output$daypartTable <- DT::renderDataTable({
  Dat <- Dat
  DT::datatable(Dat, callback = callback_js, escape = -2, editable = TRUE,
          options = list(
            columnDefs = list(
              list(visible = FALSE, targets = ncol(Dat)),
              list(orderable = FALSE, className = 'details-control', targets = 1),
              list(className = "dt-center", targets = "_all")
            )
          )
        )
})

The result should look like below but has multiple parent rows, each row from df1, with child rows from df2.

Answer 1

Please find the full code below.

I made a function NestedData which constructs the required dataframe for the datatable with child rows.

In your case, the main table df1 has three rows, and each row of df1 has df2 as child, therefore you have to do:

Dat <- NestedData(
  dat = df1, 
  children = list(df2, df2, df2)
)

The function NestedData can also be used when one wants an arbitrary depth of nesting: children rows of the children rows, children rows of the children rows of the children rows, etc. Moreover it can be used when one wants some rows without children. Here is an example of usage:

Dat <- NestedData(
  dat = dat0, # dat0 has three rows 
  children = list(
    dat01, # child of first row
    list(  # child of second row, which has children itself
      dat02, # dat02 has two rows
      children = list(dat021, dat022)
    ), 
    data.frame(NULL) # no child for the third row
  )
)

---

Here is the code applied to your example:

# function to make the required dataframe
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 <- sapply(subdats, function(x) if(length(x)) "&oplus;" else "")
  cbind(" " = oplus, dat, "_details" = I(subdats), stringsAsFactors = FALSE)
}

# make the required dataframe
# one must have: length(children) == nrow(dat)
# EDIT: need to use replicate() on df2 for cases when there is an arbitrary
# number of rows in df1 
n <-  nrow(df1)
children_list <- replicate(n, df2, simplify = FALSE)
Dat <- NestedData(
  dat = df1, 
  children = children_list
)

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

## make 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(var i=0; i < nrows; ++i){",
  "  if(parentRows.indexOf(i) > -1){",
  "    table.cell(i,j0).nodes().to$().css({cursor: 'pointer'});",
  "  }else{",
  "    table.cell(i,j0).nodes().to$().removeClass('details-control');",
  "  }",
  "}",
  "",
  "// make the table header of the nested table",
  "var format = function(d, childId){",
  "  if(d != null){",
  "    var html = ", 
  "      '<table class="display compact hover" ' + ",
  "      'style="padding-left: 30px;" id="' + childId + '"><thead><tr>';",
  "    for(var key in d[d.length-1][0]){",
  "      html += '<th>' + key + '</th>';",
  "    }",
  "    html += '</tr></thead></table>'",
  "    return html;",
  "  } else {",
  "    return '';",
  "  }",
  "};",
  "",
  "// row callback to style the rows of the 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 the header of the 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 format_datatable = function(d, childId){",
  "  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;",
  "  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,",
  "                 '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': dataset,",
  "            'autoWidth': true,",
  "            'deferRender': true,",
  "            'info': false,",
  "            'lengthChange': false,",
  "            'ordering': d[n].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",
  "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;",
  "    row.child(format(row.data(), childId)).show();",
  "    td.html('&CircleMinus;');",
  "    format_datatable(row.data(), childId);",
  "  }",
  "});")

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