Shiny datatable with child rows using ajax

Question

I'm trying to use datatables library for shiny with more customization.

Here is the example that I'm trying to make. https://datatables.net/examples/api/row_details.html Note that I have detail info in different data.frame R variables. like this

A= data.frame(Name = c("Airi Satou", "Angelica Ramos","Paul Byrd")
               , Position = c("Accountant","Accountant", "CEO")
               , Office   = c("Tokyo", "Tokyo", "New York"))
A.detail= data.frame(Name = c("Airi Satou", "Angelica Ramos")
               , Extension= c("5407c", "8422")
               , salary   = c(16000, 20000))

I don't like to merge two data.frame variables, if it is possible to do this without merge, because of the computation time. Obviously, some of rows may not have any details.

I can select a row in data table and send the line information to R by binding this as input (thanks to https://github.com/toXXIc/datatables.Selectable/) Then I can find details relevant to selected line in R from the second data.frame variable. but I don't know how to send this back to show on the html (under the selected row). I already binded the first table as shinyoutput so I;m not sure if I can pass another data to change this output again.

Maybe I should use ajax to request more data when detail button is clicked, but I don't know how to do ajax request in shiny.

Answer 1

Before answering your questions, I would like to point out that the current version of Shiny (0.10.1) on CRAN uses an older version of DataTables.js (1.0.9), whereas the example you have mentioned uses DataTables.js 1.10. There is a considerable proportion of API in DataTables 1.10 that is incompatible with version 1.0.9.

You can check out this pull request on Github: https://github.com/rstudio/shiny/pull/558 , which provides DataTables.js 1.10 support.

---

First, let's digress a little bit to understand how a data table is rendered in Shiny.

The example uses AJAX request to "pull" data from a server URL, and subsequently binds the data to the table template. This is what so-called server-side data rendering.

Shiny also uses server-side data rendering. However, the major difference between the example you've provided and Shiny, is that the data transferring in Shiny is transparent to you.

Technically, under the hood, Shiny creates an JSON API for AJAX requests by calling shiny:::registerDataObj(). You can find an example of constructing your customized AJAX request here: http://shiny.rstudio.com/gallery/selectize-rendering-methods.html .

Another difference between the example and Shiny, which will later be reflected in the R code, is how they encodes the table content into a JSON blob. The example encodes each line using plain objects. For instance, the first row is encoded as:

{ "name": "Tiger Nixon", "position": "System Architect", "salary": "$320,800", "start_date": "2011\/04\/25", "office": "Edinburgh", "extn": "5421" },

Whereas Shiny encodes each row of your data.frame as an array, e.g., something like,

["Tiger Nixon", "System Architect", "$320,800", "2011\/04\/25", "Edinburgh", "5421"]

The difference in the raw JSON data affects how we would implement the format() function later.

Finally, the example uses a fixed HTML <table> template to render the data table. You may have noticed that only visible columns are included in the template (for example, the Extension number column is not in the <table> template); whereas Shiny creates the template for you and you don't get to decide how your data binding (e.g. { "data": "name" },) is performed.

---

NOTE: The R code below uses a development branch of Shiny which you can find in the above pull request link.

Although we don't get to decide which columns to bind to what data, we can choose which columns to hide by specifying the columnDefs options when you call the DataTable() function. You can pass whatever options that are defined in https://datatables.net/reference/option/ by wrapping them in a list in R.

An example of a Shiny app using your example data is:

ui.R

library(shiny)

format.func <- "
<script type='text/javascript'>
function format ( d ) {
    return '<table cellpadding=\"5\" cellspacing=\"0\" border=\"0\" style=\"padding-left:50px;\">'+
        '<tr>'+
            '<td>Full name:</td>'+
            '<td>'+d[1]+'</td>'+
        '</tr>'+
        '<tr>'+
            '<td>Extension number:</td>'+
            '<td>'+d[4]+'</td>'+
        '</tr>'+
    '</table>';
}
</script>
"

shinyUI(
    fluidPage(
        h5("Data table"),
        dataTableOutput("dt"),
        tags$head(HTML(format.func))
    ) 
)

There is nothing special here except that I've changed the format() function accordingly because, as mentioned before, Shiny sends data as row arrays instead of objects.

server.R

library(shiny)
library(dplyr)

shinyServer(function(input, output, session) {
    A <- data.frame(Name = c("Airi Satou", "Angelica Ramos","Paul Byrd"),
                  Position = c("Accountant","Accountant", "CEO"),
                  Office   = c("Tokyo", "Tokyo", "New York"))

    A.detail <- data.frame(Name = c("Airi Satou", "Angelica Ramos"),
                          Extension = c("5407c", "8422"),
                          Salary    = c(16000, 20000))

    # You don't necessarily need to use left_join. You can simply put every column,
    # including the columns you would by default to hide, in a data.frame.
    # Then later choose which to hide.
    # Here an empty column is appended to the left to mimic the "click to expand"
    # function you've seen in the example.
    A.joined <- cbind("", left_join(A, A.detail, by="Name"))

    columns.to.hide <- c("Extension", "Salary")
    # Javascript uses 0-based index
    columns.idx.hidden <- which(names(A.joined) %in% columns.to.hide) - 1

    # Everytime a table is redrawn (can be triggered by sorting, searching and 
    # pagination), rebind the click event.

    draw.callback <- "
function(settings) {
    var api = this.api();
    var callback = (function($api) {
        return function() {
            var tr = $(this).parent();
            var row = $api.row(tr);
            if (row.child.isShown()) {
                row.child.hide();
                tr.removeClass('shown');
            }
            else {
                row.child(format(row.data())).show();
                tr.addClass('shown');
            }
        }
    })(api);

    $(this).on('click', 'td.details-control', callback);
}"
    # wrap all options you would like to specify in options=list(),
    # which will be converted into corresponding JSON object.
    output$dt <- renderDataTable(A.joined,
        options=list(
            searching=F,
            columnDefs=list(
                            list(targets=0,
                                 title="", class="details-control"),
                            list(targets=columns.idx.hidden,
                                 visible=F)
                         ),
            drawCallback=I(draw.callback)
    ))
})

Now that if you click on the first (empty) column (because I've written no CSS) of your data table, you should be able to see the extra information shown in the expanded area.

---

EDIT: Lazy loading of "more details" information

Above solution involves sending all information to the client, although in most use cases the user may not bother to view the hidden information. Essentially we end up with sending a lot of redundant data to the client side.

A better solution is to implement a AJAX request handler in Shiny, which only returns the information when needed (i.e. as the user requests).

To implement a AJAX request handler, one can use session$registerDataObj. This function registers a request handler at a unique URL, and returns this URL.

In order to call this registered request handler, you need to first send this AJAX URL to the client.

Below I hacked a quick solution: basically you create a hidden <input> element on the webpage on which you can bind a change event listener. The Shiny server updates this <input> element's value by sending a message to the client via the function call session$sendInputMessage. Once the message is received, it changes the value of the <input> element, triggering the event listener. We can then set up the AJAX request URL properly

Afterward, you can initiate any normal AJAX requests to fetch the data you need.

ui.R

library(shiny)

format.func <- "
<script type='text/javascript'>
var _ajax_url = null;

function format ( d ) {
    // `d` is the original data object for the row
    return '<table cellpadding=\"5\" cellspacing=\"0\" border=\"0\" style=\"padding-left:50px;\">'+
        '<tr>'+
            '<td>Full name:</td>'+
            '<td>'+d.Name+'</td>'+
        '</tr>'+
        '<tr>'+
            '<td>Extension number:</td>'+
            '<td>'+d.Extension+'</td>'+
        '</tr>'+
    '</table>';
}

$(document).ready(function() {
  $('#ajax_req_url').on('change', function() { _ajax_url = $(this).val()});
})
</script>
"

shinyUI(
    fluidPage(
        # create a hidden input element to receive AJAX request URL
        tags$input(id="ajax_req_url", type="text", value="", class="shiny-bound-input", style="display:none;"),

        h5("Data table"),
        dataTableOutput("dt"),
        tags$head(HTML(format.func))
    ) 
)

server.R

library(shiny)
library(dplyr)

shinyServer(function(input, output, session) {
    # extra more.details dummy column
    A <- data.frame(more.details="", Name = c("Airi Satou", "Angelica Ramos","Paul Byrd"),
                  Position = c("Accountant","Accountant", "CEO"),
                  Office   = c("Tokyo", "Tokyo", "New York"))

    A.detail <- data.frame(Name = c("Airi Satou", "Angelica Ramos"),
                          Extension = c("5407c", "8422"),
                          Salary    = c(16000, 20000))

    draw.callback <- "
function(settings) {
    var api = this.api();
    var callback = (function($api) {
        return function() {
            var tr = $(this).parent();
            var row = $api.row(tr);
            if (row.child.isShown()) {
                row.child.hide();
                tr.removeClass('shown');
            }
            else {
                // we can use the unique ajax request URL to get the extra information.
                $.ajax(_ajax_url, {
                  data: {name: row.data()[1]},
                  success: function(res) { 
                      row.child(format(res)).show(); 
                      tr.addClass('shown');
                  }
                });
            }
        }
    })(api);

    $(this).on('click', 'td.details-control', callback);
}"

    ajax_url <- session$registerDataObj(
      name = "detail_ajax_handler", # an arbitrary name for the AJAX request handler
      data = A.detail,  # binds your data
      filter = function(data, req) {
        query <- parseQueryString(req$QUERY_STRING)
        name <- query$name

        # pack data into JSON and send.
        shiny:::httpResponse(
          200, "application/json", 
          # use as.list to convert a single row into a JSON Plain Object, easier to parse at client side
          RJSONIO:::toJSON(as.list(data[data$Name == name, ]))
        )        
      }
    )

    # send this UNIQUE ajax request URL to client
    session$sendInputMessage("ajax_req_url", list(value=ajax_url))

    output$dt <- renderDataTable(A,
        options=list(
            searching=F,
            columnDefs=list(
                            list(targets=0,
                                 title="", class="details-control")
                         ),
            drawCallback=I(draw.callback)
    ))
})