Интерактивная фигура ggvis не работает должным образом, используя реактивные значения

У меня возникла проблема со следующим примером кода ggvis, который предназначен для создания графика, выделяющего всю группу точек при наведении указателя мыши на любого члена этой группы. Затем я хотел бы, чтобы выделение исчезло, как только вы наведете курсор. Происходит то, что подсветка сначала работает, но затем, когда вы наводите курсор мыши, подсветка остается и исчезает только тогда, когда вы наводите курсор на другой набор точек, а затем снова наводите курсор на них.

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)

Вы можете просмотреть результаты в виде блестящего приложения здесь: https://ecologician.shinyapps.io/ggvis_grouping_wrong/. Примечание. Операторы print предназначены для отладки. hoveroff, кажется, срабатывает, когда вы перемещаетесь от первого набора точек, но затем сразу же срабатывает hoveron с data$Species, равным тому, что было только что наведено. Я не могу объяснить, почему. Я надеюсь, что это просто простая ошибка, которую я просто не вижу в данный момент. Кто-нибудь здесь может увидеть, что не так?

Подробнее:

Вышеприведенный код был попыткой сделать менее подробную/более простую версию кода ниже, который работает так, как я ожидаю:

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)

См. это приложение здесь: https://ecologician.shinyapps.io/ggvis_grouping/

Спасибо!


person ecologician    schedule 02.07.2014    source источник
comment
Хорошо, так это работает. В чем тогда проблема?   -  person Roman Luštrik    schedule 02.07.2014
comment
Второй пример работает, первый нет (и я думаю, что должен). Я хочу понять, почему. Первый пример гораздо более лаконичен и его легче адаптировать к большому набору данных с более чем тремя факторами для группировки.   -  person ecologician    schedule 02.07.2014