demo/shinyMouse.R

In rgl: 3D Visualization Using OpenGL

# Use the mouse to select points
# Original version written by Yohann Demont

if (!require("shiny"))
  stop("This demo requires shiny.")

if (!requireNamespace("crosstalk"))
  stop("This demo requires crosstalk.")

library(rgl)

ui <- fluidPage(
  sidebarLayout(
    mainPanel(tabsetPanel(id = "navbar",
                          selected = "3D",
                          tabPanel(title = "2D",
                                   plotOutput("plot_2D", brush = brushOpts(id = "plot_2D_brush",
                                                                           resetOnNew = TRUE,
                                                                           direction = "xy")),
                                   verbatimTextOutput("brush_info_2D")),
                          tabPanel(title = "3D",
                                   uiOutput("plot_3D_mousemode"),
                                   rglwidgetOutput("plot_3D"),
                                   verbatimTextOutput("brush_info_3D"),
                                   verbatimTextOutput("selected"))
    )),
    sidebarPanel(selectInput("plot_x", label = "x feature", choices = colnames(iris)[-5], selected = colnames(iris)[1]),
                 selectInput("plot_y", label = "y feature", choices = colnames(iris)[-5], selected = colnames(iris)[2]),
                 selectInput("plot_z", label = "z feature", choices = colnames(iris)[-5], selected = colnames(iris)[3]),
                 actionButton(inputId = "reset_brush", label = "reset brush"))
  ))

server <- function(input, output, session) {
  # 2D
  output$plot_2D <- renderPlot({
    plot(x = iris[, input$plot_x],
         y = iris[, input$plot_y],
         col = as.integer(iris[, "Species"]))
  })
  output$brush_info_2D <- renderPrint(str(input$plot_2D_brush))
  
  # 3D
  sharedData <- NULL
  output$brush_info_3D <- renderPrint(print(input$rgl_3D_brush, verbose = TRUE))
  
  # How to use selectionFunction3d ?
  output$selected <- renderPrint({
    if(length(input$rgl_3D_brush) == 0 || input$rgl_3D_brush$state == "inactive") return(NULL)
    cat("Selections from crosstalk:\n")
    # Need as.logical because selection() might return NULL
    print(which(as.logical(sharedData$selection())))
    cat("Selections using function:\n")
    f <- selectionFunction3d(input$rgl_3D_brush)
    which(f(iris[, c(input$plot_x, input$plot_y, input$plot_z)]))
  })
  
  output$plot_3D_mousemode <-
    renderUI({
      rglMouse( default = "trackball",
                stayActive = FALSE,
                choices = c("trackball", "selecting"),
                sceneId = "plot_3D")
    })
  open3d(useNULL = TRUE)
  output$plot_3D <- renderRglwidget({
    clear3d()
    dat <- iris[, c(input$plot_x, input$plot_y, input$plot_z, "Species")]
    dat$id <-as.character(seq_len(nrow(iris)))
    plot3d(x = dat[, 1:3], type = "s", size = 1, col = as.integer(iris[, "Species"]), aspect = TRUE)
    sharedData <<- rglShared(id = text3d(dat[, 1:3], text = dat[, "id"], adj = -0.5),
                             group = "SharedData_plot_3D_ids",
                             deselectedFade = 0,
                             selectedIgnoreNone = FALSE)
    shinyResetBrush(session, "rgl_3D_brush")
    rglwidget(shared = sharedData,
              shinyBrush = "rgl_3D_brush")
  })
  observeEvent(input$reset_brush, {
    session$resetBrush("plot_2D_brush")
    shinyResetBrush(session, "rgl_3D_brush")
  })
}

shinyApp(ui, server)