Question

我正在尝试创建一个hexbins的交互式绘图，用户可以在其中单击给定的hexbin并接收在该单击的hexbin中分组的原始数据框的所有观察的列表。

下面是一个看起来非常接近我的目标的MWE。我正在使用Shiny，hexbin（）和ggplotly。

app.R

var Terminator = function(choice1, choice2, result) 
{
    var userChoice = prompt("Do you choose rock, paper or scissors?");
    var computerChoice = Math.random();
    if (computerChoice <= 0.25) {
        computerChoice = "rock";
    } else if(computerChoice <= 0.50) {
        computerChoice = "paper";
    } else if(computerChoice <= 0.75) {
        computerChoice = "scissors";
    } else if(computerChoice <= 0.99) {
        computerChoice = "Arnold Schwarzenegger";
    } 

    {
        if(choice1 === choice2) {
             var result = "The result is a tie!";
        }

        else if (choice1 === "rock") {
            if (choice2 === "scissors") {
                 var result = "rock Wins";
            }
            else if (choice2 === "paper") {
                 var result = "paper Wins";
            }
            else if (choice2 = "Arnold Schwarzenegger") {
                 var result = "You have been TERMINATED";
            }
        }

        else if (choice1 === "scissors") {
            if (choice2 === "rock") {
                 var result = "rock Wins";
            }
            else if (choice2 === "paper") {
                 var result = "scissors Wins";
            }
            else if (choice2 = "Arnold Schwarzenegger") {
                 var result = "You have been TERMINATED";
            }
        }

        else if (choice1 === "paper") {
            if (choice2 === "scissors") {
                 var result = "scissors Wins";
            }
            else if (choice2 === "rock") {
                 var result = "paper Wins";
            }
            else if (choice2 = "Arnold Schwarzenegger") {
                 var result = "You have been TERMINATED";
            }
        } 

        else if (choice1 === "Arnold Schwarzenegger") {
            if (choice2 === "scissors") {
                 var result = "Get to the Chopper!";
            }
            else if (choice2 === "rock") {
                 var result = "Hasta la vista, baby!";
            }
            else if (choice2 = "paper") {
                 var result = "I'll be back";
            }
        } 
    }
  };
    compare(userChoice,computerChoice,Wins);

h @ cID对象内部是所有数据点的ID（显示哪个数据点进入哪个hexbin）。因此，我觉得如果我能够在用户点击时让event_data（）返回hexbin ID，那么我应该能够成功地将该hexbin ID映射回h @ cID对象以获取相应的数据点。 / p>

不幸的是，我当前编写的方式，event_data（）将返回“curveNumber”，它似乎不等于ID。它似乎也没有转化为ID（即使使用h对象中的所有信息 - 不仅仅是h @ cID，还有更多如h @ xcm，h @ ycm等）。

有没有人知道解决此类问题的方法？任何想法将不胜感激！

注意：我最近的两篇帖子（包括赏金）与这个问题非常相似。它们位于此处（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将被认为小于数字2，因为18从数字1开始，小于数字2。

当此示例中的完整数据集用count，ID和curveNumber表示时，您可以看到此模式：

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)

以下是我对此问题的初步解决方案。我很确定它适用于此此数据集，但我打算在更多数据集上对其进行测试以确定。

app.R

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

编辑2：

Answer 1

简化了你的问题，我可以给你一个部分答案。下面的代码允许您单击分档数据（绘制为正方形）并获取原始数据。

Plotly以x，y，curveNumber和pointNumber的形式返回click events的信息。 curveNumber为跟踪编制索引，但这似乎取决于如何调用plotly。 pointNumber似乎根据数据的顺序进行索引（并且它也链接到curveNumber）。如果仅绘制一组点，则映射到原始数据相对简单。

下面的解决方案适用于点，因为它使用pointNumber（x和y可能是更好的查找组合，因为它们是绝对值而不是相对顺序）。该解决方案不适用于您最初请求的geom_hex六边形，因为只需单击鼠标即可返回curveNumber。看起来六边形首先按计数添加，然后通过其他一些排序变量添加。如果您想使用curveNumber，解决geom_hex编号背后的基本原理是关键。

下面是两个屏幕抓图：左边=带geom_hex的原始图。右=使用geom_point使用pointNumber修改绘图以正确地为结果编制索引。

修改后的代码如下。 OP和我都非常借用这个关于hexbins的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)

在单个图中获得geom_hex中的观察结果（Shiny）

1 个答案: