Tracciamento dello scambio animato (tracciamento dei bordi direzionali)

Question

Una volta ho visto this plot (LINK) sulle operazioni di spedizione. Lavoro con scambi di dialoghi e ho pensato che potrebbe essere interessante mappare questo tipo di scambio usando R.

Questa è una domanda più ampia ma penso che possa essere utile alla comunità in generale.

Diciamo che abbiamo 7 persone sedute intorno ad un tavolo come questo:

E io abbiamo registrato dialogo colloqui scambi parla e chi ascolta sente. Ho creato un fittizio data.frame con questo tipo di informazioni. ecco la testa:

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 

Vorrei creare frecce animate (all'altoparlante ricevitore) che sono colorati con gli altoparlanti e ponderato (tempo/durata e la lunghezza e/o spessore) e animato nello stesso modo come i dati di spedizione (il numero di riga è l'ordine in cui si verifica il discorso). Penso che forse il pacchetto di animazione potrebbe essere utile qui ma non ne ho idea. Forse questo non è possibile con R attualmente (come indicato dalla dichiarazione di Ben Schmidt, "Speravo di poter rinunciare ad ArcGIS per il prossimo progetto di mappa che faccio e tenere tutto in R - I'm non convinto dopo questa esperienza che sarà possibile ").

Penso che molte persone in molti campi potrebbero utilizzare questo tipo di mappatura degli scambi, ma semplicemente mi interessa uno scambio di dialoghi. Alla fine lo avrei tracciato sopra un'immagine raster, ma questa è la parte facile.

Ecco i dati e i grafici fino a qui.

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

Io non sono sposata con ggplot2 ma sono parziale ad esso, e sembra che molti di questi tipi di trame usano ggplot2.

Answer 1

Usando il pacchetto di animazione e geom_segment questo è ragionevolmente semplice

Il mio unico problema finora è sempre una scala per le dimensioni di lavorare ragionevoli

ho salvato il parlare data.frame come 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() 
    } 
} 

uso saveGIF(pp(), interval = 0.1) per esportare un'animazione GIF ecc