1つのプロット（shiny）のgeom_hexで観測値を取得

Question

ユーザーが与えられたhexbinをクリックして元のデータフレームのすべての観測値のリストを受け取ることができる、hexbinsの対話プロットを作成しようとしていますクリックしたhexbin。

以下は私の目標にかなり近いMWEです。私は光沢のあるhexbin（）とggplotlyを使用しています。時間@のCIDオブジェクト内部

app.R

library(shiny) 
library(plotly) 
library(data.table) 
library(GGally) 
library(reshape2) 
library(hexbin) 

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

server <- function(input, output, session) { 
    #Create data 
    set.seed(1) 
    bindata <- data.frame(x=rnorm(100), y=rnorm(100)) 

    h <- hexbin (bindata, xbins = 5, IDs = TRUE, xbnds = range (bindata$x), ybnds = range (bindata$y)) 

    # As we have the cell IDs, we can merge this data.frame with the proper coordinates 
    hexdf <- data.frame (hcell2xy (h), ID = h@cell, counts = h@count) 

    # I have tried different methods of generating the ggplot object 
    #p <- ggplot(hexdf, aes(x=x, y=y, fill = counts)) + geom_hex(stat="identity") 
    #p <- ggplot(hexdf, aes(x=x, y=y, fill = ID)) + geom_hex(stat="identity") 
    #p <- ggplot(hexdf, aes(x=x, y=y, fill = counts, colours = ID)) + geom_hex(stat="identity") 
    #p <- ggplot(hexdf, colours = ID, aes(x=x, y=y, colours = ID, fill = counts)) + geom_hex(stat="identity") 
    p <- ggplot(hexdf, aes(x=x, y=y, fill = counts, ID=ID)) + geom_hex(stat="identity") 

    output$plot <- renderPlotly({ 
    ggplotly(p) 
    }) 

    d <- reactive(event_data("plotly_click")) 

    output$click <- renderPrint({ 
    if (is.null(d())){ 
     "Click on a state to view event data" 
    } 
    else{ 
     str(d()) 
     #Next line would deliver all observations from original data frame (bindata) that are in the clicked hexbin... if d() from event_data() was returning ID instead of curveNumber 
     #bindata[which(h@cID==d()$curveNumber),] 
    } 
    }) 
} 

shinyApp(ui, server) 

は、すべてのデータ点（データ点がどのhexbinに入る表示）するためのIDです。したがって、ユーザーがクリックしたときにevent_data（）にhexbin IDを返すことができれば、そのhexbin IDをh @ cIDオブジェクトに正常にマッピングして対応するデータポイントを取得できるはずです。

残念ながら、event_data（）はIDを等しく見せない "curveNumber"を返します。 h @ cIDだけでなく、h @ xcm、h @ ycmなどのhオブジェクトのすべての情報を使用している場合でも、IDに変換するようには見えません。

ありますか誰もがこのタイプの問題を解決する方法を知っていますか？任意のアイデアをいただければ幸いです！

注：最新の2つの投稿（賞金を含む）は、この質問に非常に似ています。彼らはここに（Interactive selection in ggplotly with geom_hex() scatterplot）と（Obtain observations in geom_hex using plotly and Shiny）に位置しています。違いは、私は問題を各ステップでよりシンプルにしていることです。ありがとうございました。

編集 - 可能性のある回答

私はこの問題の解決策を取得しているかもしれないと思います。 @oshunが気付いたように、event_data（）から返されたcurveNumberとhexbin IDの間には隠れた変換があります。 curveNumbersは最初にhexbinsの数を増やすことによって最小から最大にソートされているようです。次に、特定のカウント内で、curverNumberがIDを増やすことによって最小から最大までさらにソートされているように見えます。ただし、IDはの文字（の番号はではない）でソートされています。たとえば、数字18は数字1よりも小さい数字2で始まるため、数字18は数字2よりも小さいと考えられます。

この例の完全なデータセットがcountで表されている場合、 ID、およびcurveNumberを以下に示します。

