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对象。在此设置中，工具提示显示在悬停上。您可以将其更改为开启＆＃34;单击＆＃34;但是在这种情况下，即使你试图＆＃34; unlick＆＃34;也会始终显示工具提示。它

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的单击选项

1 个答案: