Jak wyświetlić wartość y na etykiecie narzędzia, gdy unosić się w ggplot2

Question

Chcę pokazać wartość y, gdy trzymam mysz na punkcie na wykresie. Kod dla mojej działce wygląda następująco:

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

Zrobiłem rozeznanie i pomyślałem, że text = paste("Weight/Height:", Height) część w aes by upewnić się, że pojawi się tekst. Niestety nic się nie pojawia. Czy ktoś wie, co zrobiłem źle?

Answer 1

ggplot nie jest interaktywny, ale można go łatwo zrobić za pomocą pakietu plotly. Trzeba tylko zamienić plotOutput na plotlyOutput, a następnie wyrenderować wykres na renderPlotly.

Przykład 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) 

---

Można również grać z plotOutput opcji jak na przykład click, hover, dblclick uczynienia działka interaktywne. (Look for more examples in shiny gallery)

W poniższym przykładzie dodajemy hoverID przez hover = "plot_hover", a następnie określamy opóźnienie, które domyślnie wynosi 300ms.

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

Następnie można uzyskać dostęp do wartości poprzez input$plot_hover i użyć funkcji nearPoints pokazać wartości, które są w pobliżu punktów.

---

Przykład 2: plotOutput (..., unoszą = "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) 

---

Przykład 3: klienta ggplot2 podpowiedź:

Jednak drugie rozwiązanie może nie być satysfakcjonujące, dlatego zdecydowałem się utworzyć niestandardową podpowiedź, która wyświetla się w pobliżu wskaźnika. Wymaga trochę 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) 

---

Można również użyć ggvis pakietu.Pakiet ten jest świetny, jednak nie na tyle dojrzały jeszcze

Przykład 4: ggvis i 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) 

---

ZREDAGOWANE

---

Przykład 5:

Po tym wpisie przeszukałem internet, aby zobaczyć, czy można go wykonać ładniej niż , przykład 3. Znalazłem wspaniałą niestandardową podpowiedź dla ggplota i uważam, że nie można tego zrobić lepiej.