updated upon finished pre-bayesian

Author: englianhu

data/pre.gsform.rds

@@ -71,9 +71,9 @@ fitgaum16.alpha08 <- read_rds(path = './data/fitgaum16.alpha08.rds')
 #> 
 #> #create test data
 #> tstData <- t(cbind(c("H1", "H", 2, "pol", 185),
-#                       +                    c("M1", "M", 1, "pol", 115),
-#                       +                    c("M1", "M", 1, "inf", 118),
-#                       +                    c("F1", "F", 3, "inf", 210)))
+#                     c("M1", "M", 1, "pol", 115),
+#                     c("M1", "M", 1, "inf", 118),
+#                     c("F1", "F", 3, "inf", 210)))
 #> 
 #> tstData <- data.frame(tstData,stringsAsFactors = F)
 #> colnames(tstData) <- colnames(trnData)

data/pre.mse1.rds

@@ -6,7 +6,7 @@ glmPrice <- function(mbase, family = 'gaussian', xy.matrix = 'h1', setform = 'l1
                      newx = NULL, pred.type = 'class', parallel = TRUE, .log = FALSE) {
   ## mbase = default quantmod xts format or in data frame format.
   ## 
-  ## family = gaussian', 'binomial', 'poisson', 'multinomial', 'cox' and 'mgaussian'.
+  ## family = 'gaussian', 'binomial', 'poisson', 'multinomial', 'cox' and 'mgaussian'.
   ## 
   ## xy.matrix = 'h1' or xy.matrix = 'h2'. setting x and y variables.
   ## 

function/draft2.R

@@ -13,21 +13,21 @@ loadLAD <- function(latestDate = NULL, dataSizeDay = 365) {
   suppressAll(library('tidyquant'))
 
   ## check if the saved dataset is today's data? if previous day then need to scrap from website.
-  #'@ if(file.exists('./data/LAD.rds')) {
-  #'@   if(readRDS('./data/LAD.rds') %>% attributes %>% .$updated %>% as.Date < today()) {
-      #'@ tryCatch({
-      #'@   suppressAll(getSymbols('LAD', from = '2015-01-01'))
-      #'@ }, error = function(e) stop('Kindly restart the shiny app.'))
-  #'@     suppressAll(getSymbols('LAD', from = '2015-01-01'))
-  #'@     saveRDS(LAD, file = './data/LAD.rds')
-  #'@     
-  #'@   } else {
-  #'@     LAD <- read_rds(path = './data/LAD.rds')
-  #'@   }
-  #'@ } else {
-  #'@   suppressAll(getSymbols('LAD', from = '2015-01-01'))
-  #'@   saveRDS(LAD, file = './data/LAD.rds')
-  #'@ }
+  if(file.exists('./data/LAD.rds')) {
+    if(readRDS('./data/LAD.rds') %>% attributes %>% .$updated %>% as.Date < today()) {
+      tryCatch({
+        suppressAll(getSymbols('LAD', from = '2015-01-01'))
+        }, error = function(e) stop('Kindly restart the shiny app.'))
+      suppressAll(getSymbols('LAD', from = '2015-01-01'))
+      saveRDS(LAD, file = './data/LAD.rds')
+  
+      } else {
+        LAD <- read_rds(path = './data/LAD.rds')
+        }
+    } else {
+      suppressAll(getSymbols('LAD', from = '2015-01-01'))
+      saveRDS(LAD, file = './data/LAD.rds')
+      }
   dataSizeDay <- as.numeric(dataSizeDay)
 
   if(is.null(latestDate)) {
@@ -39,9 +39,9 @@ loadLAD <- function(latestDate = NULL, dataSizeDay = 365) {
 
   ## check if the saved dataset is today's data? if previous day then need to scrap from website.
   ## http://mazamascience.com/WorkingWithData/?p=912
-  tryCatch({
-    suppressAll(getSymbols('LAD', from = dateRange[1]))
-    }, error = function(e) suppressAll(getSymbols('LAD', from = dateRange[1], source = 'google')))
+  #'@ tryCatch({
+  #'@   suppressAll(getSymbols('LAD', from = dateRange[1]))
+  #'@   }, error = function(e) suppressAll(getSymbols('LAD', from = dateRange[1], source = 'google')))
 
   if(exists('LAD')) {
     saveRDS(LAD, file = './data/LAD.rds')

function/glmPrice.R

@@ -69,7 +69,7 @@ plotChart2 <- function(Fund, type = 'multiple', event = NULL, event.dates = NULL
     fname <- names(Op(Fund)) %>% str_replace_all('.Open', '')
 
     plotc <- plotch %>% 
-      hc_title(text = "LadbrokesCoral PLC") %>% 
+      hc_title(text = "Lithia Auto Stores") %>% 
       hc_subtitle(text = paste0("Candle stick chart with initial stock price : ", 
                                 paste0(initial, collapse = ', '))) %>% 
       hc_yAxis_multiples(
@@ -166,7 +166,7 @@ plotChart2 <- function(Fund, type = 'multiple', event = NULL, event.dates = NULL
 
     plotc <- paste0(
       'highchart(type = \'stock\') %>% ', 
-      'hc_title(text = \'LadbrokesCoral PLC\') %>% ', 
+      'hc_title(text = \'Lithia Auto Stores\') %>% ', 
       'hc_subtitle(text = paste0(\'Multiple funds trend chart initial stock price : \', paste0(initial, collapse = \', \'))) %>% ', 
       paste0('hc_add_series_xts(Fund[,', seq(fname), '], name = \'', fname,'\', id = \'', fname, '\')', collapse = ' %>% '), 
       ' %>% 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/loadLAD.R

@@ -52,7 +52,12 @@ bsGSfit <- llply(dateID, function(dt) {
   if(!dir.exists(pth)) dir.create(pth)
 
   ## predict dateID onwards from data < dateID
-  smp = filter(LADDT, Date < dt & Date >= (dt - years(1)))
+  ##   for example : in order to predict today price, I used the data from 
+  ##   1 years (365 days or 366 days for leap years.) ago from yesterday.
+  #'@ ymd("2016-2-29") %m-% years(1)
+  ## http://stackoverflow.com/questions/8490799/how-to-account-for-leap-years
+  
+  smp = filter(LADDT, Date < dt & Date >= (dt %m-% years(1)))
   gsfit = compStocks(smp, family = families[1], xy.matrix = 'h2', yv.lm = c(TRUE, FALSE), 
                      yv = c('open1', 'open2', 'high1', 'high2', 'low1', 'low2', 'close1', 'close2', 'daily.mean1', 'daily.mean2', 'daily.mean3', 'mixed1', 'mixed2', 'mixed3'), 
                      pred.type = 'class', .print = TRUE, .save = TRUE, pth = pth)
@@ -110,21 +115,96 @@ bsGSfit <- llply(dateID, function(dt) {
   }
   })
 
+## ================================= Save Basic Model ========================================
+## Arrange the best fit and save the model summary.
+files <- list.files('./data', pattern = '[0-9]{8}')
+#'@ pth <- paste0('./data/', files, '/fitgaum.mse1.rds')
+
+## list all daily minimum standard error models.
+pre.mse1 <- ldply(files, function(x) {
+  y = read_rds(path = paste0('./data/', x, '/fitgaum.mse1.rds'))
+  y %>% data.frame(Date = x, .) %>% tbl_df %>% filter(mse == min(mse))
+}) %>% tbl_df
+
+## filter and only get first unique element since the mse is same.
+#'@ unique(pre.mse1[c('Date', 'model', 'mse')])
+pre.mse1 <- pre.mse1[!duplicated(pre.mse1$Date, pre.mse1$mse), ]
+saveRDS(pre.mse1, file = './data/pre.mse1.rds')
+#> pre.mse1
+# A tibble: 517 × 4
+#       Date        .id  model       mse
+#     <fctr>      <chr> <fctr>     <dbl>
+#1  20150102 fitgaum119   mse9 0.1209190
+#2  20150105 fitgaum135   mse9 0.1211786
+#3  20150106 fitgaum132   mse3 0.1210193
+#4  20150107  fitgaum81   mse8 0.1221952
+#5  20150108 fitgaum144   mse3 0.1220447
+#6  20150109  fitgaum27   mse3 0.1210785
+#7  20150112 fitgaum129   mse3 0.1211022
+#8  20150113  fitgaum17   mse3 0.1214222
+#9  20150114  fitgaum28   mse3 0.1215031
+#10 20150115  fitgaum18   mse3 0.1208796
+
+## list all daily minimum standard error models' formula.
+pre.gsform <- ldply(files, function(x) {
+  y = read_rds(path = paste0('./data/', x, '/fitgaum.form.rds'))
+  z = paste0(substr(x, 1, 4), '-', substr(x, 5, 6), '-', substring(x, nchar(x) - 1)) %>% 
+    ymd 
+  data.frame(Date = z, form = y) %>% tbl_df
+}) %>% tbl_df
+
+## filter and only get first unique element since the mse is same.
+pre.gsform <- pre.gsform[!duplicated(pre.gsform$Date), ]
+saveRDS(pre.gsform, file = './data/pre.gsform.rds')
+
+## ================================= Weighted Model ==========================================
+## Application bayesian as weighted function and MCMC for prediction.
+
+## Read summary of the best fit model
+## From below table, we noted that the dynamic model required compare 
+##   to using constant model across the days as we can know from column `.id`.
+pre.mse1 <- read_rds(path = './data/pre.mse1.rds')
+#> pre.mse1
+# A tibble: 517 × 4
+#       Date        .id  model       mse
+#     <fctr>      <chr> <fctr>     <dbl>
+#1  20150102 fitgaum119   mse9 0.1209190
+#2  20150105 fitgaum135   mse9 0.1211786
+#3  20150106 fitgaum132   mse3 0.1210193
+#4  20150107  fitgaum81   mse8 0.1221952
+#5  20150108 fitgaum144   mse3 0.1220447
+#6  20150109  fitgaum27   mse3 0.1210785
+#7  20150112 fitgaum129   mse3 0.1211022
+#8  20150113  fitgaum17   mse3 0.1214222
+#9  20150114  fitgaum28   mse3 0.1215031
+#10 20150115  fitgaum18   mse3 0.1208796
+
+## Read best fit model.
+pre.gsform <- read_rds(path = './data/pre.gsform.rds')
+
+
+## ============================== Save Weighted Model ========================================
+## Arrange the best fit and save the data.
+## 
+llply(seq(nrow(pre.mse1)), function(i) {
+  y = read_rds(path = paste0('./data/', pre.mse1$Date[i], '/', pre.mse1$.id[i], '.rds'))
+  j = filter(y$mse, mse == pre.mse1$mse[i]) %>% .$model %>% str_replace_all('mse', '') %>% 
+    as.numeric
+  y$yhat[j] %>% unlist
+  })
 
+files <- list.files('./data/20150102/', pattern = 'fitgaum+[0-9]{1,}.rds$')
 
+wt <- ldply(files, function(x) {
+  y = read_rds(path = paste0('./data/', x, '/', x))
+  y %>% data.frame(Date = x, .) %>% tbl_df %>% filter(mse == min(mse))
+}) %>% tbl_df
 
 
 
-
-## ================================= Weighted Model ===========================================
-
-
-
-
-
-
-
-
+## ==================================== MCMC Model ===========================================
+## Application of MCMC to simulate the Profit and Loss of opt.Kelly() and optimal.f() 
+##   staking model.
 
 
 

function/plotChart2.R

@@ -27,6 +27,7 @@ suppressAll(library('PerformanceAnalytics'))
 suppressAll(library('memoise'))
 suppressAll(library('glmnet'))
 suppressAll(library('forecast'))
+suppressAll(library('RCurl'))
 
 suppressAll(source('./function/loadLAD.R'))
 suppressAll(source('./function/filterLAD.R'))
@@ -37,14 +38,25 @@ suppressAll(source('./function/plotChart2.R'))
 ## ========= Read Data =================================
 eval(parse(text = paste0('datam = loadLAD(); LAD = datam$LAD; LADDT = datam$LADDT; rm(datam)')))
 
-## use 365 days dataset.
+## use 365 days dataset but using predict().
 ## need to modify... temporarily use since baseline * times the coef rates will be consider as a weighted models but need to test. 
 tmpsumgs <- read_rds(path = './data/tmpsumgs.rds') %>% tbl_df
 #'@ tmptable <- read_rds(path = './data/tmptable.rds') %>% tbl_df
 #'@ tmpgsfit <- read_rds(path = './data/tmpgsfit.rds') #file too big and heavily to load, need to only pick the best fit.
-tmpgsform <- read_rds(path = './data/tmpgsform.rds')
+#'@ tmpgsform <- read_rds(path = './data/tmpgsform.rds')
 fitgaum16.alpha08 <- read_rds(path = './data/fitgaum16.alpha08.rds')
 
 #'@ fitgaum193.alpha08 <- read_rds(path = './data/fitgaum193.alpha08.rds')
 
+## Use 365 days dataset for time series model.
+pre.mse1 <- read_rds(path = './data/pre.mse1.rds')
+
+## Read best fit model.
+pre.gsform <- read_rds(path = './data/pre.gsform.rds')
+
+
+
+
+
+
 

function/simulateModels.R

@@ -3,9 +3,9 @@ title: binary-question
 account: englianhu
 server: beta.rstudioconnect.com
 appId: 2367
-bundleId: 5119
+bundleId: 5222
 url: https://beta.rstudioconnect.com/content/2367/
-when: 1484894707.72317
+when: 1485946421.7399
 asMultiple: FALSE
 asStatic: FALSE
-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
+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

global.R

@@ -92,8 +92,22 @@ server <- shinyServer(function(input, output, session) {
     })
   })
 
+  output$jobdes <- renderUI({
+    ## http://stackoverflow.com/questions/28982722/shiny-iframe-reactive
+    if(url.exists('https://angel.co/binary-com-1/jobs/145277-quantitative-analyst')) {
+      m_terms = tags$iframe(src='https://angel.co/binary-com-1/jobs/145277-quantitative-analyst', 
+                            height = 800, width = '100%', frameborder = 0)
+      #, seamless = 'seamless')), #seamless will hide the scroller.
+    } else {
+      m_terms = tags$iframe(src='https://englianhu.github.io/2017/02/Quantitative-Analyst-job-at-Binary.html', 
+                            height = 800, width = '100%', frameborder = 0)
+      #, seamless = 'seamless')), #seamless will hide the scroller.
+    }
+    return(m_terms)
+  })
+  
   output$firstday <- renderText({ 
-    as.character(input$dataDate - 365)
+    as.character(input$dataDate %m-% years(1))
   })
 
   #'@ repeatable()
@@ -121,7 +135,7 @@ server <- shinyServer(function(input, output, session) {
   })#, options = list(pageLength = 10))
 
   output$gsform <- renderPrint({
-    read_rds(path = './data/tmpgsform.rds')
+    pre.gsform %>% head #use first few observations as smaple.
     })
 
   output$gsmse <- renderDataTable({
@@ -140,9 +154,10 @@ server <- shinyServer(function(input, output, session) {
   })
 
   output$gsmse1 <- renderFormattable({
-    mse1 <- tmpsumgs %>% filter(mse == min(mse))
+    smp1 <- head(pre.mse1) #use first few observations as smaple.
+    
     #as.htmlwidget(
-    mse1 %>% formattable(list(
+    smp1 %>% formattable(list(
       .id = color_tile('white', 'darkgoldenrod'), 
       model = color_tile('white', 'darkgoldenrod'), 
       mse = formatter('span', style = x ~ 
@@ -167,15 +182,17 @@ server <- shinyServer(function(input, output, session) {
   #'@                                        text = 'Download'), I('colvis'))))
   #'@ })
 
-  output$bestalpha <- renderText({
-    alphaV <- tmpsumgs %>% filter(mse == min(mse)) %>% .$model %>% 
-      str_replace_all('mse', '') %>% as.numeric %>% unique
-    alphaV <- alphaV/10
-  })
+  #'@ output$bestalpha <- renderText({
+  #'@   alphaV <- unique(pre.mse1$model) %>% as.character %>% 
+  #'@     str_replace_all('mse', '') %>% as.numeric %>% unique
+  #'@   alphaV <- alphaV/10
+  #'@ })
 
   output$hcmp <- renderHighchart({
     hcM <- terms2()
     plotChart2(hcM, type = 'single', chart.type2 = input$type, 
                chart.theme = input$hc_theme, stacked = input$stacked)
   })
+  
+  
 })