Возникли проблемы с добавлением вкладки по клику в ячейке в рамках функции наблюдающего в R Shiny - PullRequest
1 голос
/ 15 января 2020

Это минимальный воспроизводимый пример, необходимый для помощи:

ui.R

library(shiny)

fluidPage(
  title = 'DataTables Information',
  tabsetPanel(id = "tabs",
                    tabPanel("Cars overview",
                             h1("Cars overview"),
                             div("Click any cell"),
                             br(),
                             DT::dataTableOutput("x4")
                    )
        )
)

Серверный скрипт:

server.R
library(shiny)
library(DT)

shinyServer(function(input, output, session) {

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



  observeEvent(input$x4_cells_clicked, {
    print("Trigger")
    value <- x4_cells_clicked$value
    details <- mtcars %>%
        filter(mpg == value)
    appendTab(inputId = "tabs",
              tabPanel(
                  DT::renderDataTable(DT::datatable(details), server = TRUE)

              )
    )
    # Focus on newly created tab
    updateTabsetPanel(session, "tabs", selected = "Car details")

  })

})

То, что я пытаюсь выполнить sh, - это вызвать событие через ячейка щелкните по фрейму данных mtcars. Я хочу добавить вкладку при щелчке и отфильтровать кадр данных, который создается значением в ячейке, по которой щелкают. Я знаю, что в этом случае я учитываю только клик по столбцу mpg, но мне просто нужно посмотреть, как регистрируется клик по ячейке с помощью наблюдающего события и как использовать значение ячейки, по которому щелкнули, для фильтрации кадра данных, который создается в новая вкладка.

1 Ответ

2 голосов
/ 06 февраля 2020
library(shiny)
library(DT)

ui <- fluidPage(
  title = 'DataTables Information',
  tabsetPanel(id = "tabs",
              tabPanel("Cars overview",
                       h1("Cars overview"),
                       div("Click any cell"),
                       br(),
                       DTOutput("x4")
              )
  )
)

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

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

  observeEvent(input$x4_cell_clicked, {
    cell <- input$x4_cell_clicked
    if(length(cell)){
      details <- mtcars[mtcars[[cell$col]]==cell$value,]
      appendTab(inputId = "tabs",
                tabPanel(
                  "Cars details",
                  renderDT(datatable(details), server = TRUE)
                ), 
                select = TRUE # Focus on newly created tab
      )
    }
  })

}

shinyApp(ui, server)
...