How about a example of data tables child row?

[CptanPanic]

Something like https://datatables.net/examples/api/row_details.html

http://stackoverflow.com/questions/23635552/shiny-datatable-with-child-rows-using-ajax

[yihui]

You may try the new DT package: http://rstudio.github.io/DT/

Here is one example: http://rstudio.github.io/DT/002-rowdetails.html

[aditya-kothari]

In the example below, same number of child rows (in this case 1 row) are present for every parent row.

http://rstudio.github.io/DT/002-rowdetails.html

Is there a way to add dynamic child rows to the parent row from another data frame? in R? meaning one parent row can have 6 (lets day) child rows based on data in parent row and another parent row can have 2 or may be no rows based on data in their respective parent rows.

Thanks for your time!

[davlee1972]

I just finished an example trying to do the same thing sort of..

Grouped mpg, cyl, disp together. Shows all matching cars under each group. There should be some way to iterate through nested levels of columns containing data.tables, but the javascript necessary to do this is beyond me..

mtcars_nested.R.txt

[davlee1972]

Ok got this working.. Took mtcars and grouped it by mpg and cyl to create a data table. If you click on the + icon the child rows for the cars show up as another nested data table.

mtcars_nested_datatable.R.txt

I got up hung up for almost a day trying to figure out why datatable() was only working on the first set of cars. Turns out <table id="child_21_6"> works in jquery, but <table id="child_22.8_4"> doesn't work. Had to reformat the id value to "child_22_8_4" to get rid of the decimal points.

[davlee1972]

More complex example with multiple levels of nesting.. This assumes the first column of every nested table is a detail-control class (+) and the last column is the next level of nested data.

datatable(
  data = my_data_dt,
  escape = -1,
  extensions = c('FixedHeader', 'Buttons', 'ColReorder', 'Scroller'),
  options = list(
    dom = 'Bfrti',
    autoWidth = FALSE,
    colReorder = TRUE,
    deferRender = TRUE,
    scrollX = TRUE,
    scrollY = "51vh",
    scroller = TRUE,
    scollCollapse = TRUE,
    fixedHeader = TRUE,
    buttons = c(I('colvis'), 'copy', 'csv', 'excel', 'pdf', 'print'),
    columnDefs = list(
      list(orderable = FALSE, className = 'details-control', targets = 0)
    )
  ),
  callback = JS("
table.column(1).nodes().to$().css({cursor: 'pointer'});

// Format child object into another table
var format = function(d) {
  if(d != null){ 
    var result = '<table id=\"' + d[1] + '\"><thead><tr>'
    for (var col in d[d.length - 1][0]){
      result += '<th>' + col + '</th>'
    }
    result += '</tr></thead></table>'
    return result
  }else{
    return '';
  }
}

var format_datatable = function(d) {
  if(d != null){ 
    var subtable = $('table#' + d[1]).DataTable({
      'data': d[d.length - 1].map(Object.values),
      'autoWidth': false, 
      'deferRender': true, 
      'info': false, 
      'lengthChange': false, 
      'ordering': false, 
      'paging': false, 
      'scrollX': false, 
      'scrollY': false, 
      'searching': false ,
      'columnDefs': [{'orderable': false, 'className': 'details-control', 'targets': 0}]
    });
  }
};

table.on('click', 'td.details-control', function() {
  var table = $(this).closest('table');
  var td = $(this)
  var row = $(table).DataTable().row(td.closest('tr'));
  if (row.child.isShown()) {
    row.child.hide();
    td.html('&oplus;');
  } else {
    row.child(format(row.data())).show();
    td.html('&CircleMinus;');
    format_datatable(row.data())
  }
});

")
  )
})

[bogdanrau]

@davlee1972 Can you post the code to get my_data_dt in your 'more complex' example? I've been trying to wrap my head around it for over an hour and can't seem to get that example to run. Thanks for your examples!

[davlee1972]

