ggvisOutput 是否有类似于 plotOutput 的点击选项答案

【问题标题】：Does ggvisOutput have a click option similar to plotOutputggvisOutput 是否有类似于 plotOutput 的点击选项
【发布时间】：2016-06-24 00:51:18
【问题描述】：

这是从online help 中提取的一些闪亮代码，用于创建一个绘图，您可以单击它来获取(x, y) 坐标。

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 来执行此操作。

【问题讨论】：

标签： r shiny ggvis

【解决方案1】：

您想通过点击来识别点，使用ggvis 至少有两种可能实现它：

使用handle_click，如下面的第一个示例所示
在第二个例子中使用add_tooltip

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

1) 在第一个示例中，您必须在服务器端定义reactiveValues 对象，例如vals。

vals <- reactiveValues(data = NULL)

2) 然后使用管道运算符将 handle_click 函数添加到 ggvis 对象。 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 中覆盖它。（reactiveValues 必须在服务器之外定义）

完整代码：

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

【讨论】：