使用闪亮和 ggvis 突出显示点击点

Question

我试图通过单击在我的散点图上突出显示（例如笔划）点。例如，我有一个工具提示，如果工具提示给了我一些重要信息，我想标记这一点。有没有已经可用的东西？

我已经玩过两个工具提示，一个打印一些信息，另一个将点的 id 附加到列表中，我尝试将此信息添加到数据中并创建一个突出显示 id 的新图形。不是很方便。

这是一个最小的例子：

library(dplyr)
library(ggvis)
library(shiny)
library(ggplot2)
df <- data.frame(x=rnorm(10), y=rnorm(10), id=letters[1:10])
server <- function(input, output) {
  movie_tooltip <- function(x) {
    x$id
  }
  vis <- reactive({
    df %>%
      ggvis(~x, ~y) %>% 
      layer_points(key := ~id)  %>%
      add_tooltip(movie_tooltip, "hover")
  })
  vis %>% bind_shiny("plot1") 
  observe({
    if(input$myBtn > 0){
      stopApp()
    }
  })
}
ui <- fluidPage(
  ggvisOutput("plot1"),
  actionButton("myBtn", "Press ME!")
)
shinyApp(ui = ui, server = server) 

如何突出显示或标记一些点？

更新：

到目前为止，我得到了部分想要展示的结果。我可以突出显示一个点，但我也想在点击时再次“取消突出显示”它们。

我添加了第二个 add_tooltip 函数和一些 reactiveValues，但我无法切换回未标记。它进入了一种循环，永远不会停止......

这是我更新的示例：

library(dplyr)
library(ggvis)
library(shiny)
library(ggplot2)
df <- data.frame(x=rnorm(10), y=rnorm(10), id=letters[1:10])

server <- function(input, output) {
  movie_tooltip <- function(x) {
    x$id
  }
  movie_tooltip2 <- function(x) {
    i <- which(df$id == x$id)
#     ifelse(values$stroke[i] == 'Yes',
#            values$stroke[i] <- 'No',
#            values$stroke[i] <- 'Yes')
    values$stroke[i] <- "Yes"
    return(NULL)
  }
  values <- reactiveValues(stroke=rep('No',nrow(df)))
  vis <- reactive({
    df %>%
      ggvis(~x, ~y, stroke = ~values$stroke) %>% 
      layer_points(key := ~id)  %>%
      add_tooltip(movie_tooltip, "hover")  %>%
      add_tooltip(movie_tooltip2, "click")
  })
  vis %>% bind_shiny("plot1") 
}
ui <- fluidPage(
  ggvisOutput("plot1")
)
shinyApp(ui = ui, server = server) 

如果我取消注释三个#cmets，并注释掉这行# values$stroke[i] <- "Yes"，我陷入了一个循环，不明白它。

Answer 1

我相信正在发生的事情是，通过更改 tooltip() 内的反应性对象，您会使工具提示本身无效，因此您会陷入无限循环。

要解决此问题，请使用 isolate() 围绕值的更改。

library(dplyr)
library(ggvis)
library(shiny)
library(ggplot2)
df <- data.frame(x=rnorm(10), y=rnorm(10), id=letters[1:10])

server <- function(input, output) {
  movie_tooltip <- function(x) {
    x$id
  }
  movie_tooltip2 <- function(x) {
    i <- which(df$id == x$id)
    isolate(values$stroke[i] <- ifelse(values$stroke[i] == 'Yes',
                values$stroke[i] <- 'No',
                values$stroke[i] <- 'Yes'))
    return(NULL)
  }
  values <- reactiveValues(stroke=rep('No',nrow(df)))
  vis <- reactive({
    df %>%
      ggvis(~x, ~y, stroke = ~values$stroke) %>% 
      layer_points(key := ~id)  %>%
      add_tooltip(movie_tooltip, "hover")  %>%
      add_tooltip(movie_tooltip2, "click")
  })
  vis %>% bind_shiny("plot1") 
}
ui <- fluidPage(
  ggvisOutput("plot1")
)
shinyApp(ui = ui, server = server)