R интерактивный сюжет: показывать вертикальную линию при наведении

Question

Я искал способ нарисовать вертикальную линию вдоль оси X при наведении курсора на точки на графике с использованием R. На самом деле не имеет значения, какой это пакет, будь то сюжет, ggvis, rCharts, googleVis или любой другой. другой в этом отношении, но я бы предпочел использовать один из этих упомянутых, если это возможно.

Вот пример того, что я хотел бы иметь.

Answer 1

Частичный ответ (не могу комментировать)... Plotly имеет тип "scattergl", который рисует горизонтальную и вертикальную линию при наведении курсора.

Данные

require(plotly)    

sdate <- as.Date("2015-01-01", format = "%Y-%m-%d")
timedf <- data.frame(Date = seq.Date(sdate, by="month", length.out=12),
                         Amount = runif(12, 0, 100))
# Plotly plot
plot_ly(timedf, x=Date, y=Amount, type="scattergl")

Выход

Answer 2

Следуйте ответу Криса, чтобы это сработало

library(ggplot2)
library(shiny)

ui <- fluidPage(
    fluidRow(
        column(width = 12,
               plotOutput("plot1", height = 350,hover = "plot_hover")
        )
    )
)

server <- function(input, output) {
    testPlot <- ggplot(mtcars, aes(x=mpg,y=disp,color=factor(cyl))) + 
        geom_point()

    #start up plot
    output$plot1 <- renderPlot({testPlot})

    # plot after mouse over
    observeEvent(input$plot_hover, {
        x = input$plot_hover$x
        y = input$plot_hover$y
        nearPoint <- nearPoints(mtcars, input$plot_hover, 
                                threshold = 10, maxpoints = 1)
        output$plot1 <- renderPlot({
            if (nrow(nearPoint) == 1) {
                testPlot + 
                    geom_vline(xintercept = nearPoint$mpg) +
                    geom_label(x = x + 1.5, y = y, 
                               label = paste(rownames(nearPoint), "\n", nearPoint$disp))
            } else {
                testPlot
            }
        })
    })
}

shinyApp(ui, server)

Answer 3

Вот частичный ответ. Я не могу заставить его работать, но, возможно, кто-то увидит что-то очевидное. Я использовал ggplot2 вместо ggvis для geom_vline() функция, которая создает вертикальную линию.

Что работает:

На input$plot_hover событие, мы назначаем x координата переменной (h), а затем использовать эту переменную в качестве xintercept аргументация geom_vline() функция, которая рисует вертикальную линию.

Эта проблема:

Поскольку это происходит в реактивной среде, при каждом обновлении h очищается, поэтому линия исчезает примерно через секунду после ее появления.

Что я пробовал:

Я пытался назначить h ко второй переменной t чтобы держать его между обновлениями. Это не сработало, поэтому я создал третью переменную prev_t и когда не было ввода (is.null(input$plot_hover) == TRUE), держать t как prev_t, Это также не работает, но у меня нет тонны времени, чтобы попробовать разные вещи.

Вот код:

library(ggplot2)
library(shiny)

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

server <- function(input, output) {

   #h <- reactive(input$plot_hover)

   prev_t <- vector()

    output$plot1 <- renderPlot({

        if(!is.null(input$plot_hover)){
            x <- input$plot_hover
            h <- x$x
            t <- h


        # the below isnt quite working
        # I was trying to store t between updates to make the line stay on 
        # the graph until there was a second hover event

        ################### !!! ###################
        } else if(is.null(input$plot_hover)) {
            t <- prev_t
        }

        prev_t <- t
        ################## !!! ####################

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

    })


}
shinyApp(ui, server)

Надеюсь, это может поставить вас на другой путь или немного помочь. Если кто-то видит что-то, что может решить эту проблему, пожалуйста, дайте мне знать.