# NOT RUN {
if(interactive()) {
# 'surfaceColors' example ####
library(shiny)
library(viridisLite)
library(graph3d)
x <- y <- seq(-10, 10, length.out = 100)
dat <- expand.grid(x = x, y = y)
f <- function(x, y){
r <- sqrt(x^2+y^2)
10 * ifelse(r == 0, 1, sin(r)/r)
}
dat <- transform(dat, z = f(x, y))
ui <- fluidPage(
br(),
fluidRow(
column(
width = 2,
radioButtons("colors", "Colors",
c("viridis", "inferno", "magma", "plasma", "cividis"))
),
column(
width = 10,
graph3dOutput("mygraph", height = "550px")
)
)
)
server <- function(input, output, session){
Colors <- reactive({
colors <- switch(
input$colors,
viridis = viridis(5),
inferno = inferno(5),
magma = magma(5),
plasma = plasma(5),
cividis = cividis(5)
)
substring(colors, 1L, 7L)
})
output[["mygraph"]] <- renderGraph3d({
graph3d(dat, surfaceColors = Colors(), showLegend = FALSE)
})
}
shinyApp(ui, server)
}
if(interactive()) {
# 'onclick' example ####
library(shiny)
library(graph3d)
dat <- data.frame(x = rnorm(30), y = rnorm(30), z = rnorm(30))
onclick <- c(
"function(point){",
" Shiny.setInputValue('point', point);",
"}"
)
ui <- fluidPage(
br(),
fluidRow(
column(
width = 4,
h4("You clicked:"),
verbatimTextOutput("pointClicked")
),
column(
width = 8,
graph3dOutput("mygraph", height = "550px")
)
)
)
server <- function(input, output, session){
output[["mygraph"]] <- renderGraph3d({
graph3d(dat, type = "dot", width = "550px", height = "550px",
onclick = JS(onclick), tooltip = FALSE)
})
output[["pointClicked"]] <- renderPrint({
input[["point"]]
})
}
shinyApp(ui, server)
}
# }
Run the code above in your browser using DataLab