Sentence Drawing: Part II

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.

Mp4 Video: Musically enhanced.

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, fontface = "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, fontface = "bold") + 
        annotate("text", x = -105, y=-125, label = "T.O.T.", 
            colour="grey75", size=4, fontface = "bold") +
        annotate("text", x = -150, y=-145, label = as.character(info[2]), 
            colour="grey75", size=4, fontface = "bold") + 
        annotate("text", x = -105, y=-145, label = as.character(info[1]),  
            colour="grey75", size=4, fontface = "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.


*Blog post created using the reports package

About these ads

About tylerrinker

I am Literacy PhD student with a bent for the quantitative and a passion for R.
This entry was posted in animation, discourse analysis, ggplot2, qdap, text, Uncategorized, visualization and tagged , , , , , , . Bookmark the permalink.

One Response to Sentence Drawing: Part II

  1. Pingback: Sentence Drawing: Function vs. Art | TRinker's R Blog

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s