Forum: help

Monitor Forum | Start New Thread

Nested Flat Threaded Ultimate

Show 25 Show 50 Show 75 Show 100

RE: Advanced rgl webgl with slider [ Reply ] By: Lars Relund on 2020-05-25 10:05

[forum:47804]

Cool :-) I got the following code to work: ptsLst <- list(pts1 = pts, pts2 = pts) ptsLst[[2]]$time <- ptsLst[[2]]$time*2 loadView(v = view, zoom = 0.75) limits <- lapply(ptsLst, function(x) { tmp <- rbind(apply(x[,c('z1', 'z2', 'z3')], 2, min), apply(x[,c('z1', 'z2', 'z3')], 2, max)) }) limits <- limits %>% reduce(rbind) limits <- rbind(apply(limits, 2, min), apply(limits, 2, max)) steps <- 1000 minUnit <- max(max(sapply(ptsLst, function(x) {max(x[,'time'])})))/steps limits[1,] <- limits[1,] - 2 limits[2,] <- limits[2,] + 2 res <- as.vector(rep(NA, length(ptsLst)), "list") mfrow3d(1, 2) for (s in 1:length(ptsLst)) { next3d() ini3D(argsPlot3d = list( xlim = c(limits[1,'z1'], limits[2,'z1']), ylim = c(limits[1,'z2'], limits[2,'z2']), zlim = c(limits[1,'z3'], limits[2,'z3'])), clear = F ) axes3d() emptyId <- min(rgl.ids()$id) res[[s]]$subId <- subsceneInfo()$id lst <- as.vector(rep(emptyId, steps+1), "list") for (j in 1:nrow(ptsLst[[s]])) { i <- min(ceiling(ptsLst[[s]]$time[j]/minUnit), steps) ids <- plotCones3D(ptsLst[[s]][j, 1:3], rectangle = T, argsPolygon3d = list(alpha = 1, color = "lightblue"), drawLines = F) if (any(lst[[i]] == emptyId)) lst[[i]] <- ids else lst[[i]] <- c(lst[[i]], ids) } names(lst) <- paste0("cone", 1:length(lst)) lst[[i+1]] <- plotHull3D(ptsLst[[s]][,1:3], addRays = TRUE, argsPolygon3d = list(alpha = 0.5), useRGLBBox = TRUE)$ids res[[s]]$lst <- lst } rglwidget() %>% playwidget(list( subsetControl(subsets = res[[1]]$lst, accumulate = T, subscenes = res[[1]]$subId), subsetControl(subsets = res[[2]]$lst, accumulate = T, subscenes = res[[2]]$subId)), start = 0, stop = length(res[[1]]$lst)-1, interval = 0.05, rate = 33, loop = F, components = c("Play", "Slower", "Faster", "Reset", "Slider"))

RE: Advanced rgl webgl with slider [ Reply ] By: Duncan Murdoch on 2020-05-20 16:28	[forum:47797]
Okay, here's a version that works: library(rgl) mfrow3d(1, 2) id1 <- plot3d(1:10, 1:10) sub1 <- subsceneInfo()$id id2 <- plot3d(1:10, 10:1) sub2 <- subsceneInfo()$id rglwidget() %>% playwidget(list( subsetControl(subsets = list(c(), id1["data"], c(), id1["data"]), subscenes = sub1), subsetControl(subsets = list(c(), c(), id2["data"], id2["data"]), subscenes = sub2)), start = 0, stop = 3)

RE: Advanced rgl webgl with slider [ Reply ] By: Duncan Murdoch on 2020-05-20 16:23

[forum:47796]

I think it wouldn't be possible to control two separate plots in the document, but it should be possible to control two subscenes within one plot. However, when I put together this example: library(rgl) mfrow3d(1, 2) id1 <- plot3d(1:10, 1:10) sub1 <- subsceneInfo()$id id2 <- plot3d(1:10, 10:1) sub2 <- subsceneInfo()$id rglwidget() %>% playwidget(subsetControl(subsets = list(c(), id1["data"], id2["data"], c(id1["data"], id2["data"])), subscenes = c(sub1, sub2)), start = 1, stop = 4) it looks as though it's not working properly. So I'm not so sure it's currently possible, but it should be...

RE: Advanced rgl webgl with slider [ Reply ] By: Lars Relund on 2020-05-20 14:53

[forum:47795]

