有没有办法通过在 R Shiny 中单击单元格来交互式过滤数据表？

Question

这是一个 R 闪亮应用程序的基本框架，我用它来测试 R 中的单元格点击向下钻取。通过这段代码，我可以看到每次点击都会打印单元格值：

ui.R

library(shiny)

fluidPage(
  title = 'DataTables Information',
  h1('A client-side table'),
  fluidRow(
    column(6, DT::dataTableOutput('x6'))
  ),
  hr(),
  h1('A table using server-side processing'),
  fluidRow(
    column(6, DT::dataTableOutput('x4')),
    column(6, verbatimTextOutput('x5'))
  )
)

服务器脚本：

server.R
library(shiny)
library(DT)

shinyServer(function(input, output, session) {

  # render the table (with row names)
  output$x6 = DT::renderDataTable(mtcars, server = TRUE)

  output$x4 = DT::renderDataTable({
    DT::datatable(mtcars, selection = 'single')
  }, server = TRUE) 

  output$x5 = renderPrint({
    cat('cell value:\n\n')
    cat(input$x4_cell_clicked$value, sep = ', ')
    cat('\n\nAll rows:\n\n')
    cat(input$x4_rows_all, sep = ', ')
    cat('\n\nSelected rows:\n\n')
    cat(input$x4_rows_selected, sep = ', ')
  })

  observeEvent(input$x4_rows_selected, {
    validate(need(!is.null(input$x4_cell_clicked), ''))
    print("You clicked something!")
  })

  observeEvent(input$x4_rows_selected, {
    validate(need(!is.null(input$x4_cell_clicked), ''))
    info <- input$x4_cell_clicked$value

  })

})

每次我单击底部表格中标记为“x4”的单元格时，我都试图让顶部表格标记为“x6”以动态过滤。我尝试使用以下代码通过代理来执行此操作：

library(shiny)
library(DT)

shinyServer(function(input, output, session) {

  # render the table (with row names)
  output$x6 = DT::renderDataTable(mtcars, server = TRUE)

  output$x4 = DT::renderDataTable({
    DT::datatable(mtcars, selection = 'single')
  }, server = TRUE) 

  output$x5 = renderPrint({
    cat('cell value:\n\n')
    cat(input$x4_cell_clicked$value, sep = ', ')
    cat('\n\nAll rows:\n\n')
    cat(input$x4_rows_all, sep = ', ')
    cat('\n\nSelected rows:\n\n')
    cat(input$x4_rows_selected, sep = ', ')
  })

  observeEvent(input$x4_rows_selected, {
    validate(need(!is.null(input$x4_cell_clicked), ''))
    print("You clicked something!")
  })

  myProxy = DT::dataTableProxy('x6')

  observeEvent(input$x4_rows_selected, {
    validate(need(!is.null(input$x4_cell_clicked), ''))
    info <- input$x4_cell_clicked$value

  })

  # reset last selected value using the proxy
  observeEvent(input$reset, {
  DT::selectRows(myProxy, NULL)
     validate(need(!is.null(input$x4_cell_clicked), ''))
     myProxy <- myProxy %>% 
       filter(mpg == input$x4_cell_clicked$value)
     output$x6 = DT::renderDataTable(myProxy, server = TRUE)
  })
})

尽管单击单元格，“x6”表不会更新。我只需要了解如何通过 observeEvent 函数动态访问单元格中的值以影响其他图形或向下钻取。对于初始测试用例，当我单击“x4”表中 mpg 列中的单元格时，我希望“x6”表按 mpg 列过滤。对不起，如果这个解释令人困惑

Answer 1

用代理想太多了，只需要让 x6 的数据对来自 x4 的输入产生反应

library(shiny)
library(DT)

ui <- fluidPage(
  title = 'DataTables Information',
  h1('A client-side table'),
  fluidRow(
    column(6, DT::dataTableOutput('x6'))
  ),
  hr(),
  h1('A table using server-side processing'),
  fluidRow(
    column(6, DT::dataTableOutput('x4'))
  )
)

server <- function(input, output, session) {
  dat <- reactive({

    temp <- mtcars

    if (is.null(input$x4_rows_selected)) {
      temp <- mtcars
    }
    else {
      select <- mtcars[input$x4_rows_selected,]

      temp <- mtcars[mtcars$mpg == select$mpg,]
    }

    return(temp)

  })


  output$x6 = DT::renderDataTable(dat(), server = TRUE)

  output$x4 = DT::renderDataTable({
    DT::datatable(mtcars, selection = 'single')
  }, server = TRUE) 

}

shinyApp(ui, server)