R Shiny Plotly Animations如何在加载时自动执行

Question

简而言之：如何在 Shiny Web 应用程序的 UI.R 中完全加载时运行 Plotly 动画？

我正在尝试使用Plot.ly's cumulative animations 向我的 R Shiny Web 应用程序添加动画。我想在 UI 中加载时执行动画情节，但找不到自动运行情节的方法。

下面的 Shiny Web 应用程序的工作示例，其中包括一个 Plot.ly 累积动画，它在单击“播放”按钮时运行并且应该自动运行。

非常感谢您的帮助！

UI.R

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

服务器.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

这是一个相当大的挑战！这可能不是唯一的方法。尽管这已经晚了几年，但很难找到这些信息。我正在做一个类似的项目，所以回答这个问题对我很有用。

一些注意事项：

• 如果只用一帧渲染 plot_ly，按钮和滑块将被抑制。
• 如果您单独使用 add_traces，以后使用 animate 会更容易。
• id（必须是唯一的和字符）有助于动画跟踪各个点。
• 您可以使用 reactiveTimer() 来触发事件，而无需用户干预。
• 使用代理是更新绘图图表的最佳方式。
• 很难为 plotlyProxyInvoke 获得正确的嵌套列表结构。
• 此示例实际上可能不需要动画，因为数据点没有移动。
• 情节参考很难。
• 您必须为每一帧提供帧和持续时间值。

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)