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)

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

更新：

到目前为止，我得到了部分结果。我可以突出一个点，但我也想＆＃34; unhighlight＆＃34;他们再次点击。

我添加了第二个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)

如果我取消注释这三个#comments，并注释掉这一行# 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)

点击闪亮和ggvis点击点

1 个答案: