来自检查数据表中行的 RStudio 闪亮列表 [英] RStudio Shiny list from checking rows in dataTables

问题描述

我想要一个与此类似的工作示例: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图书馆(闪亮)闪亮的UI(流体页面(title = '数据表中的行选择',标签列表(singleton(tags$head(tags$script(src='//cdn.datatables.net/1.10.2/js/jquery.dataTables.js',type='text/javascript'))),单例(标签$头(标签$脚本(src='//cdn.datatables.net/1.10.2/css/jquery.dataTables.min.css'，type='text/css')))),侧边栏布局(sidebarPanel(textOutput('rows_out')),主面板(数据表输出('tbl'))，位置 = '正确')))# server.R图书馆(闪亮)闪亮服务器(功能(输入，输出){输出$tbl <- renderDataTable(mtcars，选项 = 列表(页面长度 = 10)，回调 =函数(表){table.on('click.dt', 'tr', function() {$(this).toggleClass('selected');Shiny.onInputChange('rows',table.rows('.selected').indexes().toArray());});}")output$rows_out <- renderText({paste(c('您在页面上选择了这些行:', input$rows),崩溃 = ' ')})})

然后我尝试从一个使用单选按钮重新排序行的不同示例中执行此操作.

在我修改的示例中，我想从网页中显示的 dataTables 表的选定复选框按钮生成一个 id 列表.例如，从前 5 行中选择一些行，我希望我的文本框是: 1,3,4 对应于我添加到 mtcars 的 mymtcars$id 列.然后我计划将一个操作链接到文本框的值.

在这个例子中我几乎有它，但选中这些框不会更新文本框中的列表.与示例 Shinyapp 不同，如果重新使用表格，我希望我的复选框保持选择状态.这可能是棘手的部分，我不知道该怎么做.我还想在表格的左上角添加一个全选/取消全选"文本框，用于选择/取消选择表格中的所有框.有什么想法吗?

# server.R图书馆(闪亮)mymtcars = mtcarsmymtcars$id = 1:nrow(mtcars)闪亮服务器(功能(输入，输出，会话){rowSelect <- 反应式({if (is.null(input[["row"]])) {粘贴(排序(唯一(rep(0，nrow(mymtcars))))，sep ='，')} 别的 {粘贴(排序(唯一(输入[[行"]]))，sep='，')}})观察({更新文本输入(会话，collection_txt"，值 = 行选择(),label = "Foo:")})# 已排序的列现在是彩色的，因为 CSS 附加到它们输出$mytable = renderDataTable({addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")#显示带有复选框按钮的表格cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])}, options = list(bSortClasses = TRUE, aLengthMenu = c(5, 25, 50), iDisplayLength = 25))})#ui.R图书馆(闪亮)mymtcars = mtcarsmymtcars$id = 1:nrow(mtcars)闪亮的UI(页面带侧边栏(headerPanel('数据表示例'),侧边栏面板(checkboxGroupInput('show_vars', '要显示的列:', names(mymtcars),选择 = 名称(mymtcars))),主面板(数据表输出(我的表"),textInput("collection_txt",label="Foo"))))

解决方案

对于第一个问题，您需要 shiny 和 htmltools >= 0.2.6 的开发版本已安装:

# devtools::install_github("rstudio/htmltools")# devtools::install_github("rstudio/shiny")图书馆(闪亮)运行应用程序(列表(用户界面 = 流体页面(title = '数据表中的行选择',侧边栏布局(sidebarPanel(textOutput('rows_out')),主面板(数据表输出('tbl'))，位置 = '正确'))，服务器 = 功能(输入，输出){输出$tbl <- renderDataTable(mtcars，选项 = 列表(页面长度 = 10)，回调 =函数(表){table.on('click.dt', 'tr', function() {$(this).toggleClass('selected');Shiny.onInputChange('rows',table.rows('.selected').indexes().toArray());});}")output$rows_out <- renderText({paste(c('您在页面上选择了这些行:', input$rows),崩溃 = ' ')})}))

对于你的第二个例子:

图书馆(闪亮)mymtcars = mtcarsmymtcars$id = 1:nrow(mtcars)运行应用程序(列表(ui = pageWithSidebar(headerPanel('数据表示例'),侧边栏面板(checkboxGroupInput('show_vars', '要显示的列:', names(mymtcars),选择 = 名称(mymtcars)),textInput("collection_txt",label="Foo")),主面板(数据表输出(我的表")))，服务器 = 功能(输入，输出，会话){rowSelect <- 反应式({粘贴(排序(唯一(输入[[行"]]))，sep='，')})观察({updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )})输出$mytable = renderDataTable({addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")#显示带有复选框按钮的表格cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])}, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25), 回调 = "函数(表){table.on('change.dt', 'tr td input:checkbox', function() {设置超时(函数(){Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() {返回 $(this).text();}).得到())}, 10);});}")}))

I would like to have a working example similar to this: https://demo.shinyapps.io/029-row-selection/

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.

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")
              )
      )
)

解决方案

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 = ' ')
  })
}
)
)

for your second example:

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 闪亮列表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！