Question

我尝试在geom_area上使用悬停工具提示，但我无法让它们使用该几何体。它只显示最低的分组变量集（在下面的示例中，它将显示＆＃39; Lakers＆＃39;悬停值，但不会显示＆＃39;凯尔特人＆＃39;。

有趣的是，如果用例如geom_point替换geom_area，下面的代码可以正常工作。但对于我制作的真实仪表板，区域图是必要的。

library("shiny")
library("ggplot2")

d <- data.frame(date = as.Date(c("2017-01-01", "2017-01-02", "2017-01-03",
                                 "2017-01-01", "2017-01-02", "2017-01-03")),
                team = c("Celtics", "Celtics", "Celtics",
                         "Lakers", "Lakers", "Lakers"),
                points_scored = c(108, 89, 95, 78, 93, 82))

ui <- fluidPage(
  mainPanel(
      plotOutput("graph", 
                 hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
      uiOutput("hover_info")
  )
)

server <- function(input, output) {

  output$graph <- renderPlot({
    ggplot(d, aes(x = date, y = points_scored, fill = team)) +
      geom_area()
  })

  output$hover_info <- renderUI({
    hover <- input$plot_hover
    point <- nearPoints(d, hover, threshold = 5, maxpoints = 1, addDist = TRUE)
    if (nrow(point) == 0) return(NULL)

    wellPanel(
      paste0(point$team, " - ", point$date, ": ", point$points_scored)
    )
  })
}

runApp(list(ui = ui, server = server))

提前致谢！

---编辑---

它实际上是在不正确的位置显示悬停。见附图。它将点（1月1日的凯尔特人队）视为仍然在y = 108.我希望它悬停在可见红色条的顶部（108 + 78 = 186），但仍然显示108. / p>

Answer 1

我找到了一个粗略的解决方法，但它让应用程序按照我的意愿去做。我编辑的应用程序只编辑服务器功能，如下所示：

继续使用主数据框'd'生成图表。继续在该图表的plotOutput中使用悬停
创建一个相同的变通方数据框'd_workaround'，除了它包含1）与'd'和图中的y列同名的列中的点的实际y位置（points_scored。我想要将此名称命名为“位置”，但该应用仅在与“d”中的y列具有相同名称时才起作用; 2）我希望工具提示显示的“真实”值（points_scored_real）
指示我的nearPoints（）使用d_workaround，我的工具提示显示该列中的points_scored_real

该应用程序如下所示：

library(shiny)
library(ggplot2)
library(dplyr)
library(tidyr)
library(stringr)

d <- data.frame(date = as.Date(c("2017-01-01", "2017-01-02", "2017-01-03",
                                 "2017-01-01", "2017-01-02", "2017-01-03")),
                team = c("Celtics", "Celtics", "Celtics",
                         "Lakers", "Lakers", "Lakers"),
                points_scored = c(108, 89, 95, 78, 93, 82))

ui <- fluidPage(
  mainPanel(
    plotOutput("graph", 
               hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
    uiOutput("hover_info")
  )
)

server <- function(input, output) {

  output$graph <- renderPlot({
    ggplot(d, aes(x = date, y = points_scored, fill = team)) +
      geom_area()
  })

  output$hover_info <- renderUI({
    d_workaround <- d %>% 
      spread(team, points_scored) %>% 
      mutate(Celtics = str_c(Celtics + Lakers, "-", Celtics),
             Lakers = str_c(Lakers, "-", Lakers)) %>% 
      gather(team, points_scored, Celtics, Lakers) %>% 
      separate(points_scored, c("points_scored", "points_scored_real"), convert = TRUE)

    hover <- input$plot_hover
    point <- nearPoints(d_workaround, hover, threshold = 10, maxpoints = 1, addDist = TRUE)
    if (nrow(point) == 0) return(NULL)

    wellPanel(
      paste0(point$team, " - ", point$date, ": ", point$points_scored_real)
    )
  })
}

runApp(list(ui = ui, server = server))

R Shiny：如何在geom_area或堆叠的geom_bar上使用nearPoints？

1 个答案: