將事件數據信息映射到Shiny反應圖中的繪圖信息

Question

如何從even_data信息中檢索用於繪圖的原始數據？

library(plotly)
library(shiny)

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("click")
)

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

  output$plot <- renderPlotly({
    key <- row.names(mtcars)
    p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) + 
        geom_point()
    ggplotly(p) %>% layout(dragmode = "select")

  })


  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" else d
  })


}

shinyApp(ui, server)

單擊某個點時，示例輸出將類似於

  curveNumber pointNumber    x    y       key
1           1           3 24.4 3.19 Merc 240D

有什么辦法可以將這些信息映射到原始數據集mtcars ？ curveNumber和pointNumber的信息將如何有用，這些字段是什么意思？

Answer 1

curveNumber是colour = factor(vs)變量， pointNumber是組（vs的0或1）內的行號+1。

因此，使用這兩個，您可以執行以下操作：

library(plotly)
library(shiny)
library(dplyr)
ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("click")
)
server <- function(input, output, session) {
  output$plot <- renderPlotly({
    key <- row.names(mtcars)
    p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) + 
      geom_point()
    ggplotly(p) %>% layout(dragmode = "select")
  })
  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" else mtcars %>% tibble::rownames_to_column() %>% filter(vs==d$curveNumber) %>% filter(row_number()==d$pointNumber+1)

  })
}
shinyApp(ui, server)

或者，第二種選擇，您需要像這樣從event_data和mtcar子集中提取key ：

output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" 
    else mtcars[rownames(mtcars) == d$key,]
  })

完整的應用程序：

library(plotly)
library(shiny)
ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("click")
)
server <- function(input, output, session) {
  output$plot <- renderPlotly({
    key <- row.names(mtcars)
    p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) + 
      geom_point()
    ggplotly(p) %>% layout(dragmode = "select")
  })
  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Click events appear here (double-click to clear)" else mtcars[rownames(mtcars) == d$key,]
  })
}
shinyApp(ui, server)