graphs - ToolTip cuando pasas el mouse sobre un ggplot en bright

shiny graphs

Question

Estoy construyendo una aplicación brillante.

Estoy trazando gráficos utilizando ggplot.

Cuando muevo el mouse sobre los puntos en el gráfico, quiero una información sobre herramientas que muestre una de las columnas en el marco de datos (información sobre herramientas personalizable)

¿Puede por favor sugerir el mejor camino a seguir?

Aplicación 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)
    })
}
)

Cuando muevo el mouse sobre los puntos, quiero que muestre mtcars $ wt

Answer 1

Si entiendo la pregunta correctamente, esto se puede lograr con la actualización reciente del paquete shiny para ggplot2 y el paquete base. Usando este ejemplo de Winston Chang y Joe Cheng http://shiny.rstudio.com/gallery/plot-interaction-basic.html , pude resolver este problema. Hover ahora es un argumento de entrada en plotOutput (), por lo que se agrega a la ui junto con un textatTTextOutput para mostrar mtcars $ wt para el punto sobre el que se movió.

Básicamente, en el servidor, hago un vector de distancia que calcula la distancia desde el mouse a cualquier punto de la gráfica y si esta distancia es menor que 3 (funciona en esta aplicación), entonces muestra mtcars $ wt para el punto más cercano a tu mouse. Para que quede claro, la entrada $ plot_hover devuelve una lista de información sobre la ubicación del mouse y solo los elementos x e y se extraen de la entrada $ plot_hover en este ejemplo.

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)

¡Espero que esto ayude!

Answer 2

También puede usar un poco de JQuery y renderUI condicional para mostrar una información sobre herramientas cerca del puntero.

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)

EDITADO:

Después de esta publicación, busqué en Internet para ver si se podía hacer mejor y encontré this maravillosa herramienta personalizada para ggplot. Creo que difícilmente se puede hacer mejor que eso.

Answer 3

Usando plotly , puedes traducir tu ggplot a una versión interactiva de sí mismo. Simplemente llame a la función ggplotly en su objeto ggplot :

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)

Para las personalizaciones de lo que se muestra en la información sobre herramientas, consulte, por ejemplo, here .