Это то, что вы хотите?
Here is the code:
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), "⊕", "")
cbind(" " = oplus, dat, "_details" = I(subdats),
stringsAsFactors = FALSE)
}
df <- data.frame(
COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
AGE = c(20, 21, 18, 35, 40, 33, 27),
DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27")
)
children <- lapply(split(df, df$COUNTRY), "[", -1)
dat0 <- data.frame(COUNTRY = names(children))
Dat <- NestedData(dat = dat0, children = unname(children))
library(DT)
## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)
## the callback
parentRows <- 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 = ",
" ' '; "," var data = d [d.length-1] || d._details; "," for (введите данные [0]) {"," html + = '' + key + ''; ","} "," html + = '' "," return html; ","} else {"," return ''; ","} ","}; "," "," // - - обратный вызов строки для стиля строк дочерних таблиц --- // "," 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 () {"," $ (это). css (' background-color ',' papayawhip '); ","}); " , "} else {", "$ (строка). css ('цвет фона', 'лимонный шифон');", "$ (строка) .hover (function () {", "$ (this). css ('цвет фона', '# DDFF75'); ","}, function () {"," $ (this). css ('цвет фона', 'лимонный шифон'); ", "});", "}", "};", "", "// --- обратный вызов заголовка для стиля header дочерних таблиц --- //", "var headerCallback = function (thead, data, start , end, display) {"," $ ('th', thead). css ({"," 'border-top': '3px solid indi go', "," 'color': 'indi go', "," 'background-color': '#fadadd' ","}); ","}; "," "," // --- сделаем 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; "," if (colNames.indexOf ('_ details' ) === -1) {"," var 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,", "'search': false,", "'sortClasses': false,", "'rowCallback' : rowCallback, "," 'headerCallback': headerCallback, "," 'columnDefs': [{target: '_all', className: 'dt-center'}] ","}); ","} else {", "var 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,", "'search': false,", "'sortClasses': false,", "'rowCallback': rowCallback,", "'headerCallback': headerCallback,", "'columnDefs': ["," {target: -1, visible: false}, "," {target: 0, orderable: false, className: 'details-control'}, "," {target: '_all', className: 'dt -center '} ","] ","}). column (0) .nodes (). to $ (). css ({курсор:' указатель '}); ","} ","}; "," "," // --- отобразим дочернюю таблицу при нажатии --- // "," // массив для хранения идентификаторов уже созданных дочерних таблиц "," 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 ('⊕'); ","} else {"," var childId = tblId + '-child-' + rowIdx; "," if (children.indexOf (childId) === -1) {"," // этот дочерний элемент еще не создан "," children.pu sh (childId) ; "," row.child ( formatHeader (row.data (), childId)). show (); "," td. html ('⊖'); "," formatDatatable (row. data (), childId, rowIdx); ","} else {"," // этот дочерний элемент уже был создан "," row.child (true); "," td. html ('⊖'); ","} ","} ","}); ") datatable (Dat, callback = callback, rownames = rowNames, escape = -colIdx-1, options = list (paging = FALSE, search = FALSE, columnDefs = list (список (visible = FALSE, target = ncol (Dat) -1 + colIdx), list (orderable = FALSE, className = "details-control", target = colIdx), list (className = "dt-center", target = "_все"))))
РЕДАКТИРОВАТЬ
Вы должны использовать символьные столбцы, а не факторы:
df <- data.frame(
COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
AGE = c(20, 21, 18, 35, 40, 33, 27),
DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
stringsAsFactors = FALSE
)
EDIT
Вот фильтры. Благодаря плагину jQuery yadcf .
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), "⊕", "")
cbind(" " = oplus, dat, "_details" = I(subdats),
stringsAsFactors = FALSE)
}
df <- data.frame(
COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
AGE = c(20, 21, 18, 35, 40, 33, 27),
DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
stringsAsFactors = FALSE
)
children <- lapply(split(df, df$COUNTRY), "[", -1)
dat0 <- data.frame(COUNTRY = names(children))
Dat <- NestedData(dat = dat0, children = unname(children))
library(DT)
## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)
## the callback
parentRows <- which(Dat[,1] != "")
callback <- JS(
"function df2list(df){",
" var list = {};",
" var colnames = Object.keys(df[0]);",
" for(let i=0; i < colnames.length; i++){",
" var column = [], colname = colnames[i];",
" for(let j=0; j < df.length; j++){",
" column.push(df[j][colname]);",
" }",
" list[colname] = column;",
" }",
" return list;",
"}",
"function isNumeric(column){",
" return column.every($.isNumeric);",
"}",
"function isDate(column){",
" return column.every(function(x){return moment(x, 'yyyy-mm-dd').isValid();});",
"}",
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 = ",
" ' '; "," var data = d [d.length-1] | | d._details; "," for (введите данные [0]) {"," html + = '' + key + ''; ","} "," html + = '' "," return html; ","} else {"," return ''; ","} ","}; "," "," // - - обратный вызов строки для стиля строк дочерних таблиц --- // "," 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 () {"," $ (это). css (' background-color ',' papayawhip '); ","}); " , "} else {", "$ (строка). css ('цвет фона', 'лимонный шифон');", "$ (строка) .hover (function () {", "$ (this). css ('цвет фона', '# DDFF75'); ","}, function () {"," $ (this). css ('цвет фона', 'лимонно-шифон'); ", "});", "}", "};", "", "// --- обратный вызов заголовка для стиля заголовка дочерних таблиц --- //", "var headerCallback = function (thead, data, start , end, display) {"," $ ('th', thead). css ({"," 'border-top': '3px solid indi go', "," 'color': 'indi go', "," 'background-color': '#fadadd' ","}); ","}; "," "," // --- сделаем 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 dataColumns = df2list (data); "," var yadcfOptions = Object.entries (dataColumns) .map ("," function (x, index) {"," var type = 'multi_select'; "," if (isNumeri c (x [1])) {"," type = 'range_number_slider'; "," } else if (isDate (x [1])) {"," type = 'range_date'; ","} "," return {"," column_number: index, "," filter_type: type, "," date_format: 'yyyy-mm-dd', "," datepicker_type: 'jquery -ui' ","}; ","} ","); "," var id = 'table #' + childId; "," if (colNames.indexOf ('_ details') === -1) {"," var subtable = $ (id) .DataTable ({"," 'dom': 't', "," 'data': data , "," 'columns': columns, "," 'fixedHeader': true, "," 'autoWidth': true, "," 'deferRender': true, "," 'info': false, "," ' lengthChange ': false, ","' ordering ': data.length> 1, ","' order ': [], ","' paging ': false, ","' scrollX ': false, ","' scrollY ': false, ","' searchi ng ': true, ","' sortClasses ': false, ","' rowCallback ': rowCallback, ","' headerCallback ': headerCallback, ","' columnDefs ': [{цели:' _all ', className:' dt-center '}] ","}); "," yadcf.init (subtable, yadcfOptions); ","} else {"," var 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,", "'search': false,", "'sortClasses': false,", "'rowCallback': rowCallback,", "'headerCallback': headerCallback,", "'columnDefs': ["," {target: -1, visible: false}, "," {target: 0, orderable: false, className: 'details-control'}, "," {target: '_all', className: 'dt -center '} ","] ","}). column (0) .nodes (). to $ (). css ({cursor:' pointer '}); ","} ","}; "," "," // --- отобразим дочернюю таблицу при нажатии --- // "," // массив для хранения идентификаторов уже созданных дочерних таблиц "," 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 ('⊕'); ","} else {"," var childId = tblId + '-child-' + rowIdx; "," если (ребенок ren.indexOf (childId) === -1) {"," // этот дочерний элемент еще не создан »,« children.pu sh (childId); »,« row.child (formatHeader (row.data (), childId)). show (); "," td. html ('⊖'); "," formatDatatable (row.data (), childId, rowIdx); ","} else {"," // этот дочерний элемент уже был создан "," row.child (true); "," td. html ('⊖'); ","} ","} ","}); ") dtable < - datatable (Dat, callback = callback, rownames = rowNames, escape = -colIdx-1, extensions = "FixedHeader", options = list (paging = FALSE, search = FALSE, columnDefs = list (list (visible = FALSE, target = ncol (Dat) -1 + colIdx), list (orderable = FALSE, className = "details-control", target = colIdx), list (className = "dt-center", target = "_all")))) dep < - htmltools :: htmlDependency ("yadcf", "0.9.3", c (href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"), script = "jquery .dataTables.yadcf.min. js", stylesheet = " jquery .dataTables.yadcf.min. css ") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dep <- htmltools :: htmlDependency (" jquery - ui "," 1.12.1 ", sr c =" www/shared/jqueryui/ ", script =" jquery -ui. js ", stylesheet =" jquery -ui. css ", package = "блестящий") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dep <- htmltools :: htmlDependency ("moment", "2.27.0", c (href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/ "), script =" moment.min. js ") dtable $ dependencies <- c (dtable $ dependencies, list (dep)) dtable </code>
РЕДАКТИРОВАТЬ
Ползунок имеет не ожидаемый вид. Это потому, что jquery -ui загружается после yadcf . Для правильного внешнего вида измените порядок зависимостей:
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
РЕДАКТИРОВАТЬ
Вот способ иметь фильтры только для столбцов NAME
и AGE
:
NestedData <- function(dat, children){
stopifnot(length(children) == nrow(dat))
g <- function(d){
if(is.data.frame(d$data)){
list(data = purrr::transpose(d$data), filters = as.list(d$filters))
}else{
purrr::transpose(NestedData(d[[1]], children = d$children))
}
}
subdats <- lapply(children, g)
oplus <- ifelse(lengths(subdats), "⊕", "")
cbind(" " = oplus, dat, "_details" = I(subdats),
stringsAsFactors = FALSE)
}
df <- data.frame(
COUNTRY = c("USA","Japan","USA","France","Italy","Canada","Japan"),
NAME = c("Mark","Hue","Mary","Jean","Laura","John","Zhan"),
AGE = c(20, 21, 18, 35, 40, 33, 27),
DATE_OF_BIRTH = c("1980-05-01","1978-05-04","1983-11-01","1989-05-15","1985-08-08","1978-02-18","1983-09-27"),
stringsAsFactors = FALSE
)
children <- lapply(split(df, df$COUNTRY), function(d){
list(data = d[-1], filters = c("NAME", "AGE"))
})
dat0 <- data.frame(COUNTRY = names(children))
Dat <- NestedData(dat = dat0, children = unname(children))
library(DT)
## whether to show row names
rowNames = FALSE
colIdx <- as.integer(rowNames)
## the callback
parentRows <- which(Dat[,1] != "")
callback <- JS(
"function df2list(df){",
" var list = {};",
" var colnames = Object.keys(df[0]);",
" for(let i=0; i < colnames.length; i++){",
" var column = [], colname = colnames[i];",
" for(let j=0; j < df.length; j++){",
" column.push(df[j][colname]);",
" }",
" list[colname] = column;",
" }",
" return list;",
"}",
"function isNumeric(column){",
" return column.every($.isNumeric);",
"}",
"function isDate(column){",
" return column.every(function(x){return moment(x, 'yyyy-mm-dd').isValid();});",
"}",
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 children = d[d.length-1] || d._details;",
" var data = children.data;",
" 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 children = d[d.length-1] || d._details;",
" var data = children.data;",
" var colNames = Object.keys(data[0]);",
" var columns = colNames.map(function(x){",
" return {data: x.replace(/\\./g, '\\\\\\.'), title: x};",
" });",
" var dataColumns = df2list(data);",
" var hasChild = colNames.indexOf('_details') > -1;",
" var filters = children.filters;",
" var yadcfOptions = Object.entries(dataColumns).map(",
" function(x, index){",
" if($.inArray(x[0], filters) === -1 || (hasChild && (index === 0 || x[0] === '_details'))) return null;",
" var type = 'multi_select';",
" if(isNumeric(x[1])){",
" type = 'range_number_slider';",
" }else if(isDate(x[1])){",
" type = 'range_date';",
" }",
" return {",
" column_number: index,",
" filter_type: type,",
" date_format: 'yyyy-mm-dd',",
" datepicker_type: 'bootstrap-datepicker'",
" };",
" }",
" ).filter(function(x){return x !== null;});",
" var id = 'table#' + childId;",
" var options = {",
" 'dom': 't',",
" 'data': data,",
" 'columns': columns,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': data.length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': true,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback",
" };",
" if(!hasChild){",
" var columnDefs = ",
" {'columnDefs': [{targets: '_all', className: 'dt-center'}]};",
" var subtable = $(id).DataTable(",
" $.extend(options, columnDefs)",
" );",
" yadcf.init(subtable, yadcfOptions);",
" } else {",
" var columnDefs = {",
" 'columnDefs': [",
" {targets: -1, visible: false},",
" {targets: 0, orderable: false, className: 'details-control'},",
" {targets: '_all', className: 'dt-center'}",
" ]};",
" var subtable = $(id).DataTable(",
" $.extend(options, columnDefs)",
" ).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
"};",
"",
"// --- 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('⊕');",
" } 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('⊖');",
" formatDatatable(row.data(), childId, rowIdx);",
" }else{",
" // this child has already been created",
" row.child(true);",
" td.html('⊖');",
" }",
" }",
"});")
dtable <- 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"
)
)
)
)
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable