public
Created

Replicating / improving http://shaheeilyas.com/flags/

  • Download Gist
flag_plot.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
# Replicating / improving http://shaheeilyas.com/flags/
 
# Drawing a scatter plot of raster images
doInstall <- TRUE # Change to FALSE if you don't want packages installed.
toInstall <- c("png", "reshape", "ggplot2", "MASS")
if(doInstall){install.packages(toInstall, repos = "http://cran.r-project.org")}
lapply(toInstall, library, character.only = TRUE)
 
# Go to https://www.gosquared.com/resources/2400-flags, download the ZIP,
# and put the 64 x 64 files into a directory of your choosing.
# Then setwd() to that directory:
setwd("C:/Dropbox/isDotR_Files/flagIcons")
pngFiles <- list.files() # Get the file names
 
pngList <- list()
for(ii in pngFiles){
tempName <- gsub(".png", "", ii)
tempPNG <- readPNG(ii) # Loads PNGs
pngList[[tempName]] <- tempPNG # And assigns them to a list.
}
 
# Very simple dimension reduction -- just the mean R, G, and B values
meanRGB <- t(sapply(pngList, function(ll){
apply(ll[, , -4], 3, mean)
}))
 
# Similarity, through Kruskal non-metric MDS
flagDistance <- dist(meanRGB)
flagDistance[flagDistance <= 0] <- 1e-10
MDS <- isoMDS(flagDistance)$points
 
# This is slow, it "flattens" the matrices of RGBalpha values
flagColors <- sapply(pngList, function(ll){
do.call(c, lapply(ll, unlist))
})
 
# This converts those flattened frames to hex codes
flagColors <- apply(flagColors, 2, function(cc){
colMat <- matrix(cc, ncol = 4)
sort(table(hex <- rgb(colMat[, 1], colMat[, 2], colMat[, 3], colMat[, 4])))
})
 
# Sort of a hot mess, getting a data frame of pixel counts by color and flag
flagColors <- melt(flagColors)
flagColors$Alpha <- 1 # Pixel transparency indicator
flagColors$Alpha[substr(flagColors$Var.1, 8, 9) == "00"] <- 0
flagColors <- flagColors[flagColors$Alpha == 1, ] # Drop transparent pixels
flagColors$Var.1 <- substr(flagColors$Var.1, 1, 7)
 
hsvFrame <- t(rgb2hsv(col2rgb(flagColors$Var.1)))
flagColors$Orderer <- rowSums(sweep(hsvFrame, 2, c(1e5, 1e3, 1e1), "*"))
flagColors$L1 <- factor(flagColors$L1, # /\ Order colors by Hue, then Sat.,
rownames(MDS)[order(MDS[, 2])]) # then Value
flagColors <- arrange(flagColors, Orderer)
flagColors$RHS <- with(flagColors, # Find the right edge of each color band
unsplit(lapply(split(value, L1),
cumsum), L1))
flagColors$Var.1 <- as.factor(flagColors$Var.1)
 
zp1 <- ggplot(flagColors,
aes(xmax = RHS, xmin = RHS - value,
ymin = 0, ymax = 10,
fill = Var.1))
zp1 <- zp1 + facet_wrap(~ L1, ncol = 11)
zp1 <- zp1 + geom_hline(yintercept = 1:9, colour = "WHITE")
zp1 <- zp1 + geom_rect() # Drawing swaths of color
# This uses a nice trick we can talk about later...
zp1 <- zp1 + scale_fill_manual(breaks = levels(flagColors$Var.1),
values = as.character(levels(flagColors$Var.1)),
guide = "none")
zp1 <- zp1 + scale_x_continuous(breaks = NULL, expand = c(0, 0))
zp1 <- zp1 + scale_y_continuous(breaks = NULL, expand = c(0, 0))
print(zp1)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.