Skip to content

Commit 41e9dd9

Browse files
englianhuenglianhu
committed
updated upon completed pnorm() weighted, will execute phalfnorm()...
1 parent c2f56cc commit 41e9dd9

File tree

7 files changed

+52
-16
lines changed

7 files changed

+52
-16
lines changed

‎function/compStocks.R

+6-6
Original file line numberDiff line numberDiff line change
@@ -179,7 +179,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
179179
gm <- paste(paste0(
180180
nam, seq(gaum), " <- ", gaum,
181181
"; if(.save == TRUE) saveRDS(", nam, seq(gaum), ", file = '", pth, "/", nam, seq(gaum), ".rds')",
182-
"; if(.print == TRUE) cat('gaussian model ", seq(gaum), "/", length(gaum), " ", txt, ".\n')"),
182+
"; if(.print == TRUE) cat('gaussian model ", pth, seq(gaum), "/", length(gaum), " ", txt, ".\n')"),
183183
collapse = "; ")
184184

185185
## start algorithmic calculation.
@@ -287,7 +287,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
287287
bm <- paste(paste0(
288288
nam, seq(binm), " <- ", binm,
289289
"; if(.save == TRUE) saveRDS(", nam, seq(binm), ", file = '", pth, "/", nam, seq(binm), ".rds')",
290-
"; if(.print == TRUE) cat('binomial model ", seq(binm), "/", length(binm), " ", txt, ".\n')"),
290+
"; if(.print == TRUE) cat('binomial model ", pth, seq(binm), "/", length(binm), " ", txt, ".\n')"),
291291
collapse = "; ")
292292

293293
## start algorithmic calculation.
@@ -384,7 +384,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
384384
pm <- paste(paste0(
385385
nam, seq(poim), " <- ", poim,
386386
"; if(.save == TRUE) saveRDS(", nam, seq(poim), ", file = '", pth, "/", nam, seq(poim), ".rds')",
387-
"; if(.print == TRUE) cat('poisson model ", seq(poim), "/", length(poim), " ", txt, ".\n')"),
387+
"; if(.print == TRUE) cat('poisson model ", pth, seq(poim), "/", length(poim), " ", txt, ".\n')"),
388388
collapse = "; ")
389389

390390
## start algorithmic calculation.
@@ -485,7 +485,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
485485
mm <- paste(paste0(
486486
nam, seq(mnmm), " <- ", mnmm,
487487
"; if(.save == TRUE) saveRDS(", nam, seq(mnmm), ", file = '", pth, "/", nam, seq(mnmm), ".rds')",
488-
"; if(.print == TRUE) cat('multinomial model ", seq(mnmm), "/", length(mnmm), " ", txt, ".\n')"),
488+
"; if(.print == TRUE) cat('multinomial model ", pth, seq(mnmm), "/", length(mnmm), " ", txt, ".\n')"),
489489
collapse = "; ")
490490

491491
## start algorithmic calculation.
@@ -563,7 +563,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
563563
cm <- paste(paste0(
564564
nam, seq(coxm), " <- ", coxm,
565565
"; if(.save == TRUE) saveRDS(", nam, seq(coxm), ", file = '", pth, "/", nam, seq(coxm), ".rds')",
566-
"; if(.print == TRUE) cat('multinomial model ", seq(coxm), "/", length(coxm), " ", txt, ".\n')"),
566+
"; if(.print == TRUE) cat('multinomial model ", pth, seq(coxm), "/", length(coxm), " ", txt, ".\n')"),
567567
collapse = "; ")
568568

569569
## start algorithmic calculation.
@@ -641,7 +641,7 @@ compStocks <- function(mbase, family = 'gaussian', xy.matrix = c('h1', 'h2'),
641641
mgm <- paste(paste0(
642642
nam, seq(mgam), " <- ", mgam,
643643
"; if(.save == TRUE) saveRDS(", nam, seq(mgam), ", file = '", pth, "/", nam, seq(mgam), ".rds')",
644-
"; if(.print == TRUE) cat('mgaussian model ", seq(mgam), "/", length(mgam), " ", txt, ".\n')"),
644+
"; if(.print == TRUE) cat('mgaussian model ", pth, seq(mgam), "/", length(mgam), " ", txt, ".\n')"),
645645
collapse = "; ")
646646

647647
## start algorithmic calculation.

‎function/draft2.R

