Làm cách nào để hiển thị giá trị y trên chú giải công cụ khi di chuột trong ggplot2

Question

Tôi muốn hiển thị giá trị y khi tôi giữ chuột trên một điểm trong biểu đồ. Mã cho âm mưu của tôi trông như thế này:

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

tôi đã làm một số nghiên cứu và tôi nghĩ rằng text = paste("Weight/Height:", Height) gia aes sẽ đảm bảo rằng các văn bản sẽ xuất hiện. Thật không may không có gì xuất hiện. Có ai biết tôi đã làm gì sai không?

Answer 1

ggplot không tương tác nhưng có thể dễ dàng thực hiện với gói plotly. Bạn chỉ cần thay thế plotOutput bằng plotlyOutput và sau đó hiển thị một ô với renderPlotly.

Ví dụ 1: plotly

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) 

---

Bạn cũng có thể chơi với plotOutput tùy chọn như ví dụ click, hover, dblclick để làm cho cốt truyện tương tác. (Look for more examples in shiny gallery)

Trong ví dụ bên dưới, chúng tôi thêm hoverID bởi hover = "plot_hover" và sau đó chỉ định độ trễ theo mặc định là 300 mili giây.

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

Chúng tôi sau đó có thể truy cập các giá trị thông qua input$plot_hover và sử dụng một hàm nearPoints để hiển thị giá trị mà ở gần các điểm.

---

Ví dụ 2: plotOutput (..., di chuột = "plot_hover"):

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) 

---

Ví dụ 3: tooltip Tuỳ chỉnh ggplot2:

Tuy nhiên, giải pháp thứ hai có thể không thỏa đáng vì vậy tôi đã quyết định tạo chú giải công cụ tùy chỉnh hiển thị gần con trỏ. Nó đòi hỏi một chút javaScript/JQuery.

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) 

---

Bạn cũng có thể sử dụng ggvis gói.Gói này là rất tốt, tuy nhiên, chưa đủ trưởng thành chưa

Ví dụ 4: ggvis và add_tooltip:

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) 

---

EDITED

---

Ví dụ 5:

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