Vẽ chuyển đổi hoạt ảnh (vẽ các cạnh định hướng)

Question

Tôi đã từng thấy this plot (LINK) về giao dịch chuyển hàng. Tôi làm việc với các trao đổi đối thoại và nghĩ rằng có thể thú vị khi lập bản đồ trao đổi này bằng cách sử dụng R.

Đây là một câu hỏi lớn hơn nhưng tôi nghĩ nó có thể hữu ích cho cộng đồng nói chung.

Hãy nói rằng chúng tôi có 7 người ngồi quanh một chiếc bàn như thế này:

Và tôi đã ghi lại cuộc đối thoại đàm phán trao đổi loa và người nghe nghe. Tôi đã tạo một data.frame giả với loại thông tin này. đây là người đứng đầu:

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 

Tôi muốn tạo mũi tên hoạt hình (từ loa đến người nhận) được tô điểm bởi loa và trọng (thời gian/thời gian và thời gian và/hoặc độ dày) và hoạt hình trong cùng một thời trang như dữ liệu vận chuyển (số hàng là thứ tự mà bài phát biểu diễn ra). Tôi nghĩ rằng có lẽ gói hoạt hình có thể hữu ích ở đây nhưng không có đầu mối. Có lẽ điều này là không thể với R hiện tại (như được chỉ ra bởi tuyên bố của Ben Schmidt, "Tôi đã hy vọng tôi có thể từ bỏ ArcGIS cho dự án bản đồ tiếp theo tôi làm và giữ mọi thứ trong R - Tôi không bị thuyết phục sau khi trải nghiệm này sẽ có thể "".

Tôi nghĩ rằng nhiều người trong nhiều lĩnh vực có thể sử dụng loại ánh xạ trao đổi này, nó chỉ xảy ra mà tôi quan tâm đến việc trao đổi đối thoại. Cuối cùng tôi sẽ vẽ nó lên trên một hình ảnh raster nhưng đó là phần dễ dàng.

Đây là dữ liệu và âm mưu cho đến thời điểm này.

#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") 

Tôi không kết hôn với ggplot2 nhưng là một phần để nó, và có vẻ như rất nhiều các loại âm mưu sử dụng ggplot2.

Answer 1

Sử dụng gói hoạt hình và geom_segment này là hợp lý thẳng về phía trước

vấn đề duy nhất của tôi cho đến nay là nhận được một quy mô kích thước để làm việc hợp lý

tôi đã lưu nói data.frame như 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() 
    } 
} 

sử dụng saveGIF(pp(), interval = 0.1) xuất khẩu một vv GIF hoạt hình