inst/doc/bivariate_choropleths.R

In pals: Color Palettes, Colormaps, and Tools to Evaluate Them

## ----setup, message=FALSE---------------------------------------------------------------
library("knitr")
knitr::opts_chunk$set(fig.align="center", fig.width=6, fig.height=6)
options(width=90)

## ---- message=FALSE---------------------------------------------------------------------
require(latticeExtra) # USCancerRates, mapplot
require(maps) # map
require(classInt) # classIntervals, findCols
require(grid) # viewport, pushViewport
require(pals) # brewer.blues, stevens.pinkgreen

suppressWarnings(print(
  mapplot(rownames(USCancerRates) ~ log(rate.male) + log(rate.female),
          data = USCancerRates,
          colramp = brewer.blues,
          map = map("county", plot = FALSE, fill = TRUE,
                    projection = "tetra"),
          breaks=classIntervals(log(USCancerRates$rate.female), n=3, style='quantile')$brks,
          scales = list(draw = FALSE))
))


## ---------------------------------------------------------------------------------------

cols <- stevens.pinkgreen; nbins <- 3

# categorize rates into 3 percentile bins
brksm <- classIntervals(log(USCancerRates$rate.male), n=nbins, style='quantile')
brksf <- classIntervals(log(USCancerRates$rate.female), n=nbins, style='quantile')
classm <- findCols(brksm)
classf <- findCols(brksf)
# convert x,y classes into a joint class x+3(y-1)
USCancerRates$class2 <- classm + nbins*(classf-1)

# scatterplot of two variates showing bins
plot(log(rate.female) ~ log(rate.male), data=USCancerRates,
     col=cols()[USCancerRates$class2], pch=19,
     xlim=c(4.5, 6.5), ylim=c(4.0, 6))

## ---- fig.width=8-----------------------------------------------------------------------
m3 <- mapplot(rownames(USCancerRates) ~ class2, data = USCancerRates,
              colramp=cols, breaks=seq(from=0.5, by=1, length=nbins*nbins+1),
              xlab="",
              colorkey=FALSE,
              map = map("county", plot = FALSE, fill = TRUE,
                        projection = "tetra"),
              scales = list(draw = FALSE))
suppressWarnings(print( m3 ))
# add the color legend
m3leg <- levelplot(matrix(1:(nbins*nbins), nrow=nbins), axes=FALSE, col.regions=cols(),
                   xlab="male  -->", ylab="female  -->", cuts=8, colorkey=FALSE,
                   scales=list(draw=0))
vp <- viewport(x=.15, y=.25, width=.2, height=.2)
pushViewport(vp)
print(m3leg, newpage=FALSE)
popViewport()

# test
print(m3, more=TRUE)
print(m3leg, position=c(.05, .15, .25, .35), more=FALSE)