问使用ajax的带有子行的出色datatable

EN

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))
    ) 
)

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)
    ))
})

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))
    ) 
)

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)
    ))
})