连接点在 R 绘图动画中消失

问题描述 投票：0回答：2

我正在尝试使用 R plotly 动画随着时间的推移连接点。

以下代码出现了几个问题：

  1. 段从一个连接浮动到另一个。
  2. 尽管连接在连续几天仍然存在，但这些段从一天到另一天消失（见
    df
    ）。
  3. 并非所有连接都被绘制出来。
  4. 我尝试将 
    add_segments
    与 
    add_annotations
    交换以使用箭头而不是线段，但是 
    frame
    参数不起作用。

请注意，删除 

color
和 
symbol
参数有助于第 2 点和第 3 点。

library(dplyr)
library(plotly)

set.seed(12)
df <- tibble(
  day = rep(1:8, each = 10),
  id = rep(paste0("ID", 1:10), 8),
  infector = NA
) %>%
  group_by(id) %>%
  mutate(x = rnorm(1),
         y = rnorm(1),
         group =  sample(c("A", "B", "C"), 1)) %>%
  ungroup() %>%
  mutate(
    infector = case_when(
      id == "ID2" & day >= 1 ~ "ID4",
      id == "ID3" & day >= 2 ~ "ID4",
      id == "ID1" & day >= 3 ~ "ID2",
      id == "ID5" & day >= 3 ~ "ID3",
      id == "ID6" & day >= 3 ~ "ID4",
      id == "ID10" & day >= 4 ~ "ID2",
      id == "ID9" & day >= 7 ~ "ID5"
    )
  )
infectors <- df %>% filter(day == 1 & id %in% .$infector) %>%
  select(id, x, y, group) %>%
  rename(infector.x = x,
         infector.y = y,
         infector_group = group)

df <- left_join(df, infectors, by = c("infector" = "id"))

pal <- c("A" = "blue", "B" = "green", "C" = "red")

plot_ly(df) %>%
  add_markers(
    x = ~ x,
    y = ~ y,
    frame = ~ day,
    hoverinfo = "text",
    text = ~ paste("ID:", id),
    symbol = ~group,
    color = ~group,
    colors = pal
  ) %>%
  add_segments(
    x = ~infector.x,
    xend = ~x,
    y = ~infector.y,
    yend = ~y,
    color = ~infector_group,
    colors = pal,
    frame = ~day)
r plotly
2个回答
1
投票

在评论中我觉得我发现了错误，你指出我没有。你说得对。所以，我的目标是回答你的问题来挽回自己。

BLUF（或我更时髦的 TL;DR）：

将所有线条添加到每一帧，但更改线条宽度，具体取决于线段应该在哪个帧可见。 （不透明度被忽略，但宽度第一次起作用。）

冗长的解释

首先，Plotly 指出他们的动画有严重的局限性。虽然，Python 平台中存在更好的解释。还有一张关于一般线路问题的故障单已经有好几年了。

然而，这里的限制问题是第一帧中存在的每个点都必须出现在第二帧中。它不必在同一个地方，但数量非常重要。我认为这就是编程，有志者事竟成。在尝试通过许多不同的途径完成这项工作之后，我认为我将向您展示的可能是实现这一目标的最简单方法。

第一步

识别所有可能的线段，不管

frame
（或
day
）。

第二步

为每个段创建一个

layout.shapes
列表。

第三步

Create the base plot and build it.

第四步

遍历

frames
（或
day
），找出每一帧中存在哪些独特的
shapes
（线段）。如果 
shape
在 
frame
中，则将线宽指定为 2（默认宽度）。如果它不在 
frame
中，请分配一个足够接近零的线宽，这样 Plotly 仍会认为它“存在”（我使用了 .001）。

第五步完全可选

我添加了一些代码来改变图例，所以它只是一个字母而不是

A<br />A
。

步骤 6

绘制它...它完成了。

#--------------- Step 1 ---------------
shDt <- df[, c(4:5, 7:9)] %>% na.omit() %>% # identify all possible segments 
  distinct()
# # A tibble: 7 × 5
#        x       y infector.x infector.y infector_group
#    <dbl>   <dbl>      <dbl>      <dbl> <chr>         
# 1 -0.957 -0.780      -2.00     -0.152  C             
# 2 -0.920  0.0120     -2.00     -0.152  C             
# 3 -1.48  -0.778      -0.957    -0.780  C             
# 4 -0.272 -0.703      -0.920     0.0120 B             
# 5 -0.315  1.19       -2.00     -0.152  C             
# 6  1.58  -1.29       -0.957    -0.780  C             
# 7  0.428 -0.293      -0.272    -0.703  A              

#--------------- Step 2 ---------------
shps <- invisible(lapply( # create shapes list for frame layout
  1:nrow(shDt),
  function(i) {
    list(type = "line",
         xref = "x", yref = "y",
         # dbl bkt to drop name
         line = list(color = pal[[shDt[i, ]$infector_group]]),
         # simplify = F), # to prevent linking btw frames
         x0 = shDt[i, ]$infector.x,
         x1 = shDt[i, ]$x,
         y0 = shDt[i, ]$infector.y,
         y1 = shDt[i, ]$y)
    # visible = F)
  }))

