Site icon R-bloggers

Sentence Drawing: Part II

[This article was first published on TRinker's R Blog » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

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, 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< >


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

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.