Quantcast
Channel: R shiny update column value to check-box controls value on child rows on nested table - Stack Overflow
Viewing all articles
Browse latest Browse all 2

Answer by Stéphane Laurent for R shiny update column value to check-box controls value on child rows on nested table

$
0
0
library(DT)library(shiny)shinyCheckbox <- function(id, values) {  inputs <- character(length(values))  for(i in seq_along(inputs)) {    inputs[i] <-       as.character(        checkboxInput(paste0(id, i), label = NULL, value = values[i], width = "20px")      )  }  inputs}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 <- data.frame(  Sr = c(1.5, 2.3),  Description = c("A - B", "X - Y"))## details of row 1subdat1 <- data.frame(  Chromosome = c("chr18","chr4"),  SNP = c("rs2","rs3"),  YN = c(TRUE, FALSE),  stringsAsFactors = FALSE)subdat1$check <- shinyCheckbox("check", subdat1$YN)## details of row 2subdat2 <- data.frame(  Chromosome = c("chr19","chr20"),   SNP = c("rs3","rs4"),  YN = c(TRUE, FALSE),  stringsAsFactors = FALSE)subdat2$check <- shinyCheckbox("check", subdat2$YN)Dat <- NestedData(dat, list(subdat1, subdat2))## whether to show row namesrowNames = FALSEcolIdx <- as.integer(rowNames)## the callbackparentRows <- 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 subtable;","  if(colNames.indexOf('_details') === -1){","    subtable = $(id).DataTable({","      'data': data,","      'columns': columns,","      'autoWidth': true,","      'deferRender': true,","      'info': false,","      'lengthChange': false,","      'ordering': data.length > 1,","      'order': [],","      'paging': false,","      'scrollX': false,","      'scrollY': false,","      'searching': false,","      'sortClasses': false,","      'rowCallback': rowCallback,","      'headerCallback': headerCallback,","      'columnDefs': [{targets: '_all', className: 'dt-center'}]","    });","  } else {","    subtable = $(id).DataTable({","      'data': data,","      'columns': columns,","      'autoWidth': true,","      'deferRender': true,","      'info': false,","      'lengthChange': false,","      'ordering': data.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'});","  }", # THIS IS THE CODE I ADDED TO DEAL WITH THE CHECKBOXES:"  $(id).on('click', '[id^=check]', function(){","    var id = this.getAttribute('id');","    var i = parseInt(/check(\\d+)/.exec(id)[1]);","    var value = $(this).prop('checked');","    subtable.cell(i-1, 2).data(value).draw();","  });","};","","// --- 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 = -colIdx-1,  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"      )    )  ))

If you have a Shiny app and you want to update subdat1/2 when the checkboxes are clicked, you can do as follows (I changed the callback):

library(DT)library(shiny)shinyCheckbox <- function(id, values) {  inputs <- character(length(values))  for(i in seq_along(inputs)) {    inputs[i] <-       as.character(        checkboxInput(paste0(id, i), label = NULL, value = values[i], width = "20px")      )  }  inputs}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 <- data.frame(  Sr = c(1.5, 2.3),  Description = c("A - B", "X - Y"))## details of row 1subdat1 <- data.frame(  Chromosome = c("chr18","chr4"),  SNP = c("rs2","rs3"),  YN = c(TRUE, FALSE),  stringsAsFactors = FALSE)subdat1$check <- shinyCheckbox("check", subdat1$YN)## details of row 2subdat2 <- data.frame(  Chromosome = c("chr19","chr20"),   SNP = c("rs3","rs4"),  YN = c(TRUE, FALSE),  stringsAsFactors = FALSE)subdat2$check <- shinyCheckbox("check", subdat2$YN)Dat <- NestedData(dat, list(subdat1, subdat2))## whether to show row namesrowNames = FALSEcolIdx <- as.integer(rowNames)## the callbackparentRows <- 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 subtable;","  if(colNames.indexOf('_details') === -1){","    subtable = $(id).DataTable({","      'data': data,","      'columns': columns,","      'autoWidth': true,","      'deferRender': true,","      'info': false,","      'lengthChange': false,","      'ordering': data.length > 1,","      'order': [],","      'paging': false,","      'scrollX': false,","      'scrollY': false,","      'searching': false,","      'sortClasses': false,","      'rowCallback': rowCallback,","      'headerCallback': headerCallback,","      'columnDefs': [{targets: '_all', className: 'dt-center'}]","    });","  } else {","    subtable = $(id).DataTable({","      'data': data,","      'columns': columns,","      'autoWidth': true,","      'deferRender': true,","      'info': false,","      'lengthChange': false,","      'ordering': data.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'});","  }", # THIS IS THE CODE I ADDED TO DEAL WITH THE CHECKBOXES:"  $(id).on('click', '[id^=check]', function(){","    var id = this.getAttribute('id');","    var i = parseInt(/check(\\d+)/.exec(id)[1]);","    var value = $(this).prop('checked');","    subtable.cell(i-1, 2).data(value).draw();","    Shiny.setInputValue('update', {child: childId, row: i, value: value});","  });","};","","// --- 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;');","    }","  }","});")ui <- fluidPage(  br(),  actionButton("print", "Print child rows"),  br(),  DTOutput("dtable"))server <- function(input, output, session) {  output[["dtable"]] <- renderDT({    datatable(      Dat,       callback = callback, rownames = rowNames, escape = -colIdx-1,      selection = "none",      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"          )        )      )    )  })  observeEvent(input[["update"]], {    child <-       stringr::str_extract(input[["update"]][["child"]], "\\d+$")    row <- as.integer(input[["update"]][["row"]])    value <- input[["update"]][["value"]]    if(child == "0") {      subdat1[row, "YN"] <<- value    } else if(child == "1") {      subdat2[row, "YN"] <<- value    }  })  observeEvent(input[["print"]], {    print(subdat1$YN)    print(subdat2$YN)  })}shinyApp(ui, server)

Viewing all articles
Browse latest Browse all 2

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>