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

R shiny update column value to check-box controls value on child rows on nested table

$
0
0

I would like to set check-box values to the corresponding values in column 'YN' when a child rows loads and after the user clicks/unclicks a checkbox I would like 'YN' column to update. I don't need check-boxes on parent rows. I've tried to modify an example I've found, but it's not working on child rows. Please suggest how to implement this correctly. Here is an example of code that works but doesn't update the 'YN' column. Thank you very much. Here is the code:

data

      library(DT)        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)    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    }    subdat1$check <- shinyCheckbox("check", subdat1$YN)    ## details of row 2    subdat2 <- data.frame(      Chromosome = c("chr19","chr20"),       SNP = c("rs3","rs4"),      YN = c(TRUE, FALSE),  stringsAsFactors = FALSE)subdat2$check <- shinyCheckbox("check", subdat2$YN)## merge the row detailssubdats <- lapply(list(subdat1, subdat2), purrr::transpose)## dataframe for the datatable Dat <- cbind(" " = "&oplus;", dat, details = I(subdats))    ###spliting subdata into dataframes###    subdat <- data.frame(      Gene_SUB=c("MUTYH","AR"),      Location_SUB=c("chr1:45797228","chr2:45797228"),      Exon_SUB=c(NA,23),                HGVS_p_SUB=c("NP_001121897.1:p.(Gly396Asp)","NP_001121897.1:p.(Gly396Asp)"),      stopA=c(45797278,114925456),      YN = c(FALSE, FALSE),      stringsAsFactors = FALSE    )    maindat <- data.frame(      Gene=c("MUTYH","AR"),      Location=c("chr1:45797228","chr2:45797228"),      Exon=c(NA,23),                HGVS_p=c("NP_001121897.1:p.(Gly396Asp)","NP_001121897.1:p.(Gly396Asp)"),      stopA=c(45797278,114925456),      stringsAsFactors = FALSE    )    subdat$check <- shinyCheckbox("check", subdat$YN)    fs<-split(subdat, factor(subdat$stopA, levels = unique(subdat$stopA)))    subdats <- lapply(fs, purrr::transpose)    oplus <- sapply(subdats, function(x) if(length(x)) "&oplus;" else "")    Dat <- cbind(" " = oplus, maindat, details = I(subdats))## the callbackcallback = JS("$('[id^=check]').on('click', function(){","  var id = this.getAttribute('id');","  var i = parseInt(/check(\\d+)/.exec(id)[1]);","  var value = $(this).prop('checked');","  var cell = table.cell(i-1, 2).data(value).draw();","})","table.column(1).nodes().to$().css({cursor: 'pointer'});","// Format the nested table into another table","var childId = function(d){","  var tail = d.slice(2, d.length - 1);","  return 'child_'+ tail.join('_').replace(/[\\s|\\.|'|,|\\(|\\)]/g, '_');","};","var format = function (d) {","  if (d != null) {","    var id = childId(d);","    var html = ", "          '<table class=\"display compact\" id=\"'+ id +'\"><thead><tr>';","    for (var key in d[d.length-1][0]) {","      html += '<th>'+ key +'</th>';","    }","    html += '</tr></thead></table>'","    return html;","  } else {","    return '';","  }","};","var rowCallback = function(row, dat, displayNum, index){","  if($(row).hasClass('odd')){","    for(var j=0; j<dat.length; j++){","      $('td:eq('+j+')', row).css('background-color', 'papayawhip');","    }","  } else {","    for(var j=0; j<dat.length; j++){","      $('td:eq('+j+')', row).css('background-color', 'lemonchiffon');","    }","  }","};","var headerCallback = function(thead, data, start, end, display){","  $('th', thead).css({","    'border-top': '3px solid indigo',", "    'color': 'indigo',","    'background-color': '#fadadd'","  });","};","var format_datatable = function (d) {","  var dataset = [];","  var n = d.length - 1;","  for (var i = 0; i < d[n].length; i++) {","    var datarow = $.map(d[n][i], function (value, index) {","      return [value];","    });","    dataset.push(datarow);","  }","  var id = 'table#'+ childId(d);","  var subtable = $(id).DataTable({","                     'data': dataset,","                     'autoWidth': true,","                     'deferRender': true,","                     'info': false,","                     'lengthChange': false,","                     'ordering': d[n].length > 1,","                     'order': [],","                     'paging': false,","                     'scrollX': false,","                     'scrollY': false,","                     'searching': false,","                     'sortClasses': false,","                     'rowCallback': rowCallback,","                     'headerCallback': headerCallback,","                     'columnDefs': [{targets: '_all', className: 'dt-center'}]","                   });","};","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());","  }","});")## datatabledatatable(Dat, callback = callback, escape = FALSE,          options = list(            columnDefs = list(              list(visible = FALSE, targets = ncol(Dat)),              list(orderable = FALSE, className = 'details-control', targets = 1),              list(className = "dt-center", targets = "_all")            )            #preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),            #drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')          ),          )

Viewing all articles
Browse latest Browse all 2

Trending Articles