javascript - 为具有可折叠子行的多个研究汇总结果的 R DT 编写代码时出现问题
问题描述
我正在尝试制作一个交互式表格，总结在多项研究中测试的结果的最佳结果，并且我还希望用户通过子行访问更详细的结果。主表中仅显示具有最小 p 值的“顶部”模型。
现在我将相关结果放入两个数据框中：1. 仅顶部结果，2. 详细结果。我正在合并这些并根据我想要显示的顶级结果进行嵌套。
library(DT)
library(tidyr)
library(dplyr)
library(tibble)
# == Create dataframe with results to summarize
allresults <- list(c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v1", "ageSex", 1e-6),
c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v2", "ageSexBmi", 0.001),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v1", "ageSex", 0.05),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v2", "ageSexBmi", "0.2"),
c("HeartAttack", 1e-6, 0.05, 0.005, "study3", "heartAttack_v1", "ageSex", "0.005"),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v1", "ageSex", 0.6),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v2", "ageSex", 0.05),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v1", "ageSexBmi", 0.2),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v2", "ageSex", 0.01),
c("Cancer", 0.05, 0.01, 0.002, "study3", "cancer_v1", "ageSexBmi", 0.002))
df <- as.data.frame(t(as.data.frame(allresults)))
colnames(df) <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf", "studyName", "outcome", "model", "pvalue")
rownames(df)<-NULL
# == Collapse to display top-result table, one row per outcome
nest_fields <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf")
dt <- df %>%
nest(-nest_fields)
# == Add (+) column
data <- dt %>% {bind_cols(data_frame(' ' = rep('⊕',nrow(.))),.)}
# == Get dynamic info and strings
# == code via: https://github.com/rstudio/shiny-examples/issues/9
nested_columns <- which(sapply(data,class)=="list") %>% setNames(NULL)
not_nested_columns <- which(!(seq_along(data) %in% c(1,nested_columns)))
not_nested_columns_str <- not_nested_columns %>% paste(collapse="] + '_' + d[") %>% paste0("d[",.,"]")
# == The callback
# == Turn rows into child rows and remove from parent
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," + '\">').replace('.','_') + '<thead><tr>'
for (var col in d[",nested_columns,"]){
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,"]['cohort'].length; i++) {
var datarow = [];
for (var col in d[",nested_columns,"]){
datarow.push(d[",nested_columns,"][col][i])
}
dataset.push(datarow)
}
var subtable = $(('table#child_' + ",not_nested_columns_str,").replace('.','_')).DataTable({
'data': dataset,
'autoWidth': true,
'deferRender': true,
'info': false,
'lengthChange': false,
'ordering': true,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false
});
};
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('⊕');
} else {
row.child(format(row.data())).show();
td.html('⊖');
format_datatable(row.data())
}
});"
)
# == the Display DT
datatable(
data,
escape = FALSE,
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)
)
此代码创建了我想要作为小标题的汇总表，但是当我展开时没有出现子行数据：
但是，如果我以编程方式访问子行，它们似乎包含我想要的数据：
> data[data$outcome.bestOf=="Cancer", 'data'][[1]]
[[1]]
# A tibble: 5 x 4
studyName outcome model pvalue
<fct> <fct> <fct> <fct>
1 study1 cancer_v1 ageSex 0.6
2 study1 cancer_v2 ageSex 0.05
3 study2 cancer_v1 ageSexBmi 0.2
4 study2 cancer_v2 ageSex 0.01
5 study3 cancer_v1 ageSexBmi 0.002
*** 编辑 **** 下面是来自 Chrome 的检查元素选项的 html：
<html><head>
<meta charset="utf-8">
<script src="lib/htmlwidgets-1.3/htmlwidgets.js"></script>
<script src="lib/jquery-1.12.4/jquery.min.js"></script>
<link href="lib/datatables-css-0.0.0/datatables-crosstalk.css" rel="stylesheet">
<script src="lib/datatables-binding-0.5/datatables.js"></script>
<link href="lib/dt-core-1.10.16/css/jquery.dataTables.min.css" rel="stylesheet">
<link href="lib/dt-core-1.10.16/css/jquery.dataTables.extra.css" rel="stylesheet">
<script src="lib/dt-core-1.10.16/js/jquery.dataTables.min.js"></script>
<link href="lib/crosstalk-1.0.0/css/crosstalk.css" rel="stylesheet">
<script src="lib/crosstalk-1.0.0/js/crosstalk.min.js"></script>
</head>
<body style="background-color: white; margin: 0px; padding: 40px;">
<div id="htmlwidget_container">
<div id="htmlwidget-3a36880ad35572a39f25" style="width:960px;height:500px;" class="datatables html-widget html-widget-static-bound"><div id="DataTables_Table_0_wrapper" class="dataTables_wrapper no-footer"><div class="dataTables_length" id="DataTables_Table_0_length"><label>Show <select name="DataTables_Table_0_length" aria-controls="DataTables_Table_0" class=""><option value="10">10</option><option value="25">25</option><option value="50">50</option><option value="100">100</option></select> entries</label></div><div id="DataTables_Table_0_filter" class="dataTables_filter"><label>Search:<input type="search" class="" placeholder="" aria-controls="DataTables_Table_0"></label></div><table class="display dataTable no-footer" id="DataTables_Table_0" role="grid" aria-describedby="DataTables_Table_0_info">
<thead>
<tr role="row"><th class="details-control sorting_disabled" rowspan="1" colspan="1" aria-label=" "> </th><th class="sorting" tabindex="0" aria-controls="DataTables_Table_0" rowspan="1" colspan="1" aria-label="outcome.bestOf: activate to sort column ascending">outcome.bestOf</th><th class="sorting" tabindex="0" aria-controls="DataTables_Table_0" rowspan="1" colspan="1" aria-label="study1.bestOf: activate to sort column ascending">study1.bestOf</th><th class="sorting" tabindex="0" aria-controls="DataTables_Table_0" rowspan="1" colspan="1" aria-label="study2.bestOf: activate to sort column ascending">study2.bestOf</th><th class="sorting" tabindex="0" aria-controls="DataTables_Table_0" rowspan="1" colspan="1" aria-label="study3.bestOf: activate to sort column ascending">study3.bestOf</th></tr>
</thead>
<tbody><tr role="row" class="odd"><td class=" details-control" style="cursor: pointer;">⊕</td><td>HeartAttack</td><td>1e-06</td><td>0.05</td><td>0.005</td></tr><tr role="row" class="even"><td class=" details-control" style="cursor: pointer;">⊕</td><td>Cancer</td><td>0.05</td><td>0.01</td><td>0.002</td></tr></tbody></table><div class="dataTables_info" id="DataTables_Table_0_info" role="status" aria-live="polite">Showing 1 to 2 of 2 entries</div><div class="dataTables_paginate paging_simple_numbers" id="DataTables_Table_0_paginate"><a class="paginate_button previous disabled" aria-controls="DataTables_Table_0" data-dt-idx="0" tabindex="0" id="DataTables_Table_0_previous">Previous</a><span><a class="paginate_button current" aria-controls="DataTables_Table_0" data-dt-idx="1" tabindex="0">1</a></span><a class="paginate_button next disabled" aria-controls="DataTables_Table_0" data-dt-idx="2" tabindex="0" id="DataTables_Table_0_next">Next</a></div></div></div>
</div>
<script type="application/json" data-for="htmlwidget-3a36880ad35572a39f25">{"x":{"filter":"none","data":[["1","2"],["⊕","⊕"],["HeartAttack","Cancer"],["1e-06","0.05"],["0.05","0.01"],["0.005","0.002"],[{"studyName":["study1","study1","study2","study2","study3"],"outcome":["heartAttack_v1","heartAttack_v2","heartAttack_v1","heartAttack_v2","heartAttack_v1"],"model":["ageSex","ageSexBmi","ageSex","ageSexBmi","ageSex"],"pvalue":["1e-06","0.001","0.05","0.2","0.005"]},{"studyName":["study1","study1","study2","study2","study3"],"outcome":["cancer_v1","cancer_v2","cancer_v1","cancer_v2","cancer_v1"],"model":["ageSex","ageSex","ageSexBmi","ageSex","ageSexBmi"],"pvalue":["0.6","0.05","0.2","0.01","0.002"]}]],"container":"<table class=\"display\">\n <thead>\n <tr>\n <th> <\/th>\n <th> <\/th>\n <th>outcome.bestOf<\/th>\n <th>study1.bestOf<\/th>\n <th>study2.bestOf<\/th>\n <th>study3.bestOf<\/th>\n <th>data<\/th>\n <\/tr>\n <\/thead>\n<\/table>","options":{"columnDefs":[{"visible":false,"targets":[0,6]},{"orderable":false,"className":"details-control","targets":1},{"orderable":false,"targets":0}],"order":[],"autoWidth":false,"orderClasses":false},"callback":"function(table) {\n\n table.column(1).nodes().to$().css({cursor: 'pointer'});\n \n // Format data object (the nested table) into another table\n var format = function(d) {\n if(d != null){ \n var result = ('<table id=\"child_' + d[2] + '_' + d[3] + '_' + d[4] + '_' + d[5] + '\">').replace('.','_') + '<thead><tr>'\n for (var col in d[6]){\n result += '<th>' + col + '<\/th>'\n }\n result += '<\/tr><\/thead><\/table>'\n return result\n }else{\n return '';\n }\n }\n \n var format_datatable = function(d) {\n var dataset = [];\n for (i = 0; i < + d[6]['cohort'].length; i++) {\n var datarow = [];\n for (var col in d[6]){\n datarow.push(d[6][col][i])\n }\n dataset.push(datarow)\n }\n var subtable = $(('table#child_' + d[2] + '_' + d[3] + '_' + d[4] + '_' + d[5]).replace('.','_')).DataTable({\n 'data': dataset,\n 'autoWidth': true, \n 'deferRender': true, \n 'info': false, \n 'lengthChange': false, \n 'ordering': true, \n 'paging': false, \n 'scrollX': false, \n 'scrollY': false, \n 'searching': false \n });\n };\n \n table.on('click', 'td.details-control', function() {\n var td = $(this), row = table.row(td.closest('tr'));\n if (row.child.isShown()) {\n row.child.hide();\n td.html('⊕');\n } else {\n row.child(format(row.data())).show();\n td.html('⊖');\n format_datatable(row.data())\n }\n });\n}"},"evals":["callback"],"jsHooks":[]}</script>
<script type="application/htmlwidget-sizing" data-for="htmlwidget-3a36880ad35572a39f25">{"viewer":{"width":450,"height":350,"padding":15,"fill":true},"browser":{"width":960,"height":500,"padding":40,"fill":false}}</script>
</body></html>
**** 编辑 2 **** 有 Stéphane Laurent 建议的更改
allresults <- list(c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v1", "ageSex", 1e-6),
c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v2", "ageSexBmi", 0.001),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v1", "ageSex", 0.05),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v2", "ageSexBmi", "0.2"),
c("HeartAttack", 1e-6, 0.05, 0.005, "study3", "heartAttack_v1", "ageSex", "0.005"),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v1", "ageSex", 0.6),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v2", "ageSex", 0.05),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v1", "ageSexBmi", 0.2),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v2", "ageSex", 0.01),
c("Cancer", 0.05, 0.01, 0.002, "study3", "cancer_v1", "ageSexBmi", 0.002))
df <- as.data.frame(t(as.data.frame(allresults)))
colnames(df) <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf", "studyName", "outcome", "model", "pvalue")
rownames(df)<-NULL
# == Collapse to display top-result table, one row per outcome
nest_fields <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf")
dt <- df %>%
nest(-nest_fields)
# == Add (+) column
data <- dt %>% {bind_cols(data_frame(' ' = rep('⊕',nrow(.))),.)}
# == Get dynamic info and strings
# == code via: https://github.com/rstudio/shiny-examples/issues/9
nested_columns <- which(sapply(data,class)=="list") %>% setNames(NULL)
not_nested_columns <- which(!(seq_along(data) %in% c(1,nested_columns)))
not_nested_columns_str <- not_nested_columns %>% paste(collapse="] + '_' + d[") %>% paste0("d[",.,"]")
# == The callback
# == Turn rows into child rows and remove from parent
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," + '\">').replace('/\\./g','_') + '<thead><tr>'
for (var col in d[",nested_columns,"]){
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,"]['studyName'].length; i++) {
var datarow = [];
for (var col in d[",nested_columns,"]){
datarow.push(d[",nested_columns,"][col][i])
}
dataset.push(datarow)
}
var subtable = $(('table#child_' + ",not_nested_columns_str,").replace('/\\./g','_') ).DataTable({
'data': dataset,
'autoWidth': true,
'deferRender': true,
'info': false,
'lengthChange': false,
'ordering': true,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false
});
};
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('⊕');
} else {
row.child(format(row.data())).show();
td.html('⊖');
format_datatable(row.data())
}
});"
)
# == the Display DT
datatable(
data,
escape = FALSE,
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)
)
解决方案
有两个问题。
d[",nested_columns,"]['cohort'].length
没有cohort专栏。用。。。来代替
d[",nested_columns,"]['studyName'].length
另一个问题是用下划线替换点：
var result = ('<table id=\"child_' + ",not_nested_columns_str," + '\">').replace('.','_') + '<thead><tr>'
这仅替换第一个点。改成
var result = ('<table id=\"child_' + ",not_nested_columns_str," + '\">').replace('/\\./g','_') + '<thead><tr>'
也在这里：
var subtable = $(('table#child_' + ",not_nested_columns_str,").replace('.','_')).DataTable({
完整代码：
library(DT)
library(tidyr)
library(dplyr)
library(tibble)
# == Create dataframe with results to summarize
allresults <- list(c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v1", "ageSex", 1e-6),
c("HeartAttack", 1e-6, 0.05, 0.005, "study1", "heartAttack_v2", "ageSexBmi", 0.001),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v1", "ageSex", 0.05),
c("HeartAttack", 1e-6, 0.05, 0.005, "study2", "heartAttack_v2", "ageSexBmi", "0.2"),
c("HeartAttack", 1e-6, 0.05, 0.005, "study3", "heartAttack_v1", "ageSex", "0.005"),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v1", "ageSex", 0.6),
c( "Cancer", 0.05, 0.01, 0.002, "study1", "cancer_v2", "ageSex", 0.05),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v1", "ageSexBmi", 0.2),
c("Cancer", 0.05, 0.01, 0.002, "study2", "cancer_v2", "ageSex", 0.01),
c("Cancer", 0.05, 0.01, 0.002, "study3", "cancer_v1", "ageSexBmi", 0.002))
df <- as.data.frame(t(as.data.frame(allresults)))
colnames(df) <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf", "studyName", "outcome", "model", "pvalue")
rownames(df)<-NULL
# == Collapse to display top-result table, one row per outcome
nest_fields <- c("outcome.bestOf", "study1.bestOf", "study2.bestOf", "study3.bestOf")
dt <- df %>%
nest(-nest_fields)
# == Add (+) column
data <- dt %>% {bind_cols(data_frame(' ' = rep('⊕',nrow(.))),.)}
# == Get dynamic info and strings
# == code via: https://github.com/rstudio/shiny-examples/issues/9
nested_columns <- which(sapply(data,class)=="list") %>% setNames(NULL)
not_nested_columns <- which(!(seq_along(data) %in% c(1,nested_columns)))
not_nested_columns_str <- not_nested_columns %>% paste(collapse="] + '_' + d[") %>% paste0("d[",.,"]")
# == The callback
# == Turn rows into child rows and remove from parent
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," + '\">').replace(/\\./g,'_') + '<thead><tr>'
for (var col in d[",nested_columns,"]){
result += '<th>' + col + '</th>'
}
result += '</tr></thead></table>'
return result
}else{
return '';
}
}
var format_datatable = function(d) {
var dataset = [];
for (var i = 0; i < + d[",nested_columns,"]['studyName'].length; i++) {
var datarow = [];
for (var col in d[",nested_columns,"]){
datarow.push(d[",nested_columns,"][col][i])
}
dataset.push(datarow)
}
var subtable = $(('table#child_' + ",not_nested_columns_str,").replace(/\\./g,'_')).DataTable({
'data': dataset,
'autoWidth': true,
'deferRender': true,
'info': false,
'lengthChange': false,
'ordering': true,
'paging': false,
'scrollX': false,
'scrollY': false,
'searching': false
});
};
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('⊕');
} else {
row.child(format(row.data())).show();
td.html('⊖');
format_datatable(row.data())
}
});"
)
# == the Display DT
datatable(
data,
escape = FALSE,
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)
)
推荐阅读
- batch-file - 如何为我的文本文件重新排序记录？
- javafx - 升级到 Java 10 后在 CircleCI 中找不到 JavaFX
- mysql - 从表中过滤掉过时的项目
- python - 在 doxygen 中根据表达式生成公式
- subdomain - 将在端口上运行的服务映射到子域
- django - 如何在 Django 表单中显示“auto_now_add”字段？
- apache-poi - drools 无法从 XLS 文件打开决策表
- c++ - How Can I Build A Sequence Of Structs With Integer Members of Increasing Value at Compile Time in C++11
- python - 在 python27 的输入中使用变量失败并出现语法问题
- java - Java 8：RegExp - 具有各种分隔符的范围