将日期添加到日历热图R中
我正在使用Paul Bleicher's calenderHeat.R code绘制日历热图，这是我的情节：
我想知道如何在剧情中添加日期，而不是空白网格。这是我的示例数据：
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))
和生成情节的代码：
calendarHeat(stock.data$Date, stock.data$Adj.Close, varname="MSFT Adjusted Close")
我已经在互联网上搜索并尝试了我自己，但我得到的最接近的解决方案是添加如此字母：
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')
请帮我添加月份的日期。提前谢谢。
2 个答案:
答案 0 :(得分：10)
这不是一个非常可扩展的功能。然后，你可以做一些手术来插入你喜欢的行为。假设您所在的系统可以从https地址获取文件，则可以执行
source("https://raw.githubusercontent.com/iascchen/VisHealth/master/R/calendarHeat.R")
或者您可以使用httr库
library(httr)
cat(content(GET("https://raw.githubusercontent.com/iascchen/VisHealth/master/R/calendarHeat.R"), "text"), file="calendarHeat.R")
source("calendarHeat.R")
这将为您提供该文件的原始版本。现在我们可以做一些改变
#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)
现在我们可以使用这个新版本的函数来添加日期名称
calendarHeat2(stock.data$Date, stock.data$Adj.Close, varname="MSFT Adjusted Close")
您可以通过更改我们上面创建的自定义面板功能来调整代码，以便调整日期名称的打印。
当然这个编辑非常脆弱。如果源函数完全改变，我们的手术可能会中断，因为我们正在通过索引提取代码块。为了安全起见，在您按照自己喜欢的方式运行功能后，您可能应该dump() calendarHeat2版本source()并根据需要使用{{1}}。
答案 1 :(得分：2)
我喜欢answer MrFlick，但我正在寻找一些不那么混乱的东西，所以我尝试在周日的情况下打印一个月的日子：
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")
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？