Source of project : https://github.com/scibrokes/betting-strategy-and-model-validation
Error : https://github.com/jbkunst/highcharter/issues/226
suppressPackageStartupMessages(library('devtools'))
session_info()$packages## package * version date source
## backports 1.0.4 2016-10-24 CRAN (R 3.3.1)
## devtools * 1.12.0 2016-06-24 CRAN (R 3.3.1)
## digest 0.6.10 2016-08-02 CRAN (R 3.3.1)
## evaluate 0.10 2016-10-11 CRAN (R 3.3.1)
## htmltools 0.3.5 2016-03-21 CRAN (R 3.3.1)
## knitr 1.15.1 2016-11-22 CRAN (R 3.3.2)
## magrittr 1.5 2016-10-31 Github (smbache/magrittr@cf2e33f)
## memoise 1.0.0 2016-01-29 CRAN (R 3.3.0)
## Rcpp 0.12.8 2016-11-17 CRAN (R 3.3.2)
## rmarkdown 1.2 2016-11-21 CRAN (R 3.3.2)
## rprojroot 1.1 2016-10-29 CRAN (R 3.3.2)
## stringi 1.1.2 2016-10-01 CRAN (R 3.3.1)
## stringr 1.1.0 2016-08-19 CRAN (R 3.3.1)
## withr 1.0.2 2016-06-20 CRAN (R 3.3.1)
## yaml 2.1.14 2016-11-12 CRAN (R 3.3.2)compareKelly() but Dismembered plotChart()compareKelly() is a function which convert a data frame into quantmod’s xts format.
xts format and call plotChart() and plot a gaph, then display as a return value.xts format as return value.plotChart() is a function with a graphical return value.
You can get hthe source codes of the functions in Source of project.
## Due to the highcharter::highchart() return function
suppressPackageStartupMessages(library('BBmisc'))
suppressAll(library('plyr'))
suppressAll(library('magrittr'))
suppressAll(library('tidyverse'))
suppressAll(library('quantmod'))
suppressMessages(library('highcharter'))
suppressAll(source('./function/compareKelly.R', local = TRUE))
if(file.exists('./data/K1D1.rds')){
K1D1 <- read_rds(path = './data/K1D1.rds')
} else {
K1D1 <- vKelly(dat)
}
#'@ compareKelly(K1, chart = TRUE, type = 'multiple') # workable if run in chunk but but not in knit.
#'@ suppressAll(source('./function/plotChart.R', local = TRUE))
Fund <- compareKelly(K1D1)$Kelly1
event.dates = as.Date(period.apply(
diff(Op(Fund)), INDEX = endpoints(Fund), FUN = max) %>% data.frame %>% rownames, format = '%Y-%m-%d')
event = seq(length(event.dates)); chart.type = NULL
## put remarks on big gap within highest and lowest within a day.
#'@ event <- Hi(Fund) - Lo(Fund) # need to modify...
# single chart high-low candle stick might need to
# label the reason and event to cause a hight volatility.
initial <- Op(Fund)[1, ] %>% unique
chart.type <- ifelse(is.null(chart.type), 'Cl', chart.type)
## comparison of fund size and growth of various Kelly models
#'@ event <- c('netEMEdge', 'PropHKPriceEdge', 'PropnetProbBEdge', 'KProbHKPrice',
#'@ 'KProbnetProbB', 'KProbFixed', 'KProbFixednetProbB', 'KEMProb',
#'@ 'KEMProbnetProbB', 'KProbHalf','KProbHalfnetProbB', 'KProbQuarter',
#'@ 'KProbQuarternetProbB', 'KProbAdj','KProbAdjnetProbB', 'KHalfAdj',
#'@ 'KHalfAdjnetProbB', 'KEMQuarterAdj', 'KEMQuarterAdjnetProbB')
## add dates for event...
## label the high volatility daily event.
if(is.null(event.dates)) {
event.dates <- as.Date(period.apply(
diff(Op(Fund)), INDEX = endpoints(Fund), FUN = max) %>% data.frame %>%
rownames, format = '%Y-%m-%d')
} else {
event.dates <- as.Date(event.dates)
}
## id of event label, event text
id <- seq(length(event.dates))
if(is.null(event)) {
event <- id
} else {
event <- event
}
if(length(event) == length(event.dates)) {
event <- event
event.dates <- event.dates
} else {
stop('The vector length of event must be same with vector length of event.dates.')
}
if(chart.type == 'Op') {
Fund <- Op(Fund)
} else if(chart.type == 'Hi') {
Fund <- Hi(Fund)
} else if(chart.type == 'Lo') {
Fund <- Lo(Fund)
} else if(chart.type == 'Cl') {
Fund <- Cl(Fund)
} else {
stop('Kindly choose chart.type = "Op", chart.type = "Hi", chart.type = "Lo", chart.type = "Cl".')
}
plotc <- highchart(type = "stock") %>%
hc_title(text = "Charting some Funds") %>%
hc_subtitle(text = paste("Data extracted using various Kelly functions. Initial fund size : $", initial)) %>%
hc_add_series_xts(Fund[, 1], id = names(Fund)[1]) %>%
hc_add_series_xts(Fund[, 2], id = names(Fund)[2]) %>%
hc_add_series_xts(Fund[, 3], id = names(Fund)[3]) %>%
hc_add_series_xts(Fund[, 4], id = names(Fund)[4]) %>%
hc_add_series_xts(Fund[, 5], id = names(Fund)[5]) %>%
hc_add_series_xts(Fund[, 6], id = names(Fund)[6]) %>%
hc_add_series_xts(Fund[, 7], id = names(Fund)[7]) %>%
hc_add_series_xts(Fund[, 8], id = names(Fund)[8]) %>%
hc_add_series_xts(Fund[, 9], id = names(Fund)[9]) %>%
hc_add_series_xts(Fund[,10], id = names(Fund)[10]) %>%
hc_add_series_xts(Fund[,11], id = names(Fund)[11]) %>%
hc_add_series_xts(Fund[,12], id = names(Fund)[12]) %>%
hc_add_series_xts(Fund[,13], id = names(Fund)[13]) %>%
hc_add_series_xts(Fund[,14], id = names(Fund)[14]) %>%
hc_add_series_xts(Fund[,15], id = names(Fund)[15]) %>%
hc_add_series_xts(Fund[,16], id = names(Fund)[16]) %>%
hc_add_series_xts(Fund[,17], id = names(Fund)[17]) %>%
hc_add_series_xts(Fund[,18], id = names(Fund)[18]) %>%
hc_add_series_xts(Fund[,19], id = names(Fund)[19]) %>%
## add event remarks onto the chart.
hc_add_series_flags(event.dates, title = paste0('E', event), #label of the event box
text = paste('Event : High volatility ', event), id = id) %>% #text inside the event box
hc_add_theme(hc_theme_flat())
plotc compareKelly() and plotChart() independently (in list format)# workable if run in chunk but but not in knit.
suppressPackageStartupMessages(library('BBmisc'))
suppressAll(library('quantmod'))
suppressAll(library('readr'))
suppressAll(source('./function/compareKelly.R', local = TRUE))
if(file.exists('./data/K1D1.rds')){
K1D1 <- read_rds(path = './data/K1D1.rds')
} else {
K1D1 <- vKelly(dat)
}
#'@ compareKelly(K1, chart = TRUE, type = 'multiple') # workable if run in chunk but but not in knit.
#'@ source('./function/detach_package.R')
suppressAll(source('./function/plotChart.R', local = TRUE))
fund <- compareKelly(K1D1)
plotFund <- llply(fund, function(x) {
event.dates = as.Date(period.apply(
diff(Op(x)), INDEX = endpoints(x), FUN = max) %>% data.frame %>% rownames, format = '%Y-%m-%d')
plotChart(x, type = 'multiple', event.dates = event.dates,
event = seq(length(event.dates)), chart.type = 'Cl')
})# workable if run in chunk but but not in knit.
#'@ invisible(plotFund)
plotFund## $Kelly1
##
## $Kelly2
##
## $Kelly3
##
## $Kelly4compareKelly() and plotChart() independently (in data frame seperately)# workable if run in chunk but but not in knit.
suppressPackageStartupMessages(library('BBmisc'))
suppressAll(library('quantmod'))
suppressAll(library('readr'))
suppressAll(source('./function/compareKelly.R', local = TRUE))
if(file.exists('./data/K1D1.rds')){
K1D1 <- read_rds(path = './data/K1D1.rds')
} else {
K1D1 <- vKelly(dat)
}
suppressAll(source('./function/plotChart.R', local = TRUE))
fund <- compareKelly(K1D1)
plotChart(fund$Kelly1, type = 'multiple')plotChart(fund$Kelly2, type = 'multiple')plotChart(fund$Kelly3, type = 'multiple')plotChart(fund$Kelly4, type = 'multiple')compareKelly() and Call plotChart() as Internal Function#'@ suppressPackageStartupMessages(library('plyr'))
#'@ suppressPackageStartupMessages(library('magrittr'))
#'@ suppressPackageStartupMessages(library('tidyverse'))
suppressPackageStartupMessages(source('./function/compareKelly.R'))
if(file.exists('./data/K1D1.rds')){
K1D1 <- readRDS(file = './data/K1D1.rds')
} else {
K1D1 <- vKelly(dat)
}
# workable if run in chunk but but not in knit.
compareKelly(K1D1, chart = TRUE, type = 'multiple')## $Kelly1
##
## $Kelly2
##
## $Kelly3
##
## $Kelly4