Есть ли способ интерактивной фильтрации данных через щелчок ячейки в R блестящий?

Question

Это базовый c скелет приложения 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

  })

})

Я пытаюсь получить верхнюю таблицу с надписью 'x6' для динамической фильтрации каждый раз, когда я нажимаю на ячейку в нижней таблице с надписью 'x4'. Я попытался сделать это через прокси с таким кодом:

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' не обновляется при щелчках по ячейкам. Мне просто нужно понять, как можно динамически получить доступ к значению из ячейки с помощью функций наблюдающих событий, чтобы влиять на другие фигуры или детализацию. Для начального теста я хотел бы, чтобы таблица «x6» фильтровала по столбцу mpg, когда я щелкаю ячейку в столбце mpg в таблице «x4». Извините, если это объяснение сбивает с толку

Answer 1

Тяжело думая с прокси, просто нужно сделать данные х6 реактивными с вводом из х4

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)