ggvis interactive figure does not work as expected using reactive values

问题

I am having problem with the following example ggvis code which is meant to make a plot that highlights an entire group of points when you hover over any member of that group. I would then like the highlighting to vanish as soon as you hover off. What is happening is that the highlighting initially works but then when you hover off, the highlighting stays, and only vanishes when you hover over another set of points and then hover off them again.

library(magrittr)
library(dplyr)
library(ggvis)
library(shiny)

dat <- iris %>% select(-Species) %>% dist %>% cmdscale %>% data.frame %>% tbl_df %>% mutate(Species = iris$Species) %>% 
data.frame
Props <- reactiveValues(Size = rep(50, length.out = nrow(dat)), Stroke = rep("white", length.out = nrow(dat)))
hoveron <- function(data, ...) {
    Props$Size[dat$Species == data$Species] <- 150 
    print("hoveron!")
    Props$Stroke[dat$Species == data$Species] <- "black"
}
hoveroff <- function(...) {
    Props$Size <- rep(50, length.out = nrow(dat))
    print("hoveroff!")
    Props$Stroke <- rep("white", length.out = nrow(dat))
}

dat %>%
ggvis(~X1, ~X2, fill = ~Species) %>% layer_points(size = reactive(Props$Size), stroke = reactive(Props$Stroke))  %>%
scale_numeric("size", range = c(80, 180)) %>% scale_numeric("x", label = "MDS Axis 1") %>%
scale_numeric("y", label = "MDS Axis 2") %>% scale_ordinal("stroke", sort = TRUE, domain = c("black", "white"), range = c("black", "white")) %>%
add_legend(scales = "size", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
add_legend(scales = "stroke", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
set_options(duration = 0) %>% handle_hover(hoveron, hoveroff)

You can view the results as a shinyapp here: https://ecologician.shinyapps.io/ggvis_grouping_wrong/. Note: The print statements are for debugging. hoveroff seems to fire when you mover off the first set of points but then hoveron fires immediately afterwards, with data$Species equal to what was just hovered off. I can't quite explain why. I am hoping it is just a simple mistake which I just can't see at the moment. Can anyone here see what is wrong?

More Details:

The above code was an attempt to make a less verbose / simpler version of the code below, which does work as I expect it to:

library(magrittr)
library(dplyr)
library(ggvis)
library(shiny)

hoverset <- reactiveValues(setosa = 0, versicolor = 0, virginica = 0)
hoveron <- function(data, ...) {
    hoverset[[data$Species]] <- 1
}
hoveroff <- function(data, ...) {
    hoverset$setosa <- 0
    hoverset$versicolor <- 0
    hoverset$virginica <- 0
}

dat <- iris %>% select(-Species) %>% dist %>% cmdscale %>% data.frame %>% tbl_df %>% mutate(Species = iris$Species) %>% 
mutate(Size = 50, Stroke = "white") %>% data.frame
dat2 <- reactive({
    if (hoverset$setosa == 1){
        dat[dat[,"Species"] == "setosa","Size"] <<- 150
        dat[dat[,"Species"] == "setosa","Stroke"] <<- "black"
    } else {
        dat[dat[,"Species"] == "setosa","Size"] <<- 50
        dat[dat[,"Species"] == "setosa","Stroke"] <<- "white"
    }
    if (hoverset$versicolor == 1){
        dat[dat[,"Species"] == "versicolor","Size"] <<- 150
        dat[dat[,"Species"] == "versicolor","Stroke"] <<- "black"
    } else {
        dat[dat[,"Species"] == "versicolor","Size"] <<- 50
        dat[dat[,"Species"] == "versicolor","Stroke"] <<- "white"
    }
    if (hoverset$virginica == 1){
        dat[dat[,"Species"] == "virginica","Size"] <<- 150
        dat[dat[,"Species"] == "virginica","Stroke"] <<- "black"
    } else {
        dat[dat[,"Species"] == "virginica","Size"] <<- 50
        dat[dat[,"Species"] == "virginica","Stroke"] <<- "white"
    }
    dat
})

dat2 %>%
ggvis(~X1, ~X2, fill = ~Species) %>% layer_points(size = ~Size, stroke = ~Stroke)  %>%
scale_numeric("size", range = c(80, 180)) %>% scale_numeric("x", label = "MDS Axis 1") %>%
scale_numeric("y", label = "MDS Axis 2") %>% scale_ordinal("stroke", sort = TRUE, domain = c("black", "white"), range = c("black", "white")) %>%
add_legend(scales = "size", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
add_legend(scales = "stroke", properties = legend_props(title = list(fontSize = 0), labels = list(fontSize = 0), symbols = list(size = 0))) %>%
set_options(duration = 0) %>% handle_hover(hoveron, hoveroff)

See this app here: https://ecologician.shinyapps.io/ggvis_grouping/

Thanks!

来源：https://stackoverflow.com/questions/24523268/ggvis-interactive-figure-does-not-work-as-expected-using-reactive-values

标签

Shiny

ggvis