Here's an updated version, but it isn't perfect..
Need to somehow detect which child tables are the last node in the tree
Need to come up with better unique table id instead of relying on the first column value in a table.
Need to use a real browser to see how this works. The built in browser for RStudio doesn't render properly.

`
library(data.table)
library(DT)
library(shiny)

ui <- fluidPage(fluidRow(DT::dataTableOutput(width = "100%", "table")))

server <- function(input, output) {

output$table = DT::renderDataTable({

mtcars_dt = data.table(mtcars)
setkey(mtcars_dt,mpg,cyl)
mpg_dt = unique(mtcars_dt[, list(mpg, cyl)])
setkey(mpg_dt, mpg, cyl)
cyl_dt = unique(mtcars_dt[, list(cyl)])
setkey(cyl_dt, cyl)

mtcars_dt = mtcars_dt[,list(mtcars=list(.SD)), by = list(mpg,cyl)]
mtcars_dt[, ' ' := '►']

mpg_dt = merge(mpg_dt,mtcars_dt, all.x = TRUE )
setkey(mpg_dt, cyl)
setcolorder(mpg_dt, c(length(mpg_dt),c(1:(length(mpg_dt) - 1))))

mpg_dt = mpg_dt[,list(mpg=list(.SD)), by = cyl]
mpg_dt[, ' ' := '►']

cyl_dt = merge(cyl_dt,mpg_dt, all.x = TRUE )
setcolorder(cyl_dt, c(length(cyl_dt),c(1:(length(cyl_dt) - 1))))

DT::datatable(
  data = cyl_dt,
  rownames = FALSE,
  escape = -1,
  extensions = c('Scroller'),
  options = list(
    dom = 'Bfrti',
    autoWidth = TRUE,
    stripeClasses = list(),
    deferRender = TRUE,
    scrollX = TRUE,
    scrollY = "51vh",
    scroller = TRUE,
    scollCollapse = TRUE,
    columnDefs = list(
      list(orderable = FALSE, className = 'details-control', targets = 0),
      list(visible = FALSE, targets = -1 )
    )
  ),
  callback = JS("
table.column(1).nodes().to$().css({cursor: 'pointer'})

// Format child object into another table
var format = function(d) {
  if(d != null){ 
    var result = ('<table id=\"' + d[1] + '\"><thead><tr>').replace('.','_')
    for (var col in d[d.length - 1][0]){
      result += '<th>' + col + '</th>'
    }
    result += '</tr></thead></table>'
    return result
  }else{
    return ''
  }
}

var format_datatable = function(d) {
  if(d != null){
    if ('SOME CHECK' == 'LAST SET OF CHILD TABLES') {
      var subtable = $(('table#' + d[1]).replace('.','_')).DataTable({
        'data': d[d.length - 1].map(Object.values),
        'autoWidth': false, 
        'deferRender': true, 
        'stripeClasses': [],
        'info': false, 
        'lengthChange': false, 
        'ordering': false, 
        'paging': false, 
        'scrollX': false, 
        'scrollY': false, 
        'searching': false 
      }).draw()
    }else{
      var subtable = $(('table#' + d[1]).replace('.','_')).DataTable({
        'data': d[d.length - 1].map(Object.values),
        'autoWidth': false, 
        'deferRender': true,
        'stripeClasses': [],
        'info': false, 
        'lengthChange': false, 
        'ordering': false, 
        'paging': false, 
        'scrollX': false, 
        'scrollY': false, 
        'searching': false,
        'columnDefs': [{'orderable': false, 'className': 'details-control', 'targets': 0},
        {'visible': false, 'targets': -1}]
      }).draw()
    }
  }
}

table.on('click', 'td.details-control', function() {
  var table = $(this).closest('table')
  var td = $(this)
  var row = $(table).DataTable().row(td.closest('tr'))
  if (row.child.isShown()) {
    row.child.hide()
    td.html('&#9658;')
  } else {
    row.child(format(row.data())).show()
    format_datatable(row.data())
    td.html('&#9660;')
  }
})

")
  )

})
}

shinyApp (ui = ui, server = server)
`