I think that I got it to work (after updating the functions): devtools::install_github("relund/gMOIP") library(gMOIP) library(rgl) library(tidyverse) pts <- data.frame( z1 = c(-54L,-48L,-51L,-38L,-15L,-22L,-32L, -38L,-27L,-18L,-18L,-27L,-40L,-44L,-33L,-28L,-34L,-47L, -43L,-40L,-52L,-45L,-33L,-35L,-39L,-41L,-45L,-40L, -39L,-41L,-31L,-29L,-43L,-30L,-28L,-39L), z2 = c(-14L,-20L,-23L,-36L,-55L,-51L,-46L, -39L,-50L,-53L,-54L,-47L,-34L,-30L,-41L,-44L,-37L,-21L, -27L,-27L,-15L,-22L,-38L,-37L,-31L,-30L,-27L,-29L, -27L,-26L,-42L,-43L,-29L,-44L,-45L,-32L), z3 = c(-49L,-50L,-45L,-39L,-13L,-24L,-28L, -35L,-25L,-20L,-16L,-27L,-34L,-38L,-27L,-30L,-37L,-47L, -41L,-42L,-49L,-46L,-36L,-36L,-39L,-39L,-38L,-41L, -43L,-43L,-32L,-32L,-40L,-29L,-29L,-36L), time = c(0.00327706336975098,0.0032811164855957, 0.00328397750854492,0.00328707695007324,0.00328993797302246, 0.00329303741455078,0.0032961368560791,0.00329899787902832, 0.00330305099487305,0.00330615043640137,0.00331902503967285, 0.00589895248413086,0.014336109161377,0.0182859897613525, 0.0271530151367188,0.0342481136322021,0.0416231155395508, 0.0467269420623779,0.0481159687042236,0.0526230335235596, 0.0603971481323242,0.0604031085968018,0.060405969619751, 0.0604090690612793,0.0767970085144043,0.0917060375213623,0.115400075912476, 0.115412950515747,0.115416049957275,0.115419149398804, 0.115431070327759,0.115434169769287,0.115437030792236, 0.126562118530273,0.128237009048462,0.219758033752441) ) view <- matrix( c(0.82544869184494, -0.418245762586594, -0.379084706306458, 0, -0.403665781021118, 0.0320594720542431, -0.914344727993011, 0, 0.394574046134949, 0.907767832279205, -0.142367839813232, 0, 0, 0, 0, 1), nc = 4) ## Example without steps relative to time loadView(v = view, zoom = 0.75) ini3D(argsPlot3d = list(xlim = c(min(pts[,1])-2,max(pts[,1])+2), ylim = c(min(pts[,2])-2,max(pts[,2])+2), zlim = c(min(pts[,3])-2,max(pts[,3])+2))) axes3d() lst <- NULL for (i in 1:nrow(pts)) { lst[[i]] <- plotCones3D(pts[i, 1:3], rectangle = T, argsPolygon3d = list(alpha = 1, color = "lightblue"), drawLines = F) } names(lst) <- paste0("cone", 1:nrow(pts)) lst$hull <- plotHull3D(pts[,1:3], addRays = TRUE, argsPolygon3d = list(alpha = 0.5), useRGLBBox = TRUE)$ids rglwidget() %>% playwidget(start = 0, stop = length(lst)-1, interval = 1, subsetControl(1, subsets = lst, accumulate = T)) ## Example with steps relative to time minUnit <- min(pts %>% transmute(diff = time - lag(time)), na.rm = T) steps <- round(max(pts$time)/minUnit) steps <- 1000 minUnit <- max(pts$time)/steps loadView(v = view, zoom = 0.75) ini3D(argsPlot3d = list(xlim = c(min(pts[,1])-2,max(pts[,1])+2), ylim = c(min(pts[,2])-2,max(pts[,2])+2), zlim = c(min(pts[,3])-2,max(pts[,3])+2))) axes3d() emptyId <- min(rgl.ids()$id) lst <- as.vector(rep(emptyId, steps), "list") for (j in 1:nrow(pts)) { i <- min(ceiling(pts$time[j]/minUnit), steps) ids <- plotCones3D(pts[j, 1:3], rectangle = T, argsPolygon3d = list(alpha = 1, color = "lightblue"), drawLines = F) if (any(lst[[i]] == emptyId)) lst[[i]] <- ids else lst[[i]] <- c(lst[[i]], ids) } names(lst) <- paste0("cone", 1:length(lst)) lst$hull <- plotHull3D(pts[,1:3], addRays = TRUE, argsPolygon3d = list(alpha = 0.5), useRGLBBox = TRUE)$ids rglwidget() %>% playwidget(start = 0, stop = length(lst)-1, interval = 0.05, rate = 33, loop = F, subsetControl(1, subsets = lst, accumulate = T), components = c("Play", "Slower", "Faster", "Reset", "Slider")) A new question: Lets say I have two of these plots (different time column). Is it possible to have just one slider controlling both plots simultaneously?

