Цвета точек, основанные на наведении на R блестящий и Rmarkdown

Question

Я хотел бы создать блестящий график в документе Rmarkdown, где цвет точек зависит от указателя мыши (при наведении курсора). Тем не менее, требуемый график появляется только доли секунды, пока элемент наведения в списке ввода не будет установлен на 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)})
```