[stanstrup]

Hi,

I have taken the fantastic example from @davlee1972's mtcars_nested_datatable.R.txt and changed the table manipulation to dplyr/tidyr style and I have generalized the call back so that it is now plug'n'play for nested tables.

Now my question is if it would be possible to get multiple layers of nesting for this example? Preferably automatically turning all nested tables recursively into child rows.

library(DT)
library(tidyr)
library(dplyr)
library(tibble)

# nested data
mtcars_dt <- mtcars %>% 
                        rownames_to_column("model") %>% 
                        as_data_frame %>% 
                        select(mpg, cyl, model, everything()) %>% 
                        nest(-mpg, -cyl)


# add control column
data <- mtcars_dt %>% {bind_cols(data_frame(' ' = rep('&oplus;',nrow(.))),.)}

# get dynamic info and strings
nested_columns         <- which(sapply(data,class)=="list") %>% setNames(NULL)
not_nested_columns     <- which(!(seq_along(data) %in% c(1,nested_columns)))
not_nested_columns_str <- not_nested_columns %>% paste(collapse="] + '_' + d[") %>% paste0("d[",.,"]")

# The callback
# turn rows into child rows and remove from parent
callback <- paste0("
                    table.column(1).nodes().to$().css({cursor: 'pointer'});
                
                    // Format data object (the nested table) into another table
                    var format = function(d) {
                      if(d != null){ 
                        var result = ('<table id=\"child_' + ",not_nested_columns_str," + '\">').replace('.','_') + '<thead><tr>'
                        for (var col in d[",nested_columns,"]){
                          result += '<th>' + col + '</th>'
                        }
                        result += '</tr></thead></table>'
                        return result
                      }else{
                        return '';
                      }
                    }
                
                    var format_datatable = function(d) {
                      var dataset = [];
                      for (i = 0; i < + d[",nested_columns,"]['model'].length; i++) {
                        var datarow = [];
                        for (var col in d[",nested_columns,"]){
                          datarow.push(d[",nested_columns,"][col][i])
                        }
                        dataset.push(datarow)
                      }
                      var subtable = $(('table#child_' + ",not_nested_columns_str,").replace('.','_')).DataTable({
                        'data': dataset,
                        'autoWidth': true, 
                        'deferRender': true, 
                        'info': false, 
                        'lengthChange': false, 
                        'ordering': true, 
                        'paging': false, 
                        'scrollX': false, 
                        'scrollY': false, 
                        'searching': false 
                      });
                    };
                
                    table.on('click', 'td.details-control', function() {
                      var td = $(this), row = table.row(td.closest('tr'));
                      if (row.child.isShown()) {
                        row.child.hide();
                        td.html('&oplus;');
                      } else {
                        row.child(format(row.data())).show();
                        td.html('&CircleMinus;');
                        format_datatable(row.data())
                      }
                    });"
                  )


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

[stanstrup]

This breaks if a nested table also contains a nested table. No data is shown for such a row. Any ideas?
To not get an error I also needed to lower nested_columns by one if I had additional nested tables.

[davlee1972]

Did you convert the version in the mtcars_nested_datatable.R.txt or the latest version I posted from June 17th?

