Menu
I'm plotting a calender heat map using Paul Bleicher's calenderHeat.R code and this is my plot:
I was wondering how I could add dates to the plot, instead of the blank grids. Here's my sample data:
structure(list(Date = c("2014-10-01", "2014-09-30", "2014-09-29",
"2014-09-26", "2014-09-25", "2014-09-24", "2014-09-23", "2014-09-22",
"2014-09-19", "2014-09-18", "2014-09-17", "2014-09-16", "2014-09-15",
"2014-09-12", "2014-09-11", "2014-09-10", "2014-09-09", "2014-09-08",
"2014-09-05", "2014-09-04", "2014-09-03", "2014-09-02", "2014-08-29",
"2014-08-28", "2014-08-27", "2014-08-26", "2014-08-25", "2014-08-22",
"2014-08-21", "2014-08-20", "2014-08-19", "2014-08-18", "2014-08-15",
"2014-08-14", "2014-08-13", "2014-08-12", "2014-08-11", "2014-08-08",
"2014-08-07", "2014-08-06", "2014-08-05", "2014-08-04", "2014-08-01",
"2014-07-31", "2014-07-30", "2014-07-29", "2014-07-28", "2014-07-25",
"2014-07-24", "2014-07-23", "2014-07-22", "2014-07-21", "2014-07-18",
"2014-07-17", "2014-07-16", "2014-07-15", "2014-07-14", "2014-07-11",
"2014-07-10", "2014-07-09", "2014-07-08", "2014-07-07", "2014-07-03",
"2014-07-02", "2014-07-01", "2014-06-30", "2014-06-27", "2014-06-26",
"2014-06-25", "2014-06-24", "2014-06-23", "2014-06-20", "2014-06-19",
"2014-06-18", "2014-06-17", "2014-06-16", "2014-06-13", "2014-06-12",
"2014-06-11", "2014-06-10", "2014-06-09", "2014-06-06", "2014-06-05",
"2014-06-04", "2014-06-03", "2014-06-02", "2014-05-30", "2014-05-29",
"2014-05-28", "2014-05-27", "2014-05-23", "2014-05-22", "2014-05-21",
"2014-05-20", "2014-05-19", "2014-05-16", "2014-05-15", "2014-05-14",
"2014-05-13", "2014-05-12", "2014-05-09", "2014-05-08", "2014-05-07",
"2014-05-06", "2014-05-05", "2014-05-02", "2014-05-01", "2014-04-30",
"2014-04-29", "2014-04-28", "2014-04-25", "2014-04-24", "2014-04-23",
"2014-04-22", "2014-04-21", "2014-04-17", "2014-04-16", "2014-04-15",
"2014-04-14", "2014-04-11", "2014-04-10", "2014-04-09", "2014-04-08",
"2014-04-07", "2014-04-04", "2014-04-03", "2014-04-02", "2014-04-01",
"2014-03-31", "2014-03-28", "2014-03-27", "2014-03-26", "2014-03-25",
"2014-03-24", "2014-03-21", "2014-03-20", "2014-03-19", "2014-03-18",
"2014-03-17", "2014-03-14", "2014-03-13", "2014-03-12", "2014-03-11",
"2014-03-10", "2014-03-07", "2014-03-06", "2014-03-05", "2014-03-04",
"2014-03-03", "2014-02-28", "2014-02-27", "2014-02-26", "2014-02-25",
"2014-02-24", "2014-02-21", "2014-02-20", "2014-02-19", "2014-02-18",
"2014-02-14", "2014-02-13", "2014-02-12", "2014-02-11", "2014-02-10",
"2014-02-07", "2014-02-06", "2014-02-05", "2014-02-04", "2014-02-03",
"2014-01-31", "2014-01-30", "2014-01-29", "2014-01-28", "2014-01-27",
"2014-01-24", "2014-01-23", "2014-01-22", "2014-01-21", "2014-01-17",
"2014-01-16", "2014-01-15", "2014-01-14", "2014-01-13", "2014-01-10",
"2014-01-09", "2014-01-08", "2014-01-07", "2014-01-06", "2014-01-03",
"2014-01-02", "2013-12-31", "2013-12-30", "2013-12-27", "2013-12-26",
"2013-12-24", "2013-12-23", "2013-12-20", "2013-12-19", "2013-12-18",
"2013-12-17", "2013-12-16", "2013-12-13", "2013-12-12", "2013-12-11",
"2013-12-10", "2013-12-09", "2013-12-06", "2013-12-05", "2013-12-04",
"2013-12-03", "2013-12-02", "2013-11-29", "2013-11-27", "2013-11-26",
"2013-11-25", "2013-11-22", "2013-11-21", "2013-11-20", "2013-11-19",
"2013-11-18", "2013-11-15", "2013-11-14", "2013-11-13", "2013-11-12",
"2013-11-11", "2013-11-08", "2013-11-07", "2013-11-06", "2013-11-05",
"2013-11-04", "2013-11-01", "2013-10-31", "2013-10-30", "2013-10-29",
"2013-10-28", "2013-10-25", "2013-10-24", "2013-10-23", "2013-10-22",
"2013-10-21", "2013-10-18", "2013-10-17", "2013-10-16", "2013-10-15",
"2013-10-14", "2013-10-11", "2013-10-10", "2013-10-09", "2013-10-08",
"2013-10-07", "2013-10-04", "2013-10-03", "2013-10-02", "2013-10-01",
"2013-09-30", "2013-09-27", "2013-09-26", "2013-09-25", "2013-09-24",
"2013-09-23", "2013-09-20", "2013-09-19", "2013-09-18", "2013-09-17",
"2013-09-16", "2013-09-13", "2013-09-12", "2013-09-11", "2013-09-10",
"2013-09-09", "2013-09-06", "2013-09-05", "2013-09-04", "2013-09-03",
"2013-08-30", "2013-08-29", "2013-08-28", "2013-08-27", "2013-08-26",
"2013-08-23", "2013-08-22", "2013-08-21", "2013-08-20", "2013-08-19",
"2013-08-16", "2013-08-15", "2013-08-14", "2013-08-13", "2013-08-12"
), Adj.Close = c(45.9, 46.36, 46.44, 46.41, 46.04, 47.08, 46.56,
47.06, 47.52, 46.68, 46.52, 46.76, 46.24, 46.7, 47, 46.84, 46.76,
46.47, 45.91, 45.26, 44.96, 45.09, 45.43, 44.88, 44.87, 45.01,
45.17, 45.15, 45.22, 44.95, 45.33, 44.83, 44.51, 44, 43.81, 43.25,
42.93, 42.93, 42.96, 42.47, 42.81, 43.1, 42.59, 42.89, 43.31,
43.62, 43.7, 44.22, 44.12, 44.59, 44.55, 44.56, 44.41, 44.25,
43.81, 42.19, 41.88, 41.83, 41.43, 41.41, 41.52, 41.73, 41.54,
41.64, 41.61, 41.44, 41.99, 41.46, 41.77, 41.49, 41.73, 41.42,
41.25, 41.39, 41.42, 41.24, 40.97, 40.33, 40.61, 40.85, 41.01,
41.22, 40.95, 40.07, 40.04, 40.54, 40.69, 40.09, 39.76, 39.94,
39.87, 39.85, 40.1, 39.43, 39.5, 39.58, 39.35, 39.99, 40.17,
39.44, 39.02, 39.12, 38.9, 38.55, 38.91, 39.17, 39.47, 39.87,
39.98, 40.33, 39.38, 39.34, 39.17, 39.46, 39.41, 39.48, 39.87,
39.23, 38.66, 38.69, 38.84, 39.94, 39.3, 39.28, 39.34, 40.47,
40.81, 40.87, 40.45, 39.77, 38.84, 39.27, 39.81, 39.97, 39.63,
39.8, 38.75, 39.03, 37.55, 37.2, 37.39, 37.77, 37.52, 37.32,
37.4, 37.65, 37.61, 37.9, 37.28, 37.81, 37.36, 36.98, 37.05,
37.19, 37.48, 37.25, 37.02, 36.93, 36.85, 36.84, 36.7, 36.41,
36.05, 35.81, 35.44, 35.09, 35.6, 35.73, 37.06, 36.1, 35.91,
35.53, 35.29, 36.05, 35.32, 35.19, 35.43, 35.63, 36.13, 36.01,
35.05, 34.26, 35.3, 34.8, 35.03, 35.66, 35.39, 36.15, 36.4, 36.64,
36.53, 36.53, 36.67, 36.32, 35.87, 36.05, 35.51, 35.83, 35.77,
36.13, 35.94, 36.46, 36.84, 37.33, 37.92, 37.57, 37.22, 38.14,
37.52, 37.66, 37.35, 36.83, 36.58, 36.87, 36.8, 36.63, 36.32,
35.99, 36.16, 36.78, 36.96, 37.1, 36.32, 36.54, 36.73, 36.45,
37.12, 35.62, 34.94, 34.54, 34.42, 34.55, 34.53, 34.58, 34.73,
32.78, 32.82, 33.62, 34.01, 33.99, 33.95, 33.67, 33.53, 33.49,
33.18, 32.82, 32.15, 32.09, 32.37, 32.94, 32.92, 32.97, 32.64,
32.35, 32.34, 31.86, 31.6, 31.55, 31.83, 31.88, 32.7, 32.39,
32.01, 31.89, 32.11, 31.78, 31.83, 31.49, 30.78, 30.28, 30.36,
30.33, 30.99, 32.47, 32.61, 32.1, 32.33, 33.2, 33.78, 31.49,
30.73, 30.74, 30.51, 30.91, 30.9, 31.45, 31.33, 31.73)), .Names = c("Date",
"Adj.Close"), class = "data.frame", row.names = c(NA, -288L))
and code to produce the plot:
calendarHeat(stock.data$Date, stock.data$Adj.Close, varname="MSFT Adjusted Close")
I have searched all over the internet and tried on my own but the closest solution I got was one that adds letters like so:
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')
Please help me to add the dates of the months. Thanks in advance.
693
The calendR package allows creating a yearly or monthly heat map with a calendar to display the evolution a variable over the time. In order to create it pass a vector (containing the variable of interest) of the same length of the number of days of the corresponding year to special.days and set gradient = TRUE.
Time-Series Calendar Heatmaps. A new way to visualize Time Series data | by Sarang Gupta | Towards Data Science Time series is a series of data that is indexed in time order. The time order can be expressed in days, weeks, months or years.
The R code for calendarHeat () can be downloaded through Paul Bleicher’s Github page. The process of creating a calendar heatmap with ggplot2 is somewhat cumbersome.
Yearly calendar plot in R The package is very straightforward to use, as it only contains a function named the same way as the package, calendR. By default, if no argument is specified, the function will create the calendar of the current year in landscape and all the texts will be in the language of your system.
I liked the answer by MrFlick but I was looking for something less cluttered and so I try to print just the day of month in case of Sunday:
stock.data <- structure(list(Date = c("2014-10-01", "2014-09-30", "2014-09-29",
"2014-09-26", "2014-09-25", "2014-09-24", "2014-09-23", "2014-09-22",
"2014-09-19", "2014-09-18", "2014-09-17", "2014-09-16", "2014-09-15",
"2014-09-12", "2014-09-11", "2014-09-10", "2014-09-09", "2014-09-08",
"2014-09-05", "2014-09-04", "2014-09-03", "2014-09-02", "2014-08-29",
"2014-08-28", "2014-08-27", "2014-08-26", "2014-08-25", "2014-08-22",
"2014-08-21", "2014-08-20", "2014-08-19", "2014-08-18", "2014-08-15",
"2014-08-14", "2014-08-13", "2014-08-12", "2014-08-11", "2014-08-08",
"2014-08-07", "2014-08-06", "2014-08-05", "2014-08-04", "2014-08-01",
"2014-07-31", "2014-07-30", "2014-07-29", "2014-07-28", "2014-07-25",
"2014-07-24", "2014-07-23", "2014-07-22", "2014-07-21", "2014-07-18",
"2014-07-17", "2014-07-16", "2014-07-15", "2014-07-14", "2014-07-11",
"2014-07-10", "2014-07-09", "2014-07-08", "2014-07-07", "2014-07-03",
"2014-07-02", "2014-07-01", "2014-06-30", "2014-06-27", "2014-06-26",
"2014-06-25", "2014-06-24", "2014-06-23", "2014-06-20", "2014-06-19",
"2014-06-18", "2014-06-17", "2014-06-16", "2014-06-13", "2014-06-12",
"2014-06-11", "2014-06-10", "2014-06-09", "2014-06-06", "2014-06-05",
"2014-06-04", "2014-06-03", "2014-06-02", "2014-05-30", "2014-05-29",
"2014-05-28", "2014-05-27", "2014-05-23", "2014-05-22", "2014-05-21",
"2014-05-20", "2014-05-19", "2014-05-16", "2014-05-15", "2014-05-14",
"2014-05-13", "2014-05-12", "2014-05-09", "2014-05-08", "2014-05-07",
"2014-05-06", "2014-05-05", "2014-05-02", "2014-05-01", "2014-04-30",
"2014-04-29", "2014-04-28", "2014-04-25", "2014-04-24", "2014-04-23",
"2014-04-22", "2014-04-21", "2014-04-17", "2014-04-16", "2014-04-15",
"2014-04-14", "2014-04-11", "2014-04-10", "2014-04-09", "2014-04-08",
"2014-04-07", "2014-04-04", "2014-04-03", "2014-04-02", "2014-04-01",
"2014-03-31", "2014-03-28", "2014-03-27", "2014-03-26", "2014-03-25",
"2014-03-24", "2014-03-21", "2014-03-20", "2014-03-19", "2014-03-18",
"2014-03-17", "2014-03-14", "2014-03-13", "2014-03-12", "2014-03-11",
"2014-03-10", "2014-03-07", "2014-03-06", "2014-03-05", "2014-03-04",
"2014-03-03", "2014-02-28", "2014-02-27", "2014-02-26", "2014-02-25",
"2014-02-24", "2014-02-21", "2014-02-20", "2014-02-19", "2014-02-18",
"2014-02-14", "2014-02-13", "2014-02-12", "2014-02-11", "2014-02-10",
"2014-02-07", "2014-02-06", "2014-02-05", "2014-02-04", "2014-02-03",
"2014-01-31", "2014-01-30", "2014-01-29", "2014-01-28", "2014-01-27",
"2014-01-24", "2014-01-23", "2014-01-22", "2014-01-21", "2014-01-17",
"2014-01-16", "2014-01-15", "2014-01-14", "2014-01-13", "2014-01-10",
"2014-01-09", "2014-01-08", "2014-01-07", "2014-01-06", "2014-01-03",
"2014-01-02", "2013-12-31", "2013-12-30", "2013-12-27", "2013-12-26",
"2013-12-24", "2013-12-23", "2013-12-20", "2013-12-19", "2013-12-18",
"2013-12-17", "2013-12-16", "2013-12-13", "2013-12-12", "2013-12-11",
"2013-12-10", "2013-12-09", "2013-12-06", "2013-12-05", "2013-12-04",
"2013-12-03", "2013-12-02", "2013-11-29", "2013-11-27", "2013-11-26",
"2013-11-25", "2013-11-22", "2013-11-21", "2013-11-20", "2013-11-19",
"2013-11-18", "2013-11-15", "2013-11-14", "2013-11-13", "2013-11-12",
"2013-11-11", "2013-11-08", "2013-11-07", "2013-11-06", "2013-11-05",
"2013-11-04", "2013-11-01", "2013-10-31", "2013-10-30", "2013-10-29",
"2013-10-28", "2013-10-25", "2013-10-24", "2013-10-23", "2013-10-22",
"2013-10-21", "2013-10-18", "2013-10-17", "2013-10-16", "2013-10-15",
"2013-10-14", "2013-10-11", "2013-10-10", "2013-10-09", "2013-10-08",
"2013-10-07", "2013-10-04", "2013-10-03", "2013-10-02", "2013-10-01",
"2013-09-30", "2013-09-27", "2013-09-26", "2013-09-25", "2013-09-24",
"2013-09-23", "2013-09-20", "2013-09-19", "2013-09-18", "2013-09-17",
"2013-09-16", "2013-09-13", "2013-09-12", "2013-09-11", "2013-09-10",
"2013-09-09", "2013-09-06", "2013-09-05", "2013-09-04", "2013-09-03",
"2013-08-30", "2013-08-29", "2013-08-28", "2013-08-27", "2013-08-26",
"2013-08-23", "2013-08-22", "2013-08-21", "2013-08-20", "2013-08-19",
"2013-08-16", "2013-08-15", "2013-08-14", "2013-08-13", "2013-08-12"
), Adj.Close = c(45.9, 46.36, 46.44, 46.41, 46.04, 47.08, 46.56,
47.06, 47.52, 46.68, 46.52, 46.76, 46.24, 46.7, 47, 46.84, 46.76,
46.47, 45.91, 45.26, 44.96, 45.09, 45.43, 44.88, 44.87, 45.01,
45.17, 45.15, 45.22, 44.95, 45.33, 44.83, 44.51, 44, 43.81, 43.25,
42.93, 42.93, 42.96, 42.47, 42.81, 43.1, 42.59, 42.89, 43.31,
43.62, 43.7, 44.22, 44.12, 44.59, 44.55, 44.56, 44.41, 44.25,
43.81, 42.19, 41.88, 41.83, 41.43, 41.41, 41.52, 41.73, 41.54,
41.64, 41.61, 41.44, 41.99, 41.46, 41.77, 41.49, 41.73, 41.42,
41.25, 41.39, 41.42, 41.24, 40.97, 40.33, 40.61, 40.85, 41.01,
41.22, 40.95, 40.07, 40.04, 40.54, 40.69, 40.09, 39.76, 39.94,
39.87, 39.85, 40.1, 39.43, 39.5, 39.58, 39.35, 39.99, 40.17,
39.44, 39.02, 39.12, 38.9, 38.55, 38.91, 39.17, 39.47, 39.87,
39.98, 40.33, 39.38, 39.34, 39.17, 39.46, 39.41, 39.48, 39.87,
39.23, 38.66, 38.69, 38.84, 39.94, 39.3, 39.28, 39.34, 40.47,
40.81, 40.87, 40.45, 39.77, 38.84, 39.27, 39.81, 39.97, 39.63,
39.8, 38.75, 39.03, 37.55, 37.2, 37.39, 37.77, 37.52, 37.32,
37.4, 37.65, 37.61, 37.9, 37.28, 37.81, 37.36, 36.98, 37.05,
37.19, 37.48, 37.25, 37.02, 36.93, 36.85, 36.84, 36.7, 36.41,
36.05, 35.81, 35.44, 35.09, 35.6, 35.73, 37.06, 36.1, 35.91,
35.53, 35.29, 36.05, 35.32, 35.19, 35.43, 35.63, 36.13, 36.01,
35.05, 34.26, 35.3, 34.8, 35.03, 35.66, 35.39, 36.15, 36.4, 36.64,
36.53, 36.53, 36.67, 36.32, 35.87, 36.05, 35.51, 35.83, 35.77,
36.13, 35.94, 36.46, 36.84, 37.33, 37.92, 37.57, 37.22, 38.14,
37.52, 37.66, 37.35, 36.83, 36.58, 36.87, 36.8, 36.63, 36.32,
35.99, 36.16, 36.78, 36.96, 37.1, 36.32, 36.54, 36.73, 36.45,
37.12, 35.62, 34.94, 34.54, 34.42, 34.55, 34.53, 34.58, 34.73,
32.78, 32.82, 33.62, 34.01, 33.99, 33.95, 33.67, 33.53, 33.49,
33.18, 32.82, 32.15, 32.09, 32.37, 32.94, 32.92, 32.97, 32.64,
32.35, 32.34, 31.86, 31.6, 31.55, 31.83, 31.88, 32.7, 32.39,
32.01, 31.89, 32.11, 31.78, 31.83, 31.49, 30.78, 30.28, 30.36,
30.33, 30.99, 32.47, 32.61, 32.1, 32.33, 33.2, 33.78, 31.49,
30.73, 30.74, 30.51, 30.91, 30.9, 31.45, 31.33, 31.73)), .Names = c("Date",
"Adj.Close"), class = "data.frame", row.names = c(NA, -288L))
# see https://stackoverflow.com/a/26172503
# based on https://raw.githubusercontent.com/iascchen/VisHealth/master/R/calendarHeat.R
calendarHeat2 <- function (dates, values, ncolors = 99, color = "r2g", varname = "Values",
date.form = "%Y-%m-%d", ...)
{
require(lattice)
require(grid)
require(chron)
if (class(dates) == "character" | class(dates) == "factor") {
dates <- strptime(dates, date.form)
}
caldat <- data.frame(value = values, dates = dates)
min.date <- as.Date(paste(format(min(dates), "%Y"), "-1-1",
sep = ""))
max.date <- as.Date(paste(format(max(dates), "%Y"), "-12-31",
sep = ""))
dates.f <- data.frame(date.seq = seq(min.date, max.date,
by = "days"))
caldat <- data.frame(date.seq = seq(min.date, max.date,
by = "days"), value = NA)
dates <- as.Date(dates)
caldat$value[match(dates, caldat$date.seq)] <- values
caldat$dotw <- as.numeric(format(caldat$date.seq, "%w"))
caldat$woty <- as.numeric(format(caldat$date.seq, "%U")) +
1
caldat$dom <- as.numeric(format(caldat$date.seq, "%d"))
caldat$yr <- as.factor(format(caldat$date.seq, "%Y"))
caldat$month <- as.numeric(format(caldat$date.seq, "%m"))
yrs <- as.character(unique(caldat$yr))
d.loc <- as.numeric()
for (m in min(yrs):max(yrs)) {
d.subset <- which(caldat$yr == m)
sub.seq <- seq(1, length(d.subset))
d.loc <- c(d.loc, sub.seq)
}
caldat <- cbind(caldat, seq = d.loc)
r2b <- c("#0571B0", "#92C5DE", "#F7F7F7", "#F4A582", "#CA0020")
r2g <- c("#D61818", "#FFAE63", "#FFFFBD", "#B5E384")
w2b <- c("#045A8D", "#2B8CBE", "#74A9CF", "#BDC9E1", "#F1EEF6")
g2r <- c("#B5E384", "#FFFFBD", "#FFAE63", "#D61818")
assign("col.sty", get(color))
calendar.pal <- colorRampPalette((col.sty), space = "Lab")
def.theme <- lattice.getOption("default.theme")
cal.theme <- function() {
theme <- list(strip.background = list(col = "transparent"),
strip.border = list(col = "transparent"), axis.line = list(col = "transparent"),
par.strip.text = list(cex = 0.8))
}
lattice.options(default.theme = cal.theme)
yrs <- (unique(caldat$yr))
nyr <- length(yrs)
print(cal.plot <- levelplot(value ~ woty * dotw | yr, data = caldat,
as.table = TRUE, aspect = 0.12, layout = c(1, nyr%%7),
between = list(x = 0, y = c(1, 1)), strip = TRUE, main = paste("Calendar Heat Map of ",
varname, sep = ""), 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 = 0.7), y = list(at = c(0,
1, 2, 3, 4, 5, 6), labels = c("Sunday", "Monday",
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"),
alternating = 1, cex = 0.6, tck = 0)), xlim = c(0.4,
54.6), ylim = c(6.6, -0.6), cuts = ncolors - 1,
col.regions = (calendar.pal(ncolors)), xlab = "", ylab = "",
colorkey = list(col = calendar.pal(ncolors), width = 0.6,
height = 0.5), subscripts = TRUE, dom = caldat$dom, dotw = caldat$dotw,
panel = function(x, y, subscripts, dom, dotw, ...) {
panel.levelplot(x, y, subscripts = subscripts, ...)
sunday <- 0
flag<-dotw[subscripts]==rep(sunday,length(dotw))
dom <- mapply(function(value,flag){if(flag){as.character(value)}else{""}},dom,flag)
panel.text(x[subscripts], y[subscripts], labels = dom[subscripts])
}))
panel.locs <- trellis.currentLayout()
for (row in 1:nrow(panel.locs)) {
for (column in 1:ncol(panel.locs)) {
if (panel.locs[row, column] > 0) {
trellis.focus("panel", row = row, column = column,
highlight = FALSE)
xyetc <- trellis.panelArgs()
subs <- caldat[xyetc$subscripts, ]
dates.fsubs <- caldat[caldat$yr == unique(subs$yr),
]
y.start <- dates.fsubs$dotw[1]
y.end <- dates.fsubs$dotw[nrow(dates.fsubs)]
dates.len <- nrow(dates.fsubs)
adj.start <- dates.fsubs$woty[1]
for (k in 0:6) {
if (k < y.start) {
x.start <- adj.start + 0.5
}
else {
x.start <- adj.start - 0.5
}
if (k > y.end) {
x.finis <- dates.fsubs$woty[nrow(dates.fsubs)] -
0.5
}
else {
x.finis <- dates.fsubs$woty[nrow(dates.fsubs)] +
0.5
}
grid.lines(x = c(x.start, x.finis), y = c(k -
0.5, k - 0.5), default.units = "native",
gp = gpar(col = "grey", lwd = 1))
}
if (adj.start < 2) {
grid.lines(x = c(0.5, 0.5), y = c(6.5, y.start -
0.5), default.units = "native", gp = gpar(col = "grey",
lwd = 1))
grid.lines(x = c(1.5, 1.5), y = c(6.5, -0.5),
default.units = "native", gp = gpar(col = "grey",
lwd = 1))
grid.lines(x = c(x.finis, x.finis), y = c(dates.fsubs$dotw[dates.len] -
0.5, -0.5), default.units = "native", gp = gpar(col = "grey",
lwd = 1))
if (dates.fsubs$dotw[dates.len] != 6) {
grid.lines(x = c(x.finis + 1, x.finis +
1), y = c(dates.fsubs$dotw[dates.len] -
0.5, -0.5), default.units = "native",
gp = gpar(col = "grey", lwd = 1))
}
grid.lines(x = c(x.finis, x.finis), y = c(dates.fsubs$dotw[dates.len] -
0.5, -0.5), default.units = "native", gp = gpar(col = "grey",
lwd = 1))
}
for (n in 1:51) {
grid.lines(x = c(n + 1.5, n + 1.5), y = c(-0.5,
6.5), default.units = "native", gp = gpar(col = "grey",
lwd = 1))
}
x.start <- adj.start - 0.5
if (y.start > 0) {
grid.lines(x = c(x.start, x.start + 1), y = c(y.start -
0.5, y.start - 0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start + 1, x.start + 1),
y = c(y.start - 0.5, -0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start, x.start), y = c(y.start -
0.5, 6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
if (y.end < 6) {
grid.lines(x = c(x.start + 1, x.finis +
1), y = c(-0.5, -0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start, x.finis), y = c(6.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
else {
grid.lines(x = c(x.start + 1, x.finis),
y = c(-0.5, -0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start, x.finis), y = c(6.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
}
else {
grid.lines(x = c(x.start, x.start), y = c(-0.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
if (y.start == 0) {
if (y.end < 6) {
grid.lines(x = c(x.start, x.finis + 1),
y = c(-0.5, -0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start, x.finis), y = c(6.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
else {
grid.lines(x = c(x.start + 1, x.finis),
y = c(-0.5, -0.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.start, x.finis), y = c(6.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
}
for (j in 1:12) {
last.month <- max(dates.fsubs$seq[dates.fsubs$month ==
j])
x.last.m <- dates.fsubs$woty[last.month] +
0.5
y.last.m <- dates.fsubs$dotw[last.month] +
0.5
grid.lines(x = c(x.last.m, x.last.m), y = c(-0.5,
y.last.m), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
if ((y.last.m) < 6) {
grid.lines(x = c(x.last.m, x.last.m - 1),
y = c(y.last.m, y.last.m), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
grid.lines(x = c(x.last.m - 1, x.last.m -
1), y = c(y.last.m, 6.5), default.units = "native",
gp = gpar(col = "black", lwd = 1.75))
}
else {
grid.lines(x = c(x.last.m, x.last.m), y = c(-0.5,
6.5), default.units = "native", gp = gpar(col = "black",
lwd = 1.75))
}
}
}
}
trellis.unfocus()
}
lattice.options(default.theme = def.theme)
}
calendarHeat2(stock.data$Date, stock.data$Adj.Close, varname="MSFT Adjusted Close")
It's not a very extensible function. Howerver, you could do some surgery to insert the behavior you like. Assuming you are on a system where you can source the file from an https address, you could do
source("https://raw.githubusercontent.com/iascchen/VisHealth/master/R/calendarHeat.R")
Or you could use the httr library
library(httr)
cat(content(GET("https://raw.githubusercontent.com/iascchen/VisHealth/master/R/calendarHeat.R"), "text"), file="calendarHeat.R")
source("calendarHeat.R")
That will get you the original version of the file. Now we can make some changes
#copy
calendarHeat2<-calendarHeat
#insert line to calulate day number
bl<-as.list(body(calendarHeat2))
body(calendarHeat2) <- as.call(c(
bl[1:14],
quote(caldat$dom <- as.numeric(format(caldat$date.seq, "%d"))),
bl[-(1:14)]
))
#change call to level plot
lp<-as.list(body(calendarHeat2)[[c(32,2,3)]])
lp$dom <- quote(caldat$dom)
lp$panel <- quote(function(x,y,subscripts,dom,...) {
panel.levelplot(x,y,subscripts=subscripts,...)
panel.text(x[subscripts],y[subscripts],labels=dom[subscripts])
})
body(calendarHeat2)[[c(32,2,3)]]<-as.call(lp)
Now we can use this new version of the function to add date names
calendarHeat2(stock.data$Date, stock.data$Adj.Close, varname="MSFT Adjusted Close")
You can tweak the code how ever you like to adjust the printing of the date names by altering the custom panel function we created above.
Of course this edit is very fragile. If the source function changes at all, our surgery may break because we are pulling out chunks of code by index. So to be safe, after you get the function working the way you like, you should probably dump() your version of calendarHeat2 and source() it as needed.
20
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
