RStudio从listTable中检查行的闪亮列表 [英] RStudio Shiny list from checking rows in dataTables
问题描述
我想要一个类似于此的工作示例：
https：/ /demo.shinyapps.io/029-row-selection/
I would like to have a working example similar to this: https://demo.shinyapps.io/029-row-selection/
我在运行 Shiny Server v1的Shiny服务器中尝试过该示例.1.0.10000 ， packageVersion：0.10.0 和 Node.js v0.10.21 ，但即使我从网站加载了js和css文件，它也无法正常工作。它根本没有从表中选择行：
I tried the example in my Shiny server running Shiny Server v1.1.0.10000, packageVersion: 0.10.0 and Node.js v0.10.21, but it is not working even if I load the js and css files from the website. It simply does not select rows from the table:
# ui.R
library(shiny)
shinyUI(fluidPage(
title = 'Row selection in DataTables',
tagList(
singleton(tags$head(tags$script(src='//cdn.datatables.net/1.10.2/js/jquery.dataTables.js',type='text/javascript'))),
singleton(tags$head(tags$script(src='//cdn.datatables.net/1.10.2/css/jquery.dataTables.min.css',type='text/css')))
),
sidebarLayout(
sidebarPanel(textOutput('rows_out')),
mainPanel(dataTableOutput('tbl')),
position = 'right'
)
))
# server.R
library(shiny)
shinyServer(function(input, output) {
output$tbl <- renderDataTable(
mtcars,
options = list(pageLength = 10),
callback = "function(table) {
table.on('click.dt', 'tr', function() {
$(this).toggleClass('selected');
Shiny.onInputChange('rows',
table.rows('.selected').indexes().toArray());
});
}"
)
output$rows_out <- renderText({
paste(c('You selected these rows on the page:', input$rows),
collapse = ' ')
})
})
然后尝试从使用单选按钮重新排序行的另一个示例来执行此操作。
I then tried to do this from a different example that was using radio buttons to re-sort the rows.
在我的修改示例中，我想生成一个从选择在网页中显示的dataTables表的复选框按钮，例如，从前5个选择一些行，我希望我的文本框为： 1,3,4 对应于 mymtcars $ id 列我添加到mtcars中，然后计划将动作链接到文本框的值。
In my modified example, I want to produce a list of ids from the selected checkbox buttons of the dataTables table shown in the webpage. E.g., selecting some rows from the first 5, I want my textbox to be: 1,3,4 corresponding to the mymtcars$id column I added to mtcars. I then plan to link an action to the values of the textbox.
我在这个例子中几乎存在，但检查框不会更新文本框中的列表。与此相反，在这个例子中，我想让我的复选框保持选择状态，如果表被采用，这可能是棘手的部分，我不知道该怎么做。我还想在表的左上角添加一个选择/取消选择所有文本框，可以选择/取消选择表中的所有框。任何想法？
I have it almost there in this example, but checking the boxes does not update the list in the textbox. Differently to the example shinyapp, I would like my checkboxes to keep the selection status if the table is resorted. This may be the tricky part, and I am not sure how to do it. I would also like to add a "Select/Unselect all" textbox on the top left corner of the table, that selects/unselects all boxes in the table. Any ideas?
# server.R
library(shiny)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
shinyServer(function(input, output, session) {
rowSelect <- reactive({
if (is.null(input[["row"]])) {
paste(sort(unique(rep(0,nrow(mymtcars)))),sep=',')
} else {
paste(sort(unique(input[["row"]])),sep=',')
}
})
observe({
updateTextInput(session, "collection_txt",
value = rowSelect()
,label = "Foo:"
)
})
# sorted columns are colored now because CSS are attached to them
output$mytable = renderDataTable({
addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
#Display table with checkbox buttons
cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])
}, options = list(bSortClasses = TRUE, aLengthMenu = c(5, 25, 50), iDisplayLength = 25))
})
# ui.R
library(shiny)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
shinyUI(pageWithSidebar(
headerPanel('Examples of DataTables'),
sidebarPanel(
checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
selected = names(mymtcars))
),
mainPanel(
dataTableOutput("mytable")
,textInput("collection_txt",label="Foo")
)
)
)
推荐答案
第一个问题你需要开发版本的发光和 htmltools> = 0.2.6 安装：
For the first problem you need the dev version of shiny and htmltools >= 0.2.6 installed:
# devtools::install_github("rstudio/htmltools")
# devtools::install_github("rstudio/shiny")
library(shiny)
runApp(list(ui = fluidPage(
title = 'Row selection in DataTables',
sidebarLayout(
sidebarPanel(textOutput('rows_out')),
mainPanel(dataTableOutput('tbl')),
position = 'right'
)
)
, server = function(input, output) {
output$tbl <- renderDataTable(
mtcars,
options = list(pageLength = 10),
callback = "function(table) {
table.on('click.dt', 'tr', function() {
$(this).toggleClass('selected');
Shiny.onInputChange('rows',
table.rows('.selected').indexes().toArray());
});
}"
)
output$rows_out <- renderText({
paste(c('You selected these rows on the page:', input$rows),
collapse = ' ')
})
}
)
)
为您的第二个例子：
library(shiny)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
list(ui = pageWithSidebar(
headerPanel('Examples of DataTables'),
sidebarPanel(
checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
selected = names(mymtcars))
,textInput("collection_txt",label="Foo")
),
mainPanel(
dataTableOutput("mytable")
)
)
, server = function(input, output, session) {
rowSelect <- reactive({
paste(sort(unique(input[["rows"]])),sep=',')
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )
})
output$mytable = renderDataTable({
addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
#Display table with checkbox buttons
cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])
}, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25)
, callback = "function(table) {
table.on('change.dt', 'tr td input:checkbox', function() {
setTimeout(function () {
Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() {
return $(this).text();
}).get())
}, 10);
});
}")
}
)
)
这篇关于RStudio从listTable中检查行的闪亮列表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
