Punktfarben basierend auf Hover in R shiny und Rmarkdown

Question

Ich möchte ein glänzendes Diagramm in einem Rmarkdown-Dokument erstellen, in dem die Farbe der Punkte vom Mauszeiger abhängt (Hover). Der gewünschte Plot erscheint jedoch nur einen Bruchteil einer Sekunde, bis das Hover-Element der Eingabeliste erneut auf NULL gesetzt wird. Warum ist das?

Beispiel:

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

Wenn Sie die Farbe Teil der Handlung entfernen, die Textausgabe wie erwartet verhält, also denke ich, es etwas mit dem Plotten selbst (gleich für pch statt col oder sein muß ggplot() anstelle von plot()).

Jede Hilfe wäre willkommen.

Answer 1

Ihr Code funktioniert nicht, denn wenn Sie mit der neuen Farbe plotten, wird ein Hover-Ereignis gesendet, das die Farbe neu initialisiert.

können Sie reactiveValue verwenden zusammen mit observeEvent die Werte zu speichern, wenn das Ereignis angezeigt:

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