如何在Calendar Heatmap上使用黑白填充图案而不是颜色编码

Question

我正在使用Paul Bleicher的日历热图来随着时间的推移可视化一些事件,我有兴趣添加 黑白填充图案而不是(或在颜色编码之上)以增加日历热图的可读性.黑白打印.

以下是Calendar Heatmap颜色的示例,

这是黑白相间的样子,

很难区分黑人和白人的各个级别.

是否有一种简单的方法可以让R为6级而不是颜色添加某种模式？

用于以彩色重现Calendar Heatmap的代码.

source("http://blog.revolution-computing.com/downloads/calendarHeat.R")

stock <- "MSFT"
start.date <- "2012-01-12"
end.date <- Sys.Date()

quote <- paste("http://ichart.finance.yahoo.com/table.csv?s=", stock, "&a=", substr(start.date,6,7), "&b=", substr(start.date, 9, 10), "&c=", substr(start.date, 1,4), "&d=", substr(end.date,6,7), "&e=", substr(end.date, 9, 10), "&f=", substr(end.date, 1,4), "&g=d&ignore=.csv", sep="")
stock.data <- read.csv(quote, as.is=TRUE)

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

calendarHeat(stock.data$Date, stock.data$by, varname="MSFT Adjusted Close")

更新02-13-2013 03:52:11Z,添加图案是什么意思,

我设想在日历热图中的各个日框中添加一个模式,因为模式被添加到此图中右侧(B)的饼图中的各个切片中,

在这里找到类似于这个情节中的状态.

Answer 1

在他成为赏金之前我回答了这个问题.看起来OP看起来我以前的答案有点复杂.我在这里用一个要点组织了代码.你只需要下载文件并获取它.

我创建了新函数extra.calendarHeat,它是第一个绘制双时间序列hetmap的扩展.(dat,value1,value2).我添加了这个新参数:

   pch.symbol : vector of symbols , defualt 15:20
   cex.symbol : cex of the symbols , default = 2
   col.symbol : color of symbols , default #00000044
   pvalues    : value of symbols

这里有一些例子:

## I am using same data 
stock <- "MSFT"
start.date <- "2012-01-12"
end.date <- Sys.Date()
quote <- paste("http://ichart.finance.yahoo.com/table.csv?s=",
               stock,
               "&a=", substr(start.date,6,7),
               "&b=", substr(start.date, 9, 10),
               "&c=", substr(start.date, 1,4), 
               "&d=", substr(end.date,6,7),
               "&e=", substr(end.date, 9, 10),
               "&f=", substr(end.date, 1,4),
               "&g=d&ignore=.csv", sep="")             
stock.data <- read.csv(quote, as.is=TRUE)

p1 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         pvalues = stock.data$Volume,
                         varname="W&B MSFT Adjusted Close 
                                  \n Volume as no border symbol ")

## multiply symbols
p2 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         pvalues = stock.data$Volume,
                         varname="W&B MSFT Adjusted Close \n 
                                    black Volume as multiply symbol ",
                         pch.symbol = c(3,4,8,9),
                         col.symbol='black')

## circles symbols
p3 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         pvalues = stock.data$Volume,
                         varname="W&B  MSFT Adjusted Close \n blue Volume as circles",
                         pch.symbol = c(1,10,13,16,18),
                         col.symbol='blue')

## triangles  symbols
p4 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         pvalues = stock.data$Volume,
                         varname="W&B MSFT Adjusted Close \n red Volume as triangles",
                         pch.symbol = c(2,6,17,24,25),
                         col.symbol='red')

p5 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         varname="MSFT Adjusted Close",
                         pch.symbol = LETTERS,
                         col.symbol='black')

# symbols are LETTERS
p6 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
                         pvalues = stock.data$Volume,
                         varname="MSFT Adjusted Close  \n Volume as LETTERS symbols",
                         pch.symbol = letters,
                         color='r2b')

Answer 2

你可以panel.level.plot从中latticeExtra添加模式.我认为问的问题有点具体.所以我试着概括它.我们的想法是将时间序列转换为日历热图:使用2种模式(填充颜色和形状).我们可以想象多个时间序列(关闭/打开).例如,你可以得到这样的东西

或者像这样,使用ggplot2主题:

该函数calendarHeat给出一个时间序列(dat,value),转换如下数据:

   date.seq value dotw woty   yr month seq
1 2012-01-01    NA    0    2 2012     1   1
2 2012-01-02    NA    1    2 2012     1   2
3 2012-01-03    NA    2    2 2012     1   3
4 2012-01-04    NA    3    2 2012     1   4
5 2012-01-05    NA    4    2 2012     1   5
6 2012-01-06    NA    5    2 2012     1   6

所以,我认为我有格式化这样的数据,否则,我从calendarHeat提取的数据转换部分在一个函数(见本要点)

 dat <- transformdata(stock.data$Date, stock.data$by)

然后日历本质上是一个levelplot自定义sacles,自定义theme和自定义panel' function.

library(latticeExtra)
levelplot(value~woty*dotw | yr, data=dat, border = "black",
          layout = c(1, nyr%%7),
          col.regions = (calendar.pal(ncolors)),
          aspect='iso',
          between = list(x=0, y=c(1,1)),
          strip=TRUE,
          panel = function(...) {
            panel.levelplot(...)
            calendar.division(...)  
            panel.levelplot.points(...,na.rm=T,
                                   col='blue',alpha=0.5,
                                   ## you can play with cex and pch here to get the pattern you      
                                   ## like
                                   cex =dat$value/max(dat$value,na.rm=T)*3
                                   pch=ifelse(is.na(dat$value),NA,20),
                                   type = c("p"))

          },
          scales= scales,
          xlim =extendrange(dat$woty,f=0.01),
          ylim=extendrange(dat$dotw,f=0.1),
          cuts= ncolors - 1,
          colorkey= list(col = calendar.pal(ncolors), width = 0.6, height = 0.5),
          subscripts=TRUE,
          par.settings = calendar.theme)

比例是:

 scales = list(
   x = list( at= c(seq(2.9, 52, by=4.42)),
             labels = month.abb,
             alternating = c(1, rep(0, (nyr-1))),
             tck=0,
             cex =1),
   y=list(
     at = c(0, 1, 2, 3, 4, 5, 6),
     labels = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
                "Friday", "Saturday"),
     alternating = 1,
     cex =1,
     tck=0))

主题是:

 calendar.theme <- list(
   xlab=NULL,ylab=NULL,
   strip.background = list(col = "transparent"),
   strip.border = list(col = "transparent"),
   axis.line = list(col="transparent"),
   par.strip.text=list(cex=2))

面板功能使用caelendar.division功能.事实上,网格的划分(月黑色计数)非常长,并且使用grid硬盘包装(面板焦点...)完成.我稍微改了一下,现在我在格子面板功能中调用它:caelendar.division.

Answer 3

我们可以使用ggplot2 scale_shape_manual来获得看起来接近阴影的形状,我们可以在灰色热图上绘制这些形状.
注意:这是根据@ Jay 在日历热图的原始博客文章中的评论改编的

# 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)