Animate plotly plot in shiny when data changes

Question

I want an R-shiny-plotly plot to smoothly transition when the data changes. I don't want the action button approach provided by R-plotly. So I am trying to get animations as per the linked example via plotlyProxyInvoke("animate", ...):

https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate

My app runs but the plot does not animate. I'm missing something.

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

ui <- fluidPage(
    actionButton("go", "Click to recalc"),
    plotlyOutput("plot")
)

gendata <- function(){
    ndata <- 10
    tibble(text=LETTERS[1:ndata], f=1, x=runif(ndata)) %>% mutate(r = rank(x))
}

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

    origdata <- gendata()
    if (FALSE){ # for offline testing
        print(head(origdata))
        my <- list(olddata = origdata, newdata = origdata)
    }

    my <- reactiveValues(
        olddata = origdata,
        newdata = origdata
        )

    output$plot <- renderPlotly({
        cat("renderPlotly\n")
        plot_ly() %>%
            add_trace(x=origdata$x, y=origdata$r, frame=origdata$f, width=0.8, type="bar", orientation="h", name="Rank") %>%
            add_trace(x=origdata$x + 0.02, y=origdata$r, frame=origdata$f, text=origdata$text, type="scatter", mode="text", showlegend=FALSE)
    })

    observeEvent(input$go, {
        req(my$newdata)
        cat("observeEvent input$go\n")
        my$olddata <- my$newdata # save old data
        my$newdata <- gendata() %>% # generate new data
            mutate(f=my$olddata$f+1)
        print(head(my$newdata))
        # https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
        plotlyProxy("plot", session=session, deferUntilFlush=FALSE) %>%
            plotlyProxyInvoke("animate",
                              # frameOrGroupNameOrFrameList
                              list(
                                list(
                                    traces = list(as.integer(0)),
                                    data = list(
                                        x = my$newdata$x,
                                        y = my$newdata$r,
                                        frame = my$newdata$f
                                    )
                                ),
                                list(
                                    traces = list(as.integer(1)),
                                    data = list(
                                        x = my$newdata$x + 0.02,
                                        y = my$newdata$r,
                                        text = my$newdata$text,
                                        frame = my$newdata$f
                                    )
                                )
                              ),
                              # animationAttributes
                              list(
                                transition = list(duration = 500, easing="linear"),
                                frame = list(duration = 500)
                              )
                              )# plotlyProxyInvoke
    })

}

shinyApp(ui, server)

Simon Woodward Simon Woodward · Accepted Answer · 2019-06-17T02:11:12

It turns out I only had to modify the list structure. Also bar traces can't currently be animated in plotly, so I had to fake it using fat lines.

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

ui <- fluidPage(
    actionButton("go", "Click to recalc"),
    plotlyOutput("plot")
)

gendata <- function(){
    ndata <- 10
    d <- tibble(text=LETTERS[1:ndata], f=1, x=runif(ndata)) %>% mutate(r = rank(x))
    rbind(mutate(d, x=-1), d, mutate(d, x=-1)) %>%
        arrange(text)
}

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

    origdata <- gendata()
    if (FALSE){ # for offline testing
        print(head(origdata))
        my <- list(olddata = origdata, newdata = origdata)
    }

    my <- reactiveValues(
        olddata = origdata,
        newdata = origdata
        )

    output$plot <- renderPlotly({
        cat("renderPlotly\n")
        plot_ly() %>%
            add_trace(x=origdata$x, y=origdata$r, frame=origdata$f, line=list(width=20, simplify=FALSE), type="scatter", opacity=0.5, mode="lines", name="Rank") %>%
            add_trace(x=origdata$x + 0.02, y=origdata$r, frame=origdata$f, text=origdata$text, type="scatter", mode="text", showlegend=FALSE) %>%
            layout(xaxis=list(range=list(0,1.1))) %>%
            animation_opts(frame=500, transition=500, redraw=FALSE)
    })

    observeEvent(input$go, {
        req(my$newdata)
        cat("observeEvent input$go\n")
        my$olddata <- my$newdata # save old data
        my$newdata <- gendata() %>% # generate new data
            mutate(f=my$olddata$f+1)
        print(head(my$newdata))
        # https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
        plotlyProxy("plot", session=session, deferUntilFlush=FALSE) %>%
            plotlyProxyInvoke("animate",
                              # frameOrGroupNameOrFrameList
                              list(
                                data = list(list(
                                                x = my$newdata$x,
                                                y = my$newdata$r,
                                                frame = my$newdata$f
                                            ),
                                            list(
                                                x = my$newdata$x + 0.02,
                                                y = my$newdata$r,
                                                text = my$newdata$text,
                                                frame = my$newdata$f
                                         )),
                                traces = list(as.integer(0), as.integer(1)),
                                layout = list()
                              ),
                              # animationAttributes
                              list()
                              )# plotlyProxyInvoke
    })

}

shinyApp(ui, server)

Animate plotly plot in shiny when data changes

1 Answers