更改日历热图中的颜色

Question

我正在使用名为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 = '$$' 
) 

如何改变颜色，使其从红色到绿色的一个不错过渡？

由于

Answer 1

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

思考

虽然上面的 “作品”，仍然有改进的地方。我会把这些留给你的。