Показывать всплывающую подсказку при наведении указателя мыши на график flexdashboard в JS или при наведении - PullRequest
Новая
       11

Показывать всплывающую подсказку при наведении указателя мыши на график flexdashboard в JS или при наведении

3 голосов
/ 25 февраля 2020

У меня есть следующий пример flexdashboard: 

---
title: "Hover"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
data(iris)

Column {data-width=650}
-----------------------------------------------------------------------

### Chart A

```{r}
iris %>% group_by(Species) %>% 
  summarise(mean = mean(Sepal.Length)) %>% 
  ggplot(aes(Species, mean)) + geom_col()

Мне нужна подсказка при наведении курсора на столбцы на графике и показ его значений. Я прочитал эту статью в SO Как показать значение y во всплывающей подсказке при наведении курсора на ggplot2 , но это работает для Shiny. Я попробовал это: 

p <- iris %>% group_by(Species) %>% 
  summarise(mean = mean(Sepal.Length))

labels <- sprintf("<strong>%s</strong><br/>Mean: %f", 
                     p$Species, p$mean) %>% 
     lapply(htmltools::HTML)

p %>% ggplot(aes(Species, mean)) + geom_col() + geom_text(aes(label = labels))

Это создает инструмент html с spe cie и значением, но у меня нет наведенного курсора (возможно, plot_hover?), Чтобы показать подсказку .

Любая помощь будет принята с благодарностью

С уважением,

1 Ответ

2 голосов
/ 02 марта 2020

Вот способ. Вы должны нацелиться на верхний центр бара, чтобы получить подсказку. 

---
title: "Untitled"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

```{r setup, include=FALSE}
library(flexdashboard)
library(dplyr)
library(ggplot2)
library(shiny)
```

Column {data-width=650}
-----------------------------------------------------------------------

### Chart A

```{r}
dat <- iris %>% group_by(Species) %>% 
  summarise(mean = mean(Sepal.Length))
output[["ggplot"]] <- renderPlot({
  dat %>% 
  ggplot(aes(Species, mean)) + geom_col()
})
output[["hoverinfo"]] <- renderUI({ 
  hover <- input[["plot_hover"]]
  if(is.null(hover)) return(NULL)
  point <- nearPoints(dat, hover, threshold = 50, maxpoints = 1)
  if(nrow(point) == 0) return(NULL)
  left_px <- hover$coords_css$x
  top_px <- hover$coords_css$y
  style <- 
    paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ",
           "left:", left_px, 
           "px; top:", top_px, "px;")
  # tooltip created as wellPanel
  tooltip <- paste0(
    "<b> Species: </b>", point[["Species"]], "<br/>",
    "<b> mean: </b>", point[["mean"]]
  )
  wellPanel(
    style = style, p(HTML(tooltip))
  )
}) 
plotOutput("ggplot", hover = hoverOpts("plot_hover"))
div(uiOutput("hoverinfo"), style = "pointer-events: none;")
```
...