Does ggvisOutput have a click option similar to plotOutput

Here is some shiny code taken from the online help that creates a plot, which you can click on to obtain the (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)

I am interested to know whether it is possible to do this with a ggvisOutput object instead of plotOutput.

Solution

You want to identify points by a click and there are at least two possibilities of achieving it with ggvis:

use handle_click as in the first example below
use add_tooltip as in the second example

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

1) In the first example you have to define reactiveValues object, for instance, vals on the server side.

vals <- reactiveValues(data = NULL)

2) You then add handle_click function to ggvis object using pipe operator. handle_click contains an anonymous function which takes data and saves it in the object vals.

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

3) Finally you can access the data with vals$data and pass it to *render functions. vals$data contains a data fame which may looks as follows:

      wt  mpg
  1 3.19 24.4

Full code:

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----------------------------------------------------------------

The other possibility is to use tooltip that will apear near the point of interest.

1) First you have to define a function xy_vals which will be responsible for what should be shown in the tooltip. (You could define it within add_tooltip as an anonymous function as well) The argument x contains a data frame.

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) Then you add add_tooltip function ggvis object. In this setting the tooltip is shown on hover. You can change it to on "click" but in this case the tooltip is going to be always shown, even if you try to "unclick" it.

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

If you wanted to pass identified points to some render* functions you can define reactiveValues object, as in the first example, and then within xy_vals overwrite it. (reactiveValues had to be defined outside the server)

Full code:

# 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)