Sentence Drawing: Part II

December 23, 2013
By

(This article was first published on TRinker's R Blog » R, and kindly contributed to R-bloggers)

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


To leave a comment for the author, please follow the link and comment on his blog: TRinker's R Blog » R.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.