tidyverse demo animation

animatetopn.R

library(dplyr)
library(ggplot2)
library(gganimate)
library(tidyr)
library(stringr)
library(extrafont)

# set up data
dat <- data_frame(type=sort(rep(c("canine","feline","avian"),3)),
                  name=c("Sam","Austin","Squawk",
                       "Lili","Luna","Garth",
                        "Coco","Theo","Soup"),
                  cuteness=c(9,7,8,9,10,8,7,8,10))

# shuffle to avoid hard-coded hacks
dat <- dat %>% sample_frac()

# hack
varnames <-  data.frame(t(data_frame(names(dat))),stringsAsFactors = FALSE)
names(varnames) <- names(dat)
varnames <- tibble::as.tibble(varnames)
# fn by drob to melt the data
longDat <- function(x){
  x %>%
    setNames(seq_len(ncol(x))) %>%
    mutate(row = row_number()) %>%
    tidyr::gather(column, value, -row) %>%
    mutate(column = as.integer(column)) %>%
    ungroup() %>%
    arrange(column, row) %>% 
    mutate(fillval="none") %>% 
    mutate(fillval=if_else(value=="type"|value=="name"|value=="cuteness",
      "varname",fillval))
}

# raw data
datList <- rbind(varnames,dat)
# to long
ldat1 <- longDat(datList) %>% mutate(tstep=1)

#### mutate pet types
datmut <- 
   dat %>% mutate(type=case_when(type=="feline"~"cat",
                              type=="canine"~"dog",
                              TRUE~"bird"))

# bind and melt
datmutList <- rbind(varnames,datmut)
ldat2 <- longDat(datmutList) %>% mutate(tstep=2)

### filter
datfilt <- datmut %>% filter(type!="bird")
datfiltList <-  rbind(varnames,datfilt)
ldat3 <- longDat(datfiltList) %>% mutate(tstep=3)

# group
ldat4 <- 
    datfilt %>%  distinct(type) %>% 
      mutate(gpid=as.character(1:n())) %>% 
      right_join(ldat3,by=c("type"="value")) %>% 
      mutate(fillval=if_else(is.na(gpid),fillval,gpid)) %>% 
      mutate(tstep=4)

# top_n  
datfiltTop <- 
    datfilt %>% group_by(type) %>% top_n(1) %>% ungroup()
datfiltTopList <-  rbind(varnames,datfiltTop)
ldat5 <- longDat(datfiltTopList) %>% mutate(tstep=5)

ldat5 <- 
 datfilt %>%  distinct(type) %>% 
   mutate(gpid=as.character(1:n())) %>% 
   right_join(ldat5,by=c("type"="value")) %>% 
   mutate(fillval=if_else(is.na(gpid),fillval,gpid))
# bind
ladatll <- bind_rows(ldat1,ldat2,ldat3,ldat4,ldat5)

# hack fix
ladatll <- 
    ladatll %>% mutate(value=if_else(is.na(value),type,value))

# code as title
titlevec <- 
c("dat %>% mutate(type= case_when(type==\"feline\"~\"cat\",
        type==\"canine\"~\"dog\",
        TRUE~\"bird\")) %>%
    filter(type!=\"bird\") %>%
    group_by(type) %>%
    top_n(1,cuteness)")


# draw
dpanim <- 
    ggplot(ladatll,aes(column,-row,label=value))+
    geom_tile(color="black",aes(fill=fillval))+
  geom_text(family="ABeeZee")+
  scale_fill_manual(values = c("#9893da","#008da8","white","light grey"),guide=FALSE)+
  theme_void()+
  labs(title=titlevec)+
  theme(plot.title = element_text(size = rel(1.5),hjust=0.5))+
  transition_states(
    states            = tstep, # variable in data
    transition_length = 2,   # all states display for 1 time unit
    state_length      = 1    # all transitions take 1 time unit
  ) +
  enter_fade() +             # How new blocks appear
  exit_fade() +              # How blocks disappear
  ease_aes('back-in-out')  

#dpanim
#anim_save("topndemo.gif")