カレンダーヒートマップの色を変更する

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の代わりに価格を使用することは、私にはあまり意味がありませんが、私の例では、元の例に固執するために価格を使用しています。私が警告したように、正しいフォーマットでデータを取得するには、いくつかの醜い手動操作が必要です。

1本のカレンダーのヒートマップ

私は1年のカレンダーのヒートマップを作ることから始めます。

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

思考

上記の "作品" しながら、改善の多くの分野が残っています。私はあなたにそれらを残します。