#--------------- Step 3 ---------------
plt <- plot_ly(df) %>% # base plot (markers only; as originally doc)
  add_markers(
    x = ~ x,
    y = ~ y,
    frame = ~ day,
    hoverinfo = "text",
    text = ~ paste("ID:", id),
    symbol = ~group,
    color = ~group,
    colors = pal
  )

plt <- plotly_build(plt)      # build plot

#--------------- Step 4 ---------------
# add every shape to every frame, change width
invisible(lapply(                     # by day, what segments are present?
  unique(df$day),
  function(j) {
    df2 <- df[, c(1, 4:5, 7:9)] %>% na.omit() %>% 
      filter(day == j) %>% select(-day)
    df2_ <- do.call(paste, df2)       # make row into 1 el for comparison
    shDt_ <- do.call(paste, shDt)
    keepers <- which(df2_ %in% shDt_) # get match indices
    # message(keepers)                # view segment indices by day
    shps2 <- invisible(lapply(
      1:length(shps),
      function(k) {
        if(k %in% keepers) {
          shps[[k]]$line$width <- 2      # width if present in frame
        } else {
          shps[[k]]$line$width <- .001   # width if not in frame
        }
        shps[[k]]                        # update the shape in shapes
      }
    ))
    plt$x$frames[[j]]$layout <<- list(shapes = shps2) # add to the plot
  }))

#--------------- Step 5 ---------------
# optional.... fix double chars in legend
invisible(
  lapply(
    1:length(plt$x$data),   # remove duplicate name in legend
    function(l) {           # only keep first letter
      plt$x$data[[l]]$name <<- substr(plt$x$data[[l]]$name, 1, 1)
    }
  )
)

#--------------- Step 6 ---------------
plt

我想我应该指出一个非常奇怪的矛盾之处。当我为片段分配颜色时，我使用了您创建的 

pal
对象，该对象用于绘图的 
markers
部分。但是，如果您注意到，绿色部分绝对是不同的绿色阴影。奇数

1
投票

以下不是@Kat 所示的完整解决方法 - 但我想提供一些太长的上下文，无法发表评论。

这里的问题是，通过 

symbol = ~group, color = ~group
和 
color = ~infector_group
将数据拆分为不同的轨迹不能很好地播放 plotly 的动画。

请看这条相关的评论：

动画被设计为在每一行输入都存在时运行良好 跨越所有动画帧，以及当分类值映射到 符号、颜色和刻面在帧中保持不变。动画可能是 如果不满足这些限制，就会产生误导或不一致。

换句话说：如果动画的每一帧中都存在所有痕迹，则动画效果很好，但您的示例并非如此。

如果我们注释掉分组，您会得到以下内容：

library(dplyr)
library(plotly)

set.seed(12)

df <- tibble(
  day = rep(1:8, each = 10),
  id = rep(paste0("ID", 1:10), 8),
  infector = NA
) %>%
  group_by(id) %>%
  mutate(x = rnorm(1),
         y = rnorm(1),
         group =  sample(c("A", "B", "C"), 1)) %>%
  ungroup() %>%
  mutate(
    infector = case_when(
      id == "ID2" & day >= 1 ~ "ID4",
      id == "ID3" & day >= 2 ~ "ID4",
      id == "ID1" & day >= 3 ~ "ID2",
      id == "ID5" & day >= 3 ~ "ID3",
      id == "ID6" & day >= 3 ~ "ID4",
      id == "ID10" & day >= 4 ~ "ID2",
      id == "ID9" & day >= 7 ~ "ID5"
    )
  )

infectors <- df %>% filter(day == 1 & id %in% .$infector) %>%
  select(id, x, y, group) %>%
  rename(infector.x = x,
         infector.y = y,
         infector_group = group)

df <- left_join(df, infectors, by = c("infector" = "id"))

pal <- c("A" = "blue", "B" = "green", "C" = "red")

plot_ly(df) %>%
  add_markers(
    x = ~ x,
    y = ~ y,
    frame = ~ day,
    hoverinfo = "text",
    text = ~ paste("ID:", id),
    # symbol = ~group,
    # color = ~group,
    colors = pal
  ) %>%
  add_segments(
    x = ~infector.x,
    xend = ~x,
    y = ~infector.y,
    yend = ~y,
    # color = ~infector_group,
    colors = pal,
    frame = ~day) %>% animation_opts(
      frame = 500, transition = 0, easing = "linear", redraw = FALSE
    )

关于

add_annotations
：注释是布局属性而不是痕迹。可以将重新布局调用链接到 plotly (JS) 中的动画步骤，但是，目前 R plotly 不允许定义custom animation steps.

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.