r - カレンダーヒートマップで色分けする代わりに白黒の塗りつぶしパターンを使用する方法

Question

PaulBleicherのCalendarHeatmapを使用して、時間の経過に伴ういくつかのイベントを視覚化しています 。色分けの代わりに（または上に）白黒の塗りつぶしパターンを追加して、CalendarHeatmapの読みやすさを向上させたいと考えています。白黒で印刷されます。

これは、カレンダーヒートマップのカラールックの例です。

これが白黒でどのように見えるかです、

黒と白の個々のレベルを区別することは非常に困難になります。

Rに色の代わりにある種のパッテンを6つのレベルに追加させる簡単な方法はありますか？

カレンダーヒートマップをカラーで再現するためのコード。

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

update 02-13-2013 03：52：11Z、パターンを追加するとはどういう意味ですか、

このプロットの右側（ B ）の円グラフの個々のスライスにパターンが追加されると、カレンダーヒートマップの個々のデイボックスにパターンを追加することを想定しています。

このプロットの状態のようなものがここに見つかりました。

Answer 1

彼が賞金を獲得する前に、私はこの質問に答えました。OPは私の前の答えを少し複雑に感じているようです。ここでは、コードを1つの要点にまとめました。ファイルをダウンロードして入手するだけです。

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)