plotly - 使用共享动画进行地图和绘图

Question

我的 Flexdashboard 有 2 个动画输出 - 地图和散点图，通过动画滑块链接，动画滑块会遍历数据中的日期戳。为了链接动画，我使用

subplot

和共享滑块，如此处所示。

当我使用散点图而不是地图时，一切正常。但是当我切换到地图时，我遇到了两个问题 - 地图不再是动画的，并且第二个图绘制在地图下方并且不可见。下面提供了一个玩具示例，显示了工作版本和非工作版本。任何帮助将不胜感激。

library(dplyr)         
library(plotly)       

# Make data
data <- expand.grid(Lat = c(46.5, 46.7, 46.8), Lon = seq(-110, -115, -0.5), Group = c("A", "B"),
                      Date = as.Date(c("24/02/2020", "25/02/2020", "26/02/2020", "27/02/2020", "28/02/2020", "29/02/2020"), 
                                     format = "%d/%m/%Y")) %>%
        mutate(Date = as.factor(Date),
                Lat = rnorm(n(), Lat, 1),
               Lon = rnorm(n(), Lon, 1))
data <- data[sample(1:nrow(data), 50), ]
df <- data %>% mutate(Y = rnorm(n(), 0, 1))

## the map does not work - no animation and the other plot is blocked from view
p1 <- data %>%
  plot_ly(lon = ~Lon, lat = ~Lat, frame = ~Date,
    type = "scattermapbox", mode = "markers") %>%
