R Shiny Plotly Animations how to execute automatically when loaded

Question

Question in short: how to run a Plotly Animation when fully loaded in the UI.R of a Shiny Web Application?

I'm trying to add an animation to my R Shiny Web Application, using Plot.ly's cumulative animations. I would like to execute the animation plot when loaded in the UI, but can't find a way to automatically run the plots.

Working example of a Shiny Web application below, which includes a Plot.ly cumulative animation, which runs when clicking the 'play' button and should be running automatically.

Help is highly appreciated!

UI.R

pageWithSidebar(
  sidebarPanel(
    'some controls'
  ),
  mainPanel(
    plotlyOutput("frontPage", width = "100%")
  )
)

server.R

library(shiny)
library(dplyr)

function(input, output, session) {
  accumulate_by <- function(dat, var) {
    var <- lazyeval::f_eval(var, dat)
    lvls <- plotly:::getLevels(var)
    dats <- lapply(seq_along(lvls), function(x) {
      cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
    })
    dplyr::bind_rows(dats)
  }

  d <- txhousing %>%
    filter(year > 2005, city %in% c("Abilene", "Bay Area")) %>%
    accumulate_by(~date)

  observe({
    output$frontPage <- renderPlotly({
    p <- d %>%
      plot_ly(
        x = ~date, 
        y = ~median,
        split = ~city,
        frame = ~frame, 
        type = 'scatter',
        mode = 'lines', 
        line = list(simplyfy = F)
      ) %>% 
      layout(
        xaxis = list(
          title = "Date",
          zeroline = F
        ),
        yaxis = list(
          title = "Median",
          zeroline = F
        )
      ) %>% 
      animation_opts(
        frame = 10, 
        transition = 5, 
        redraw = FALSE
      ) %>%
      animation_slider(
        hide = T
      ) %>%
      animation_button(
        x = 1, xanchor = "right", y = 0, yanchor = "bottom"
      )
    })
  })
}

Answer 1

This was quite a challenge! And this might not be the only way of doing it. Even though this is a few years late, this information is hard to find. I am doing a similar project so answering this question was useful to me.

Some notes:

• if you render the plot_ly with only one frame, the button and slider are suppressed.
• if you use add_traces individually it's easier to use animate later on.
• ids (which must be unique and character) help animate keep track of individual points.
• you can use reactiveTimer() to trigger things without user intervention.
• using a proxy is the best way to update plotly charts.
• getting the nested list structure right for plotlyProxyInvoke is hard.
• animation might not actually be necessary for this example since the data points are not moving.
• the plotly reference is hard.
• you have to provide frame and duration values for each frame.

library(shiny)
library(dplyr)
library(plotly)

ui <- fluidPage(
  # actionButton("go", "Advance"),
  plotlyOutput("frontPage", width = "100%")
)

server <- function(input, output, session) {

  accumulate_by <- function(dat, var) {
    var <- lazyeval::f_eval(var, dat)
    lvls <- plotly:::getLevels(var)
    dats <- lapply(seq_along(lvls), function(x) {
      cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
    })
    dplyr::bind_rows(dats)
  }

  cities <- c("Abilene", "Bay Area")
  colors <- c(I("blue"), I("orange"))

  d <- txhousing %>%
    filter(year > 2005, city %in% cities) %>%
    accumulate_by(~date)

  frames <- unique(d$frame)
  speed = 50

  r <- reactiveValues(
    i = 1
  )

    output$frontPage <- renderPlotly({
      isolate({
        # plot only one frame to avoid button and slider
        cat("first frame", frames[r$i], "\n")
        p <- plot_ly()
        for (i in seq_along(cities)){
          temp <- d %>%
            filter(frame==frames[r$i]) %>%
            filter(city==cities[i])
          p <- p %>%
            add_trace(
              x = temp$date,
              y = temp$median,
              ids = as.character(temp$date),
              name = cities[i],
              frame = temp$frame,
              type = 'scatter',
              mode = 'lines',
              line = list(color=colors[i], simplify=FALSE)
            )
        }
        p <- p %>%
          layout(
            xaxis = list(
              range = range(frames),
              title = "Date",
              zeroline = F
            ),
            yaxis = list(
              range = range(d$median),
              title = "Median",
              zeroline = F
            )
          ) %>%
          animation_opts(
            frame = speed,
            transition = speed,
            redraw = FALSE
          )
        p # return plot_ly
      }) # isolate
    }) # renderPlotly

    proxy <- plotlyProxy("frontPage", session=session, deferUntilFlush=FALSE)

    # https://shiny.rstudio.com/reference/shiny/0.14/reactiveTimer.html
    autoInvalidate <- reactiveTimer(speed)

    observe({
      autoInvalidate()
    })

    observeEvent(autoInvalidate(), {
      req(r$i<length(frames))
      r$i <- r$i + 1 # next frame
      cat("add frame", frames[r$i], "\n")
      f <- vector("list", length(cities))
      for (i in seq_along(cities)){
        temp <- d %>%
          filter(frame==frames[r$i]) %>%
          filter(city==cities[i])
        f[[i]] <- list(
          x = temp$date,
          y = temp$median,
          ids = as.character(temp$date),
          frame = temp$frame
        )
      }
      plotlyProxyInvoke(proxy, "animate",
                        # frameOrGroupNameOrFrameList
                        list(
                          data = f,
                          traces = as.list(as.integer(seq_along(f)-1)),
                          layout = list()
                        ),
                        # animationAttributes
                        list(
                          frame=as.list(rep(list(duration=speed), length(f))),
                          transition=as.list(rep(list(duration=speed), length(f)))
                        )
      )# plotlyProxyInvoke
    }) # observeEvent

}

shinyApp(ui, server)