RStudio来自检查dataTables中的行的Shiny列表
719*_*016 10 r datatables shiny
我想有一个类似的工作示例:https: //demo.shinyapps.io/029-row-selection/
我试过例如在我闪亮的服务器上运行Shiny Server v1.1.0.10000,packageVersion: 0.10.0并且Node.js v0.10.21,但是即使我加载从网站的JS和CSS文件,它不工作.它根本不从表中选择行:
# 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 = ' ')
})
})
然后我尝试从另一个使用单选按钮重新排序行的示例中执行此操作.
在我修改过的示例中,我想从网页中显示的dataTables表的所选复选框按钮生成一个id列表.例如,从前5个中选择一些行,我希望我的文本框为:1,3,4对应于mymtcars$id我添加到mtcars 的列.然后,我计划将操作链接到文本框的值.
我在这个示例中几乎已经有了它,但是检查框不会更新文本框中的列表.与示例shinyapp不同,我希望我的复选框能够保留选择状态(如果使用该表).这可能是棘手的部分,我不知道该怎么做.我还想在表格的左上角添加一个"选择/取消全选"文本框,用于选择/取消选择表格中的所有框.有任何想法吗？
# 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")
)
)
)
jdh*_*son 17
对于第一个问题,您需要dev版本shiny并htmltools >= 0.2.6安装:
# 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);
});
}")
}
)
)
