rbokeh中的Shiny_callback捕获了什么？

Question

I'm trying to use the tool_lasso_select feature in rbokeh. What I would like is for the user to use the tool to select a group of points in a scatterplot and summary statistics of the group of points selected would be created as a result in the next panel of a shiny tabBox. My primary question is:

What exactly is captured by the shiny_callback option?

This is an example of the type of figure I'm creating:

figure() %>%
ly_points(x = cty, y = hwy, data = mpg,
        hover = c(cty, hwy), lname = "points") %>%
tool_hover(shiny_callback(id = "hover_info"), "points") %>%
tool_tap(shiny_callback(id = "tap_info"), "points") %>%
tool_box_select(shiny_callback(id = "selection_info"), "points")

What exactly are the contents placed in the "selection_info" id and how could I extract that information? I'm just not sure what the next block of code I could write that would take the information captured by the lasso_tool. The most I can find in the documentation is the example used but output seems to only be an index number.

UPDATE:

Thanks for adding a reproducible example. My apologies. I've added a little more to it below:

library("dplyr")
library("rbokeh")
library("shiny")

attach(mtcars)

server <- shinyServer(function(input,output){

  output$myChart <- renderRbokeh({
    print(paste0("now rendering!"," ",date()))
    input$myText
    figure() %>%
      ly_points(x = mtcars$cyl, y = mtcars$hp, data = mtcars,
                hover = c(mtcars$cyl, mtcars$hp), lname = "points") %>%
      tool_hover(callback = shiny_callback(id = "hover_info"), "points") %>%
      tool_tap(callback = shiny_callback(id = "tap_info"), "points") %>%
      tool_box_select(callback = shiny_callback(id = "selection_info"), "points")
  })

  output$selection_summary <- renderText({
    input$selection_info
  })


})

ui <- shinyUI(
  fluidPage(

    rbokehOutput(outputId = "myChart", width = "400px", height = "400px"),
    textInput(inputId="myText",label="Input Text please."),
    textInput(inputId="selection_info",label="Selection info"),

    textOutput("selection_summary")
  )
)

shinyApp(server = server, ui = ui)

So the above output$selection_summary does provide some type of info that is given by the tool_box_select. I'm just not sure what it is. I'd eventually like to produce a table or summary statistics on the attributes associated with the points selected by the tool. But I don't know how to figure out what it is the callback feature is capturing. I couldn't find anymore details in the documentation, unless I've missed something.

Thanks.

Answer 1

Thanks a lot! I also figured it out. The callback essentially grabs the index number of the point selected which corresponds to the row number of the dataset. So to get more information of the selected points, just match up the index number with the row number of the dataset and you can run with it from there. Below is a rough version of that.

library("dplyr")
library("rbokeh")
library("shiny")

attach(mtcars)
d <- mtcars
server <- shinyServer(function(input,output){

  output$myChart <- renderRbokeh({
    print(paste0("now rendering!"," ",date()))
    input$myText
    figure() %>%
      ly_points(x = mtcars$cyl, y = mtcars$hp, data = mtcars,
                hover = c(mtcars$cyl, mtcars$hp), lname = "points") %>%
      tool_hover(callback = shiny_callback(id = "hover_info"), "points") %>%
      tool_tap(callback = shiny_callback(id = "tap_info"), "points") %>%
      tool_box_select(callback = shiny_callback(id = "selection_info"), "points")
  })

  output$selection_table <- renderTable({
    index <- input$selection_info
    index <- as.data.frame(index)
    d$index<-seq.int(nrow(d))

    d <- semi_join(d, index, by="index")
    d
  })

  output$summary_stats_selected <- renderPrint({
    index <- input$selection_info
    index <- as.data.frame(index)
    d$index<-seq.int(nrow(d))

    d <- semi_join(d, index, by="index")
    summary(d)
  })

})

ui <- shinyUI(
  fluidPage(

    rbokehOutput(outputId = "myChart", width = "400px", height = "400px"),
    textInput(inputId="myText",label="Input Text please."),
    textInput(inputId="selection_info",label="Selection info"),

    tableOutput("selection_table"),
    verbatimTextOutput("summary_stats_selected")
  )
)

shinyApp(server = server, ui = ui)

First, I turned the indices selected by the tool into a dataframe. Then I created an "index" variable for the dataset based on its row number. Then I implemented a semi_join between the two dataframes based on matching the "index" numbers. And from there you have a dataframe of the selected points with their corresponding attributes.

Thanks a lot guys.

UPDATE:

After a while, I realized the index was off. The index the callback refers to and the actual dataset's index was off. After speaking with the creator of rbokeh, the problem was that the callback feature's index was zero-based. So I added 1 to the index and that solved the problem.

Answer 2

Now I found the perfect answer, taken from this piece of code here: https://www.snip2code.com/Snippet/1040781/rbokeh-shiny-callback-experiment

What shinyCallback does is simply store the information of the respective event inside the input object . Then, it is easy to listen to input changes via reactive() and work with the results. You could also use your own client-side javascript callback with custom_callback() for a thinner server side:

tool_hover(callback = custom_callback(code = "$('#hover_info').val(cb_data.geometry.x+'|'+cb_data.geometry.y);"), "points") %>%
tool_box_select(callback = custom_callback(code = "$('#selection_info').val(points_data.changed.selected['1d'].indices.join());","points"), "points")

This manual might also help you: http://hafen.github.io/rbokeh/rd.html#callback-interactivity

library("dplyr")
library("rbokeh")
library("shiny")

data(mtcars)

server <- shinyServer(function(input,output){

  output$myChart <- renderRbokeh({
    print(paste0("now rendering!"," ",date()))
    input$myText # make it dependent on some input
    figure() %>%
      ly_points(x = mtcars$cyl, y = mtcars$hp, data = mtcars,
                hover = c(mtcars$cyl, mtcars$hp), lname = "points") %>%
      tool_hover(shiny_callback("hover_info"), "points") %>%
      tool_tap(shiny_callback("tap_info"), "points") %>%
      tool_box_select(shiny_callback("selection_info"), "points")
  })

  output$hover_text <- reactive({
    hi <- input$hover_info
    if(!is.null(hi)) {
      paste0("index: ", hi$index[["1d"]]$indices, ", x: ",
             hi$geom$sx, ", y:", hi$geom$sy)
    } else {
      "waiting for hover event (hover over plot or points on plot to trigger)..."
    }
  })

  output$tap_text <- reactive({
    ti <- input$tap_info
    if(!is.null(ti)) {
      paste("index:", paste(ti, collapse = ", "))
    } else {
      "waiting for tap/click event (click point(s) to trigger)..."
    }
  })

  output$selection_text <- reactive({
    si <- input$selection_info
    if(!is.null(si)) {
      paste("index:", paste(si, collapse = ", "))
    } else {
      "waiting for selection event (click point(s) or use box select tool to trigger)..."
    }
  })


})

ui <- shinyUI(
  fluidPage(
    rbokehOutput(outputId = "myChart", width = "400px", height = "400px"),
    strong("hover event:"),
    textOutput("hover_text"),

    strong("triggered by tap/click:"),
    htmlOutput("tap_text"),

    strong("index of selected triggered by any selection:"),
    textOutput("selection_text")
  )
)

shinyApp(server = server, ui = ui)