Точечные цвета на основе зависания в R shiny и Rmarkdown

Question

Я хотел бы создать блестящий сюжет в документе Rmarkdown, где цвет точек зависит от указателя мыши (hover). Однако желаемый график появляется только часть секунды, пока элемент наведения в списке ввода не будет установлен на NULL. Почему это?

Пример:

--- 
title: "Untitled" 
runtime: shiny 
output: html_document 
--- 

```{r,echo=FALSE} 
library(ggplot2) 
x <- rnorm(100) 
y <- rnorm(100) 

dfr <- data.frame(x, y) 

give_col <- function(){ 
    if(is.null(input$hover$y)){ 
    rep(2, length(x)) 
    }else{ 
     (input$hover$y < dfr$y) + 1 
    }} 

imageOutput("image_id", hover = "hover") 
textOutput("text_id") 

output$image_id <- renderPlot({ 
    plot(dfr$x, dfr$y, col = factor(give_col())) 
    # plot(dfr$x, dfr$y) # Without col the give_col() element remains 
         # as can be seen in the output text 
}) 
output$text_id <- reactive({paste(give_col())}) 
``` 

Если удалить цвет часть сюжета, выводимый текст ведет себя, как и ожидалось, так что я предполагаю, что это должно быть что-то с черчения себя (то же самое для pch вместо col или с ggplot() вместо plot()).

Любая помощь будет оценена по достоинству.

Answer 1

Ваш код не работает, потому что, когда вы планируете новый цвет, он отправляет событие зависания, которое повторно инициализирует цвет.

Вы можете использовать reactiveValue вместе с observeEvent для хранения значений при появлении события:

--- 
title: "Untitled" 
runtime: shiny 
output: html_document 
--- 

```{r,echo=FALSE} 
library(ggplot2) 
x <- rnorm(100) 
y <- rnorm(100) 

dfr <- data.frame(x, y) 
give <- reactiveValues(col=rep(2, length(x))) 
observeEvent(input$hover,{give$col <- (input$hover$y < dfr$y) + 1}) 

imageOutput("image_id", hover = "hover") 
textOutput("text_id") 

output$image_id <- renderPlot({ 
    plot(dfr$x, dfr$y, col = factor(give$col)) 
    # plot(dfr$x, dfr$y) # Without col the give_col() element remains 
         # as can be seen in the output text 
}) 
output$text_id <- reactive({paste(give$col)}) 
```