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

user_4262624 · Answer

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], "
")
        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%
          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)

R Shiny Plotly Animations how to execute automatically when loaded

1 Answers