更改Calendar Heatmap中的颜色

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仍然需要相当多的手动操作。

价格？

我假设您提供的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)}
    )
  )
)

思想

虽然上述“有效”，但仍有许多方面有待改进。我会留给你的。