RE: Advanced rgl webgl with slider [ Reply ] By: Duncan Murdoch on 2020-05-19 13:56

[forum:47789]

`ageControl` is designed to modify a single object according to a time index: each vertex has a certain "birth time", and some characteristic of that vertex is set based on its age at a certain fixed time. Your for loop creates new objects in each step, so `ageControl` is probably not what you want. I'd guess you might get what you want with a `subsetControl` instead. Save the object ids at each step through your for loop, then display only those objects in response to the slider. This will need changes to `plotCones3D`, because currently it doesn't return the ids of the objects it plotted.

Advanced rgl webgl with slider [ Reply ] By: Lars Relund on 2020-05-19 13:35

[forum:47788]

The following code plots a set of 3D objects: devtools::install_github("relund/gMOIP") library(gMOIP) library(rgl) pts <- data.frame( z1 = c(-54L,-48L,-51L,-38L,-15L,-22L,-32L, -38L,-27L,-18L,-18L,-27L,-40L,-44L,-33L,-28L,-34L,-47L, -43L,-40L,-52L,-45L,-33L,-35L,-39L,-41L,-45L,-40L, -39L,-41L,-31L,-29L,-43L,-30L,-28L,-39L), z2 = c(-14L,-20L,-23L,-36L,-55L,-51L,-46L, -39L,-50L,-53L,-54L,-47L,-34L,-30L,-41L,-44L,-37L,-21L, -27L,-27L,-15L,-22L,-38L,-37L,-31L,-30L,-27L,-29L, -27L,-26L,-42L,-43L,-29L,-44L,-45L,-32L), z3 = c(-49L,-50L,-45L,-39L,-13L,-24L,-28L, -35L,-25L,-20L,-16L,-27L,-34L,-38L,-27L,-30L,-37L,-47L, -41L,-42L,-49L,-46L,-36L,-36L,-39L,-39L,-38L,-41L, -43L,-43L,-32L,-32L,-40L,-29L,-29L,-36L), time = c(0.00327706336975098,0.0032811164855957, 0.00328397750854492,0.00328707695007324,0.00328993797302246, 0.00329303741455078,0.0032961368560791,0.00329899787902832, 0.00330305099487305,0.00330615043640137,0.00331902503967285, 0.00589895248413086,0.014336109161377,0.0182859897613525, 0.0271530151367188,0.0342481136322021,0.0416231155395508, 0.0467269420623779,0.0481159687042236,0.0526230335235596, 0.0603971481323242,0.0604031085968018,0.060405969619751, 0.0604090690612793,0.0767970085144043,0.0917060375213623,0.115400075912476, 0.115412950515747,0.115416049957275,0.115419149398804, 0.115431070327759,0.115434169769287,0.115437030792236, 0.126562118530273,0.128237009048462,0.219758033752441) ) view <- matrix( c(0.82544869184494, -0.418245762586594, -0.379084706306458, 0, -0.403665781021118, 0.0320594720542431, -0.914344727993011, 0, 0.394574046134949, 0.907767832279205, -0.142367839813232, 0, 0, 0, 0, 1), nc = 4) loadView(v = view, zoom = 0.75) ini3D(argsPlot3d = list(xlim = c(min(pts[,1])-2,max(pts[,1])+2), ylim = c(min(pts[,2])-2,max(pts[,2])+2), zlim = c(min(pts[,3])-2,max(pts[,3])+2))) axes3d() for (i in 1:nrow(pts)) { plotCones3D(pts[i, 1:3], rectangle = T, argsPolygon3d = list(alpha = 1, color = "lightblue"), drawLines = F) } plotHull3D(pts[,1:3], addRays = TRUE, argsPolygon3d = list(alpha = 0.5), useRGLBBox = TRUE) Is it possible to make a WebGL plot with a slider using rglwiget, playwidget and (maybe ageControl). That shows the objects in the for loop when time equals the time column in pts? I have tried to experiment with ageControl however not succeded.