Mẹo Công cụ khi bạn di chuột qua một ggplot trên sáng bóng

Question

Tôi đang xây dựng một ứng dụng sáng bóng.

Tôi đang vẽ đồ thị bằng ggplot.

Khi tôi di chuột lên các điểm trên đồ thị, tôi muốn có một tooltip cho thấy một trong các cột trong khung dữ liệu (tùy tooltip)

Bạn có thể xin đề nghị cách tốt nhất về phía trước.

Simple App:

# 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) 
    }) 
} 
) 

Khi tôi chuột lên điểm, tôi muốn nó hiển thị mtcars $ wt

Answer 1

Nếu tôi hiểu câu hỏi một cách chính xác, điều này có thể đạt được với bản cập nhật gần đây của gói sáng bóng cho cả ggplot2 và gói cơ sở. Sử dụng ví dụ này từ Winston Chang và Joe Cheng http://shiny.rstudio.com/gallery/plot-interaction-basic.html, tôi đã có thể giải quyết vấn đề này. Di chuột bây giờ là một đối số đầu vào vào plotOutput() để được thêm vào ui cùng với một verbatimTextOutput để hiển thị mtcars $ wt cho điểm di chuột qua. Trong máy chủ, tôi về cơ bản tạo một khoảng cách tính toán khoảng cách từ con chuột đến bất kỳ điểm nào trong ô và nếu khoảng cách này nhỏ hơn 3 (hoạt động trong ứng dụng này) thì nó hiển thị mtcars $ wt cho điểm gần nhất cho con chuột của bạn. Để được đầu vào rõ ràng $ plot_hover trả về một danh sách thông tin về vị trí của con chuột và chỉ các phần tử x và y được trích xuất từ ​​đầu vào $ plot_hover trong ví dụ này.

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) 

Tôi hy vọng điều này sẽ hữu ích!

Answer 2

Bạn cũng có thể sử dụng một chút JQuery và có điều kiện renderUI để hiển thị chú giải công cụ tùy chỉnh gần con trỏ.

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) 

---

EDITED:

Sau bài này, tôi đã tìm kiếm Internet để xem liệu nó có thể được thực hiện độc đáo hơn và tìm thấy this tooltip tùy chỉnh tuyệt vời cho ggplot. Tôi tin rằng nó khó có thể làm tốt hơn thế. Thông tin thêm here.

---

Answer 3

Sử dụng plotly, bạn chỉ có thể chuyển thành ggplot bạn một phiên bản tương tác của chính nó. Chỉ cần gọi hàm ggplotly trên ggplot đối tượng của bạn:

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) 

Đối với các tùy chỉnh về những gì được thể hiện trong các tooltip, nhìn ví dụ here.