layout(mapbox= list(style = "white-bg", sourcetype = 'raster', zoom = 4,
      center = list(lon = -110 ,lat= 46.5),
      layers = list(list(below = 'traces', sourcetype = "raster",
        source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}")))))

# scatterplot works just fine - comment this out to see the map issue
p1 <- data %>%
  plot_ly(x = ~Lon, y = ~Lat, frame = ~Date,
    type = "scatter", mode = "markers") %>%
 layout(xaxis = list(range = c(-120, -100), constrain="domain"),
     yaxis = list(range = c(46, 47), constrain="domain"))

p2 <- df %>%
  plot_ly(x = ~Group, y = ~Y, frame = ~Date, type = "scatter", mode = "markers") 

subplot(p1, p2, nrows = 2, heights = c(0.5, 0.5), titleX = TRUE) %>%
  animation_opts(1000, frame = 1100, redraw = FALSE) %>%
  animation_slider() 

Answer 1

这里发生了一些令人沮丧的事情。与许多其他情况一样，我找不到 Plotly 参数的“正确”组合来使这项工作按预期进行。

这是一个不太动态的解决方法 - 在大多数其他设置中不起作用，特别是由于跟踪数量。

在答案的最后，我将再次提供所有代码，但都是为了更轻松地复制+粘贴。

在这个答案中，我按原样使用了您的数据，没有额外的库。

我更改的第一个图的唯一元素是使标记过大——这只是为了确保它明显有效（或无效）。

在第二个情节中，我没有改变你的问题中的任何内容。

情节：

## the map does not work - no animation and the other plot is blocked from view
(p1 <- data %>%
  plot_ly(lon = ~Lon, lat = ~Lat, frame = ~Date, marker = list(size = 20), 
          type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                      center = list(lon = -110 ,lat= 46.5),
                      layers = list(list(below = 'traces', sourcetype = "raster",
                                         source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))))

(p2 <- df %>%
  plot_ly(x = ~Group, y = ~Y, frame = ~Date, type = "scatter", mode = "markers"))

接下来，我有一个函数可以用来修复子图。它有三个参数，第一个参数将被前馈（子图），其余参数是您在

subplot()

中调用的图（

p1

和

p2

）。

此函数解决的问题之一是轴分配。 Plotly 无法识别

scattermapbox

有轴，因此当您创建子图时，它将第二个图的框架分配给

xaxis

和

yaxis

，但这些确实属于地图。因为它的帧出现故障，可能是由于这个问题，所以它在创建子图时会删除子图中的所有帧，因此该函数使用您调用子图的图中已创建的内容重新创建框架结构（

p1

和

p2

）。

功能

fixer <- function(plt, pl1, pl2) {
  pl1 <- plotly_build(pl1) # get all plot data to prepare for breakdown
  pl2 <- plotly_build(pl2); plt <- plotly_build(plt)
  comFr <- lapply(1:length(pl1$x$frames), function(k) { # combine anim frames
    fr <- pl1$x$frames[[k]]         # capture frame structure and frame name
    # combine data, currently 1 trace per frame in ea. plot
    fr$data <- list(pl1$x$frames[[k]]$data[[1]], pl2$x$frames[[k]]$data[[1]])
    fr$data[[2]]$xaxis <- "x2"     # fixed assigned axes for the second trace
    fr$data[[2]]$yaxis <- "y2"
    fr$traces <- c(0, 1)           # set traces for subplot
    fr                             # return frame
  })
  plt$x$frames <- comFr            # add frames to subplot
  plt                              # return modified subplot
}

最后，请致电

subplot

。

我添加了对

layout

的调用，以便这两个图具有指定的域。通常，只需在

subplot

中调用它就足够了，但它不在这里。当然，我称之为

fixer()

。除此之外，这个函数就像你在问题中所做的那样。

subplot(p1, p2, nrows = 2, titleX = TRUE) %>%
  layout(grid = list(rows = 2, columns = 1)) %>% # create a grid to sep plots
  fixer(., p1, p2) %>%                           # manually consolidate frames
  animation_opts(1000, frame = 1100, redraw = FALSE) %>%
  animation_slider() 

顺便说一句，在制作动画之前，第二个图将是橙色的。动画帧将反射蓝色标记。

这又是所有代码，但是全部。

library(dplyr)
library(plotly)       

# Make data
data <- expand.grid(Lat = c(46.5, 46.7, 46.8), Lon = seq(-110, -115, -0.5), Group = c("A", "B"),
                    Date = as.Date(c("24/02/2020", "25/02/2020", "26/02/2020", "27/02/2020", "28/02/2020", "29/02/2020"), 
                                   format = "%d/%m/%Y")) %>%
  mutate(Date = as.factor(Date),
         Lat = rnorm(n(), Lat, 1),
         Lon = rnorm(n(), Lon, 1))
data <- data[sample(1:nrow(data), 50), ]
df <- data %>% mutate(Y = rnorm(n(), 0, 1))

## the map does not work - no animation and the other plot is blocked from view
(p1 <- data %>%
  plot_ly(lon = ~Lon, lat = ~Lat, frame = ~Date, marker = list(size = 20), 
          type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                      center = list(lon = -110 ,lat= 46.5),
                      layers = list(list(below = 'traces', sourcetype = "raster",
                                         source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))))

(p2 <- df %>%
  plot_ly(x = ~Group, y = ~Y, frame = ~Date, type = "scatter", mode = "markers"))

fixer <- function(plt, pl1, pl2) {
  pl1 <- plotly_build(pl1) # get all plot data to prepare for breakdown
  pl2 <- plotly_build(pl2); plt <- plotly_build(plt)
  comFr <- lapply(1:length(pl1$x$frames), function(k) { # combine anim frames
    fr <- pl1$x$frames[[k]]         # capture frame structure and frame name
    # combine data, currently 1 trace per frame in ea. plot
    fr$data <- list(pl1$x$frames[[k]]$data[[1]], pl2$x$frames[[k]]$data[[1]])
    fr$data[[2]]$xaxis <- "x2"     # fixed assigned axes for the second trace
    fr$data[[2]]$yaxis <- "y2"
    fr$traces <- c(0, 1)           # set traces for subplot
    fr                             # return frame
  })
  plt$x$frames <- comFr            # add frames to subplot
  plt                              # return modified subplot
}

subplot(p1, p2, nrows = 2, titleX = TRUE) %>%
  layout(grid = list(rows = 2, columns = 1)) %>% # create a grid to sep plots
  fixer(., p1, p2) %>%                           # manually consolidate frames
  animation_opts(1000, frame = 1100, redraw = FALSE) %>%
  animation_slider()