Выделите очки при щелчке с помощью блестящих и ggvis

Question

Я пытаюсь выделить (например, штрих) точки на моей диаграмме рассеяния, щелкнув. Так, например, у меня есть всплывающая подсказка, и если всплывающая подсказка дает мне важную информацию, я хочу отметить эту точку. Есть ли что-то уже доступное?

Я уже немного сыграл с двумя подсказками, один печатает некоторую информацию, другой добавляет идентификатор точки в список, и я пытаюсь добавить эту информацию к данным и создать новый график с подсветкой идентификаторов. Не очень удобно.

Вот минимальный пример:

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) 

Как я могу выделить или отметить некоторые из точек?

UPDATE:

я получил частично некоторые результаты, которые я хотел представить до сих пор. Я могу выделить точку, но мне также хотелось бы «высветить» их снова щелчком.

Я добавил вторую функцию add_tooltip и некоторые реактивные значения, но я не могу вернуться к немеченному. Он получает в виде петли и никогда не останавливается ...

Вот мой обновленный пример:

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) 

Если я раскомментировать три # комментарий, и закомментируйте эту строку # 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)