我在R中的ShinyApp上作業，只要選擇相應的復選框，我想在RGLWIDGETOUTPUT中繪制數百個箭頭。但是，每當我選擇復選框時，我的螢屏都會凍結幾秒鐘，現在我想知道是否有更有效的方法來繪制箭頭。
這是一個最小的示例（在 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")
所有點都可以在一個運算式中繪制（例如plot3d(mat0[2:9,]），但是要繪制箭頭需要一個回圈。有沒有辦法在一個運算式中同時繪制所有箭頭？箭頭有不同的長度、方向和原點。因此我相信我不能使用這個spriteOrigin論點還是我誤解了這一點？我還研究vectors3d了庫中的函式，matlib但似乎需要一個原點。我也不確定性能問題是否來自我閃亮的應用程式中服務器功能的低效設計。一個更詳細的例子：
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)
注意：在這些示例中，僅繪制了 8 個箭頭。不過，使用 ~ 500 個箭頭，該應用程式會凍結一段時間。
uj5u.com熱心網友回復：
這是使用庫（
沒有標記的版本：
library(plotly)
library(data.table)
# Example Data
# P0 data: origin of arrows
DT0 <- setnames(data.table(replicate(4, 1:10)), new = c("x", "y", "z", "sep"))
DT1 <- copy(DT0)
DT1[, c("x", "y", "z") := .(x * cos(seq(0, 2 * pi, length = 10)) - y * sin(seq(0, 2 * pi, length = 10)),
x * sin(seq(0, 2 * pi, length = 10)) y * cos(seq(0, 2 * pi, length = 10)),
z)]
DT1[,1:3] <- DT1[,1:3] 0.5
# Artifical Separator
DTsep <- copy(DT0)
DTsep[,1:3] <- NA
# Each set of points from P0 and P1 is separated by a row of NA coordinates
DT <- rbindlist(list(var_1 = DT0, var_2 = DT1, var_3 = DTsep), idcol = "id")
setorder(DT, sep, id)
# Direction of Arrows
dirDT <- copy(DT1[,1:3])
dirDT <- dirDT - DT0[,1:3] # direction vector
dirDT <- dirDT / sqrt(rowSums(dirDT ^ 2)) # unit vector for evenly sized cones
setnames(dirDT, new = c("u", "v", "w"))
dirDT <- cbind(dirDT, DT1)
# # Add P0 and P1
# fig <- plot_ly(
# data = DT,
# type = "scatter3d",
# mode = "markers",
# x = ~ x,
# y = ~ y,
# z = ~ z,
# size = 1,
# marker = list(color = "#000000", line = list(color = "#000000")),
# showlegend = FALSE
# )
# Add Lines from P0 to P1
fig <- plot_ly(
# fig,
data = DT,
type = "scatter3d",
mode = "lines",
x = ~ x,
y = ~ y,
z = ~ z,
# inherit = FALSE,
showlegend = FALSE,
line = list(color = "black")
)
# Add Cones
fig <- add_trace(
fig,
data = dirDT,
type = "cone",
x = ~ x,
y = ~ y,
z = ~ z,
u = ~ u,
v = ~ v,
w = ~ w,
inherit = FALSE,
showscale = FALSE,
colorscale = list(list(0, "black"), list(1, "black"))
)
# Remove grid and axes
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
# Update Layout
fig <- layout(
fig,
showlegend = FALSE,
scene = list(
aspectmode = "data",
#equal aspect ratio
xaxis = ax,
yaxis = ax,
zaxis = ax,
camera = list(eye = list(
x = -0.76, y = 1.8, z = 0.92
))
)
)
fig
uj5u.com熱心網友回復：
這是一個巧妙的解決方案：
library(plotly)
# Example data
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
dir = mat1 - mat0 #direction vector
dir = dir / sqrt(rowSums(dir^2)) #unit vector
fig = plotly_empty()
#Add P0
fig = fig %>%
add_markers(type = "scatter3d", mode = "markers", size = 1,
x = mat0[,1], y = mat0[,2], z = mat0[,3],
color = rep(1, length(mat0[,1])) ,colors = c("#000000", "#ff0000"))
#Add P1
fig = fig %>%
add_markers(type = "scatter3d", mode = "markers", size = 1,
x = mat1[,1], y = mat1[,2], z = mat1[,3],
color = rep(2, length(mat1[,1])) ,colors = c("#000000", "#ff0000"))
#Add Lines from P0 to P1
fig = fig %>%
add_trace(type = "scatter3d", mode = "lines", split = rep(1:length(mat0[,1]), each = 2),
x = c(rbind(mat0[,1],mat1[,1])), y = c(rbind(mat0[,2],mat1[,2])), z = c(rbind(mat0[,3],mat1[,3])),
color = rep(1, length(mat0[,1])*2), colors = c("#000000", "#ff0000"))
#Add Cones
fig = fig %>%
add_trace(type = "cone",
x = mat1[,1], y = mat1[,2], z = mat1[,3],
u = dir[,1], v = dir[,2], w = dir[,3],
color = rep(1, length(mat1[,1])), colors = c("#000000"),
showscale = FALSE)
#ensure that no lines and numbers for axes are shown
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
#Update Layout
fig = fig %>%
layout(
showlegend = FALSE,
scene = list(
aspectmode = "data", #equal aspect ratio
xaxis = ax,
yaxis = ax,
zaxis = ax,
camera = list(
eye = list(x= -0.76, y= 1.8, z= 0.92)
)
)
)
#Show plot
fig
出于某種原因，第一個和最后一個圓錐的顏色錯誤（我會在找到解決方案時更新）。此外，添加錐體的速度非常快。但是，現在添加從 P0 到 P1 的行非常慢。
uj5u.com熱心網友回復：
Rgl 解決方案：現在我已經使用了一些基本的幾何圖形來計算僅基于線段的箭頭：
library(rgl)
#example data
p0 = matrix(rep(1:10,3), ncol = 3)
p1 = cbind(p0[,1]*cos(seq(0,2*pi,length = 10)) - p0[,2] * sin(seq(0,2*pi,length = 10)),
p0[,1]*sin(seq(0,2*pi,length = 10)) p0[,2] * cos(seq(0,2*pi,length = 10)),
p0[,3])
p1 = p1 0.5
pu = p1 - p0 #direction vector
pu = pu / sqrt(rowSums(pu^2)) #make it a unit vector
pu = pu / 2 # scaling: division by 2 for shorter arrows
#a vector that is perpendicular to the unit vector
#based on: https://math.stackexchange.com/questions/137362/how-to-find-perpendicular-vector-to-another-vector (Ken Whatmough)
ppu = cbind(pu[,3] * sign(sign(pu[,1]) 0.5),
pu[,3] * sign(sign(pu[,2]) 0.5),
-((abs(pu[,1]) abs(pu[,2])) * sign(sign(pu[,3]) 0.5)))
tp1 = p1 - pu - ppu #triangle points 1
tp2 = p1 - pu ppu #triangle points 2 (opposite direction)
#draw points
open3d()
plot3d(p0, aspect = FALSE, axes = FALSE, xlab = "", ylab ="", zlab = "", col = 4)
plot3d(p1, add = TRUE, col = 2)
#draw arrows
segments3d(x = c(t(cbind(p0[,1],p1[,1]))), y = c(t(cbind(p0[,2],p1[,2]))), z = c(t(cbind(p0[,3],p1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp1[,1]))), y = c(t(cbind(p1[,2], tp1[,2]))), z = c(t(cbind(p1[,3], tp1[,3]))), lwd = 2)
segments3d(x = c(t(cbind(p1[,1], tp2[,1]))), y = c(t(cbind(p1[,2], tp2[,2]))), z = c(t(cbind(p1[,3], tp2[,3]))), lwd = 2)
盡管箭頭看起來不那么漂亮，但這段代碼已經運行得更快了。也許它仍然可以幫助其他人。
我將這個問題留待一段時間，以防會有更優雅的答案。
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/497597.html
下一篇：Expressjs所需的表單元素