+22
Original file line numberDiff line numberDiff line change
@@ -649,6 +649,28 @@ wtGSfit <- llply(dateID, function(dt) {
649649
}
650650
})
651651

652+
## ---------- Start corerection on the selected models ---------------------------
653+
654+
check.form <- ldply(list.files('./data', pattern = '^[0-9]{8}$'), function(x) {
655+
ldply(list.files(paste0('./data/', x), pattern = '^fitgaum.mse1.rds$'),
656+
function(y) {
657+
read_rds(path = paste0('./data/', x, '/', y))
658+
}) %>% data.frame(x, .) %>% tbl_df
659+
}) %>% tbl_df
660+
661+
> ## best fit models across the study from 2015-01-01 to 2017-01-20 (trading days only).
662+
> check.form$.id %>% as.character %>% unique %>% str_extract_all('[0-9]{1,}') %>% as.numeric %>% sort
663+
[1] 17 18 19 20 22 23 24 25 26 27 28 30 31 49 50 51 52 53 54 55 56 57 58 59 60 61
664+
[27] 62 63 64 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 113 114 115 116 117 118 119
665+
[53] 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 153
666+
[79] 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
667+
668+
## Need to review and filter only take models (based on formula) from 17 to 168 for weighted models.
669+
670+
671+
## ---------- End corerection on the selected models ---------------------------
672+
673+
652674
## =============================================================
653675
files <- list.files('./data/20150102/', pattern = 'fitgaum+[0-9]{1,}.rds$')
654676

‎function/simcompS.R

