是否有一种方法可以通过R Shining中的单元格单击来交互式过滤数据表?

时间:2020-01-15 16:48:38

标签: r shiny

这是我用来测试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列进行过滤。抱歉,如果这种解释令人困惑

1 个答案:

答案 0 :(得分: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)