5

我在使用以下示例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/

谢谢！

4

0 回答 0