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

debugcn 发表于 Dev

亚历克斯

这是从联机帮助中获取的一些闪亮代码，它们创建了一个绘图，您可以单击该绘图以获取(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。

米哈尔·马伊卡（Michal Majka）

您想通过单击来识别点，并且至少有两种方法可以实现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)

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。