javascriptrshinydtemoticons

Add icons to the parent rows of a DT table


The problem: Including an emoticon to a parent/child table mutes the child table. How to overcome this difficulty?

The added issue is that the inclusion of virtually any special character leads to the same result. I suspect that the answer is in the call back but it beats my JS skills.

The code:


library(shiny)
library(DT)
library(tidyverse)

### == script knicked from https://github.com/rstudio/shiny-examples/issues/9
shinyApp(
    ui = fluidPage(DT::DTOutput("tbl")),
    server = function(input, output, session) {
        
df <- tibble(names=c("Joan", "Michael", "Vincent"), hex =c("&#129409;","&#129409;","&#129409;"), DOB=c("2020-04-05", "2020-04-05","2020-04-05"))

            df <- df %>%
                as.data.frame() %>%
                nest(-names, -hex)
            
            # add control column
            data <- df %>% {bind_cols(data_frame(' ' = rep('&#9658;',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,"]['DOB'].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': false,
                        '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('&#9658;');
                      } else {
                        row.child(format(row.data())).show();
                        td.html('&#9660;');
                        format_datatable(row.data())
                      }
                    });
                           
                           "
            )
            
            
            DDT <-  datatable(
                data,
                escape = -c(2,4), # raw HTML in column 2
                options = list( paging=FALSE,info = FALSE,
                                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)
            )
            
    
        
        output$tbl <- DT::renderDT({
            DDT
            
        }, server = FALSE, width = 6)
        
        session$onSessionEnded(function() {
            observe(cat(paste0("Ended: ", values$sessionId)))
        })
        
        if(format(Sys.time(), "%M")=='00'){
            onStop(function() {
                dbDisconnect(con)
            })
        }
        
        # you need set the server to FALSE
    },
    options = list(port = 33333)
)

pretty but empty

Any thoughts?


Solution

  • In order to make a datatable with children, it's better to use the method I give on my blog. Currently there are some mistakes in the callback code, I need to update this post, so I provide the full code here for your case:

    library(DT)
    
    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)
    }
    
    
    Dat <- NestedData(
      data.frame(
        names = c("Joan", "Michael", "Vincent"), 
        hex = c("&#129409;","&#129409;","&#129409;"),
        stringsAsFactors = FALSE
      ),
      children = list(
        data.frame(DOB = "2020-04-05", stringsAsFactors = FALSE),
        data.frame(DOB = "2020-04-05", stringsAsFactors = FALSE),
        data.frame(DOB = "2020-04-05", stringsAsFactors = FALSE)
      )
    )
    
    
    ## 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;",
      "  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",
      "  };",
      "  var hasChild = colNames.indexOf('_details') > -1",
      "  if(!hasChild){",
      "    var columnDefs = ",
      "      {'columnDefs': [{targets: '_all', className: 'dt-center'}]};",
      "    var subtable = $(id).DataTable(",
      "      $.extend(options, columnDefs)",
      "    );",
      "  } 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;');",
      "    }",
      "  }",
      "});")
    
    datatable(
      Dat, 
      callback = callback, rownames = rowNames, escape = -c(colIdx+1, 3),
      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"
          )
        )
      )
    )