Search code examples
rplotlygeometry

Transform and plot individual grouped values into (almost) full circles in `plotly` 3D spiral


I'm trying (but failing) to plot individual data points, in column prop, as a full circles (when looked at from above) in a plotly 3D spiral (see Data below). My idea was to repeat the prop values by 10 so as to have enough points to draw the circle around, but the resulting plot is far from what I'd like to get -- a 3D spiral where every prop value grouped by size and position is represented as an full circle. How can that be achieved?

data <- df %>%
  group_by(size) %>%
  slice(rep(row_number(), 10)) %>% 
  arrange(size, position) %>% 
  group_by(size, position) %>%
  mutate(
    radius = prop,
    theta = 2 * pi * position/row_number(),
    x = radius * sin(theta),
    y = radius * cos(theta)
  ) %>%
  ungroup() %>%
  mutate(z = row_number())

enter image description here

library(plotly)
plot_ly(data, x = ~x, y = ~y, z = ~z,
        type = 'scatter3d', 
        mode = 'lines',
        line = list(width = 5, color = ~size,
                    colorscale = list(c(0,'#0000FF'), c(0.5, "#00FF00"), c(1,'#FF0000'))))

EDIT:

I do have an at least initial solution here:

data <- df %>%
  group_by(size) %>%
  slice(rep(row_number(), 360)) %>%   # larger number of duplicated rows
  arrange(size, position) %>% 
  group_by(size, position) %>%
  mutate(row = row_number(),
         radius = prop,
         theta = 2 * pi * position/row,
         x = radius * sin(theta),
         y = radius * cos(theta)
  ) %>%
  ungroup() %>%
  mutate(z = consecutive_id(position))  # different conceptualization of z

And the result is much closer to what I have in mind:

enter image description here

What is still suboptimal are (i) the lines connecting the different z levels and (ii) the (curious) connecting lines on the circle planes. How can these types of lines be removed, rendered invisible or changed to dotted?

Data:

df <- structure(list(size = c(3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 
                              5L, 5L), position = c(1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5), prop = c(0.0926574818826153, 
                                                                                                  0.110336863900613, 0.30584534522577, 0.0632319256702261, 0.0857179727070362, 
                                                                                                  0.0963964254605284, 0.269251863083524, 0.0500172581505538, 0.0706956603595971, 
                                                                                                  0.0864162665913584, 0.102858577300825, 0.288838683360005)), row.names = c(NA, 
                                                                                                                                                                            -12L), class = c("tbl_df", "tbl", "data.frame"))

Solution

  • Using your data and initial solution, this is merely erasure without addressing what is going on in initial solution, essentially a mechanical and repetitive operation, additionally using split to remove connector lines between circles:

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

    Color distinctions between circles are lost.

    enter image description here

    The removal and subsequent split obscures the plot order as plot on a given z starts at the connecting line from the prior z.

    Levels 1,2,4,8,9 required no removal to arrive at their shape that is distinctive.

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

    enter image description here

    Peaks correspond to circle levels start index, z[x][1], levels 1-12 from left to right, number of points above 'red' abline correspond to number of points removed to achieve the above plot_ly, employing the split on data$z to remove connecting lines between circles.

    The plot analysis and its relation to number of points to remove was arrived at after the fact, so I took a rather more empirical approach of looking at a lot of plots and asking, 'Does that look right?' As said above, Levels 1,2,4,8,9 required no removal, resulting in these removed rows.

    # 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
    

    Now, failing the 'use my data test', your approach under samples theta. Using an approach I found whose link I'll include when found again:

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

    enter image description here

    The rats nest of crossing chords that make these appear as disks can be simplified to circle perimeter rings (without gaps) using chull, then plot_ly.

    Adapting circle_xy to accomodate 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))
    

    We have largest circles nearly closed, n is multiples of max(z), and one feels as though Zeno is arguing against arrival. So, just a few more samples closes.

    enter image description here