Add VT2-examples: all 6 chapters of 'Visualize This' (110 files) — data scraping, ETL, trends, categorical, multivariate, spatial, distribution analysis

VT2-examples/vt2-ch4-codedata-dir/make-heatmap.R

@@ -0,0 +1,73 @@
+library(readr)
+library(dplyr)
+library(extrafont)
+
+# Load data.
+accidents <- read_tsv("data/month_hour_pct.tsv")
+
+# Color scale.
+getCol <- function(p) {
+    if (p <= .1) {
+        col <- "#dff5ee"
+    } else if (p <= .2) {
+        col <- "#92dee9"
+    } else if (p <= .3) {
+        col <- "#3fc1f9"
+    } else if (p <= .4) {
+        col <- "#5598fd"
+    } else if (p <= .5) {
+        col <- "#a75bd8"
+    } else {
+        col <- "#d4007f"
+    }
+    return(col)
+}
+
+
+# Setup blank plot.
+par(mar=c(0,0,0,0), bg="white", las=1, family="Inconsolata")
+plot(0:1, 0:1, type="n", xlab="", ylab="", axes=FALSE, asp=1, bty="n")
+
+
+par(new=TRUE, plt=c(0.33, .66, 0.1, .12))
+symbols(1:6, rep(1, 6), squares=rep(1, 6), 
+        bg=sapply(c(.1, .2, .3, .4, .5, .6), getCol),
+        fg="white",
+        inches=FALSE, bty="n",
+        xaxt="n", yaxt="n", ylab="", xlab="")
+axis(1, at=c(2,3,4,5,6)-.5,
+     labels=paste0(c(.1, .2, .3, .4, .5)*100, "%"), lwd=0, lwd.ticks=.5)
+
+par(new=TRUE, plt=c(0.1, .99, 0.25, .95))
+plot(NA, xlim=c(0, 24), ylim=c(12,1), type="n", asp="1", 
+     xlab="", ylab="",
+     xaxt="n", yaxt="n", bty="n", cex.main=1.7,
+     main="")
+axis(2, at=1:12, 
+     labels=c("Jan.", "Feb.", "March", "April", "May", "June", "July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec."),
+     lwd=0, lwd.ticks=.8)
+axis(1, at=c(0, 6, 12, 18, 23),
+     labels=c("12am", "6am", "noon", "6pm", "11pm"),
+     lwd=0, lwd.ticks=.8)
+
+
+
+# Get color.
+squarecol <- sapply(accidents$pct_drunk_all, getCol)
+
+# Add squares.
+symbols(accidents$HOUR, accidents$MONTH, 
+        squares=rep(1, dim(accidents)[1]),
+        inches=FALSE,
+        bg=squarecol,
+        fg="#ffffff",
+        add=TRUE)
+
+# Make a matrix.
+pmat <- matrix(NA, nrow=12, ncol=24)
+for (i in 1:dim(accidents)[1]) {
+    pmat[accidents$MONTH[i], accidents$HOUR[i]+1] <- accidents$pct_drunk_all[i]
+}
+# pmat[accidents$MONTH, accidents$HOUR+1] <- accidents$pct_drunk_all
+row.names(pmat) <- c("Jan.", "Feb", "March", "April", "May", "June", "July", "Aug", "Sept", "Oct", "Nov", "Dec")
+write.table(pmat, file="month_hour_pct_matrix.csv", sep=",")