Segments connecting points disappear in R plotly animation

I am trying to connect points over time using a R plotly animation.

Several issues appear with the code below:

1. The segments float from one connection to another.
2. The segments disappear from one day to another even though the connection still exists on the consecutive days (see df).
3. Not all connections were plotted.
4. I tried to exchange add_segments with add_annotations to have arrows instead of segments but the frame argument would not work.

Note that removing the color and symbol arguments help with point #2 and #3.

library(dplyr)
library(plotly)

set.seed(12)
df <- tibble(
  day = rep(1:8, each = 10),
  id = rep(paste0("ID", 1:10), 8),
  infector = NA
) %>%
  group_by(id) %>%
  mutate(x = rnorm(1),
         y = rnorm(1),
         group =  sample(c("A", "B", "C"), 1)) %>%
  ungroup() %>%
  mutate(
    infector = case_when(
      id == "ID2" & day >= 1 ~ "ID4",
      id == "ID3" & day >= 2 ~ "ID4",
      id == "ID1" & day >= 3 ~ "ID2",
      id == "ID5" & day >= 3 ~ "ID3",
      id == "ID6" & day >= 3 ~ "ID4",
      id == "ID10" & day >= 4 ~ "ID2",
      id == "ID9" & day >= 7 ~ "ID5"
    )
  )
infectors <- df %>% filter(day == 1 & id %in% .$infector) %>%
  select(id, x, y, group) %>%
  rename(infector.x = x,
         infector.y = y,
         infector_group = group)

df <- left_join(df, infectors, by = c("infector" = "id"))

pal <- c("A" = "blue", "B" = "green", "C" = "red")

plot_ly(df) %>%
  add_markers(
    x = ~ x,
    y = ~ y,
    frame = ~ day,
    hoverinfo = "text",
    text = ~ paste("ID:", id),
    symbol = ~group,
    color = ~group,
    colors = pal
  ) %>%
  add_segments(
    x = ~infector.x,
    xend = ~x,
    y = ~infector.y,
    yend = ~y,
    color = ~infector_group,
    colors = pal,
    frame = ~day)

In the comments I felt I found the mistake, you pointed out that I didn't. You're right. So, I made it my goal to answer your question to redeem myself.

BLUF (or my the more trendy TL;DR):

Add all lines to every frame, but change the line width, depending on which frame the segments are supposed to be visible. (Opacity was ignored, but width worked the first time.)

<hr>

Lengthy Explanation

First, Plotly has pointed out there are severe limitations in their animations. Although, far better explanations exist in the Python platform. There is a trouble ticket that is several years old about issues with lines in general, as well.

However, the limitation issue here is that each point that is present in the first frame has to be present in the second. It doesn't have to be in the same place, but the quantity is very relevant. I figured this is programming and where there is a will, there is a way. After attempting to make this work through many different avenues, I think what I'll show you is probably the easiest way to make this happen.

Step 1

Identify all possible line segments, regardless of frame (or day).

Step 2

Create a list of layout.shapes for each segment.

Step 3

Create the base plot and build it.

Step 4

Iterate through the frames (or day), and find which of the unique shapes (line segments) exist in each frame. If shape is in frame, assign linewidth to 2 (default width). If it's not in the frame, assign a linewidth of close enough to zero that Plotly will still consider it 'to exist' (I used .001).

Step 5 Entirely Optional

I added a bit of code to change the legend, so it's just the single letter instead of A<br />A.

Step 6

Plot it... it's done.

#--------------- Step 1 ---------------
shDt <- df[, c(4:5, 7:9)] %>% na.omit() %>% # identify all possible segments 
  distinct()
# # A tibble: 7 × 5
#        x       y infector.x infector.y infector_group
#    <dbl>   <dbl>      <dbl>      <dbl> <chr>         
# 1 -0.957 -0.780      -2.00     -0.152  C             
# 2 -0.920  0.0120     -2.00     -0.152  C             
# 3 -1.48  -0.778      -0.957    -0.780  C             
# 4 -0.272 -0.703      -0.920     0.0120 B             
# 5 -0.315  1.19       -2.00     -0.152  C             
# 6  1.58  -1.29       -0.957    -0.780  C             
# 7  0.428 -0.293      -0.272    -0.703  A              

#--------------- Step 2 ---------------
shps <- invisible(lapply( # create shapes list for frame layout
  1:nrow(shDt),
  function(i) {
    list(type = "line",
         xref = "x", yref = "y",
         # dbl bkt to drop name
         line = list(color = pal[[shDt[i, ]$infector_group]]),
         # simplify = F), # to prevent linking btw frames
         x0 = shDt[i, ]$infector.x,
         x1 = shDt[i, ]$x,
         y0 = shDt[i, ]$infector.y,
         y1 = shDt[i, ]$y)
    # visible = F)
  }))

