web-dev-qa-db-fra.com

Info-bulle lorsque vous passez la souris sur un ggplot sur brillant

Je crée une application brillante.

Je trace des graphiques en utilisant ggplot.

Lorsque je passe la souris sur les points du graphique, je veux une info-bulle montrant l'une des colonnes du bloc de données (info-bulle personnalisable)

Pouvez-vous s'il vous plaît suggérer la meilleure voie à suivre.

Application simple:

# ui.R

shinyUI(fluidPage(
 sidebarLayout(
    sidebarPanel(
        h4("TEst PLot")),
    mainPanel(
        plotOutput("plot1")
    )
)
))

# server.R

library(ggplot2)
data(mtcars)

shinyServer(
function(input, output) {
    output$plot1 <- renderPlot({
        p <- ggplot(data=mtcars,aes(x=mpg,y=disp,color=factor(cyl)))
        p <- p + geom_point()
        print(p)
    })
}
)

Lorsque je passe la souris sur les points, je veux qu'il affiche mtcars $ wt

rggplot2shinytooltipmouseover
21
guna

Si je comprends bien la question, cela peut être réalisé avec la récente mise à jour du package brillant pour le ggplot2 et le package de base. En utilisant cet exemple de Winston Chang et Joe Cheng http://shiny.rstudio.com/gallery/plot-interaction-basic.html , j'ai pu résoudre ce problème. Le survol est maintenant un argument d'entrée dans plotOutput () de sorte qu'il est ajouté à l'interface utilisateur avec un verbatimTextOutput pour afficher mtcars $ wt pour le point survolé.

Dans le serveur, je fais essentiellement un vecteur de distance qui calcule la distance de la souris à n'importe quel point du tracé et si cette distance est inférieure à 3 (fonctionne dans cette application), il affiche alors mtcars $ wt pour le point le plus proche de votre souris. Pour être clair, l'entrée $ plot_hover renvoie une liste d'informations sur l'emplacement de la souris et seuls les éléments x et y sont extraits de l'entrée $ plot_hover dans cet exemple.

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

ui <- fluidPage(
    fluidRow(
        column(width = 12,
               plotOutput("plot1", height = 350,hover = hoverOpts(id ="plot_hover"))
        )
    ),
    fluidRow(
        column(width = 5,
               verbatimTextOutput("hover_info")
        )
    )
)

server <- function(input, output) {


    output$plot1 <- renderPlot({

        ggplot(mtcars, aes(x=mpg,y=disp,color=factor(cyl))) + geom_point()

    })

    output$hover_info <- renderPrint({
        if(!is.null(input$plot_hover)){
            hover=input$plot_hover
            dist=sqrt((hover$x-mtcars$mpg)^2+(hover$y-mtcars$disp)^2)
            cat("Weight (lb/1000)\n")
            if(min(dist) < 3)
                mtcars$wt[which.min(dist)]
        }


    })
}
shinyApp(ui, server)

J'espère que ça aide!

17
Sölvi

Vous pouvez également utiliser un peu JQuery et conditionnel renderUI pour afficher une info-bulle personnalisée près du pointeur.

library(shiny)
library(ggplot2)

ui <- fluidPage(

  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
     }
  ')),
  tags$script('
    $(document).ready(function(){
      // id of the plot
      $("#plot1").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(mtcars), selected = "disp"),
  plotOutput("plot1", hover = hoverOpts(id = "plot_hover", delay = 0)),
  uiOutput("my_tooltip")
)

server <- function(input, output) {

  data <- reactive({
    mtcars
  })

  output$plot1 <- renderPlot({
    req(input$var_y)
    ggplot(data(), aes_string("mpg", input$var_y)) + 
      geom_point(aes(color = factor(cyl)))
  })

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

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(data(), input$plot_hover)[ , c("mpg", input$var_y)]
    # y <- nearPoints(data(), input$plot_hover)["wt"]
    req(nrow(y) != 0)
    # y is a data frame and you can freely edit content of the tooltip 
    # with "paste" function 
    y
  })
}
shinyApp(ui = ui, server = server)

ÉDITÉ:

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

12
Michal Majka

En utilisant plotly, vous pouvez simplement traduire votre ggplot en une version interactive de lui-même. Appelez simplement la fonction ggplotly sur votre ggplot objet:

library(plotly)

data(mtcars)

shinyApp(
ui <- shinyUI(fluidPage(
  sidebarLayout(sidebarPanel( h4("Test Plot")),
    mainPanel(plotlyOutput("plot1"))
  )
)),

server <- shinyServer(
  function(input, output) {
    output$plot1 <- renderPlotly({
      p <- ggplot(data=mtcars,aes(x=mpg,y=disp,color=factor(cyl)))
      p <- p + geom_point()

      ggplotly(p)
    })
  }
))

shinyApp(ui, server)

Pour les personnalisations de ce qui est montré dans l'info-bulle, regardez par ex. ici .

enter image description here

2
shosaco