In a recent blog post I introduced Stefanie Posavec‘s Sentence Drawings. We created this ggplot2 rendition:

We left off weighing the aesthetics of the Sentence Drawing with information of quality visualizations. I asked others to think of ways to display the information and also hinted that I’d use Yihui’s animation package to show the fluid nature of the conversation. Jim Vallandingham stepped up with a D3 rendering of the Sentence Drawing (though not implemented in R as we’ve grown accustomed to with rCharts) that gives a mouse over of the dialogue (GitHub here). I too followed up with the animation version as seen in the video outcome and accompanying script below.

Click Here to view the html version.

If you likes what you see then have a lookyloo at the code below.

Getting Started

Installing Packages from GitHub and Turn Function

# install.packages("devtools")
library(devtools)
install_github(c('slidify', 'slidifyLibraries'), 'ramnathv', ref = 'dev')
install_github("knitcitations", "cboettig")
install_github(c("reports", "qdapDictionaries", "qdap"), "trinker")
install_github("ggthemes", "jrnold")
install.packages('scales')

invisible(lapply(c("qdap", "ggplot2", "ggthemes", "scales", "grid"), 
    require, character.only = TRUE))

turn_it <- function(dataframe, len.col, turn = -pi/2) {

    dat <- dataframe
    dat[, "turn"] <- rep(turn, nrow(dataframe))
    dat <- within(dat, { 
        facing <- pi/2 + cumsum(turn)
        move <- dat[, len.col] * exp(1i * facing)
        position <- cumsum(move)
        x2 <- Re(position)
        y2 <- Im(position)
        x1 <- c(0, head(x2, -1))
        y1 <- c(0, head(y2, -1))
    })

    dat[, c("x1", "y1", "x2", "y2")] <- 
        lapply(dat[, c("x1", "y1", "x2", "y2")], round, digits=0)
    data.frame(dataframe, dat[, c("x1", "y1", "x2", "y2")])
}

The Animation Code

library(animation)

## Prepping the data

dat2b <- rajSPLIT
dat2b$wc <- wc(rajSPLIT$dialogue)
dat2b <- dat2b[!is.na(dat2b[, "wc"]), ]

## Reassign names to family affiliation
dat2b[, "fam.aff"] <- factor(lookup(as.character(dat2b[, "fam.aff"]), 
    levels(dat2b[, "fam.aff"])[1:3], qcv(Escalus, Capulet, Montague), 
    missing = NULL))

## Make dataframe with the beginning coordinates of each act
beg_act <- do.call(rbind, lapply(with(turn_it(dat2b, "wc"), 
    split(turn_it(dat2b, "wc"), act)), function(x) {
        x[1, qcv(act, x1, y1, x2, y2)]
}))


keys <- sapply(split(1:nrow(dat2b), dat2b[, "act"]), head, 1)

factor(all.birds$birds)

ani_dat <- turn_it(dat2b, "wc")
yl <- range(ani_dat[, c("y1", "y2")])
xl <- range(ani_dat[, c("x1", "x2")])

## An animation base function

ani_sent <- function(i){

    base <- ggplot(ani_dat[1:i, ], aes(x = x1, y = y1, xend = x2, yend = y2)) + 
        geom_segment(aes(color=fam.aff), lineend = "butt", size=1) +
        guides(colour = guide_legend(override.aes = list(alpha = 1))) + 
        theme_few() + 
        scale_colour_few(name="Family\nAffiliation", drop = FALSE) +
        theme(axis.ticks = element_blank(), 
            axis.text = element_blank(),  
            axis.title= element_blank(),
            legend.position = c(.1, .85),
            legend.title.align = .5) +
        ggtitle("Romeo and Juliet Family\nAffiliation: Sentence Drawing") 

    addon1 <- geom_text(data=beg_act[i >= keys,], 
        aes(x = x1, y=y1, label = paste("Act", act)), 
        colour = "grey25", hjust = -.1, size=5, face = "bold") 
    addon2 <- geom_point(data=beg_act[i >= keys,], 
        aes(x = x1, y=y1), size=2.3, colour = "grey25") 

    base2 <- base + addon1 + addon2
    info <- ani_dat[i, c("tot", "act")]
    base3 <- base2 +  geom_rect(aes(xmin = -173, xmax = -79, ymin = -160, ymax = -110), 
        fill="white", colour="grey75") + 
        annotate("text", x = -150, y=-125, label = "ACT", 
            colour="grey75", size=4, face = "bold") + 
        annotate("text", x = -105, y=-125, label = "T.O.T.", 
            colour="grey75", size=4, face = "bold") +
        annotate("text", x = -150, y=-145, label = as.character(info[2]), 
            colour="grey75", size=4, face = "bold") + 
        annotate("text", x = -105, y=-145, label = as.character(info[1]),  
            colour="grey75", size=4, face = "bold")  +
        xlim(xl) + ylim(yl)

    print(base3)      
}

pp2 <- function(x=base, alph = .15){
    for(i in 1:nrow(ani_dat)){
        ani_sent(i)
        ani.pause()
    }
}

## Plot it

out <- file.path(getwd(), "sent3") ## Change this as needed

saveVideo(pp2(), interval = 0.01, outdir = out, 
    ffmpeg = "C:/Program Files (x86)/ffmpeg-latest-win32-static/ffmpeg-20130306-git-28adecf-win32-static/bin/ffmpeg.exe")

saveHTML(pp2(), autoplay = FALSE, loop = FALSE, verbose = FALSE, outdir = out,
    single.opts = "'controls': ['first', 'previous', 'play', 'next', 'last', 'loop', 'speed'], 'delayMin': 0")

For more on intro to animations see, this blog post.

< size="1">*Blog post created using the reports package< >