Wykreślanie animowanej wymiany (rysowanie kierunkowych krawędzi)

Question

Kiedyś widziałem this plot (LINK) w sprawie wysyłek. Pracuję z wymianami dialogowymi i uważam, że interesujące może być mapowanie tego rodzaju wymiany za pomocą R.

To jest większe pytanie, ale myślę, że może być użyteczny dla całej społeczności.

Powiedzmy mamy 7 osób siedzących wokół stołu tak:

I mam nagrane rozmowy dialog wymiany głośnika i słuchacz słyszy. Stworzyłem manekin danych.frame z tego rodzaju informacji. oto głowa:

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 

Chciałbym tworzyć animowane strzałki (z głośnikiem do odbiornika), które są barwione przez głośnik i ważone (czas/czas i długość i/lub grubość) i animowane w ten sam sposób jako dane wysyłki (numer wiersza jest kolejnością występowania mowy). Myślę, że być może pakiet animacyjny może być przydatny tutaj, ale nie ma pojęcia. Być może nie jest to możliwe z R obecnie (jak wskazuje wypowiedź Bena Schmidta, "Mam nadzieję, że będę w stanie zrezygnować z ArcGIS dla następnego projektu mapy, który wykonam i zachować wszystko w R - Jestem nie przekonany po tym doświadczeniu, że będzie to możliwe ").

Myślę, że wielu ludzi z różnych dziedzin mogłoby korzystać z tego rodzaju map wymiany, tak się składa, że ​​interesuje mnie wymiana dialogu. W końcu wyłożyłbym to na obrazie rastrowym, ale to jest łatwe.

Oto dane i działki do tej pory.

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

Nie jestem żonaty ggplot2 ale jestem częściowo do niego i wydaje się, że wiele z tych rodzajów działek używać ggplot2.

Answer 1

Korzystanie pakiet animacji i geom_segment to rozsądnie prosta

Moim jedynym problemem jest coraz dotąd skalę dla rozmiaru pracować rozsądny

mam zapisane rozmowy data.frame jak 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() 
    } 
} 

użycie saveGIF(pp(), interval = 0.1) eksportować itp animacji GIF