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

Question

这是从 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。

Answer 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对象。在此设置中，工具提示显示在悬停时。您可以将其更改为 on "click" 但在这种情况下，工具提示将始终显示，即使您尝试 "unclick" 它也是如此。

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)

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

Does ggvisOutput have a click option similar to plotOutput

r

shiny

ggvis