Does ggvisOutput haben einen Klick Option ähnlich wie plotOutput

Question

Hier einige glänzende Code aus dem online help genommen ist, die ein Plot erstellt, die Sie klicken können, um die (x, y) coords zu erhalten.

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) 

Ich bin daran interessiert zu wissen, ob es möglich ist, diese mit einem ggvisOutput Objekt zu tun, statt plotOutput.

Answer 1

Sie wollen durch einen Klick Punkte zu identifizieren, und es gibt mindestens zwei Möglichkeiten, es mit ggvis zu erreichen:

• Verwendung handle_click wie im ersten Beispiel unter

• Verwendung add_tooltip wie in der zweites Beispiel

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

1) Im ersten Beispiel müssen Sie reactiveValues Objekt definieren, zum Beispiel vals auf der Serverseite.

vals <- reactiveValues(data = NULL) 

2) Sie fügen Sie dann handle_click Funktionsobjekt mit Rohr Bediener ggvis. handle_click enthält eine anonyme Funktion, die Daten aufnimmt und im Objekt vals speichert.

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

3) Schließlich können Sie die Daten mit vals$data zuzugreifen und es zu *render Funktionen übergeben. vals$data enthält einen Daten Ruhm, kann sieht wie folgt aus:

 wt mpg 
    1 3.19 24.4 

---

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

Die andere Möglichkeit besteht darin, einen Tooltip zu verwenden, der in der Nähe des interessierenden Punkts erscheint.

1) Zuerst müssen Sie eine Funktion xy_vals definieren, die dafür verantwortlich ist, was im Tooltip angezeigt werden soll. (Sie könnten es auch als anonyme Funktion innerhalb von add_tooltip definieren.) Das Argument x enthält einen Datenrahmen.

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) Dann fügen Sie add_tooltip Funktion ggvis Objekt. In dieser Einstellung wird der Tooltip beim Hover angezeigt. Sie können es auf "Klick" ändern, aber in diesem Fall wird der Tooltip immer angezeigt, auch wenn Sie versuchen, ihn zu "entklicken".

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

Wenn Sie identifizierten Punkte auf einige render* Funktionen übergeben wollte, dass du reactiveValues Objekt definieren können, wie im ersten Beispiel, und dann innerhalb von xy_vals überschrieben. (ReactiveValues ​​hatte außerhalb des Servers definiert werden)

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