count=1 (ID=24) —> curveNumber 0 
count=1 (ID=26) —> curveNumber 1 
count=1 (ID=34) —> curveNumber 2 
count=1 (ID=5) —> curveNumber 3 
count=1 (ID=7) —> curveNumber 4 
count=2 (ID=11) —> curveNumber 5 
count=2 (ID=14) —> curveNumber 6 
count=2 (ID=19) —> curveNumber 7 
count=2 (ID=23) —> curveNumber 8 
count=2 (ID=3) —> curveNumber 9 
count=2 (ID=32) —> curveNumber 10 
count=2 (ID=4) —> curveNumber 11 
count=3 (ID=10) —> curveNumber 12 
count=3 (ID=13) —> curveNumber 13 
count=3 (ID=33) —> curveNumber 14 
count=3 (ID=40) —> curveNumber 15 
count=3 (ID=9) —> curveNumber 16 
count=4 (ID=17) —> curveNumber 17 
count=4 (ID=20) —> curveNumber 18 
count=5 (ID=28) —> curveNumber 19 
count=5 (ID=8) —> curveNumber 20 
count=6 (ID=21) —> curveNumber 21 
count=8 (ID=27) —> curveNumber 22 
count=9 (ID=22) —> curveNumber 23 
count=11 (ID=16)—> curveNumber 24 
count=14 (ID=15)—> curveNumber 25 

この問題の解決策は次のとおりです。私はそれがこのために動作することを確信していますこのデータセット、私はより多くのデータセットでそれを確かめるためにテストするつもりです。

app.R

library(shiny) 
library(plotly) 
library(data.table) 
library(GGally) 
library(reshape2) 
library(hexbin) 

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

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

    # Curve number to ID 
    cnToID <- function(h){ 
    df <- data.frame(table(h@cID)) 
    colnames(df) <- c("ID","count") 
    cnID <- df[order(df$count,as.character(df$ID)),] 
    cnID$curveNumber <- seq(0, nrow(cnID)-1) 
    return(cnID) 
    } 

    # Create data 
    set.seed(1) 
    bindata <- data.frame(x=rnorm(100), y=rnorm(100)) 
    h <- hexbin (bindata, xbins = 5, IDs = TRUE, xbnds = range (bindata$x), ybnds = range (bindata$y)) 
    hexdf <- data.frame (hcell2xy (h), ID = h@cell, counts = h@count) 
    p <- ggplot(hexdf, aes(x=x, y=y, fill = counts, ID=ID)) + geom_hex(stat="identity") 
    #p <- ggplot(hexdf, aes(x=x, y=y, fill = counts), ID=ID) + geom_hex(stat="identity") 
    cnID <- cnToID(h) 

    output$plot <- renderPlotly({ 
    p2 <- ggplotly(p) 
    for (i in 1:nrow(hexdf)){ 
     p2$x$data[[i]]$text <- gsub("<.*$", "", p2$x$data[[i]]$text) 
    } 
    p2 
    }) 

    d <- reactive(event_data("plotly_click")) 

    output$click <- renderPrint({ 
    if (is.null(d())){ 
     "Click on a state to view event data" 
    } 
    else{ 
     clickID <- as.numeric(as.character(cnID[which(cnID$curveNumber==d()$curveNumber),]$ID)) 
     clickID 
     bindata[which(h@cID==clickID),] 
    } 
    }) 
} 

shinyApp(ui, server) 

編集2：私はあなたの部分的な答えを与えることができることを十分にご質問を簡素化

Answer 1

。以下のコードでは、binnedデータ（四角でプロット）をクリックして元のデータを取得できます。

Plotlyはxの形態でclick events、y、curveNumberとpointNumberに関する情報を返します。 curveNumberはトレースにインデックスを付けますが、これはプロットされた方法によって異なります。 pointNumberは、データの順番に応じて索引付けされます（また、curveNumberにリンクされています）。 1つの点群しかプロットされていない場合、元のデータにマッピングするのは比較的簡単です。