#--------------- Step 3 ---------------
plt <- plot_ly(df) %>% # base plot (markers only; as originally doc)
  add_markers(
    x = ~ x,
    y = ~ y,
    frame = ~ day,
    hoverinfo = "text",
    text = ~ paste("ID:", id),
    symbol = ~group,
    color = ~group,
    colors = pal
  )

plt <- plotly_build(plt)      # build plot

#--------------- Step 4 ---------------
# add every shape to every frame, change width
invisible(lapply(                     # by day, what segments are present?
  unique(df$day),
  function(j) {
    df2 <- df[, c(1, 4:5, 7:9)] %>% na.omit() %>% 
      filter(day == j) %>% select(-day)
    df2_ <- do.call(paste, df2)       # make row into 1 el for comparison
    shDt_ <- do.call(paste, shDt)
    keepers <- which(df2_ %in% shDt_) # get match indices
    # message(keepers)                # view segment indices by day
    shps2 <- invisible(lapply(
      1:length(shps),
      function(k) {
        if(k %in% keepers) {
          shps[[k]]$line$width <- 2      # width if present in frame
        } else {
          shps[[k]]$line$width <- .001   # width if not in frame
        }
        shps[[k]]                        # update the shape in shapes
      }
    ))
    plt$x$frames[[j]]$layout <<- list(shapes = shps2) # add to the plot
  }))

#--------------- Step 5 ---------------
# optional.... fix double chars in legend
invisible(
  lapply(
    1:length(plt$x$data),   # remove duplicate name in legend
    function(l) {           # only keep first letter
      plt$x$data[[l]]$name <<- substr(plt$x$data[[l]]$name, 1, 1)
    }
  )
)

#--------------- Step 6 ---------------
plt

I guess I should point out one very odd inconsistency. When I assigned a color to the segments I used the pal object that you created and that is used in the markers portion of the plot. However, if you notice, the green segment is definitely a different shade of green. Odd.

The following is not a complete workaround as shown by @Kat - but I'd like to provide some context which is too long for a comment.

The issue here is, that the splitting of your data into different traces via symbol = ~group, color = ~group and color = ~infector_group does not play well with plotly's animations.

Please see this related comment:

> Animations are designed to work well when each row of input is present
> across all animation frames, and when categorical values mapped to
> symbol, color and facet are constant across frames. Animations may be
> misleading or inconsistent if these constraints are not met.

In other words: animations work well if all traces exist in every frame of the animation, which is not the case for your example.

If we comment out the grouping you get the following:

library(dplyr)
library(plotly)
set.seed(12)
df <- tibble(
day = rep(1:8, each = 10),
id = rep(paste0("ID", 1:10), 8),
infector = NA
) %>%
group_by(id) %>%
mutate(x = rnorm(1),
y = rnorm(1),
group =  sample(c("A", "B", "C"), 1)) %>%
ungroup() %>%
mutate(
infector = case_when(
id == "ID2" & day >= 1 ~ "ID4",
id == "ID3" & day >= 2 ~ "ID4",
id == "ID1" & day >= 3 ~ "ID2",
id == "ID5" & day >= 3 ~ "ID3",
id == "ID6" & day >= 3 ~ "ID4",
id == "ID10" & day >= 4 ~ "ID2",
id == "ID9" & day >= 7 ~ "ID5"
)
)
infectors <- df %>% filter(day == 1 & id %in% .$infector) %>%
select(id, x, y, group) %>%
rename(infector.x = x,
infector.y = y,
infector_group = group)
df <- left_join(df, infectors, by = c("infector" = "id"))
pal <- c("A" = "blue", "B" = "green", "C" = "red")
plot_ly(df) %>%
add_markers(
x = ~ x,
y = ~ y,
frame = ~ day,
hoverinfo = "text",
text = ~ paste("ID:", id),
# symbol = ~group,
# color = ~group,
colors = pal
) %>%
add_segments(
x = ~infector.x,
xend = ~x,
y = ~infector.y,
yend = ~y,
# color = ~infector_group,
colors = pal,
frame = ~day) %>% animation_opts(
frame = 500, transition = 0, easing = "linear", redraw = FALSE
)

Regarding add_annotations: annotations are layout attributes not traces. It would be possible to link a relayout call to the animation steps in plotly (JS) however, currently R plotly does not allow the definition of custom animation steps.