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（0または1のvs）です。

ですから、次の操作を行うことができ、これらの2を使用して：

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) 
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からkeyを抽出し、このようなサブセットmtcarsする必要があります：

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)