Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
229 lines (214 sloc) 7.36 KB
library(ggplot2)
library(plotrix)
library(plyr)
library(waffle)
library(grid)
tc <- function(x) {
return (head(color.id(x), n = 1))
}
printf <- function(...) {
invisible(print(sprintf(...)))
}
#use letters658 instead of LETTERS R constant
letters658 = make.unique(rep(letters, length.out = 658), sep='')
# The above code makes up for the R constant ```LETTERS```
# only having 26 levels when R has 657 colours (add 1 since
# waffle() starts at 'B' instead of 'A'). So having 657 letters
# will allow all R colours to be plotted safely instead of any colour beyond the
# first 26 being turned into 'not a number' i.e. ```NA```.
roland_waffle <-
function (parts,
rows = 10,
xlab = NULL,
title = NULL,
colors = NA,
size = 2,
flip = FALSE,
reverse = FALSE,
equal = TRUE,
pad = 0,
use_glyph = FALSE,
glyph_size = 12,
legend_pos = "right")
{
part_names <- names(parts)
print("part_names BEFORE adding LETTERS:")
print(part_names)
if (length(part_names) < length(parts)) {
print("Adding LETTERS to part_names!!!")
printf("length:parts:%d", length(parts))
printf("length partname:%d", length(part_names))
part_names <- c(part_names, letters658[1:length(parts) -
length(part_names)])
}
print("part_names after adding LETTERS:")
print(part_names)
if (all(is.na(colors))) {
colors <- brewer.pal(length(parts), "Set2")
}
print("parts after adding LETTERS:")
print(parts)
printf("BEFORE unlist() length:parts:%d", length(parts))
parts_vec <- unlist(sapply(1:length(parts), function(i) {
rep(letters658[i + 1], parts[i])
}))
if (reverse) {
parts_vec <- rev(parts_vec)
}
print("parts_vec:")
print(parts_vec)
dat <-
expand.grid(y = 1:rows, x = seq_len(pad + (ceiling(sum(
parts
) / rows))))
dat$value <- c(parts_vec, rep(NA, nrow(dat) - length(parts_vec)))
print(dat)
if (!inherits(use_glyph, "logical")) {
fontlab <- rep(fa_unicode[use_glyph], length(unique(parts_vec)))
dat$fontlab <- c(fontlab[as.numeric(factor(parts_vec))],
rep(NA, nrow(dat) - length(parts_vec)))
}
if (flip) {
gg <- ggplot(dat, aes(x = y, y = x))
}
else {
gg <- ggplot(dat, aes(x = x, y = y))
}
gg <- gg + theme_bw()
if (inherits(use_glyph, "logical")) {
gg <- gg + geom_tile(aes(fill = value), color = "white",
size = size)
gg <- gg + scale_fill_manual(name = "",
values = colors,
labels = part_names)
gg <-
gg + guides(fill = guide_legend(override.aes = list(colour = NULL)))
}
else {
if (choose_font("FontAwesome", quiet = TRUE) == "") {
stop(
"FontAwesome not found. Install via: https://github.com/FortAwesome/Font-Awesome/tree/master/fonts",
call. = FALSE
)
}
suppressWarnings(suppressMessages(font_import(
system.file("fonts",
package = "waffle"),
recursive = FALSE,
prompt = FALSE
)))
if (!(!interactive() || stats::runif(1) > 0.1)) {
message("Font Awesome by Dave Gandy - http://fontawesome.io")
}
gg <- gg + geom_tile(
color = NA,
fill = NA,
size = size,
alpha = 0,
show_guide = FALSE
)
gg <- gg + geom_point(
aes(color = value),
fill = NA,
size = 0,
show_guide = TRUE
)
gg <- gg + geom_text(
aes(color = value, label = fontlab),
family = "FontAwesome",
size = glyph_size,
show_guide = FALSE
)
gg <- gg + scale_color_manual(name = "",
values = colors,
labels = part_names)
gg <-
gg + guides(color = guide_legend(override.aes = list(shape = 15,
size = 7)))
gg <- gg + theme(legend.background = element_rect(fill = NA,
color = NA))
gg <- gg + theme(legend.key = element_rect(color = NA))
}
gg <- gg + labs(x = xlab, y = NULL, title = title)
gg <- gg + scale_x_continuous(expand = c(0, 0))
gg <- gg + scale_y_continuous(expand = c(0, 0))
if (equal) {
gg <- gg + coord_equal()
}
gg <- gg + theme(panel.grid = element_blank())
gg <- gg + theme(panel.border = element_blank())
gg <- gg + theme(panel.background = element_blank())
gg <- gg + theme(panel.margin = unit(0, "null"))
gg <- gg + theme(axis.text = element_blank())
gg <- gg + theme(axis.title.x = element_text(size = 10))
gg <- gg + theme(axis.ticks = element_blank())
gg <- gg + theme(axis.line = element_blank())
gg <- gg + theme(axis.ticks.length = unit(0, "null"))
gg <- gg + theme(plot.title = element_text(size = 18))
gg <- gg + theme(plot.background = element_blank())
gg <- gg + theme(plot.margin = unit(c(0, 0, 0, 0), "null"))
gg <- gg + theme(plot.margin = rep(unit(0, "null"), 4))
gg <- gg + theme(legend.position = legend_pos)
gg
}
get_linear <- function(colour) {
colour_matrix <- col2rgb(colour)
linear_colour_matrix <- (colour_matrix / 255.0) ^ 2.2
#return (linear_colour_matrix)
return (unname(c(linear_colour_matrix[1,1], linear_colour_matrix[2,1],
linear_colour_matrix[3,1])))
}
args <- commandArgs(TRUE)
## Default setting when no arguments passed
if (length(args) < 1) {
args <- c("--help")
}
if ("--help" %in% args) {
cat(
"
Arguments:
CSV file with a column with colour with hex values for colours
--help - print this text
Example:
Rscript twenty-four-square-piechart-from-csv.R 001_ThuJan1.csv\n\n"
)
q(save = "no")
}
getcolour_for_hour <- function(df, hh) {
hour_subset = subset(df, hour == hh)
red = 255 * (sum(hour_subset$linear_colour_matrix[[1]][1])/nrow(hour_subset))^(1.0/2.2)
green = 255 * (sum(hour_subset$linear_colour_matrix[[1]][2])/nrow(hour_subset))^(1.0/2.2)
blue = 255* (sum(hour_subset$linear_colour_matrix[[1]][3])/nrow(hour_subset))^(1.0/2.2)
return (tc(round((red*65536.0) + (blue * 256.0) + blue)))
}
main <- function() {
data3 = read.csv(file = args[1], stringsAsFactors = F)
data3$linear_colour_matrix <- lapply(data3$colour, get_linear)
df <- data.frame(colourname = character(24), stringsAsFactors = FALSE)
for (i in 0:23) {
colourname = getcolour_for_hour(data3, i)
df$colourname[i+1] <- colourname
}
print (df)
countcolourname = count(df, "colourname")
countcolourname <- countcolourname[order(-countcolourname$freq), ]
colour_vector2 <- setNames(countcolourname$freq, countcolourname$colourname)
print(colour_vector2)
print(sum(colour_vector2))
p = roland_waffle(
colour_vector2,
rows = 4,
size = 1.0,
colors = countcolourname$colourname) +
theme(legend.position = "none")
filename = sprintf("24squares-per-hour-%s", gsub("csv", "png", basename(args[1])))
ggsave(filename,
p,
width = 14.222222222,
height =10.666666667,
dpi = 72,
limitsize = FALSE) #multiply height and width by dpi to get px
}
sink("log.txt")
main()
sink()