r - 使用 R 绘制 3D 透明球体内部的轨迹图

我想在透明的 3d 球体内制作我的 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))

最佳答案

我同意弗兰克的回答。如果您想做的是像提供的图片那样在球体上绘制轨迹，则应该更加小心，因为普通插值不会给出球体上的路径。有不同的选项，但最简单的可能是将路径投影到球体上。

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

关于r - 使用 R 绘制 3D 透明球体内部的轨迹图，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/31354303/