2017-04-18 7 views
1

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 = '$$' 
) 

enter image description here 이 다음 코드와 출력 전이?

감사

+0

아마도 http://durtal.github.io/calheatmapR/chLegend.html이 도움이 될 수 있습니다. – timelyportfolio

답변

0

calheatmapR

이 솔루션은 옵션의보다 완전한 범위를 허용 calheatmapR를 사용합니다. 그러나 calheatmapR에는 아직도 많은 수작업 조작이 필요합니다.

가격이?

귀하가 제공 한 데이터를 재현 가능성에 대한 것으로 가정합니다 (AAPL). ROC 대신에 가격을 사용하는 것은 나에게 많은 의미가 없지만, 예를 들어 가격을 사용하여 원래 사례를 고수합니다. 내가 경고했듯이 올바른 형식으로 데이터를 가져 오기 위해서는 추악한 수동 조작이 필요합니다.

한 나는 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)} 
    ) 
) 
) 

partial screenshot

생각

위는 "작동"하지만 여전히 개선의 많은 지역이있다. 내가 너에게 맡길거야.