how to use black-and-white fill patterns instead of color coding on Calendar Heatmap

Question

I\'m using Paul Bleicher\'s Calendar Heatmap to visualize some events over time and I\'m interested to add black-and-white fill patterns instead of (or on top of) the color

Answer 1

We can use ggplot2's scale_shape_manual to get us shapes that appear close to shading, and we can plot these over the grey heatmap.
Note: This was adapted from @Jay's comments in the original blog posting for the calendar heatmap

# PACKAGES
library(ggplot2)
library(data.table)

# Transofrm data
stock.data <- transform(stock.data,
  week = as.POSIXlt(Date)$yday %/% 7 + 1,
  month = as.POSIXlt(Date)$mon + 1,
  wday = factor(as.POSIXlt(Date)$wday, levels=0:6, labels=levels(weekdays(1, abb=FALSE)), ordered=TRUE),
  year = as.POSIXlt(Date)$year + 1900)

# find when the months change
#   Not used, but could be 
stock.data$mchng <- as.logical(c(0, diff(stock.data$month)))

# we need dummy data for Sunday / Saturday to be included.
#  These added rows will not be plotted due to their NA values
dummy <- as.data.frame(stock.data[1:2, ])
dummy[, -which(names(dummy) %in% c("wday", "year"))] <- NA
dummy[, "wday"] <- weekdays(2:3, FALSE)
dummy[, "mchng"] <- TRUE
rbind(dummy, stock.data) -> stock.data

# convert the continuous var to a categorical var 
stock.data$Adj.Disc <- cut(stock.data$Adj.Close, b = 6, labels = F)

# vals is the greyscale tones used for the outer monthly borders
vals <- gray(c(.2, .5))

# PLOT
  # Expected warning due to dummy variable with NA's: 
  # Warning message:
  # Removed 2 rows containing missing values (geom_point). 
ggplot(stock.data) + 
  aes(week, wday, fill=as.factor(Adj.Disc), 
      shape=as.factor(Adj.Disc), color=as.factor(month %% 2)) + 
  geom_tile(linetype=1, size=1.8) + 
  geom_tile(linetype=6, size=0.4, color="white") + 
  scale_color_manual(values=vals) +
  geom_point(aes(alpha=0.2), color="black") + 
  scale_fill_grey(start=0, end=0.9) +  scale_shape_manual(values=c(2, 3, 4, 12, 14, 8)) + 
  theme(legend.position="none")  +  labs(y="Day of the Week") +  facet_wrap(~ year, ncol = 1)