web-dev-qa-db-fra.com

Comment afficher la valeur y sur l'infobulle pendant le survol dans ggplot2

Je veux que la valeur y s'affiche lorsque je tiens ma souris sur un point du graphique. Le code de mon intrigue ressemble à ceci:

output$graph <- renderPlot({
  p1 <- ggplot(data, aes(x= date)) + 
  geom_line(aes(y=Height, colour = "Height"), size=1) + 
  geom_point(aes(y=Height, colour = "Height", text = paste("Weight/Height:", Height)))
  plot(p1)
})

J'ai fait quelques recherches et j'ai pensé que la partie text = paste("Weight/Height:", Height) dans aes ferait en sorte que le texte apparaisse. Malheureusement, rien n'apparaît. Est-ce que quelqu'un sait ce que j'ai fait de mal?

rggplot2shiny
17
Hav11

Malheureusement, ggplot n'est pas interactif mais il peut être facilement "corrigé" avec plotly package. Il vous suffit de remplacer plotOutput par plotlyOutput puis de rendre un tracé avec renderPlotly.

Exemple 1: complotement 

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
    plotlyOutput("distPlot")
)

server <- function(input, output) {
   output$distPlot <- renderPlotly({
      ggplot(iris, aes(Sepal.Width, Petal.Width)) + 
       geom_line() + 
       geom_point()
   })
}

shinyApp(ui = ui, server = server)


Exemple 2: plotOutput (..., hover = "plot_hover") :

Nous n'avons cependant pas besoin d'utiliser de package spécial pour introduire l'interactivité dans nos graphiques. Tout ce dont nous avons besoin, c'est de notre belle shiny brillante! Nous pouvons simplement jouer avec les options plotOutput comme par exemple click, hover ou dblclick pour rendre l'intrigue interactive. (Voir plus d'exemples dans la galerie brillante)

Dans l'exemple ci-dessous, nous ajoutons "survol" par hover = "plot_hover", puis spécifiez un délai qui est par défaut de 300 ms.

plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0)

Nous pouvons alors accéder aux valeurs via input$plot_hover et utilisez une fonction nearPoints pour afficher les valeurs proches des points.

ui <- fluidPage(
  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("dynamic")

)

server <- function(input, output) {

  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$dynamic <- renderUI({
    req(input$plot_hover) 
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    # print(str(hover)) # list
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })

}
shinyApp(ui = ui, server = server)

Exemple 3: info-bulle ggplot2 personnalisée:

La deuxième solution fonctionne très bien mais oui ... nous voulons le faire mieux! Et oui ... on peut le faire mieux! (... Si nous utilisons du javaScript mais que pssssss n'en parle à personne!).

library(shiny)
library(ggplot2)

ui <- fluidPage(

  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),

  tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 

        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),

  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("my_tooltip")


)

server <- function(input, output) {


  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$my_tooltip <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })  
}
shinyApp(ui = ui, server = server)


Exemple 4: ggvis et add_tooltip:

Nous pouvons également utiliser le package ggvis. Ce package est génial, cependant, pas encore assez mature.

Mise à jour : ggvis est actuellement inactif: https://github.com/rstudio/ggvis#status

library(ggvis)

ui <- fluidPage(
  ggvisOutput("plot")
)

server <- function(input, output) {

  iris %>%
    ggvis(~Sepal.Width, ~Petal.Width) %>%
    layer_points() %>%
    layer_lines() %>% 
    add_tooltip(function(df) { paste0("Petal.Width: ", df$Petal.Width) }) %>%
    bind_shiny("plot")
}

shinyApp(ui = ui, server = server)

[~ # ~] modifié [~ # ~]

Exemple 5:

Après ce post, j'ai cherché sur Internet pour voir si cela pouvait être plus bien fait que exemple 3 . J'ai trouvé ceci une merveilleuse info-bulle personnalisée pour ggplot et je crois que cela ne peut guère être mieux fait que cela.

37
Michal Majka