使用 R 在 3D 透明球体内部绘制轨迹图
Trajectory Plot inside of 3D transparent sphere using R
我想在透明的 3d 球体中绘制 df
的轨迹图。
我搜索了 Whosebug,但找不到相同的问题。所以它可能对每个对他们的矢量轨迹感兴趣的人都有帮助。
df
可能是这样的
df <- data.frame(mx=runif(100,-0.05,0.05),
my=runif(100,-1,1),
mz=runif(100,-0.5,0.5))
您可以在 plot3d
中使用 type="l"
连接球体内的点,并使用 spheres3d
:
绘制球体
library(rgl)
plot3d(df, type="l", axes=FALSE) # type="l" is for "line"
spheres3d(0,0,0, radius=1, alpha=0.3, back="cull") # transparency set by alpha from 0 to 1
或使用样条曲线制作 "smooth" 轨迹,取自 Duncan Murdoch:
xx <- splinefun(seq_along(df$mx), df$mx)
yy <- splinefun(seq_along(df$my), df$my)
zz <- splinefun(seq_along(df$mz), df$mz)
times<-seq(1, dim(df)[1], len=2000) # vary length to change smoothness
plot3d(xx(times), yy(times), zz(times), type="l", axes=FALSE)
spheres3d(0,0,0, radius=1, alpha=0.3, back="cull")
如您所见,这样,您可能最终得到半径为 1 之外的直线,因此您可以通过输入更大的半径数或使用 radius=max(xx(times), yy(times), zz(times))
我同意弗兰克的回答。如果你想做的是像提供的图片一样在球体上绘制轨迹,你应该更加小心,因为普通插值不会给出球体上的路径。有不同的选择,但最简单的可能是将路径投影到球体上。
require(rgl)
# Construct a Brownian motion on a sphere
n <- 100
sigma <- 0.5
df <- array(NA, dim = c(n, 3))
df[1, ] <- rnorm(3, sd = sigma) # Starting point
df[1, ] <- df[1, ] / sqrt(sum(df[1, ]^2))
for (i in 2:n) {
df[i, ] <- rnorm(3, sd = sigma) + df[i - 1, ]
df[i, ] <- df[i, ] / sqrt(sum(df[i, ]^2))
}
# Linear interpolation of observed trajectories, but projected onto sphere
times <- seq(1, n, length = 1000)
xx <- approx(1:n, df[, 1], xout = times)$y
yy <- approx(1:n, df[, 2], xout = times)$y
zz <- approx(1:n, df[, 3], xout = times)$y
df_proj <- cbind(xx, yy, zz)
df_proj <- df_proj / sqrt(rowSums(df_proj ^2))
# Plot
plot3d(df_proj, type = 'l', col = heat.colors(1000), lwd = 2, xlab = 'x', ylab = 'y', zlab = 'z')
rgl.spheres(0, 0, 0, radius = 0.99, col = 'red', alpha = 0.6, back = 'lines')
你当然可以用弗兰克回答中的平滑轨迹做同样的事情:
# Smooth trajectories plot
times <- seq(1, n, length = 1000)
xx <- spline(1:n, df[, 1], xout = times)$y
yy <- spline(1:n, df[, 2], xout = times)$y
zz <- spline(1:n, df[, 3], xout = times)$y
df_smooth <- cbind(xx, yy, zz)
df_smooth <- df_smooth / sqrt(rowSums(df_smooth^2))
plot3d(df_smooth, type = 'l', col = heat.colors(1000), lwd = 2, xlab = 'x', ylab = 'y', zlab = 'z')
rgl.spheres(0, 0, 0, radius = 0.99, col = 'red', alpha = 0.6, back = 'lines')
我想在透明的 3d 球体中绘制 df
的轨迹图。
我搜索了 Whosebug,但找不到相同的问题。所以它可能对每个对他们的矢量轨迹感兴趣的人都有帮助。
df
可能是这样的
df <- data.frame(mx=runif(100,-0.05,0.05),
my=runif(100,-1,1),
mz=runif(100,-0.5,0.5))
您可以在 plot3d
中使用 type="l"
连接球体内的点,并使用 spheres3d
:
library(rgl)
plot3d(df, type="l", axes=FALSE) # type="l" is for "line"
spheres3d(0,0,0, radius=1, alpha=0.3, back="cull") # transparency set by alpha from 0 to 1
或使用样条曲线制作 "smooth" 轨迹,取自 Duncan Murdoch:
xx <- splinefun(seq_along(df$mx), df$mx)
yy <- splinefun(seq_along(df$my), df$my)
zz <- splinefun(seq_along(df$mz), df$mz)
times<-seq(1, dim(df)[1], len=2000) # vary length to change smoothness
plot3d(xx(times), yy(times), zz(times), type="l", axes=FALSE)
spheres3d(0,0,0, radius=1, alpha=0.3, back="cull")
如您所见,这样,您可能最终得到半径为 1 之外的直线,因此您可以通过输入更大的半径数或使用 radius=max(xx(times), yy(times), zz(times))
我同意弗兰克的回答。如果你想做的是像提供的图片一样在球体上绘制轨迹,你应该更加小心,因为普通插值不会给出球体上的路径。有不同的选择,但最简单的可能是将路径投影到球体上。
require(rgl)
# Construct a Brownian motion on a sphere
n <- 100
sigma <- 0.5
df <- array(NA, dim = c(n, 3))
df[1, ] <- rnorm(3, sd = sigma) # Starting point
df[1, ] <- df[1, ] / sqrt(sum(df[1, ]^2))
for (i in 2:n) {
df[i, ] <- rnorm(3, sd = sigma) + df[i - 1, ]
df[i, ] <- df[i, ] / sqrt(sum(df[i, ]^2))
}
# Linear interpolation of observed trajectories, but projected onto sphere
times <- seq(1, n, length = 1000)
xx <- approx(1:n, df[, 1], xout = times)$y
yy <- approx(1:n, df[, 2], xout = times)$y
zz <- approx(1:n, df[, 3], xout = times)$y
df_proj <- cbind(xx, yy, zz)
df_proj <- df_proj / sqrt(rowSums(df_proj ^2))
# Plot
plot3d(df_proj, type = 'l', col = heat.colors(1000), lwd = 2, xlab = 'x', ylab = 'y', zlab = 'z')
rgl.spheres(0, 0, 0, radius = 0.99, col = 'red', alpha = 0.6, back = 'lines')
你当然可以用弗兰克回答中的平滑轨迹做同样的事情:
# Smooth trajectories plot
times <- seq(1, n, length = 1000)
xx <- spline(1:n, df[, 1], xout = times)$y
yy <- spline(1:n, df[, 2], xout = times)$y
zz <- spline(1:n, df[, 3], xout = times)$y
df_smooth <- cbind(xx, yy, zz)
df_smooth <- df_smooth / sqrt(rowSums(df_smooth^2))
plot3d(df_smooth, type = 'l', col = heat.colors(1000), lwd = 2, xlab = 'x', ylab = 'y', zlab = 'z')
rgl.spheres(0, 0, 0, radius = 0.99, col = 'red', alpha = 0.6, back = 'lines')