Преобразуйте и нарисуйте отдельные сгруппированные значения в (почти) полные круги в «графической» трехмерной спирали

Не уверен, что это хоть сколько-нибудь близко к тому, чего вы хотели бы достичь, но я могу получить 3 отдельные спирали, адаптировав идею пружины, описанную здесь.

split = ~z в вызове plot_ly() избегал соединительных линий.

library(tidyverse)
library(plotly)

create_spiral <- \(x, y, xend, yend, diameter = 1, tension = 0.75, n = 50) {
  length <- sqrt((x - xend)^2 + (y - yend)^2)
  n_revolutions <- length / (diameter * tension)
  n_points <- n * n_revolutions
  radians <- seq(0, n_revolutions * 2 * pi, length.out = n_points)
  x <- seq(x, xend, length.out = n_points)
  y <- seq(y, yend, length.out = n_points)
  data.frame(
    x = cos(radians) * diameter / 2 + x,
    y = sin(radians) * diameter / 2 + y
  )
}

spirals <- map(1:3, \(z) {
  create_spiral(
    x = 4, y = 2, xend = 8, yend = 6,
    diameter = 4, tension = 0.6, n = 50
  ) |>
    mutate(z = z * 5)
}) |>
  bind_rows()

plot_ly(spirals,
  x = ~x, y = ~y, z = ~z, split = ~z,
  type = "scatter3d",
  mode = "lines"
)

^{Created on 2024-04-22 with reprex v2.1.0}

Используя ваши данные и исходное решение, это просто стирание без учета того, что происходит в исходном решении, по сути, механическая и повторяющаяся операция, дополнительно используя split для удаления соединительных линий между кругами:

remove_rows
 [1]  721  722 1441 1801 1802 2161 2162 2163 3241 3242 3601 3602 3603 3961 3962
[16] 3963 3964 

data5 <- data4[-remove_rows, ]
plot_ly(data5, x = ~x, y = ~y, z = ~z, split = factor(data5$z), 
        type = 'scatter3d', 
        mode = 'lines',
        line = list(width = 5, color = ~size,
                    colorscale = list(c(0,'#0000FF'), c(0.5, "#00FF00"), c(1,'#FF0000'))))

Цветовые различия между кругами теряются.

Удаление и последующий split скрывают порядок сюжета, поскольку график по заданному z начинается на соединительной линии от предшествующего z.

Уровни 1,2,4,8,9 не требовали удаления, чтобы получить характерную форму.

seq(1, 4320, 360) # for start rows by `z[x]` in data
 [1]    1  361  721 1081 1441 1801 2161 2521 2881 3241 3601 3961
plot(data$theta)
abline(h = 7, col = 'red')
abline(h = 6, col = 'black')

Пики соответствуют индексу начала уровней круга, z[x][1], уровни 1–12 слева направо, количество точек над «красной» линией соответствует количеству точек, удаленных для достижения вышеуказанного графика, использование split на data$z для удаления соединительных линий между кругами .

Анализ сюжета и его связь с количеством точек, которые нужно удалить, были получены постфактум, поэтому я применил более эмпирический подход, просматривая множество графиков и спрашивая: «Это выглядит правильно?» Как было сказано выше, уровни 1,2,4,8,9 не требовали удаления, в результате чего были удалены строки.

# data$z[1-12] starting rows 
[1]    1  361  721 1081 1441 1801 2161 2521 2881 3241 3601 3961
remove_rows
 [1]  721  722 1441 1801 1802 2161 2162 2163 3241 3242 3601 3602 3603 3961 3962
[16] 3963 3964

Теперь, если вы не выполнили тест «использовать мои данные», ваш подход основан на выборках тета. Используя подход, который я нашел, link которого я включу, когда найду снова:

circles <- function(n, mu, sigma) {
    lr <- Map(rlnorm, n = n, meanlog = mu, sdlog = sigma)
    N <- length(lr)
    n <- lengths(lr, FALSE)
    data.frame(group = rep.int(gl(N, 1L), n),
               r = unlist(lr, FALSE, FALSE),
               theta = runif (sum(n), 0, 2 * pi))
} 
d <- circles(n = rep(c(500, 750, 1000),3), mu = rep(log(c(1,2,4)),3), sigma = rep(c(0.00001, 0.00001, 0.00001),3))
d$x = d$r * sin(d$theta)
d$y = d$r * cos(d$theta)
d$z = as.numeric(as.character(d$group))
plot_ly(d, x = ~x, y = ~y, z = ~z, split = factor(d$z),
type = 'scatter3d', 
        mode = 'lines',
        line = list(width = 5))

Крысиное гнездо из пересекающихся хорд, из-за которых они выглядят как диски, можно упростить, обведя кольцами по периметру (без пробелов), используя chull, а затемplot_ly.

Адаптация circle_xy для размещения z

circle_xyz <- function(n, r, z, close_loop = FALSE) {
theta = seq(0, 2 * pi, length.out = n + 1)
if (!close_loop) theta = theta[-(n +1)]
cbind(x = r * cos(theta), y = r * sin(theta), z = z)
}
too_many_circles <- circle_xyz(n = 4896, r = df$prop, z = 1:12, close_loop = TRUE)
Warning messages:
1: In r * cos(theta) :
  longer object length is not a multiple of shorter object length
2: In r * sin(theta) :
  longer object length is not a multiple of shorter object length
3: In cbind(x = r * cos(theta), y = r * sin(theta), z = z) :
  number of rows of result is not a multiple of vector length (arg 3)
 too_many_df = as.data.frame(too_many_circles)
plot_ly(too_many_df, x = ~x, y = ~y, z = ~z, split = factor(too_many_df$z),
 type = 'scatter3d',
 mode = 'lines', 
 line = list(width = 5))

У нас самые большие круги почти замкнуты, n кратно max(z), и создается впечатление, что Зенон выступает против прибытия. Итак, осталось еще несколько образцов.