將事件數據信息映射到Shiny reactive plot中的繪圖信息

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是組內的行號+1（vs的0或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和子mtcars這樣提取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)