# 50 US states, with the four-level region factor attached
xy2_hat <- USArrests
xy2_hat$Region <- state.region
# A second factor: assault rate split at the median
# Crossing it with the regions gives eight groups, each small.
xy2_hat$AssaultLevel <- factor(ifelse(xy2_hat$Assault > median(xy2_hat$Assault), 'High assault', 'Low assault'),
levels=c('Low assault', 'High assault'))
table(xy2_hat$Region, xy2_hat$AssaultLevel)
##
## Low assault High assault
## Northeast 7 2
## South 4 12
## North Central 9 3
## West 6 7
# Region hue stays fixed to each region's identity; shade (light/dark) marks assault level.
# Regions are ordered along the x-axis by median murder rate, lowest to highest.
region2_order <- names(sort(tapply(xy2_hat$Murder, xy2_hat$Region, median)))
xy2_hat$RegionOrdered <- factor(xy2_hat$Region, levels=region2_order)
region2_hues <- setNames(hcl.colors(4), levels(xy2_hat$Region))
col2_low_shade <- sapply(region2_hues[region2_order], adjustcolor, alpha.f=.35)
col2_high_shade <- sapply(region2_hues[region2_order], adjustcolor, alpha.f=.85)
box2_cols <- as.vector(rbind(col2_low_shade, col2_high_shade))
med2_cols <- adjustcolor(box2_cols, alpha.f=2, red.f=.5, green.f=.5, blue.f=.5) # darker shades, for the medians
par(mar=c(4, 4, 4, 1))
boxplot(Murder ~ AssaultLevel + RegionOrdered, data=xy2_hat,
col=box2_cols, border=NA, medcol=med2_cols, xaxt='n', ylim=range(xy2_hat$Murder),
whisklty=0, staplelty=0, outline=FALSE,
xlab='Region (ordered by median murder rate)', ylab='Murder arrests (per 100,000)', main=NA)
# Raw Observations, in place of whiskers and outliers
stripchart(Murder ~ AssaultLevel + RegionOrdered, data=xy2_hat,
pch='-', col=grey(0, .5), cex=2,
vert=TRUE, add=TRUE)
axis(1, at=seq(1.5, by=2, length.out=4), labels=region2_order, tick=FALSE, line=0.5)
axis(1, at=seq_len(8), labels=FALSE)
legend('topleft', inset=c(0, -.16), xpd=TRUE, horiz=TRUE, bty='n',
legend=c('Low assault', 'High assault'), fill=c(grey(.75), grey(.25)))