Skip to content

Commit 5ed0888

Browse files
englianhuenglianhu
committed
updated upon finished pre-bayesian
1 parent 943c0d4 commit 5ed0888

24 files changed

+333
-102
lines changed

‎data/pre.gsform.rds

2.74 KB
Binary file not shown.

‎data/pre.mse1.rds

8.13 KB
Binary file not shown.

‎function/draft2.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -71,9 +71,9 @@ fitgaum16.alpha08 <- read_rds(path = './data/fitgaum16.alpha08.rds')
7171
#>
7272
#> #create test data
7373
#> tstData <- t(cbind(c("H1", "H", 2, "pol", 185),
74-
# + c("M1", "M", 1, "pol", 115),
75-
# + c("M1", "M", 1, "inf", 118),
76-
# + c("F1", "F", 3, "inf", 210)))
74+
# c("M1", "M", 1, "pol", 115),
75+
# c("M1", "M", 1, "inf", 118),
76+
# c("F1", "F", 3, "inf", 210)))
7777
#>
7878
#> tstData <- data.frame(tstData,stringsAsFactors = F)
7979
#> colnames(tstData) <- colnames(trnData)

‎function/glmPrice.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ glmPrice <- function(mbase, family = 'gaussian', xy.matrix = 'h1', setform = 'l1
66
newx = NULL, pred.type = 'class', parallel = TRUE, .log = FALSE) {
77
## mbase = default quantmod xts format or in data frame format.
88
##
9-
## family = gaussian', 'binomial', 'poisson', 'multinomial', 'cox' and 'mgaussian'.
9+
## family = 'gaussian', 'binomial', 'poisson', 'multinomial', 'cox' and 'mgaussian'.
1010
##
1111
## xy.matrix = 'h1' or xy.matrix = 'h2'. setting x and y variables.
1212
##

‎function/loadLAD.R

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -13,21 +13,21 @@ loadLAD <- function(latestDate = NULL, dataSizeDay = 365) {
1313
suppressAll(library('tidyquant'))
1414

1515
## check if the saved dataset is today's data? if previous day then need to scrap from website.
16-
#'@ if(file.exists('./data/LAD.rds')) {
17-
#'@ if(readRDS('./data/LAD.rds') %>% attributes %>% .$updated %>% as.Date < today()) {
18-
#'@ tryCatch({
19-
#'@ suppressAll(getSymbols('LAD', from = '2015-01-01'))
20-
#'@ }, error = function(e) stop('Kindly restart the shiny app.'))
21-
#'@ suppressAll(getSymbols('LAD', from = '2015-01-01'))
22-
#'@ saveRDS(LAD, file = './data/LAD.rds')
23-
#'@
24-
#'@ } else {
25-
#'@ LAD <- read_rds(path = './data/LAD.rds')
26-
#'@ }
27-
#'@ } else {
28-
#'@ suppressAll(getSymbols('LAD', from = '2015-01-01'))
29-
#'@ saveRDS(LAD, file = './data/LAD.rds')
30-
#'@ }
16+
if(file.exists('./data/LAD.rds')) {
17+
if(readRDS('./data/LAD.rds') %>% attributes %>% .$updated %>% as.Date < today()) {
18+
tryCatch({
19+
suppressAll(getSymbols('LAD', from = '2015-01-01'))
20+
}, error = function(e) stop('Kindly restart the shiny app.'))
21+
suppressAll(getSymbols('LAD', from = '2015-01-01'))
22+
saveRDS(LAD, file = './data/LAD.rds')
23+
24+
} else {
25+
LAD <- read_rds(path = './data/LAD.rds')
26+
}
27+
} else {
28+
suppressAll(getSymbols('LAD', from = '2015-01-01'))
29+
saveRDS(LAD, file = './data/LAD.rds')
30+
}
3131
dataSizeDay <- as.numeric(dataSizeDay)
3232

3333
if(is.null(latestDate)) {
@@ -39,9 +39,9 @@ loadLAD <- function(latestDate = NULL, dataSizeDay = 365) {
3939

4040
## check if the saved dataset is today's data? if previous day then need to scrap from website.
4141
## http://mazamascience.com/WorkingWithData/?p=912
42-
tryCatch({
43-
suppressAll(getSymbols('LAD', from = dateRange[1]))
44-
}, error = function(e) suppressAll(getSymbols('LAD', from = dateRange[1], source = 'google')))
42+
#'@ tryCatch({
43+
#'@ suppressAll(getSymbols('LAD', from = dateRange[1]))
44+
#'@ }, error = function(e) suppressAll(getSymbols('LAD', from = dateRange[1], source = 'google')))
4545

4646
if(exists('LAD')) {
4747
saveRDS(LAD, file = './data/LAD.rds')

‎function/plotChart2.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ plotChart2 <- function(Fund, type = 'multiple', event = NULL, event.dates = NULL
6969
fname <- names(Op(Fund)) %>% str_replace_all('.Open', '')
7070

7171
plotc <- plotch %>%
72-
hc_title(text = "LadbrokesCoral PLC") %>%
72+
hc_title(text = "Lithia Auto Stores") %>%
7373
hc_subtitle(text = paste0("Candle stick chart with initial stock price : ",
7474
paste0(initial, collapse = ', '))) %>%
7575
hc_yAxis_multiples(
@@ -166,7 +166,7 @@ plotChart2 <- function(Fund, type = 'multiple', event = NULL, event.dates = NULL
166166

167167
plotc <- paste0(
168168
'highchart(type = \'stock\') %>% ',
169-
'hc_title(text = \'LadbrokesCoral PLC\') %>% ',
169+
'hc_title(text = \'Lithia Auto Stores\') %>% ',
170170
'hc_subtitle(text = paste0(\'Multiple funds trend chart initial stock price : \', paste0(initial, collapse = \', \'))) %>% ',
171171
paste0('hc_add_series_xts(Fund[,', seq(fname), '], name = \'', fname,'\', id = \'', fname, '\')', collapse = ' %>% '),
172172
' %>% hc_add_series_flags(event.dates, title = paste0(\'E\', event), text = paste(\'Event : High volatility \', event), id = id) %>% hc_add_theme(hc_theme_flat());')

‎function/simulateModels.R

Lines changed: 91 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,12 @@ bsGSfit <- llply(dateID, function(dt) {
5252
if(!dir.exists(pth)) dir.create(pth)
5353

5454
## predict dateID onwards from data < dateID
55-
smp = filter(LADDT, Date < dt & Date >= (dt - years(1)))
55+
## for example : in order to predict today price, I used the data from
56+
## 1 years (365 days or 366 days for leap years.) ago from yesterday.
57+
#'@ ymd("2016-2-29") %m-% years(1)
58+
## http://stackoverflow.com/questions/8490799/how-to-account-for-leap-years
59+
60+
smp = filter(LADDT, Date < dt & Date >= (dt %m-% years(1)))
5661
gsfit = compStocks(smp, family = families[1], xy.matrix = 'h2', yv.lm = c(TRUE, FALSE),
5762
yv = c('open1', 'open2', 'high1', 'high2', 'low1', 'low2', 'close1', 'close2', 'daily.mean1', 'daily.mean2', 'daily.mean3', 'mixed1', 'mixed2', 'mixed3'),
5863
pred.type = 'class', .print = TRUE, .save = TRUE, pth = pth)
@@ -110,21 +115,96 @@ bsGSfit <- llply(dateID, function(dt) {
110115
}
111116
})
112117

118+
## ================================= Save Basic Model ========================================
119+
## Arrange the best fit and save the model summary.
120+
files <- list.files('./data', pattern = '[0-9]{8}')
121+
#'@ pth <- paste0('./data/', files, '/fitgaum.mse1.rds')
122+
123+
## list all daily minimum standard error models.
124+
pre.mse1 <- ldply(files, function(x) {
125+
y = read_rds(path = paste0('./data/', x, '/fitgaum.mse1.rds'))
126+
y %>% data.frame(Date = x, .) %>% tbl_df %>% filter(mse == min(mse))
127+
}) %>% tbl_df
128+
129+
## filter and only get first unique element since the mse is same.
130+
#'@ unique(pre.mse1[c('Date', 'model', 'mse')])
131+
pre.mse1 <- pre.mse1[!duplicated(pre.mse1$Date, pre.mse1$mse), ]
132+
saveRDS(pre.mse1, file = './data/pre.mse1.rds')
133+
#> pre.mse1
134+
# A tibble: 517 × 4
135+
# Date .id model mse
136+
# <fctr> <chr> <fctr> <dbl>
137+
#1 20150102 fitgaum119 mse9 0.1209190
138+
#2 20150105 fitgaum135 mse9 0.1211786
139+
#3 20150106 fitgaum132 mse3 0.1210193
140+
#4 20150107 fitgaum81 mse8 0.1221952
141+
#5 20150108 fitgaum144 mse3 0.1220447
142+
#6 20150109 fitgaum27 mse3 0.1210785
143+
#7 20150112 fitgaum129 mse3 0.1211022
144+
#8 20150113 fitgaum17 mse3 0.1214222
145+
#9 20150114 fitgaum28 mse3 0.1215031
146+
#10 20150115 fitgaum18 mse3 0.1208796
147+
148+
## list all daily minimum standard error models' formula.
149+
pre.gsform <- ldply(files, function(x) {
150+
y = read_rds(path = paste0('./data/', x, '/fitgaum.form.rds'))
151+
z = paste0(substr(x, 1, 4), '-', substr(x, 5, 6), '-', substring(x, nchar(x) - 1)) %>%
152+
ymd
153+
data.frame(Date = z, form = y) %>% tbl_df
154+
}) %>% tbl_df
155+
156+
## filter and only get first unique element since the mse is same.
157+
pre.gsform <- pre.gsform[!duplicated(pre.gsform$Date), ]
158+
saveRDS(pre.gsform, file = './data/pre.gsform.rds')
159+
160+
## ================================= Weighted Model ==========================================
161+
## Application bayesian as weighted function and MCMC for prediction.
162+
163+
## Read summary of the best fit model
164+
## From below table, we noted that the dynamic model required compare
165+
## to using constant model across the days as we can know from column `.id`.
166+
pre.mse1 <- read_rds(path = './data/pre.mse1.rds')
167+
#> pre.mse1
168+
# A tibble: 517 × 4
169+
# Date .id model mse
170+
# <fctr> <chr> <fctr> <dbl>
171+
#1 20150102 fitgaum119 mse9 0.1209190
172+
#2 20150105 fitgaum135 mse9 0.1211786
173+
#3 20150106 fitgaum132 mse3 0.1210193
174+
#4 20150107 fitgaum81 mse8 0.1221952
175+
#5 20150108 fitgaum144 mse3 0.1220447
176+
#6 20150109 fitgaum27 mse3 0.1210785
177+
#7 20150112 fitgaum129 mse3 0.1211022
178+
#8 20150113 fitgaum17 mse3 0.1214222
179+
#9 20150114 fitgaum28 mse3 0.1215031
180+
#10 20150115 fitgaum18 mse3 0.1208796
181+
182+
## Read best fit model.
183+
pre.gsform <- read_rds(path = './data/pre.gsform.rds')
184+
185+
186+
## ============================== Save Weighted Model ========================================
187+
## Arrange the best fit and save the data.
188+
##
189+
llply(seq(nrow(pre.mse1)), function(i) {
190+
y = read_rds(path = paste0('./data/', pre.mse1$Date[i], '/', pre.mse1$.id[i], '.rds'))
191+
j = filter(y$mse, mse == pre.mse1$mse[i]) %>% .$model %>% str_replace_all('mse', '') %>%
192+
as.numeric
193+
y$yhat[j] %>% unlist
194+
})
113195

196+
files <- list.files('./data/20150102/', pattern = 'fitgaum+[0-9]{1,}.rds$')
114197

198+
wt <- ldply(files, function(x) {
199+
y = read_rds(path = paste0('./data/', x, '/', x))
200+
y %>% data.frame(Date = x, .) %>% tbl_df %>% filter(mse == min(mse))
201+
}) %>% tbl_df
115202

116203

117204

118-
119-
## ================================= Weighted Model ===========================================
120-
121-
122-
123-
124-
125-
126-
127-
205+
## ==================================== MCMC Model ===========================================
206+
## Application of MCMC to simulate the Profit and Loss of opt.Kelly() and optimal.f()
207+
## staking model.
128208

129209

130210

‎global.R

Lines changed: 14 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ suppressAll(library('PerformanceAnalytics'))
2727
suppressAll(library('memoise'))
2828
suppressAll(library('glmnet'))
2929
suppressAll(library('forecast'))
30+
suppressAll(library('RCurl'))
3031

3132
suppressAll(source('./function/loadLAD.R'))
3233
suppressAll(source('./function/filterLAD.R'))
@@ -37,14 +38,25 @@ suppressAll(source('./function/plotChart2.R'))
3738
## ========= Read Data =================================
3839
eval(parse(text = paste0('datam = loadLAD(); LAD = datam$LAD; LADDT = datam$LADDT; rm(datam)')))
3940

40-
## use 365 days dataset.
41+
## use 365 days dataset but using predict().
4142
## need to modify... temporarily use since baseline * times the coef rates will be consider as a weighted models but need to test.
4243
tmpsumgs <- read_rds(path = './data/tmpsumgs.rds') %>% tbl_df
4344
#'@ tmptable <- read_rds(path = './data/tmptable.rds') %>% tbl_df
4445
#'@ tmpgsfit <- read_rds(path = './data/tmpgsfit.rds') #file too big and heavily to load, need to only pick the best fit.
45-
tmpgsform <- read_rds(path = './data/tmpgsform.rds')
46+
#'@ tmpgsform <- read_rds(path = './data/tmpgsform.rds')
4647
fitgaum16.alpha08 <- read_rds(path = './data/fitgaum16.alpha08.rds')
4748

4849
#'@ fitgaum193.alpha08 <- read_rds(path = './data/fitgaum193.alpha08.rds')
4950

51+
## Use 365 days dataset for time series model.
52+
pre.mse1 <- read_rds(path = './data/pre.mse1.rds')
53+
54+
## Read best fit model.
55+
pre.gsform <- read_rds(path = './data/pre.gsform.rds')
56+
57+
58+
59+
60+
61+
5062

‎reference/Quantitative-Analyst-job-at-Binary.pdf

298 KB
Binary file not shown.

‎rsconnect/beta.rstudioconnect.com/englianhu/binary-question.dcf

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,9 @@ title: binary-question
33
account: englianhu
44
server: beta.rstudioconnect.com
55
appId: 2367
6-
bundleId: 5119
6+
bundleId: 5222
77
url: https://beta.rstudioconnect.com/content/2367/
8-
when: 1484894707.72317
8+
when: 1485946421.7399
99
asMultiple: FALSE
1010
asStatic: FALSE
11-
ignoredFiles: data/AAPL.rds|data/alfit.rds|data/bnfit.rds|data/cxfit.rds|data/fitgaum1410.rds|data/fitgaum193.rds|data/gsfit.rds|data/mgfit.rds|data/mnfit.rds|data/psfit.rds
11+
ignoredFiles: data/AAPL.rds|data/alfit.rds|data/bnfit.rds|data/cxfit.rds|data/fitgaum1410.rds|data/fitgaum193.rds|data/gsfit.rds|data/mgfit.rds|data/mnfit.rds|data/psfit.rds|function/opt.glmPrice.R

0 commit comments

Comments
 (0)