更改日历热图中的颜色
问题描述:
我正在使用名为rChartsCalmap
的程序包。这是下面的代码输出:更改日历热图中的颜色
library(devtools)
install.packages('htmlwidgets')
install.packages(c("curl", "httr"))
install_github("ramnathv/rChartsCalmap")
library(rChartsCalmap)
例子在这里找到:
https://github.com/ramnathv/rChartsCalmap
library(quantmod)
getSymbols("AAPL")
xts_to_df <- function(xt){
data.frame(
date = format(as.Date(index(xt)), '%Y-%m-%d'),
coredata(xt)
)
}
dat = xts_to_df(AAPL)
calheatmap('date', 'AAPL.Adjusted',
data = dat,
domain = 'month',
legend = seq(500, 700, 40),
start = '2014-01-01',
itemName = '$$'
)
由于
答
calheatmapR
此解决方案使用calheatmapR
其允许的选项的更完整的范围。但是,calheatmapR
仍然需要相当多的手动操作。
Prices?
我假设您提供AAPL
数据用于重现性。使用价格而不是ROC
对我来说没有多大意义,但我在我的示例中使用价格来坚持原始示例。正如我所警告的那样,需要进行一些丑陋的手动操作才能以正确的格式获取数据。
一个日历热图
我会做一个日历热图的一年开始。
# devtools::install_github("durtal/calheatmapR")
library(calheatmapR)
library(quantmod)
getSymbols("AAPL")
aapl_list <- lapply(as.vector(AAPL[,6]), identity)
names(aapl_list) <- as.character(
as.numeric(index(AAPL)) * 60 * 60 * 24 +
6 * 60 * 60 # timezone adjustment (I am in GMT - 6)
)
calheatmapR(data = aapl_list) %>%
chDomain(
domain = "month",
subDomain = "day",
start = (as.numeric(as.Date("2016-01-01")) * 24 * 60 * 60 + 6 * 60 * 60) * 1000,
range = 12
) %>%
chLabel(position = "top", itemName = "") %>%
chLegend(
legend = pretty(quantile(AAPL[,6],seq(0,1,.1))),
colours = list(
min = RColorBrewer::brewer.pal(n=9,"Blues")[1],
max = RColorBrewer::brewer.pal(n=9,"Blues")[9],
empty = "#424242"
)
)
所有的年份
我假设你想使每一年的日历热图,所以下一个代码位将采用快速的功能,这样我们就可以做到这一点。
# now let's make a function so we can one for each year
library(htmltools)
year_map <- function(year) {
aapl_list <- lapply(as.vector(AAPL[year,6]), identity)
names(aapl_list) <- as.character(
as.numeric(index(AAPL[year,])) * 60 * 60 * 24 +
6 * 60 * 60 # timezone adjustment (I am in GMT - 6)
)
tags$div(
tags$h1(year),
calheatmapR(data = aapl_list, height = "auto") %>%
chDomain(
domain = "month",
subDomain = "day",
start = (as.numeric(as.Date(paste0(year,"-01-01"))) * 24 * 60 * 60 + 6 * 60 * 60) * 1000, # in milliseconds with time zone adjustment
range = 12
) %>%
chLabel(position = "top", itemName = "") %>%
chLegend(
legend = pretty(quantile(AAPL[,6],seq(0,1,.1))),
colours = list(
min = RColorBrewer::brewer.pal(n=9,"Blues")[1],
max = RColorBrewer::brewer.pal(n=9,"Blues")[9],
empty = "#424242"
)
)
)
}
browsable(
tagList(
lapply(
unique(format(index(AAPL),"%Y")),
function(yr) {year_map(yr)}
)
)
)
思考
虽然上面的 “作品”,仍然有改进的地方。我会把这些留给你的。
也许http://durtal.github.io/calheatmapR/chLegend.html可能有帮助 – timelyportfolio