guia - cómo usar patrones de relleno en blanco y negro en lugar de códigos de colores en Calendar Heatmap

qgis español

Question

Estoy usando el Calendario de Calor de Paul Bleicher para visualizar algunos eventos a lo largo del tiempo y estoy interesado en agregar patrones de relleno en blanco y negro en lugar de (o en la parte superior) del código de color para aumentar la legibilidad del Mapa de Calor del Calendario cuando impreso en blanco y negro.

Aquí hay un ejemplo del aspecto del mapa de calor del calendario en color,

y así es como se ve en blanco y negro,

se hace muy difícil distinguir entre los niveles individuales en blanco y negro.

¿Hay alguna manera fácil de hacer que R agregue algún tipo de patten a los 6 niveles en lugar de a color?

Código para reproducir el mapa de calor del calendario en color.

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

actualización 13/02/2013 03: 52: 11Z, ¿qué quiero decir con agregar un patrón ,

Me imagino agregar un patrón a los cuadros de días individuales en el Calendario de Calor como se agrega el patrón a los sectores individuales en el gráfico circular a la derecha ( B ) en este gráfico,

encontrado here algo así como los estados en esta trama .

Answer 1

Podemos usar scale_shape_manual de scale_shape_manual para obtener formas que se scale_shape_manual cercanas al sombreado, y podemos trazarlas sobre el mapa de calor gris.
Nota: Esto fue adaptado de los comentarios de @ Jay en la publicación original del blog para el mapa de calor del calendario

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

Answer 2

Puede panel.level.plot desde latticeExtra para agregar un patrón. Creo que la pregunta tal como se formula es un poco específica. Entonces intento generalizarlo. La idea es dar los pasos para transformar una serie temporal en un mapa de calor del calendario: con 2 patrones (color de relleno y una forma). Podemos imaginar series de tiempo múltiples (Cerrar / Abrir). Por ejemplo, puedes obtener algo como esto

o así, usando un tema ggplot2:

La función calendarHeat , que da una única serie de tiempo (dat, value), transforma datos como este:

   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

Así que supongo que tengo los datos formateados de esta manera, de lo contrario, extraje de calendarHeat la parte de la transformación de datos en una función (ver esta gist )

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

Entonces el calendario es esencialmente un levelplot con sacles personalizados, theme personalizado y panel'' function personalizado.

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)

Donde las escalas son:

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

Y el tema se establece como:

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

La función del panel utiliza una función caelendar.division. De hecho, la división de la grilla (countour black countour) es muy larga y se hace usando el paquete de grid de la manera difícil (panel de enfoque ...). Lo cambio un poco, y ahora lo llamo en la función del panel de celosía: caelendar.division .

Answer 3

Respondí esta pregunta antes de que se convierta en una recompensa. Parece que el OP encuentra mi respuesta anterior un poco complicada. Organicé el código de una sola vez here . solo necesita descargar el archivo y buscarlo.

Creo nueva función extra.calendarHeat que es una extensión de la primera para dibujar hetmap de series de doble tiempo. (Dat, value1, value2). Añadí estos nuevos parámetros:

   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

Aquí algunos ejemplos:

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