使用反应值时,ggvis交互式图形无法正常工作

时间:2014-07-02 05:07:24

标签: r shiny 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)

您可以在此处以shinyapp查看结果:https://ecologician.shinyapps.io/ggvis_grouping_wrong/注意: print语句用于调试。当你移开第一组点时,hoveroff似乎会触发,但随后hoveron会立即触发,数据$ 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/

谢谢!

0 个答案:

没有答案