如何解决在R Shiny中为嵌套数据表添加其他按钮
是否可以在嵌套数据表的父行和子行中添加其他操作按钮？我尝试通过JS和Shiny面添加按钮，但似乎不起作用。有什么建议？大多数代码都是从这篇文章中借来的：Matching Parent/Child data up in a DataTable in R Shiny app谢谢
library(data.table)
library(DT)
library(purrr)
library(shiny)
library(dplyr)
library(foreach)
library(data.table)
library(tidyverse)
df <- data.frame("Gene.5" = c("PDE1A","SLC45A3","TARBP1","CUL4A","CUL4A"),"Junction.5" = c("chr2:182198385:-","chr1:205680393:-","chr1:234420701:-","chr13:113245060:+","chr13:113245060:+"),"Gene.3" = c("ELK4","ETV2","CEACAM1","chr13_q32.3","chr13_q32.3"),"Junction.3" = c("chr1:205623892:-","chr19:35642433:+","chr19:35642614:+","chr19:35642964:+","chr19:42522203:-","chr13:100068494:-","chr13:100069868:-"),"breakpoints" = c("1","5","2","3","3"),"primary" = c("p","p","s","s")
)
head(df)
gene_list <- c("SLC45A3","CUL4A")
df$V4=(
df$Gene.5 %in% gene_list |
df$Gene.3 %in% gene_list
)
print(df)
par <- subset(df,df$primary == 'p')
ch <- df
all <-rbind(par,ch) #rbind the columns
ch_only_df <- all[!duplicated(all,fromLast = FALSE)&!duplicated(all,fromLast = TRUE),]
print(ch_only_df)
children_list<-list()
for (row in 1:nrow(par)) {
g5 <- paste(par[row,"Gene.5"])
print(g5)
g3 <- paste(par[row,"Gene.3"])
tdf <- subset(ch_only_df,ch_only_df$Gene.5 == g5 & ch_only_df$Gene.3 == g3)
if (nrow(tdf)<1){
children_list[[row]] <- data.frame(NULL)
}else{
children_list[[row]] <- tdf
}
}
children_list
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 <- sapply(subdats,function(x) if(length(x)) "⊕" else "")
cbind(" " = oplus,dat,"_details" = I(subdats),stringsAsFactors = FALSE)
}
rowNames <- FALSE
colIdx <- as.integer(rowNames)
ui <- fluidPage(# Application title
titlePanel("Example"),checkboxInput("unroll",label = "Panel Genes",value = FALSE),tags$hr(),mainPanel(DTOutput("my_table"))
)
server <- function(input,output) {
market_mix_table <- reactive({
Dat <- NestedData(
dat = par,children = children_list
)
if (!input$unroll) {
Dat
} else {
Dat <- subset(Dat,Dat$V4 == TRUE)
}
return(Dat)
})
## make 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(var i=0; i < nrows; ++i){"," if(parentRows.indexOf(i) > -1){"," table.cell(i,j0).nodes().to$().css({cursor: 'pointer'});"," }else{",j0).nodes().to$().removeClass('details-control');"," }","}","","// make the table header of the nested table","var format = function(d,childId){"," if(d != null){"," var html = "," '<table class=\"display compact hover\" ' + "," 'style=\"padding-left: 30px;\" id=\"' + childId + '\"><thead><tr>';"," for(var key in d[d.length-1][0]){"," html += '<th>' + key + '</th>';"," }"," html += '</tr></thead></table>'"," return html;"," } else {"," return '';","};","// row callback to style the rows of the child tables","var rowCallback = function(row,displayNum,index){"," if($(row).hasClass('odd')){"," $(row).css('background-color','##DDDDDD');"," $(row).hover(function(){"," $(this).css('background-color','#DDDDDD');"," },function() {"," $(this).css('background-color'," });",'#EAF2F8');","// header callback to style the header of the child tables","var headerCallback = function(thead,data,start,end,display){"," $('th',thead).css({"," 'border-top': '3px solid indigo',"," 'color': '#00274c'," 'background-color': '##DDDDDD'"," });","// make the datatable","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;"," if (Object.keys(d[n][0]).indexOf('_details') === -1) {"," 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'}]"," });"," '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: -1,visible: false}," {targets: 0,orderable: false,className: 'details-control'}," {targets: '_all',className: 'dt-center'}"," ]"," }).column(0).nodes().to$().css({cursor: 'pointer'});","// display the child table on click","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('⊕');"," var childId = tblId + '-child-' + rowIdx;"," row.child(format(row.data(),childId)).show();"," td.html('⊖');"," format_datatable(row.data(),childId);","});")
output$my_table <- DT::renderDT({
Dat <- market_mix_table()
datatable(
Dat,callback = callback,rownames = rowNames,escape = -colIdx-1,options = list(
columnDefs = list(
list(visible = FALSE,targets = ncol(Dat)-1+colIdx),list(orderable = FALSE,className = 'details-control',targets = colIdx)
)
)
)
})
}
# Run the application
shinyApp(ui = ui,server = server)
解决方法
dat0 = iris[1:3,] # main table,with three rows
dat01 = airquality[1:4,] # |- child of first row
dat02 = cars[1:2,] # |- child of second row,with two rows
dat021 = mtcars[1:3,] # | |- child of first row of dat02
dat022 = PlantGrowth[1:4,] # | |- child of second row of dat02
dat03 = data.frame(NULL) # |- third row has no child
# add buttons
dat01 <- cbind(
dat01,"Click me" = as.character(htmltools::tags$button("Click me")),stringsAsFactors = FALSE
)
Dat <- NestedData(
dat = dat0,children = list(
dat01,list(
dat02,children = list(
dat021,dat022
)
),dat03
)
)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
