Skip to content

Instantly share code, notes, and snippets.

@emitanaka
Last active August 24, 2018 21:11
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save emitanaka/ef1d1b6ade5e57acc4734bc4bfbcc0cd to your computer and use it in GitHub Desktop.
Save emitanaka/ef1d1b6ade5e57acc4734bc4bfbcc0cd to your computer and use it in GitHub Desktop.
Making the Rladies Sydney Bitmap Animation
library(readbitmap)
library(gganimate)
library(dplyr)
library(ggplot2)
b1 <- read.bitmap("~/Documents/rladies.png")
b2 <- read.bitmap("~/Documents/sydney.png")
x1 <- 1 - b1[,,1]
x2 <- 1 - b2[,,1]
# plot(raster::raster(x1)) # check
# plot(raster::raster(x2)) # check
df_rladies <- data.frame(row=as.vector(col(x1)),
col=8 - as.vector(row(x1)),
value=as.vector(x1)) %>%
filter(value==1)
#ggplot(df_rladies, aes(row, col)) + geom_tile() + coord_equal() + theme_minimal()
df_sydney <- data.frame(row=as.vector(col(x2)),
col=8 - as.vector(row(x2)),
value=as.vector(x2)) %>%
filter(value==1)
plot_df <- bind_rows(
df_rladies %>% mutate(idx=1),
df_sydney %>% mutate(idx=2)
)
p <- ggplot(plot_df, aes(row, col)) + geom_tile(fill="#88398a", width=0.9, height=0.9) + coord_equal() + xlab("") + ylab("")
#p +
# facet_wrap(~idx) +
# theme_bw()
panim <- p +
transition_states(
states = idx, # variable in data
transition_length = 1, # 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('sine-in-out') # Tweening movement
save_animation(animate(panim, fps=20, nframes=50, width=1400, height=200), "rladies.gif")
@emitanaka
Copy link
Author

Resulting gif is shown here.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment