R plot_ly animation with 2 traces has issue with animation slider

Question

I'm working on an animation with a factor level on the x-axis and the same factor level as the frame in the animation. I would like to show the full dataset as stationary, and have a single trace follow the time series over time in an animation. Below is a toy example showing the issue I'm seeing. Any help would be appreciated!

library(dplyr)
library(plotly)

#### create data
dat <- expand.grid(x = 1:5, f = 1:5)
dat <- dat %>% mutate(y = x^f/10) %>%
  arrange(desc(f)) %>%
  mutate(fr = letters[f], 
      fr = factor(fr, levels = unique(fr))) %>%
  data.frame()

Three plots - two of them show each of the 2 traces separately (plotting correctly), and the third show the traces combined, with the animation slider reversing order erroneously.

### stationary plot of all data - showing correct ordering of x-axis values
plot_ly(dat) %>%
  add_trace(x = ~fr,
            y = ~y,
            type = "scatter",
            mode = "markers") 

#### animated trace, showing correct ordering of the animation slider(from e to a)
plot_ly(dat) %>%
  add_trace(x = ~fr,
            y = ~y,
            frame = ~fr,
            type = "scatter",
            mode = "markers") %>%
  animation_opts(frame = 500) 

#### both traces combined, showing the problem - the x-axis is ordered correctly, 
#### but the animation slider reversed order, now playing from a to e. e to a)
plot_ly(dat) %>%
     add_trace(x = ~fr,
               y = ~y,
               type = "scatter",
               mode = "markers") %>%
     add_trace(x = ~fr,
               y = ~y,
               frame = ~fr,
               type = "scatter",
               mode = "markers") %>%
     animation_opts(frame = 500) %>%
     animation_slider()

EDIT

I created a dataset that is closer to my actual data. Running it with the fixer() function provided in the answer is still messing up the animation bar, and I can't figure out why, considering that it works perfectly with the original toy dataset...

dat <- data.frame(Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day"),
                  N = rnorm(92, 0, 1)) %>%
            mutate(fr = format(Date, "%d-%b"),
                fr = factor(fr, levels = unique(fr)))

plot_ly(dat) %>%
    add_trace(x = ~fr,
            y = ~N,
            type = "scatter",
            mode = "markers") %>%
   add_trace(x = ~fr,
            y = ~N,
            frame = ~fr,
            type = "scatter",
            mode = "markers") %>%
  animation_opts(frame = 500) %>%
  animation_slider() %>% fixer()  

Answer 1

I wasn't able to find a parameter that would address this issue, nor some rearrangement of the functions called. It's pretty annoying, ya?

Here's a workaround—that while it works, isn't great for in general use.

I've provided the function fixer(). In that function, there's a line of code that starts with plt$x$data[[2]]. The 2 was determined by the order in which you called your traces. Since the frames trace was called second, this is a two.

Other than that, the comments in the code are there to explain the how and why. If anything's unclear or doesn't work as you expected, please let me know.

fixer <- function(plt) {
  plt <- plotly_build(plt)                   # build to get data
                                             # capture current animation order in plot
  curOrd <- invisible(lapply(1:length(plt$x$frames), function(j) {
    plt$x$frames[[j]]$name
  })) %>% unlist()
  
  fixOrd <- match(curOrd, levels(dat$fr))    # compare current order; get index to fix
  plt$x$frames <- plt$x$frames[fixOrd]       # rearrange frames & slider (steps)
  plt$x$layout$sliders[[1]]$steps <- plt$x$layout$sliders[[1]]$steps[fixOrd]

                                       # change the base anim frame (when not animating)
  plt$x$data[[2]] <- plt$x$frames[[1]]$data[[1]]
  plt # return plot
}

plot_ly(dat) %>%
  add_trace(x = ~fr,
            y = ~y,
            type = "scatter",
            mode = "markers") %>%
  add_trace(x = ~fr,
            y = ~y,
            frame = ~fr,
            type = "scatter",
            mode = "markers") %>%
  animation_opts(frame = 500) %>%
  animation_slider() %>% fixer()      ## <<-- I'm new!