Есть ли у ggvisOutput опция щелчка, похожая на plotOutput

Question

Вот некоторый блестящий код, взятый из онлайн-справки, которая создает график, по которому можно щелкнуть, чтобы получить (x, y) Coords.

library(shiny)

ui <- basicPage(
  plotOutput("plot1", click = "plot_click"),
  verbatimTextOutput("info")
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    plot(mtcars$wt, mtcars$mpg)
  })

  output$info <- renderText({
    paste0("x=", input$plot_click$x, "\ny=", input$plot_click$y)
  })
}

shinyApp(ui, server)

Мне интересно знать, возможно ли это сделать с помощью ggvisOutput объект вместо plotOutput,

Answer 1

Вы хотите идентифицировать точки одним кликом, и есть как минимум две возможности для достижения этого с ggvis:

• использование handle_click как в первом примере ниже

• использование add_tooltip как во втором примере

------------------------------------------------- handle_click-------------------------------------------------- -------

1) В первом примере вы должны определить reactiveValues объект, например, vals на стороне сервера.

vals <- reactiveValues(data = NULL)  

2) Затем вы добавляете handle_click функция объекта ggvis с использованием оператора pipe. handle_click содержит анонимную функцию, которая принимает данные и сохраняет их в объекте vals,

handle_click(function(data, ...) {
      vals$data <- data
    })

3) Наконец, вы можете получить доступ к данным с vals$data и передать его *render функции. vals$data содержит данные, которые могут выглядеть следующим образом:

      wt  mpg
  1 3.19 24.4

---

Полный код:

library(shiny)
library(ggvis)

ui <- fluidPage(
  ggvisOutput("ggvis"),
  verbatimTextOutput("info")
)

server <- function(input, output, session) {

  vals <- reactiveValues(data = NULL)  

  mtcars %>%
    ggvis(~wt, ~mpg) %>%
    layer_points() %>%
    handle_click(function(data, ...) {
      # print(data) 
      vals$data <- data
    }) %>% 
    bind_shiny("ggvis")

  # Print values saved in the reactiveValues object
  output$info <- renderPrint({
    req(vals$data)
    cat(paste0(names(vals$data), "= ", vals$data, collapse = "\n"))
  })
}

shinyApp(ui, server)

------------------------------------------------- add_tooltip-------------------------------------------------- --------------

Другая возможность состоит в том, чтобы использовать всплывающую подсказку, которая появится рядом с точкой интереса.

1) Сначала вы должны определить функцию xy_vals который будет нести ответственность за то, что должно быть показано в подсказке. (Вы можете определить это внутри add_tooltip в качестве анонимной функции, а) x содержит фрейм данных.

xy_vals <- function(x) {
  if(is.null(x)) 
    return(NULL)

  # show the data in the console
  # print(x) 

  # Define what should be shown in the tooltip
  # paste0(c("wt= ", "mpg= "),  c(x$wt, x$mpg), collapse = "<br />")
  paste0(names(x), "= ", paste0(x), collapse = "<br />")
}

2) Затем вы добавляете add_tooltip функция ggvis объект. При этой настройке подсказка отображается при наведении курсора. Вы можете изменить его на "щелчок", но в этом случае всплывающая подсказка будет отображаться всегда, даже если вы попытаетесь "отжать" ее.

add_tooltip(html = xy_vals, on = "hover")

Если вы хотите передать определенные баллы некоторым render* функции, которые вы можете определить reactiveValues объект, как в первом примере, а затем внутри xy_vals переписать это. (реактивные значения должны быть определены вне сервера)

Полный код:

# Define a function that goes to "add_tooltip"
xy_vals <- function(x) {
  if(is.null(x)) 
    return(NULL)

  # show the values in the console
  # print(x) 

  # Define what should be shown in the tooltip
  # paste0(c("wt= ", "mpg= "),  c(x$wt, x$mpg), collapse = "<br />")
  paste0(names(x), "= ", paste0(x), collapse = "<br />")
}


ui2 <- fluidPage(
  ggvisOutput("ggvis")
)

server2 <- function(input, output, session) {

  mtcars %>%
    ggvis(~wt, ~mpg) %>%
    layer_points() %>%
    add_tooltip(html = xy_vals, on = "hover") %>% # on = "click" # using "click" tooltip doesn't disappear
    bind_shiny("ggvis")
}

shinyApp(ui2, server2)