The posted version from June 17th supports multiple levels of nesting ( 3 levels) assuming the last column of each row contains a nested table. If the cell of data is NULL (aka doesn't contain a nested table) then it doesn't render a arrow icon nor tries to format data into another nested table..

Note that the detail-control is not added to a row if it doesn't have a nested table in the last column.
/* Adds detail control to a child table */
mtcars_dt[, ' ' := '►']
/*Left outer join merge child with parent. If the a parent has no children then detail-control column ends up as NULL so there is nothing to click for that parent */
mpg_dt = merge(mpg_dt,mtcars_dt, all.x = TRUE )

The rest is managed in JavaScript

On any details-control click:
Maps last column in the clicked row to an object if that last column contains a non-NULL nested data table:
'data': d[d.length - 1].map(Object.values),

Adds detail control to the child table's first column which should contain a &#9658 arrow icon for rows that contain a nested table in the last column.
'columnDefs': [{'orderable': false, 'className': 'details-control', 'targets': 0},

[stanstrup]

I took the first version. On my computer the 2nd version seems to have the same issue I am experiencing with the data you posted. The data is never shown for the nested table:

I wonder if something was changed since then that could have broken it.

[davlee1972]

Run it in Chrome.
"Need to use a real browser to see how this works. The built in browser for RStudio doesn't render properly."

[stanstrup]

Oh maaan 😬 That worked... Thanks.

I don't think that particular layout will work nicely for my use-case in the end though. So I set up a question on SO for where I am currently stuck: https://stackoverflow.com/questions/46593607/datatable-with-nesting-child-rows-and-modal
The Java scripting is surpassing my hacking skills...

[davlee1972]

You can inject formatting for every single table depending on how you want it to look.. Floating / repeating headers, justification, etc..
https://rstudio.github.io/DT/
https://datatables.net/

I think these are my usual suspects for formatting..

  extensions = c('FixedHeader', 'Buttons', 'ColReorder', 'Scroller'),
  options = list(
    dom = 'Bfrti',
    stripeClasses = list(),
    autoWidth = TRUE,
    colReorder = TRUE,
    deferRender = TRUE,
    scrollX = TRUE,
    scrollY = "51vh",
    scroller = TRUE,
    scollCollapse = TRUE,

[stanstrup]

Thanks again. I used your last example now and I think I more or less understand. It is working as designed.

Is there an easy way to set a maximum number of sub-grouping? So that for my use-case I can limit it to one layer of grouping and the have another layer of nesting I want to look at using a modal.

[stanstrup]

OK I managed to get the one level of grouping only by remove the lines in the java script.

 // 'columnDefs': [{'orderable': false, 'className': 'details-control', 'targets': 0},
 // {'visible': false, 'targets': -1}]

[gryslik]

Hi,

Is there a way to get this to work with the 'FixedColumns' extensions? I find that when I do that the row ordering breaks if I look at it in the browser and it stops working if I do it just in R.

Observe the following for a full example:

library(DT)
temp <- datatable(
  escape = -2,
  cbind(' ' = '&oplus;', mtcars),
  extensions = c('FixedColumns'),
  options = list(
    columnDefs = list(
      list(visible = FALSE, targets = c(0, 2, 3)),
      list(orderable = FALSE, className = 'details-control', targets = 1)
    ),
    dom ='Bfrtip',
    fixedColumns = list(leftColumns = 3, rightColumns = 0),
    pageLength = 1000, scrollX = TRUE,
    deferRender = TRUE,
    scrollY = "250px",
    scroller = TRUE
  ),
  callback = JS("
                table.column(1).nodes().to$().css({cursor: 'pointer'});
                var format = function(d) {
                return '<div style=\"background-color:#eee; padding: .5em;\"> Model: ' +
                d[0] + ', mpg: ' + d[2] + ', cyl: ' + d[3] + '</div>';
                };
                table.on('click', 'td.details-control', function() {
                var td = $(this), row = table.row(td.closest('tr'));
                if (row.child.isShown()) {
                row.child.hide();
                td.html('&oplus;');
                } else {
                row.child(format(row.data())).show();
                td.html('&CircleMinus;');
                }
                });"
))

[Plum57]

davelee1972,

Just came across this and I've not been able to get your example from june 17th to work. When I launch it, the table immediately fails with the error: "DataTables warning: table id = DataTables_Table_0 - Error in [<-.data.frame(*tmp*,,j,value = list(structure(list(' ' = c("►",: replacement element 1 is a matrix/data frame of 9 rows, need 3. "

I'm not sure what what is causing the error.

[davlee1972]

I just copied and pasted the June 17th code into my rstudio and ran it. It still works in a chrome browser..

Running R version 3.3.3
data.table version 1.10.4
dplyr version 0.5.0

[Plum57]

What version of DT are you using?

my versions are:
R 3.4.3
DT 0.4
dplyr 0.7.4
data.table 1.10.4-3

[davlee1972]

R 3.3.3 on my PC
DT 0.2
dplyr 0.5.0
data.table 1.10.4

I get the same error after upgrading just packages to the latest version. Not sure if i have time to debug this this week..

If I look at cyl_dt and cyl_dt[1]$mpg it has:

cyl_dt
cyl mpg
1: ► 4 <data.table>
2: ► 6 <data.table>
3: ► 8 <data.table>

cyl_dt[1]$mpg
[[1]]
mpg mtcars
1: ► 21.4 <data.table>
2: ► 21.5 <data.table>
3: ► 22.8 <data.table>
4: ► 24.4 <data.table>
5: ► 26.0 <data.table>
6: ► 27.3 <data.table>
7: ► 30.4 <data.table>
8: ► 32.4 <data.table>
9: ► 33.9 <data.table>

This should be correct.. Clicking on the first row should produce a child data table with nine records. It looks like it is somehow iterating through the data structure and maybe trying to add extra columns to the parent table of 3 records from the child record of 9 rows.

[Plum57]

Thanks Dave. I'll be working on it some myself. I will let you know if I solve it.

[davlee1972]

Here's a partial fix. with one outstanding item.

Headers and columns aren't aligning unless you resize the window..

I ended up getting rid of all the nested data tables and converted everything to JSON strings and then used Javascript to convert JSON strings into Objects.

library(data.table)
library(DT)
library(shiny)
library(jsonlite)

ui <- fluidPage(fluidRow(DT::dataTableOutput(width = "100%", "table")))

server <- function(input, output) {

output$table = DT::renderDataTable({

mtcars_dt = data.table(mtcars)
setkey(mtcars_dt,mpg,cyl)
mpg_dt = unique(mtcars_dt[, list(mpg, cyl)])
setkey(mpg_dt, mpg, cyl)
cyl_dt = unique(mtcars_dt[, list(cyl)])
setkey(cyl_dt, cyl)

mtcars_dt = mtcars_dt[, toJSON(.SD), by = list(mpg,cyl)]
setnames(mtcars_dt,'V1','mtcars')
mtcars_dt[, ' ' := '&#9658;']

mpg_dt = merge(mpg_dt,mtcars_dt, all.x = TRUE )
setkey(mpg_dt, cyl)
setcolorder(mpg_dt, c(length(mpg_dt),c(1:(length(mpg_dt) - 1))))

mpg_dt = mpg_dt[, toJSON(.SD), by = cyl]
setnames(mpg_dt,'V1','mpg')
mpg_dt[, ' ' := '&#9658;']

cyl_dt = merge(cyl_dt,mpg_dt, all.x = TRUE )
setcolorder(cyl_dt, c(length(cyl_dt),c(1:(length(cyl_dt) - 1))))

DT::datatable(
  data = cyl_dt,
  rownames = FALSE,
  escape = FALSE,
  options = list(
    dom = 'Bfrti',
    autoWidth = TRUE,
    stripeClasses = list(),
    deferRender = TRUE,
    scrollX = TRUE,
    scrollY = "51vh",
    scroller = TRUE,
    scollCollapse = TRUE,
    columnDefs = list(
      list(orderable = FALSE, className = 'details-control', targets = 0),
      list(visible = FALSE, targets = -1 )
    )
  ),
  callback = JS("
table.column(01).nodes().to$().css({cursor: 'pointer'})

var table_id = 1000

// Format child object into another table
var format = function(table_id, columns) {
  if(columns != null){ 
    var result = ('<table id=\"' + table_id + '\"><thead><tr>')
    for (var i in columns){
      result += '<th>' + columns[i] + '</th>'
    }
    result += '</tr></thead></table>'
    return result
  }else{
    return ''
  }
}

var format_datatable = function( table_id, newtable, columns) {
  if(newtable != null){

    var column_defs = []

    for (var i in columns)
    {
      if (i == 0)
      {
        column_defs[i] = {'data': columns[i], 'targets': parseInt(i), 'orderable': false, 'className': 'details-control'}
      }
      else if (i == columns.length - 1)
      {
        column_defs[i] = {'data': columns[i], 'targets': parseInt(i), 'visible': false}
      }
      else
      {
        column_defs[i] = {'data': columns[i], 'targets': parseInt(i)}
      }
    }

/*    alert(JSON.stringify(column_defs)) */

    var subtable = $(('table#' + table_id)).DataTable({
      'data': newtable,
      'autoWidth': false, 
      'deferRender': true,
      'stripeClasses': [],
      'info': false, 
      'lengthChange': false, 
      'ordering': false, 
      'paging': false, 
      'scrollX': false, 
      'scrollY': false, 
      'searching': false,
      'columnDefs': column_defs
    }).draw()
  }
}

table.on('click', 'td.details-control', function() {
  var td = $(this)
  var table = $(td).closest('table')
  var row = $(table).DataTable().row(td.closest('tr'))

  if (row.child.isShown()) {
    row.child.hide()
    td.html('&#9658;')
  }
  else
  {
    var row_data = row.data()

    if (!Array.isArray(row_data))
    {
      row_data = Object.keys(row_data).map(function (key) {
        return row_data[key]
      });
    }

    var newtable = JSON.parse(row_data[row_data.length - 1])
    var columns = Object.keys(newtable[0])

    table_id++

    row.child(format(table_id, columns)).show()
    format_datatable(table_id, newtable, columns)
    td.html('&#9660;')
  }

})


")
  )
})
}

shinyApp (ui = ui, server = server)

[amjadtalib]

@davlee1972 @Plum57
As someone who's spent the better part of the past 48 hours pouring over R/Shiny code looking for a problem that wasn't there, I wish more than anything that I had rechecked this thread first..

I had to roll back to DT 0.2 to get my app working again. I'm not sure what exactly broke the package, but my hunch is it may have to do with a change to the actual DataTables js itself. As evidenced in this screenshot, they seem to have changed their site and featured our culprit functionality on the homepage...

If this bug is resolved or there's a workaround without having to convert everything to json first, please share!

[joelnc]

This may be an easy one for some on this thread (apparently not me).

Making a very simple modification of @stanstrup's 2018-10-5 example (built off of @davlee1972's previous example), I tried adding an additional grouping variable using disp.

mtcars_dt <- mtcars %>% 
                        rownames_to_column("model") %>% 
                        as_data_frame %>% 
                        select(mpg, cyl, model, disp, everything()) %>% 
                        nest(-mpg, -cyl, -disp)

This works partially, creating a 31 row nested table. There is a two row child table for mpg/cyc/disp 21/6/160 (the only duplicate in this grouping), and several 1 row child tables as needed. But for 12 of the rows where there would be only one row in the child table, child tables are just headers with no data. Anyone see the problem?

[piyuw]

@joelnc yes i have a smilar issue,

Ive used @davlee1972 example and substituted my own data to get a grouping of a few columns

The resulting picture below is the output, but as you can see AccountRefFullname column and fullamount column only has the headers.

in the case of the COGS row, its even missing the fullamount column heading.

These AccountRefFullname column and fullamount headings for the different financial categories (should have multiple should have multiple rows underneath them.

i dont have much of a javascript background and was hoping if anyone might be able to help out.

thanks
piyuw

[stla]

@piyuw 's question is answered here: https://stackoverflow.com/a/56599838/1100107