plotly / plotly.R

An interactive graphing library for R
https://plotly-r.com
Other
2.55k stars 623 forks source link

axis range not updated after animate layout #1570

Closed woodwards closed 5 years ago

woodwards commented 5 years ago

I am trying to build a shiny app that includes an animated plotly scatter. I want to animate the position of the traces (as in the example below) and then animate to the new xaxis scaling (also in the example below). However after doing this plotly always resets the xaxis scaling to its original extent (as in the example below), which I do not want. This seems like a bug. How do I retain the axis scaling between frames?

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

ui <- fluidPage(
    plotlyOutput("plot")
)

gendata <- function(){
    cat("gendata\n")
    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()

    axrange <- function(x){
        c(-0.1*runif(1), 1+0.1*runif(1))
    }

    my <- reactiveValues(
        data = origdata,
        xrange = c(-0.1, 1.1)
        )

    speed = 1000 # redraw interval in milliseconds

    output$plot <- renderPlotly({
        isolate({
            cat("renderPlotly\n")
            plot_ly() %>%
                add_trace(x=my$data$x, y=my$data$r, frame=my$data$f, line=list(width=20, simplify=FALSE), opacity=0.3, color=I("orange"), type="scatter", mode="lines", name="Rank") %>%
                add_trace(x=my$data$x + 0.02, y=my$data$r, frame=my$data$f, text=my$data$text, type="scatter", mode="text", showlegend=FALSE) %>%
                layout(xaxis=list(range=my$xrange)) %>%
                animation_opts(frame=speed, transition=speed, redraw=FALSE, mode="afterall")
        })
    })

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

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

    observe({
        autoInvalidate()
    })

    observeEvent(autoInvalidate(), {
        # req(NULL)
        cat("observeEvent autoInvalidate()\n")
        my$data <- gendata() %>% mutate(f = my$data$f + 1)
        # print(head(my$data))
        # https://plot.ly/javascript/plotlyjs-function-reference/#plotlyanimate
        data <- list(list(
            x = my$data$x,
            y = my$data$r,
            line=list(width=20, simplify=FALSE, color=sample(c(I("red"), I("green"), I("blue")), 1)),
            frame = my$data$f
        ),
        list(
            x = my$data$x + 0.02,
            y = my$data$r,
            text = my$data$text,
            frame = my$data$f
        ))
        cat("animate scatter\n")
        plotlyProxyInvoke(proxy, "animate",
                          # frameOrGroupNameOrFrameList
                          list(
                            data = data,
                            traces = as.list(as.integer(0:1))
                            # ,
                            # layout = list()
                          ),
                          # animationAttributes
                          list(
                            frame=as.list(rep(list(duration=speed), length(0:1))),
                            transition=as.list(rep(list(duration=speed), length(0:1)))
                          )
        )# plotlyProxyInvoke
        my$data$f <- my$data$f + 1
        my$xrange <- axrange(my$data$x)
        data <- list(list(
            frame = my$data$f
        ),
        list(
            frame = my$data$f
        ))
        cat("animate axis\n")
        plotlyProxyInvoke(proxy, "animate",
                          # frameOrGroupNameOrFrameList
                          list(
                            # data = data,
                            # traces = as.list(as.integer(0:1)),
                            layout = list(xaxis=list(range=my$xrange))
                          ),
                          # animationAttributes
                          list(
                            frame=list(duration=speed),
                            transition=list(duration=speed)
                          )
        ) # plotlyProxyInvoke
    }) # observeEvent

}

shinyApp(ui, server)
cpsievert commented 5 years ago

Wow, kudos to you for trying to work with the plotly.js animate API directly, it's not easy! It seems this is wonky because the server-side reactiveTimer() is the same value as the duration speed. You probably want to set the timer to a value larger than the duration. Indeed, if you change:

autoInvalidate <- reactiveTimer(speed)

to

autoInvalidate <- reactiveTimer(2000)

Then it appears to work! Also, I don't think you need the deferUntilFlush or the observe(autoInvalidate())...

If you want a saner approach and don't absolutely need a smooth transition of the layout, let me propose this Plotly.react()-based solution instead. Although the layout doesn't appear to smoothly transition in this example, I feel like it should, and could maybe be considered a bug in plotly.js

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

ui <- fluidPage(
  plotlyOutput("plot")
)

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

plot_data <- function(data) {
  plot_ly(data) %>%
    add_segments(
      x = 0, xend = ~x, y = ~r, yend = ~r,
      opacity = 0.3, color = sample(c(I("red"), I("green"), I("blue")), 1),
      line = list(width = 20, simplify = FALSE)
    ) %>%
    add_text(
      text = ~text, x = ~x, y = ~r,
      textposition = "right middle"
    ) %>%
    layout(
      showlegend = FALSE,
      xaxis = list(
        range = ~grDevices::extendrange(range(c(0, x)))
      )
    )
}

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

  output$plot <- renderPlotly({
    plot_data(gendata())
  })

  observe({
    invalidateLater(2000)

    b <- gendata() %>%
      plot_data() %>%
      layout(
        # See https://github.com/plotly/plotly.js/pull/3217#issue-228521121 
        transition = list(
          duration = 1000,
          easing = "linear", 
          ordering = "traces first"
        )
      ) %>%
      plotly_build()

    plotlyProxy("plot", session=session) %>%
      plotlyProxyInvoke(
        "react",
        list(
          data = b$x$data,
          layout = b$x$layout
        )
      )
  })

}

shinyApp(ui, server)

If you want to

woodwards commented 5 years ago

Thanks Carson! It still doesn't work with reactiveTimer(2000). You'll notice that after the bars animate, and then the layout animates, it flicks back to the original axis range. This is what I want to avoid.

I'm working in the ploty.js API because it's less restrictive than the R one. The R animate forces you to have a manual animate button, but I want it to happen automiatically in my code. It's confusing that the data passing is different in the two interfaces.

Your code doesn't give the same animation.