Nothing
## ----setup, echo=FALSE, results="asis"----------------------------------------
source("setup.R")
setupKnitr(autoprint = FALSE)
set.seed(123)
## ----elementId----------------------------------------------------------------
library(rgl)
plotids <- with(iris, plot3d(Sepal.Length, Sepal.Width, Petal.Length,
type="s", col=as.numeric(Species)))
rglwidget(elementId = "plot3drgl")
## -----------------------------------------------------------------------------
toggleWidget(sceneId = "plot3drgl", ids = plotids["data"], label = "Data")
## -----------------------------------------------------------------------------
names(plotids)
unclass(plotids)
## ----Pipes--------------------------------------------------------------------
rglwidget() %>%
toggleWidget(ids = plotids["data"], label = "Data")
## ----eval=FALSE---------------------------------------------------------------
# rglwidget() |>
# toggleWidget(ids = plotids["data"], label = "Data")
## ----"Control before widget"--------------------------------------------------
toggleWidget(NA, ids = plotids["data"], label = "Data") %>%
rglwidget(controllers = .)
## ----eval=FALSE---------------------------------------------------------------
# toggleWidget(NA, ids = plotids["data"], label = "Data") |>
# w => rglwidget(controllers = w)
## ----"Toggle subsets"---------------------------------------------------------
clear3d() # Remove the earlier display
with(subset(iris, Species == "setosa"),
spheres3d(Sepal.Length, Sepal.Width, Petal.Length,
col=as.numeric(Species),
radius = 0.211,
tag = "setosa"))
with(subset(iris, Species == "versicolor"),
spheres3d(Sepal.Length, Sepal.Width, Petal.Length,
col=as.numeric(Species),
radius = 0.211,
tag = "versicolor"))
with(subset(iris, Species == "virginica"),
spheres3d(Sepal.Length, Sepal.Width, Petal.Length,
col=as.numeric(Species),
radius = 0.211,
tag = "virginica"))
aspect3d(1,1,1)
decorate3d(tag = "axes")
rglwidget() %>%
toggleWidget(tags = "setosa") %>%
toggleWidget(tags = "versicolor") %>%
toggleWidget(tags = "virginica") %>%
toggleWidget(tags = "axes") %>%
asRow(last = 4)
## ----Slider-------------------------------------------------------------------
rglwidget() %>%
playwidget(start = 0, stop = 3, interval = 1,
subsetControl(1, subsets = list(
Setosa = tagged3d("setosa"),
Versicolor = tagged3d("versicolor"),
Virginica = tagged3d("virginica"),
All = tagged3d(c("setosa", "versicolor", "virginica"))
)))
## ----"par3dinterpControl()"---------------------------------------------------
M <- r3dDefaults$userMatrix
fn <- par3dinterp(time = (0:2)*0.75, userMatrix = list(M,
rotate3d(M, pi/2, 1, 0, 0),
rotate3d(M, pi/2, 0, 1, 0)) )
rglwidget() %>%
playwidget(par3dinterpControl(fn, 0, 3, steps=15),
step = 0.01, loop = TRUE, rate = 0.5)
## ----"vertexControl()"--------------------------------------------------------
setosavals <- subset(iris, Species == "setosa")
which <- which.min(setosavals$Sepal.Width)
init <- setosavals$Sepal.Length[which]
rglwidget() %>%
playwidget(
vertexControl(values = matrix(c(init, 0, 0, 0,
8, 1, 1, 1),
nrow = 2, byrow = TRUE),
attributes = c("x", "red", "green", "blue"),
vertices = which, tag = "setosa"),
step = 0.01)
## ----"ageControl()"-----------------------------------------------------------
time <- 0:500
xyz <- cbind(cos(time/20), sin(time/10), time)
lineid <- plot3d(xyz, type="l", col = "black")["data"]
sphereid <- spheres3d(xyz[1, , drop=FALSE], radius = 8, col = "red")
rglwidget() %>%
playwidget(list(
ageControl(births = time, ages = c(0, 0, 50),
colors = c("gray", "red", "gray"), objids = lineid),
ageControl(births = 0, ages = time,
vertices = xyz, objids = sphereid)),
start = 0, stop = max(time) + 20, rate = 50,
components = c("Reverse", "Play", "Slower", "Faster",
"Reset", "Slider", "Label"),
loop = TRUE)
## ----crosstalk,eval = requireNamespace("crosstalk", quietly=TRUE)-------------
# This example requires the crosstalk package
# We skip it if crosstalk is not available.
ids <- with(iris, plot3d(Sepal.Length, Sepal.Width, Petal.Length,
type="s", col=as.numeric(Species)))
par3d(mouseMode = "selecting")
rglwidget(shared = rglShared(ids["data"])) %>%
rglMouse()
## ----"rglShared()",eval=requireNamespace("crosstalk", quietly = TRUE)---------
# This example requires the crosstalk package.
# We skip it if crosstalk is not available.
library(crosstalk)
sd <- SharedData$new(mtcars)
ids <- plot3d(sd$origData(), col = mtcars$cyl, type = "s")
# Copy the key and group from existing shared data
rglsd <- rglShared(ids["data"], key = sd$key(), group = sd$groupName())
rglwidget(shared = rglsd) %>%
asRow("Mouse mode: ", rglMouse(getWidgetId(.)),
"Subset: ", filter_checkbox("cylinderselector",
"Cylinders", sd, ~ cyl, inline = TRUE),
last = 4, colsize = c(1,2,1,2), height = 60)
## ----plot3d2------------------------------------------------------------------
plotids <- with(iris, plot3d(Sepal.Length, Sepal.Width, Petal.Length,
type="s", col=as.numeric(Species)))
subid <- currentSubscene3d()
rglwidget(elementId="plot3drgl2")
## ----echo=FALSE, results="asis"-----------------------------------------------
writeIndex(cols = 5)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.