+15-6
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,10 @@ simcompS <- function(mbase, family, weight.dist = 'none') {
5353
#'@ ymd("2016-2-29") %m-% years(1)
5454
## http://stackoverflow.com/questions/8490799/how-to-account-for-leap-years
5555
fld = str_replace_all(dt, '-', '')
56-
fl = ldply(seq(224), function(x) {
56+
fitnum = list.files(paste0('./data/', fld), pattern = '^fitgaum+[0-9]{1,}.rds$') %>%
57+
str_extract_all('([0-9]{1,})') %>% unlist %>% as.numeric %>% sort
58+
59+
fl = ldply(seq(fitnum), function(x) {
5760
read_rds(path = paste0('./data/', fld, '/wt.fitgaum', x, '.rds'))
5861
}) %>% tbl_df
5962
#'@ files <- list.files(paste0('./data/', fld), pattern = 'wt.fitgaum+[0-9]{1,}.rds$')
@@ -95,7 +98,8 @@ simcompS <- function(mbase, family, weight.dist = 'none') {
9598
wt.pnorm.fitgaum.form = wt.pnorm.fitgaum$formula1[str_replace_all(
9699
name514gs, 'wt.pnorm.fitgaum', '') %>% as.numeric]
97100
saveRDS(wt.pnorm.fitgaum.form, file = paste0(pth, '/wt.pnorm.fitgaum.form.rds'))
98-
101+
rm(fld, fitnum, fl, wtdt, wtpc, wt.pnorm.fitgaum, wt.pnorm.fitgaum.mse1, wt.pnorm.fitgaum.best, wt.pnorm.fitgaum.sum, wt.pnorm.fitgaum.form)
102+
99103
} else if(weight.dist == 'phalfnorm') {
100104

101105
## predict dateID onwards from data < dateID
@@ -104,7 +108,10 @@ simcompS <- function(mbase, family, weight.dist = 'none') {
104108
#'@ ymd("2016-2-29") %m-% years(1)
105109
## http://stackoverflow.com/questions/8490799/how-to-account-for-leap-years
106110
fld = str_replace_all(dt, '-', '')
107-
fl = ldply(seq(224), function(x) {
111+
fitnum = list.files(paste0('./data/', fld), pattern = '^fitgaum+[0-9]{1,}.rds$') %>%
112+
str_extract_all('([0-9]{1,})') %>% unlist %>% as.numeric %>% sort
113+
114+
fl = ldply(seq(fitnum), function(x) {
108115
read_rds(path = paste0('./data/', fld, '/wt.fitgaum', x, '.rds'))
109116
}) %>% tbl_df
110117
#'@ files <- list.files(paste0('./data/', fld), pattern = 'wt.fitgaum+[0-9]{1,}.rds$')
@@ -146,7 +153,8 @@ simcompS <- function(mbase, family, weight.dist = 'none') {
146153
wt.phalfnorm.fitgaum.form = wt.phalfnorm.fitgaum$formula1[str_replace_all(
147154
name514gs, 'wt.phalfnorm.fitgaum', '') %>% as.numeric]
148155
saveRDS(wt.phalfnorm.fitgaum.form, file = paste0(pth, '/wt.phalfnorm.fitgaum.form.rds'))
149-
156+
rm(fld, fitnum, fl, wtdt, wtpc, wt.phalfnorm.fitgaum, wt.phalfnorm.fitgaum.mse1, wt.phalfnorm.fitgaum.best, wt.phalfnorm.fitgaum.sum, wt.phalfnorm.fitgaum.form)
157+
150158
} else if(weight.dist == 'none') {
151159

152160
fitgaum = compStocks(smp, family = family, xy.matrix = 'h2', yv.lm = c(TRUE, FALSE), preset.weight = TRUE,
@@ -172,12 +180,13 @@ simcompS <- function(mbase, family, weight.dist = 'none') {
172180
## saved best model's formula.
173181
fitgaum.form = fitgaum$formula1[str_replace_all(name514gs, 'fitgaum', '') %>% as.numeric]
174182
saveRDS(fitgaum.form, file = paste0(pth, '/fitgaum.form.rds'))
175-
183+
rm(fld, fitnum, fl, wtdt, wtpc, fitgaum, fitgaum.mse1, fitgaum.best, fitgaum.sum, fitgaum.form)
184+
176185
} else {
177186
stop('Kindly select weight.dist = "pnorm" or weight.dist = "phalfnorm" or weight.dist = "none".')
178187
}
179188
})
180-
189+
181190
#'@ rm(list = ls(all.names = TRUE))
182191
return(fitm)
183192
}

‎function/simulateModels.R

+1
Original file line numberDiff line numberDiff line change
@@ -216,6 +216,7 @@ LAD <- read_rds(path = './data/LAD_full.rds')
216216

217217
## weighted model 1 : preset 224 models
218218
simcompS(mbase = LAD, family = 'gaussian', weight.dist = 'pnorm')
219+
## read_rds(path = './data/20160601/wt.pnorm.fitgaum176.rds') #error on wt.pnorm.fitgaum177.rds
219220

220221
## weighted model 2 : preset 224 models
221222
## need to simulate upon completion of weighted model 1

‎function/simulateWT.R

+4-4
Original file line numberDiff line numberDiff line change
@@ -92,18 +92,18 @@ simulateWT <- function(mbase, settledPrice = 'Close', .parallel = TRUE, .save =
9292

9393
if(.print == TRUE) {
9494
if(.save == TRUE) {
95-
cat(paste0('./data/', x, '. All wt.fitgaum.rds had saved.\n'))
95+
cat(paste0('./data/', x, '. All wt.fitgaum.rds had saved.\n\n'))
9696
} else {
97-
cat(paste0('./data/', x, '. All wt.fitgaum.rds had calculated.\n'))
97+
cat(paste0('./data/', x, '. All wt.fitgaum.rds had calculated.\n\n'))
9898
}
9999
}
100100
})
101101

102102
if(.print == TRUE) {
103103
if(.save == TRUE) {
104-
cat('Save all and completed.\n')
104+
cat('Save all and completed.\n\n')
105105
} else {
106-
cat('Calculate all and completed.\n')
106+
cat('Calculate all and completed.\n\n')
107107
}
108108
}
109109

‎ui.R

+4
Original file line numberDiff line numberDiff line change
@@ -561,6 +561,10 @@ ui <- shinyUI(fluidPage(
561561
code('glmPrice()'), ' to checked if the duplicated arguments and filter to be unique formula.'),
562562
p('There are a lot of anonymous errors or unmatched outcome when I test my function and models, ',
563563
'you are feel free to read the files named ', code('draft'), code('draft2'), '.'),
564+
br(),
565+
HTML('<iframe width="560" height="315" src="https://www.youtube.com/embed/Utbs2EgRMIE" frameborder="0" allowfullscreen></iframe>'),
566+
br(),
567+
HTML('<iframe width="560" height="315" src="https://www.youtube.com/embed/2igEZxPFz38" frameborder="0" allowfullscreen></iframe>'),
564568
br(),
565569
br(),
566570
h4('Question 2'),

‎www/20160601-wt.pnorm.fitgaum - error177.jpg

64 KB
Loading

0 commit comments

Comments
 (0)