是否有更有效的方法在R中绘制3D箭头?
我在R中进行了ShinyApp的工作,只要选择相应的复选框,我想在RGLWidgetOutput中绘制数百个箭头。但是,每当我选择复选框时,我的屏幕都会冻结几秒钟,现在我想知道是否有更有效的绘制箭头的方法。
这是一个最小示例(在闪亮之外):
library(rgl)
mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
mat0[,3])
mat1 = mat1 + 0.5
open3d()
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)
for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
所有点都可以在单个表达式中绘制(例如plot3d(mat0 [2:9,]
),但是要绘制箭头,需要一个循环。有没有一种方法可以在单个表达式中同时绘制所有箭头?我还从matlib
库中查看了vectors3d
功能从我的Shiny应用程序中的服务器功能效率低下
library(shiny)
library(rgl)
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with checkbox
sidebarLayout(
sidebarPanel(
checkboxInput("cb", "Show Arrows", value = FALSE),
),
# Show plot
mainPanel(
rglwidgetOutput(outputId = "threeDPlot", width = "1200px", height = "800px")
)
)
)
# Define server logic
server <- function(input, output) {
#create 3D Plot
output$threeDPlot = renderRglwidget({
rgl.open(useNULL=TRUE)
rgl.bg(color="white")
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab = "", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)
if(input$cb == TRUE){
for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
}
rglwidget()
})
}
#global variables - read only once
mat0 = matrix(rep(1:10,3), ncol = 3)
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
mat0[,3])
mat1 = mat1 + 0.5
# Run the application
shinyApp(ui = ui, server = server)
。
I'm working on a ShinyApp in R where I want to draw hundreds of arrows displayed in an rglwidgetOutput whenever the respective checkbox is selected. However, my screen is freezing for a couple of seconds whenever I select the checkbox and now I'm wondering if there is a more efficient way to draw the arrows.
Here is a minimal example (outside of Shiny):
library(rgl)
mat0 = matrix(rep(1:10,3), ncol = 3) # 1:n to adjust number of points
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
mat0[,3])
mat1 = mat1 + 0.5
open3d()
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)
for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
All points can be drawn in a single expression (e.g. plot3d(mat0[2:9,]
), however to draw the arrows a loop is required. Is there a way to draw all arrows at the same time within a single expression? The arrows have different lengths, orientation and points of origin. Therefore I believe I cannot use the spriteOrigin
argument or do I misunderstand this? I have also looked into the vectors3d
function from the matlib
library but it seems a single point of origin is required. I'm also not sure if the perfomance issue maybe comes from an inefficient design of the server function within my shiny application. A more elaborate example:
library(shiny)
library(rgl)
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with checkbox
sidebarLayout(
sidebarPanel(
checkboxInput("cb", "Show Arrows", value = FALSE),
),
# Show plot
mainPanel(
rglwidgetOutput(outputId = "threeDPlot", width = "1200px", height = "800px")
)
)
)
# Define server logic
server <- function(input, output) {
#create 3D Plot
output$threeDPlot = renderRglwidget({
rgl.open(useNULL=TRUE)
rgl.bg(color="white")
plot3d(mat0[2:9,], aspect = FALSE, axes = FALSE, xlab = "", ylab = "", zlab = "", col = 1)
plot3d(mat1[2:9,], add = TRUE, col = 2)
if(input$cb == TRUE){
for(i in 2:9) arrow3d(mat0[i,], mat1[i,], type = "rotation")
}
rglwidget()
})
}
#global variables - read only once
mat0 = matrix(rep(1:10,3), ncol = 3)
mat1 = cbind(mat0[,1]*cos(seq(0,2*pi,length = 10)) - mat0[,2] * sin(seq(0,2*pi,length = 10)),
mat0[,1]*sin(seq(0,2*pi,length = 10)) + mat0[,2] * cos(seq(0,2*pi,length = 10)),
mat0[,3])
mat1 = mat1 + 0.5
# Run the application
shinyApp(ui = ui, server = server)
Note: in these examples only 8 arrows are drawn. With ~ 500 arrows the app is freezing for a while, though.
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(3)
这是使用库的替代方法( data.table ):
//i.sstatic.net/nvyhq.png“ rel =“ nofollow noreferrer >一个没有标记的版本:
Here is an alternative approach using library(data.table):
A version without markers:
RGL解决方案:
现在,我使用了一些基本的几何形状来计算箭头,仅基于线段:
此代码已经运行得更快,尽管箭头看起来不那么漂亮。也许它仍然对别人有帮助。
我将这个问题打开了一段时间,以防有更多优雅的答案。
Rgl solution:
For now I've used some basic geometry to calculate the arrows based solely on line segments:
This code is already running much faster, although the arrows do not look as beautiful. Maybe it still helps someone else.
I'm leaving this question open for a while in case there will be some more elegant answers.
这是一个情节解决方案:
出于某种原因,第一个和最后一个锥体的颜色错误(找到解决方案时我会更新)。另外,添加锥体工作非常快。但是,现在添加从P0到P1的线非常慢。
Here is a plotly solution:
For some reason the first and last cone have the wrong color (I'll update when I find a solution). Also, adding cones works very fast. However, now adding the lines from P0 to P1 is very slow.