绘图动画交换(绘制定向边缘)(Plotting animated exchange (plottin

2019-08-17 09:08发布

我曾经看到这样的情节(LINK)航运行业。 我与对话的交流合作,认为其可能是有趣的地图使用R.这种交流

这是一个更大的问题,但我认为它可能在大是对社会有益的。

比方说,我们有7人围坐像这样的表:

并已记录的对话交流发言者的发言和听众听到。 我已经创建了这种信息的虚拟data.frame。 这里的头:

  speaker receiver duration speaker.x speaker.y receiver.x receiver.y
1       D        A       16     0.626     0.163      0.755      0.741
2       E        D        3     0.391     0.161      0.626      0.163
3       A        B       25     0.755     0.741      0.745      0.517
4       B        E        6     0.745     0.517      0.391      0.161
5       B        C       45     0.745     0.517      0.737      0.251
6       E        F       37     0.391     0.161      0.258      0.285

我想创建动画的箭头(从扬声器到接收器),其是通过扬声器(行号是其中顺序着色和加权(时间/持续时间和长度和/或厚度)和动画以相同的方式作为航运数据语音发生时)。 我想,也许是动画包可以在这里有用,但没有任何线索。 也许这是不可能有R当前(由本施密特的声明所指示的,“我一直希望我也许可以放弃对ArcGIS的下一个地图项目,我做的,并保持R中的一切-我不是这方面的经验后,相信将有可能”)。

我想很多人在很多领域可以使用这种交流的映射,它只是碰巧我感兴趣的对话交流。 最后,我想这个情节上的光栅图像的顶部,但是这是比较容易的部分。

这里的数据和图表这么远。

#the data
the_table <- data.frame(
    xmin = .3,
    xmax = .7,
    ymin = .2,
    ymax = .8
)

points <- structure(list(x = c(0.754594594594595, 0.744864864864865, 0.736756756756757, 
    0.626486486486486, 0.391351351351351, 0.258378378378378, 0.261621621621622
    ), y = c(0.741172932330827, 0.517052631578947, 0.250706766917293, 
    0.163007518796992, 0.161383458646617, 0.284812030075188, 0.494315789473684
    )), .Names = c("x", "y"))


mapping <- data.frame(person=LETTERS[1:7], points)

set.seed(10)
n <- 120
dat <- data.frame(id = 1:n, speaker=sample(LETTERS[1:7], n, TRUE),
     receiver=sample(LETTERS[1:7], n, TRUE),
    duration=sample(1:50, n, TRUE)
)
dat <- dat[as.character(dat$speaker)!=as.character(dat$receiver), ]

dat <- merge(merge(dat, mapping, by.x=c("speaker"), by.y=c("person"), sort=FALSE), 
    mapping, by.x=c("receiver"), by.y=c("person"), sort=FALSE)
names(dat)[5:8] <- c("speaker.x", "speaker.y", "receiver.x", "receiver.y")
dat <- dat[order(dat$id), c(2, 1, 4:8)]
rownames(dat) <- NULL

#the plot
ggplot() +
    geom_point(data=mapping, aes(x=x, y=y), size=10) +
    geom_text(data=mapping, aes(x=x, y=y, label=as.character(person)), 
        color="blue") +
    ylim(-.2, 1.2) + xlim(-.2, 1.2) + 
    geom_rect(data=the_table, aes(xmax = xmax, xmin=xmin, 
        ymin=ymin, ymax = ymax), fill="gray80")

我不结婚GGPLOT2但我偏爱它,它似乎是很多这些类型的图表中使用GGPLOT2。

Answer 1:

使用动画包和geom_segment这是合理的直线前进

我唯一的问题迄今是得到一个规模为大小合理的工作

我已经保存在说话data.frame作为talking

library(animation)
library(RColorBrewer)
library(grid)         ## for arrow
library(ggplot2)      
# scale the duration (not ideal)
talking$scale_duration <-scale(talking$duration, center = FALSE)
# ensure that we have different colours for each speaker

ss <- levels(talking$speaker)

speakerCol <- scale_colour_manual(values = setNames(brewer.pal(n=length(ss), 'Set2' ), ss), guide = 'none')

# the base plot with the table and speakers (and `talking` base dataset)
base <- ggplot(data = talking, aes(colour = speaker)) +
  geom_point(data=mapping, aes(x=x, y=y), size=10, inherit.aes = FALSE) +
  geom_text(data=mapping, aes(x=x, y=y, label=as.character(person)), 
    inherit.aes = FALSE, color="blue") +
  ylim(-.2, 1.2) + xlim(-.2, 1.2) + 
  geom_rect(data=the_table, aes(xmax = xmax, xmin=xmin, 
      ymin=ymin, ymax = ymax), fill="gray80", inherit.aes = FALSE) +
  speakerCol
 oopt <- ani.options(interval = 0.5)

# a function to create the animation


pp <- function(){
  print(base)
  interval = ani.options("interval")
  for(n in rep(seq_along(talking$duration), each = talking$duration))){
    # a segment for each row
    tn <- geom_segment(aes(x= speaker.x, y= speaker.y, xend = receiver.x, yend = receiver.y), arrow = arrow(), 
                       data =talking[n, ,drop = FALSE])
    print(base + tn)
    ani.pause()
  }
}

使用saveGIF(pp(), interval = 0.1)以导出一个GIF动画等



文章来源: Plotting animated exchange (plotting directional edges)