pointNumber（xおよびyは、相対的な順序ではなく絶対値なので、おそらくより良いルックアップコンボです）、以下の解決策はポイントで動作します。マウスクリックでcurveNumberのみが返されるため、このソリューションは最初に要求したとおり、六角形のgeom_hexで動作しません。外見上は、六角形が最初に数えられ、次に他のソート変数によって追加されます。 geom_hexを使用する場合は、curveNumberナンバリングの背後にある根拠を解決することが重要です。

以下は2つのスクリーングラブです：左=元のプロットはgeom_hexです。右= geom_pointのプロットをpointNumberに変更して結果を正しく索引付けします。

変更されたコードは、以下です。 OPと私はどちらもヘックスビンについてこのanswerから大いに借りています。

library(shiny); library(plotly); library(GGally); library(reshape2); library(hexbin) 

ui <- fluidPage(
    plotlyOutput("plot"), 
    checkboxInput("squarePoints", label = "Switch to points?"), 
    verbatimTextOutput("click"), 
    HTML("Check the work:"), 
    plotlyOutput("plot1") 
) 

server <- function(input, output, session) { 
    #Create data 
    set.seed(1) 
    bindata <- data.frame(myIndex = factor(paste0("ID",1:100)), 
         x=rnorm(100), y=rnorm(100)) 

    h <- hexbin (bindata[,2:3], xbins = 5, IDs = TRUE, 
       xbnds = range(bindata$x), ybnds = range(bindata$y)) 

    # As we have the cell IDs, we can merge this data.frame with the proper coordinates 
    hexdf <- data.frame (hcell2xy (h), ID = h@cell, counts = h@count) 

    #New code added below ### 
    counts <- hexTapply(h, bindata$myIndex, table) #list of 26 
    counts <- t(simplify2array (counts)) 
    counts <- melt (counts)     #2600 rows = 26 hexagons * 100 observations 
    colnames (counts) <- c ("ID", "myIndex", "present") 

    allhex <- merge (counts, hexdf)   #2600 rows = 26 hexagons * 100 observations 
    #rename hex coordinates 
    names(allhex)[names(allhex) %in% c("x", "y")] <- c("hex.x", "hex.y") 
    allhex <- merge(allhex, bindata) 
    somehex <- allhex[allhex$present > 0,] #100 rows (original data) 

    #Plotly graphs objects in a certain order, so sort the lookup data by the same order 
    #in which it's plotted. 
    #No idea how curveNumber plots data. First by counts, then by ...? 
    #pointNumber seems more straightforward. 
    sorthex <- hexdf[with(hexdf, order(ID)), ] 

    #Create a switch to change between geom_hex() and geom_point() 
    switchPoints <- reactive(if(input$squarePoints) { 
    geom_point(shape = 22, size = 10) 
    } else { 
     geom_hex(stat = "identity") 
     }) 

    hexdf$myIndex <- "na" #Added here for second plotly 
    ### New code added above ### 

    p <- reactive(ggplot(hexdf, aes(x=x, y=y, fill = counts)) + coord_equal() + 
       switchPoints()) 

    output$plot <- renderPlotly({ 
    ggplotly(p()) 
    }) 

    d <- reactive(event_data("plotly_click")) 
    #pointNumber = index starting from 0 
    hexID <- reactive(sorthex[d()$pointNumber + 1, "ID"]) 

    output$click <- renderPrint({ 
    if (is.null(d())){ 
     "Click on a state to view event data" 
    } 
    else{ 
     list(
     str(d()), 
     somehex[somehex$ID == hexID(),] 
    ) 
    } 
    }) 

    #Check your work: plot raw data over hexagons 
    p.check <- ggplot(hexdf, aes(x=x, y=y, fill = counts)) + geom_hex(stat="identity") + 
    geom_point(data = somehex, aes(x=x, y=y)) + coord_equal() 

    output$plot1 <- renderPlotly({ 
    ggplotly(p.check + aes(label= myIndex)) 
    }) 


} 

shinyApp(ui, server)