How to add multiple scrollbar in R Shiny data table - r

Question

I am trying to build a shiny app that has the following feature:
It has a parent-child feature that can expand and collapse as per
user interaction (Requirement 1 - Done)
When the rows are expanded, several child rows are displayed in the
data table. I want to introduce multiple scroll bars in this table.
1st scrollbar will be for 1st 4 columns and another scrollbar for the
rest of the columns. (Requirement 2 - Not Done)
The below code is able to produce results for the 1st requirement (using JQuery) however, I am unable to find a way out for Requirement 2.
Can anyone assist here?
packages = c(
'shiny',
'shinydashboard',
'tidyverse',
'dplyr',
'magrittr',
'plotly',
'ggplot2',
'scales',
'DT',
"shinyWidgets",
"fontawesome"
)
for (p in packages) {
if (!require(p, character.only = T)) {
install.packages(p)
}
library(p, character.only = T)
}
DataIn <- mtcars
DataIn <- DataIn %>% tidyr::nest(-cyl)
DataIn <- DataIn %>%
{
bind_cols(data_frame(
' ' = rep(
'<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_open.png\"/>',
nrow(.)
)
), .)
}
# get dynamic info and strings
nested_columns <-
which(sapply(DataIn, class) == "list") %>% setNames(NULL)
not_nested_columns <-
which(!(seq_along(DataIn) %in% c(1, nested_columns)))
not_nested_columns_str <-
not_nested_columns %>% paste(collapse = "] + '_' + d[") %>% paste0("d[", ., "]")
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,
" + '\">') + '<thead><tr>'
for (var col in d[",
nested_columns,
"][0]){
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,
"].length-1; i++) {
var datarow = $.map(d[",
nested_columns,
"][i], function(value, index) {
return [value];
});
dataset.push(datarow);
}
var subtable = $(('table#child_' + ",
not_nested_columns_str,
")).DataTable({
'data': dataset,
'autoWidth': true,
'deferRender': true,
'info': false,
'lengthChange': false,
'ordering': true,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false
// 'fnRowCallback': function (nRow, aData, iDisplayIndex, iDisplayIndexFull) {
// $('td', nRow).css('background-color', 'Red')}
});
};
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('<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_open.png\"/>');
} else {
row.child(format(row.data())).show();
td.html('<img src=\"https://raw.githubusercontent.com/DataTables/DataTables/master/examples/resources/details_close.png\"/>');
format_datatable(row.data())
}
});"
)
shinyApp(
ui = fluidPage(DT::dataTableOutput('tbl')),
server = function(input, output) {
output$tbl = DT::renderDataTable(datatable(
DataIn,
escape = -2,
# raw HTML in column 2
options = list(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)
))
}
)