在编写带有可折叠子行的多个研究的R DT汇总结果的代码时遇到问题

本文介绍了在编写带有可折叠子行的多个研究的R DT汇总结果的代码时遇到问题的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试制作一个交互式表格，汇总在多项研究中测试的结果的最高结果，我还希望用户通过子行访问更详细的结果。主表中仅显示具有最小p值的顶部模型。

I'm trying to make an interactive table summarizing the top result of an outcome tested in multiple studies, and I would also like the user to access more detailed results via child rows. Only the "top" model with the smallest p-value is shown in the main table.

现在，我将相关结果分为两个数据框：1.顶部结果仅和2.详细结果。我正在合并这些内容，并根据要显示的顶部结果进行嵌套。

Right now I have the relevant results into two data frames: 1. top result only, and 2. detailed results. I am merging these and nesting based on the top results which I want to display.

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('&oplus;',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('&oplus;');
                   } else {
                   row.child(format(row.data())).show();
                   td.html('&CircleMinus;');
                   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)
)

此代码创建我想要的摘要表，但没有子行数据当我展开时出现：

This code creates the summary table that I want as a tibble, but no child row data appears when I expand:

但是，如果我访问了子行以编程方式显示，它们似乎包含我想要的数据：

However, if I access the child rows programmatically, they seem to contain the data I want:

> 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的inspect元素选项中的html：

*** EDIT ****Below is the html from Chrome's inspect element option:


    <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"],["&oplus;","&oplus;"],["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('&oplus;');\n                   } else {\n                   row.child(format(row.data())).show();\n                   td.html('&CircleMinus;');\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éphaneLaurent建议更改

**** EDIT 2 **** With changes suggested by 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('&oplus;',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('&oplus;');
                   } else {
                   row.child(format(row.data())).show();
                   td.html('&CircleMinus;');
                   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

没有队列列。替换为

d[",nested_columns,"]['studyName'].length

另一个问题是用下划线替换圆点：

The other issue is the replacement of the dots with underscores:

var result = ('<table id=\"child_' + ",not_nested_columns_str," + '\">').replace('.','_') + '<thead><tr>'

这仅替换第一个点。更改为

This replaces only the first dot. Change to

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('&oplus;',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('&oplus;');
                   } else {
                   row.child(format(row.data())).show();
                   td.html('&CircleMinus;');
                   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)
)

这篇关于在编写带有可折叠子行的多个研究的R DT汇总结果的代码时遇到问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！