绘制动画交换（绘制方向边缘） [英] Plotting animated exchange (plotting directional edges)

问题描述

我曾经看到此图（LINK）关于航运业。

I once saw this plot (LINK) on shipping trades. I work with dialogue exchanges and thought it may be interesting to map this sort of exchange using R.

这是一个较大的问题，但我认为这可能对社区有用

This is a larger question but I think it may be useful to the community at large.

比方说，我们有7个人围坐在这样的桌子上：

Let's say we have 7 people sitting around a table like this:

我记录了演讲者和听众的对话交流。我已经使用此类信息创建了一个虚拟的data.frame。这是头像：

And I have recorded dialogue exchanges speaker talks and listener hears. I've created a dummy data.frame with this sort of information. here's the head:

  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中是不可能的（如Ben Schmidt的陈述所示，我一直希望我可以放弃ArcGIS从事下一个地图项目，并将所有内容保留在R中。 。在经历之后，我不相信这将是可能的。

I'd like to create animated arrows (from speaker to receiver) that are colored by speaker and weighted (time/duration and length and/or thickness) and animated in the same fashion as the shipping data (row number is the order in which the speech occurs). I think that perhaps the animation package may be useful here but have no clue. Maybe this isn't possible with R currently (as indicated by Ben Schmidt's statement, "I've been hoping I might be able to give up on ArcGIS for the next map project I do and keep everything in R--I'm not convinced after this experience that it will be possible").

我认为许多领域的许多人都可以使用这种交易所映射，碰巧我有兴趣进行对话交流。最终，我将其绘制在光栅图像上，但这是简单的部分。

I think many people in many fields could use this sort of mapping of exchanges, it just happens that I'm interested in an exchange of dialogue. Eventually I'd plot this on top of a raster image but that's the easy part.

以下是数据并绘制至此。

#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，而且似乎其中许多情节都使用ggplot2。

I'm not married to ggplot2 but am partial to it, and it seems that many of these sorts of plots use ggplot2.

推荐答案

使用动画包和 geom_segment 直截了当地

Using the animation package and geom_segment this is reasonably straight forward

到目前为止，我唯一的问题是获得可以正常使用的规模的标尺

My only issue thus far is getting a scale for the size to work reasonable

将发话的data.frame保存为发话

I've saved the talking data.frame as 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动画等

这篇关于绘制动画交换（绘制方向边缘）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！