[英]R Shiny selectedInput inside renderDataTable cells
I search for solution to put selectedInputs in renderDataTable cells.我寻找将 selectedInputs 放入 renderDataTable 单元格的解决方案。 I found js solutions: https://datatables.net/examples/api/form.html , however I do not know how to implement this solution in shinyjs as renderDataTable object.我找到了 js 解决方案: https ://datatables.net/examples/api/form.html,但是我不知道如何在 shinyjs 中将此解决方案实现为 renderDataTable 对象。 I would be grateful for hints / ideas / solutions how to implement editable renderDataTable in shiny.对于如何在 shiny 中实现可编辑的 renderDataTable 的提示/想法/解决方案,我将不胜感激。
Very similar to this: adding a column with TRUE/FALSE and showing that as a checkbox 与此非常相似: 添加一个TRUE / FALSE列并将其显示为复选框
library(shiny)
library(DT)
runApp(list(
ui = basicPage(
h2('The mtcars data'),
DT::dataTableOutput('mytable'),
h2("Selected"),
tableOutput("checked")
),
server = function(input, output) {
# helper function for making checkbox
shinyInput = function(FUN, len, id, ...) {
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}
# datatable with checkbox
output$mytable = DT::renderDataTable({
data.frame(mtcars,Rating=shinyInput(selectInput,nrow(mtcars),"selecter_",
choices=1:5, width="60px"))
}, selection='none',server = FALSE, escape = FALSE, options = list(
paging=TRUE,
preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() {
Shiny.bindAll(this.api().table().node()); } ')
) )
# helper function for reading checkbox
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
# output read checkboxes
output$checked <- renderTable({
data.frame(selected=shinyValue("selecter_",nrow(mtcars)))
})
}
))
Note that if you rerender the table, the inputs won't work unless you add some extra code to unbind. 请注意,如果您重新呈现表,除非添加一些额外的代码以解除绑定,否则输入将不起作用。
edit: 编辑:
Let's say the data in the table is reactive so it changes, and the table rerenders. 假设表中的数据是反应性的,因此它会发生变化,表格会重新呈现。 You will need to explicitely unbind as per @yihui here: https://groups.google.com/forum/#!msg/shiny-discuss/ZUMBGGl1sss/zfcG9c6MBAAJ 根据@yihui,您需要明确解开绑定: https ://groups.google.com/forum/#!msg / shiny-discuss / ZUMBGGl1sss / zfcG9c6MBAAJ
So you need to add in the UI: 所以你需要在UI中添加:
tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) {
Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
})"))
And then in the Server you trigger the function whenever you rerender the datatable with: 然后在服务器中,只要您使用以下内容重新渲染数据表,就会触发该函数:
session$sendCustomMessage('unbind-DT', 'mytable')
The colnames parameter is a vector of column names so when you specify a length one vector of FALSE it gives you a table with one column named FALSE. colnames参数是列名的向量,因此当您指定一个FALSE向量的长度时,它会为您提供一个表,其中一列名为FALSE。 I am not sure of a straightforward way of removing column names from datatables. 我不确定从数据表中删除列名的简单方法。 That would be a good SO question on its own. 这本身就是一个很好的问题。
Why not use standart fucntional of DT (Shiny.bindAll) 为什么不使用DT的标准功能(Shiny.bindAll)
Example( in console print select of 1-st row) 示例(在控制台打印选择第1行)
library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
list(ui = fluidPage(
DT::dataTableOutput("mytable")
)
, server = function(input, output, session) {
observe({
print(input$row1)
})
output$mytable = DT::renderDataTable({
#Display table with select
DT::datatable(cbind(Pick=paste0('
<select id="row', mymtcars$id, '"> <option>1</option>
<option>2</option></select>',""), mymtcars),
options = list(orderClasses = TRUE,
lengthMenu = c(5, 25, 50),
pageLength = 25 ,
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}')
),selection='none',escape=F)
} )
})
)
I have provided a solution here: https://stackoverflow.com/a/74784940/16038025 .我在这里提供了一个解决方案: https ://stackoverflow.com/a/74784940/16038025。 Alternatively, here is a simple solution:或者,这是一个简单的解决方案:
buildOptionalDropdowns <- function(id, choices, selected){
if(length(choices) > 1)
return(selectInput(inputId = id, label = NULL, choices = choices, selected = selected))
else
return(choices)
}
res <- data.frame(a = c(rep(0,5), rep(1,5)),
b = character(10)) # adds an empty column
for (i in seq_along(res)) {
res$b[i] <- as.character(buildOptionalDropdowns(paste0("row_select_", i),
choices,
res$b[[i]]))
}
resultTable <- DT::datatable(res,
escape = FALSE)
Even if the question was posted years ago, it maybe still helps someone.即使问题是几年前发布的,它也可能对某人有所帮助。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.