在R中使用3D透明球体绘制轨迹图

Question

我想在一个透明的三维球内制作我的df的轨迹图。

我在stackoverflow上搜索了一下，但没有找到相同的问题。所以这对所有对他们的向量轨迹感兴趣的人可能会有帮助。

df可能是这样的

df <- data.frame(mx=runif(100,-0.05,0.05),
             my=runif(100,-1,1),
             mz=runif(100,-0.5,0.5))

- Alexander

Answer 1

我同意Frank的回答。如果您想在像提供的图片一样的球体上绘制轨迹，那么您需要更加小心，因为普通的插值不会在球面上给出路径。有不同的选择，但最简单的可能就是将路径投影到球面上。

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')

当然，你也可以使用Frank答案中的平滑轨迹进行相同的操作：

# 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')

- Lars Lau Raket

Answer 2

你可以使用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

或者使用样条函数制作“平滑”轨迹，引用自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))来实现。

- Jota