Skip to content

Instantly share code, notes, and snippets.

@xxyjoel

xxyjoel/state_shift_model.R

Created January 16, 2020 00:50
Show Gist options
  • Save xxyjoel/2dd9e6438b58d535b7402ed93c791835 to your computer and use it in GitHub Desktop.
Save xxyjoel/2dd9e6438b58d535b7402ed93c791835 to your computer and use it in GitHub Desktop.
Download ZIP
rudimentary state shift probability model
Raw
state_shift_model.R
require(lubridate)
require(quantmod)
require(forecast)
require(alphavantager)
require(dplyr)
require(plyr)
require(purrr)
#stock.data <- filtered.data[1:1000,]
#output <- price.shift(stock.data)
#strategy wrapper
state.shift <- function(stock.data) {
#browser()
output <- data.frame(
date = numeric(length(stock.data$date)),
price = numeric(length(stock.data$date)),
signals = numeric(length(stock.data$date))
)
stock.data$price <- stock.data$adj
output$date <- stock.data$date
output$price <- stock.data$price
#calculate wrapper values from price data
price.diff <- function(stock.data) {
price <- stock.data$adj
output <- vector()
for (i in 1:length(price)) {
if (i < 2) {
output[i] <- 0
} else {
output[i] <- ((price[i] - price[i-1]) / price[i-1])*100
}
}
return(output)
}
price.diff <- price.diff(stock.data)
stock.data$price.diff <- price.diff
pos.price.diff <- function(stock.data) {
#browser()
window <- 10
diff <- stock.data$price.diff
pos.diff <- vector()
output <- vector()
for (i in 1:length(diff)) {
if(diff[i] > 0) {
pos.diff[i] <- diff[i]
} else if (diff[i] <= 0) {
pos.diff[i] <- NA
}
if ( i < window){
output[i] <- NA
} else if (i >= window && !all(is.na(pos.diff[( i - (window - 1) ):i]))) {
output[i] <- (sum(pos.diff[( i - (window - 1) ):i], na.rm = TRUE) / window)
} else {
output[i] <- output[i-1]
}
}
return(output)
}
pos.price.diff <- pos.price.diff(stock.data)
stock.data$pos.price.diff <- pos.price.diff
neg.price.diff <- function(stock.data) {
#browser()
window <- 10
diff <- stock.data$price.diff
neg.diff <- vector()
output <- vector()
for (i in 1:length(diff)) {
if(diff[i] < 0) {
neg.diff[i] <- diff[i]
} else if (diff[i] >= 0) {
neg.diff[i] <- NA
}
if ( i < window){
output[i] <- NA
} else if (i >= window && !all(is.na(neg.diff[( i - (window - 1) ):i]))) {
output[i] <- (sum(neg.diff[( i - (window - 1) ):i], na.rm = TRUE) / window)
} else {
output[i] <- output[i-1]
}
}
return(output)
}
neg.price.diff <- neg.price.diff(stock.data)
stock.data$neg.price.diff <- neg.price.diff
swing.prob <- function(stock.data) {
#browser()
diff <- stock.data$price.diff
pos <- stock.data$pos.price.diff
neg <- stock.data$neg.price.diff
#TRACK ACTUAL VALUES
sm.bear.delta <- vector()
lg.bear.delta <- vector()
sm.bull.delta <- vector()
lg.bull.delta <- vector()
#STATE CHANGES
sm.br.sm.br <- vector()
sm.br.lg.br <- vector()
sm.br.sm.bl <- vector()
sm.br.lg.bl <- vector()
lg.br.sm.br <- vector()
lg.br.lg.br <- vector()
lg.br.sm.bl <- vector()
lg.br.lg.bl <- vector()
sm.bl.sm.br <- vector()
sm.bl.lg.br <- vector()
sm.bl.sm.bl <- vector()
sm.bl.lg.bl <- vector()
lg.bl.sm.br <- vector()
lg.bl.lg.br <- vector()
lg.bl.sm.bl <- vector()
lg.bl.lg.bl <- vector()
#PROBABILITIES
sm.br.sm.br.prob <- vector()
sm.br.lg.br.prob <- vector()
sm.br.sm.bl.prob <- vector()
sm.br.lg.bl.prob <- vector()
lg.br.sm.br.prob <- vector()
lg.br.lg.br.prob <- vector()
lg.br.sm.bl.prob <- vector()
lg.br.lg.bl.prob <- vector()
sm.bl.sm.br.prob <- vector()
sm.bl.lg.br.prob <- vector()
sm.bl.sm.bl.prob <- vector()
sm.bl.lg.bl.prob <- vector()
lg.bl.sm.br.prob <- vector()
lg.bl.lg.br.prob <- vector()
lg.bl.sm.bl.prob <- vector()
lg.bl.lg.bl.prob <- vector()
output <- data.frame()
# calculate up / down actual occurrences
for (i in 1:length(diff)) {
if(!is.na(pos[i])
&& diff[i] != 0
&& !is.na(diff[i])
&& diff[i] < 0 && diff[i] > neg[i]) {
sm.bear.delta[i] = 1
lg.bear.delta[i] = 0
sm.bull.delta[i] = 0
lg.bull.delta[i] = 0
}else if(!is.na(pos[i])
&& diff[i] != 0
&& !is.na(diff[i])
&& diff[i] < neg[i]) {
sm.bear.delta[i] = 0
lg.bear.delta[i] = 1
sm.bull.delta[i] = 0
lg.bull.delta[i] = 0
}else if(!is.na(pos[i])
&& diff[i] != 0
&& !is.na(diff[i])
&& diff[i] > 0
&& diff[i] < pos[i]) {
sm.bear.delta[i] = 0
lg.bear.delta[i] = 0
sm.bull.delta[i] = 1
lg.bull.delta[i] = 0
}else if(!is.na(pos[i])
&& diff[i] != 0
&& !is.na(diff[i])
&& diff[i] > pos[i]) {
sm.bear.delta[i] = 0
lg.bear.delta[i] = 0
sm.bull.delta[i] = 0
lg.bull.delta[i] = 1
}else{
sm.bear.delta[i] = 0
lg.bear.delta[i] = 0
sm.bull.delta[i] = 0
lg.bull.delta[i] = 0
}
# calculate transition occurrences (state changes)
if(!is.na(pos[i-1]) && sm.bear.delta[i-1] == 1 && sm.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 1
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
# if yesterday was positive and today is negative
}else if(!is.na(pos[i-1]) && sm.bear.delta[i-1] == 1 && lg.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 1
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 1
}else if(!is.na(pos[i-1]) && sm.bear.delta[i-1] == 1 && sm.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 1
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 2
}else if(!is.na(pos[i-1]) && sm.bear.delta[i-1] == 1 && lg.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 1
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 3
}else if(!is.na(pos[i-1]) && lg.bear.delta[i-1] == 1 && sm.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 1
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 4
}else if(!is.na(pos[i-1]) && lg.bear.delta[i-1] == 1 && lg.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 1
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 5
}else if(!is.na(pos[i-1]) && lg.bear.delta[i-1] == 1 && sm.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 1
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 6
}else if(!is.na(pos[i-1]) && lg.bear.delta[i-1] == 1 && lg.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 1
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 7
}else if(!is.na(pos[i-1]) && sm.bull.delta[i-1] == 1 && sm.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 1
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 8
}else if(!is.na(pos[i-1]) && sm.bull.delta[i-1] == 1 && lg.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 1
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 9
}else if(!is.na(pos[i-1]) && sm.bull.delta[i-1] == 1 && sm.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 1
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 10
}else if(!is.na(pos[i-1]) && sm.bull.delta[i-1] == 1 && lg.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 1
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 11
}else if(!is.na(pos[i-1]) && lg.bull.delta[i-1] == 1 && sm.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 1
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 12
}else if(!is.na(pos[i-1]) && lg.bull.delta[i-1] == 1 && lg.bear.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 1
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#add 13
}else if(!is.na(pos[i-1]) && lg.bull.delta[i-1] == 1 && sm.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 1
lg.bl.lg.bl[i] <- 0
#add 14
}else if(!is.na(pos[i-1]) && lg.bull.delta[i-1] == 1 && lg.bull.delta[i] == 1) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 1
#price diff == 0 error handling
}else if(diff[i] == 0) {
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
#error handling
}else{
sm.br.sm.br[i] <- 0
sm.br.lg.br[i] <- 0
sm.br.sm.bl[i] <- 0
sm.br.lg.bl[i] <- 0
lg.br.sm.br[i] <- 0
lg.br.lg.br[i] <- 0
lg.br.sm.bl[i] <- 0
lg.br.lg.bl[i] <- 0
sm.bl.sm.br[i] <- 0
sm.bl.lg.br[i] <- 0
sm.bl.sm.bl[i] <- 0
sm.bl.lg.bl[i] <- 0
lg.bl.sm.br[i] <- 0
lg.bl.lg.br[i] <- 0
lg.bl.sm.bl[i] <- 0
lg.bl.lg.bl[i] <- 0
next
}
#small bear state prob
#cap max probability values
if (i < 20 + sum(is.na(pos))) {
prob.counter <- sum(is.na(pos)) + 2
} else {
#remove NA from probability calculations
prob.counter <- prob.counter + 1
}
sm.br.sm.br.prob[i] <- sum(sm.br.sm.br[prob.counter:i]/
(sum(sm.br.sm.br[prob.counter:i]) +
sum(sm.br.lg.br[prob.counter:i]) +
sum(sm.br.sm.bl[prob.counter:i]) +
sum(sm.br.lg.bl[prob.counter:i]) ))
if (is.nan(sm.br.sm.br.prob[i]) || is.na(sm.br.sm.br.prob[i])) {
sm.br.sm.br.prob[i] <- 0
} else {
sm.br.sm.br.prob[i] <- sm.br.sm.br.prob[i]
}
sm.br.lg.br.prob[i] <- sum(sm.br.lg.br[prob.counter:i]/
(sum(sm.br.sm.br[prob.counter:i]) +
sum(sm.br.lg.br[prob.counter:i]) +
sum(sm.br.sm.bl[prob.counter:i]) +
sum(sm.br.lg.bl[prob.counter:i]) ))
if (is.nan(sm.br.lg.br.prob[i]) || is.na(sm.br.lg.br.prob[i])) {
sm.br.lg.br.prob[i] <- 0
} else {
sm.br.lg.br.prob[i] <- sm.br.lg.br.prob[i]
}
sm.br.sm.bl.prob[i] <- sum(sm.br.sm.bl[prob.counter:i]/
(sum(sm.br.sm.br[prob.counter:i]) +
sum(sm.br.lg.br[prob.counter:i]) +
sum(sm.br.sm.bl[prob.counter:i]) +
sum(sm.br.lg.bl[prob.counter:i]) ))
if (is.nan(sm.br.sm.bl.prob[i]) || is.na(sm.br.sm.bl.prob[i])) {
sm.br.sm.bl.prob[i] <- 0
} else {
sm.br.sm.bl.prob[i] <- sm.br.sm.bl.prob[i]
}
sm.br.lg.bl.prob[i] <- sum(sm.br.lg.bl[prob.counter:i]/
(sum(sm.br.sm.br[prob.counter:i]) +
sum(sm.br.lg.br[prob.counter:i]) +
sum(sm.br.sm.bl[prob.counter:i]) +
sum(sm.br.lg.bl[prob.counter:i]) ))
if (is.nan(sm.br.lg.bl.prob[i]) || is.na(sm.br.lg.bl.prob[i])) {
sm.br.lg.bl.prob[i] <- 0
} else {
sm.br.lg.bl.prob[i] <- sm.br.lg.bl.prob[i]
}
# large bear state prob
lg.br.sm.br.prob[i] <- sum(lg.br.sm.br[prob.counter:i]/
(sum(lg.br.sm.br[prob.counter:i]) +
sum(lg.br.lg.br[prob.counter:i]) +
sum(lg.br.sm.bl[prob.counter:i]) +
sum(lg.br.lg.bl[prob.counter:i]) ))
if (is.nan(lg.br.sm.br.prob[i]) || is.na(lg.br.sm.br.prob[i])) {
lg.br.sm.br.prob[i] <- 0
} else {
lg.br.sm.br.prob[i] <- lg.br.sm.br.prob[i]
}
lg.br.lg.br.prob[i] <- sum(lg.br.lg.br[prob.counter:i]/
(sum(lg.br.sm.br[prob.counter:i]) +
sum(lg.br.lg.br[prob.counter:i]) +
sum(lg.br.sm.bl[prob.counter:i]) +
sum(lg.br.lg.bl[prob.counter:i]) ))
if (is.nan(lg.br.lg.br.prob[i]) || is.na(lg.br.lg.br.prob[i])) {
lg.br.lg.br.prob[i] <- 0
} else {
lg.br.lg.br.prob[i] <- lg.br.lg.br.prob[i]
}
lg.br.sm.bl.prob[i] <- sum(lg.br.sm.bl[prob.counter:i]/
(sum(lg.br.sm.br[prob.counter:i]) +
sum(lg.br.lg.br[prob.counter:i]) +
sum(lg.br.sm.bl[prob.counter:i]) +
sum(lg.br.lg.bl[prob.counter:i]) ))
if (is.nan(lg.br.sm.bl.prob[i]) || is.na(lg.br.sm.bl.prob[i])) {
lg.br.sm.bl.prob[i] <- 0
} else {
lg.br.sm.bl.prob[i] <- lg.br.sm.bl.prob[i]
}
lg.br.lg.bl.prob[i] <- sum(lg.br.lg.bl[prob.counter:i]/
(sum(lg.br.sm.br[prob.counter:i]) +
sum(lg.br.lg.br[prob.counter:i]) +
sum(lg.br.sm.bl[prob.counter:i]) +
sum(lg.br.lg.bl[prob.counter:i]) ))
if (is.nan(lg.br.lg.bl.prob[i]) || is.na(lg.br.lg.bl.prob[i])) {
lg.br.lg.bl.prob[i] <- 0
} else {
lg.br.lg.bl.prob[i] <- lg.br.lg.bl.prob[i]
}
# small bull state prob
sm.bl.sm.br.prob[i] <- sum(sm.bl.sm.br[prob.counter:i]/
(sum(sm.bl.sm.br[prob.counter:i]) +
sum(sm.bl.lg.br[prob.counter:i]) +
sum(sm.bl.sm.bl[prob.counter:i]) +
sum(sm.bl.lg.bl[prob.counter:i]) ))
if (is.nan(sm.bl.sm.br.prob[i]) || is.na(sm.bl.sm.br.prob[i])) {
sm.bl.sm.br.prob[i] <- 0
} else {
sm.bl.sm.br.prob[i] <- sm.bl.sm.br.prob[i]
}
sm.bl.lg.br.prob[i] <- sum(sm.bl.lg.br[prob.counter:i]/
(sum(sm.bl.sm.br[prob.counter:i]) +
sum(sm.bl.lg.br[prob.counter:i]) +
sum(sm.bl.sm.bl[prob.counter:i]) +
sum(sm.bl.lg.bl[prob.counter:i]) ))
if (is.nan(sm.bl.lg.br.prob[i]) || is.na(sm.bl.lg.br.prob[i])) {
sm.bl.lg.br.prob[i] <- 0
} else {
sm.bl.lg.br.prob[i] <- sm.bl.lg.br.prob[i]
}
sm.bl.sm.bl.prob[i] <- sum(sm.bl.sm.bl[prob.counter:i]/
(sum(sm.bl.sm.br[prob.counter:i]) +
sum(sm.bl.lg.br[prob.counter:i]) +
sum(sm.bl.sm.bl[prob.counter:i]) +
sum(sm.bl.lg.bl[prob.counter:i]) ))
if (is.nan(sm.bl.sm.bl.prob[i]) || is.na(sm.bl.sm.bl.prob[i])) {
sm.bl.sm.bl.prob[i] <- 0
} else {
sm.bl.sm.bl.prob[i] <- sm.bl.sm.bl.prob[i]
}
sm.bl.lg.bl.prob[i] <- sum(sm.bl.lg.bl[prob.counter:i]/
(sum(sm.bl.sm.br[prob.counter:i]) +
sum(sm.bl.lg.br[prob.counter:i]) +
sum(sm.bl.sm.bl[prob.counter:i]) +
sum(sm.bl.lg.bl[prob.counter:i]) ))
if (is.nan(sm.bl.lg.bl.prob[i]) || is.na(sm.bl.lg.bl.prob[i])) {
sm.bl.lg.bl.prob[i] <- 0
} else {
sm.bl.lg.bl.prob[i] <- sm.bl.lg.bl.prob[i]
}
# large bull state prob
lg.bl.sm.br.prob[i] <- sum(lg.bl.sm.br[prob.counter:i]/
(sum(lg.bl.sm.br[prob.counter:i]) +
sum(lg.bl.lg.br[prob.counter:i]) +
sum(lg.bl.sm.bl[prob.counter:i]) +
sum(lg.bl.lg.bl[prob.counter:i]) ))
if (is.nan(lg.bl.sm.br.prob[i]) || is.na(lg.bl.sm.br.prob[i])) {
lg.bl.sm.br.prob[i] <- 0
} else {
lg.bl.sm.br.prob[i] <- lg.bl.sm.br.prob[i]
}
lg.bl.lg.br.prob[i] <- sum(lg.bl.lg.br[prob.counter:i]/
(sum(lg.bl.sm.br[prob.counter:i]) +
sum(lg.bl.lg.br[prob.counter:i]) +
sum(lg.bl.sm.bl[prob.counter:i]) +
sum(lg.bl.lg.bl[prob.counter:i]) ))
if (is.nan(lg.bl.lg.br.prob[i]) || is.na(lg.bl.lg.br.prob[i])) {
lg.bl.lg.br.prob[i] <- 0
} else {
lg.bl.lg.br.prob[i] <- lg.bl.lg.br.prob[i]
}
lg.bl.sm.bl.prob[i] <- sum(lg.bl.sm.bl[prob.counter:i]/
(sum(lg.bl.sm.br[prob.counter:i]) +
sum(lg.bl.lg.br[prob.counter:i]) +
sum(lg.bl.sm.bl[prob.counter:i]) +
sum(lg.bl.lg.bl[prob.counter:i]) ))
if (is.nan(lg.bl.sm.bl.prob[i]) || is.na(lg.bl.sm.bl.prob[i])) {
lg.bl.sm.bl.prob[i] <- 0
} else {
lg.bl.sm.bl.prob[i] <- lg.bl.sm.bl.prob[i]
}
lg.bl.lg.bl.prob[i] <- sum(lg.bl.lg.bl[prob.counter:i]/
(sum(lg.bl.sm.br[prob.counter:i]) +
sum(lg.bl.lg.br[prob.counter:i]) +
sum(lg.bl.sm.bl[prob.counter:i]) +
sum(lg.bl.lg.bl[prob.counter:i]) ))
if (is.nan(lg.bl.lg.bl.prob[i]) || is.na(lg.bl.lg.bl.prob[i])) {
lg.bl.lg.bl.prob[i] <- 0
} else {
lg.bl.lg.bl.prob[i] <- lg.bl.lg.bl.prob[i]
}
next
}
output <- cbind(sm.br.sm.br.prob,
sm.br.lg.br.prob,
sm.br.sm.bl.prob,
sm.br.lg.bl.prob,
lg.br.sm.br.prob,
lg.br.lg.br.prob,
lg.br.sm.bl.prob,
lg.br.lg.bl.prob,
sm.bl.sm.br.prob,
sm.bl.lg.br.prob,
sm.bl.sm.bl.prob,
sm.bl.lg.bl.prob,
lg.bl.sm.br.prob,
lg.bl.lg.br.prob,
lg.bl.sm.bl.prob,
lg.bl.lg.bl.prob )
return(output)
}
state.shift.prob <- as.data.frame(swing.prob(stock.data))
buy.signal.gen <- function(state.shift.prob) {
#browser()
output <- vector()
for (i in 1:length(state.shift.prob[,1])) {
if (
(max(state.shift.prob[i,1:16]) != 0)
&&(!is.na(max(state.shift.prob[i,1:16])))
&&(max(state.shift.prob[i,1:16]) == state.shift.prob$sm.br.lg.bl.prob[i])
)
{
output[i] <- 1
} else if (
(max(state.shift.prob[i,1:16]) != 0)
&&(!is.na(max(state.shift.prob[i,1:16])))
&&(max(state.shift.prob[i,1:16]) == state.shift.prob$sm.bl.lg.bl.prob[i])
)
{
output[i] <- 1
} else if (
(max(state.shift.prob[i,1:16]) != 0)
&&(!is.na(max(state.shift.prob[i,1:16])))
&&(max(state.shift.prob[i,1:16]) == state.shift.prob$lg.br.lg.bl.prob[i])
)
{
output[i] <- 1
} else if (
(max(state.shift.prob[i,1:16]) != 0)
&&(!is.na(max(state.shift.prob[i,1:16])))
&&(max(state.shift.prob[i,1:16]) == state.shift.prob$lg.bl.lg.bl.prob[i])
)
{
output[i] <- 1
} else {
output[i] <- 0
}
}
return(output)
}
buy.signal <- buy.signal.gen(state.shift.prob)
stock.data$buy.signal <- buy.signal
filter <- function(stock.data) {
#browser()
signal <- stock.data$buy.signal
output <- vector()
for (i in 1:length(signal)) {
if (
signal[i-1] == 0 && signal[i] == 1
||
signal[i-1] == -1 && signal[i] == 1
)
{
output[i] <- 1
} else if (
signal[i-1] == 1 && signal[i] == 1
)
{
output[i] <- -1
} else {
output[i] <- 0
}
if (output[i-1] == -1 && output[i] == -1) {
output[i] <- 0
}
}
return(output)
}
filter <- filter(stock.data)
stock.data$filter <- filter
# TRADE ACTIONS / INDICATOR GENERATOR
#browser()
for (i in 2:length(stock.data$date)) {
if (
filter[i] == 1
)
{
output$signals[i] <- 1
} else if (
#alt.swing.prob[i] == -1
filter[i] == -1
)
{
output$signals[i] <- -1
} else {
output$signals[i] <- 0
}
}
return(output)
}
StateShift <- state.shift(stock.data)
#bear plots
par(mfrow=(2:1))
plot(stock.data$adj, type = "l")
plot(state.shift.prob$sm.br.sm.br.prob, type = 'l', col = 'red', ylim = c(0,1),
main = "Small 'Bear' Sate Shift Probability")
points(state.shift.prob$sm.br.lg.br.prob, type = 'l', col = 'blue' )
points(state.shift.prob$sm.br.sm.bl.prob, type = 'l', col = 'green' )
points(state.shift.prob$sm.br.lg.bl.prob, type = 'l', col = 'black' )
legend(0,1,
c("to Small Bear",
"to Large Bear",
"to Small Bull",
"to Large Bull"),
lty = c(1,1,1,1),
lwd = c(2,2,2,2), col = c('red','blue','green','black'))
plot(state.shift.prob$lg.br.sm.br.prob, type = 'l', col = 'red', ylim = c(0,1),
main = "Large 'Bear' Sate Shift Probability")
points(state.shift.prob$lg.br.lg.br.prob, type = 'l', col = 'blue' )
points(state.shift.prob$lg.br.sm.bl.prob, type = 'l', col = 'green' )
points(state.shift.prob$lg.br.lg.bl.prob, type = 'l', col = 'black' )
legend(0,1,
c("to Small Bear",
"to Large Bear",
"to Small Bull",
"to Large Bull"),
lty = c(1,1,1,1),
lwd = c(2,2,2,2), col = c('red','blue','green','black'))
plot(state.shift.prob$sm.bl.sm.br.prob, type = 'l', col = 'red', ylim = c(0,1),
main = "Small 'Bull' Sate Shift Probability")
points(state.shift.prob$sm.bl.lg.br.prob, type = 'l', col = 'blue' )
points(state.shift.prob$sm.bl.sm.bl.prob, type = 'l', col = 'green' )
points(state.shift.prob$sm.bl.lg.bl.prob, type = 'l', col = 'black' )
legend(0,1,
c("to Small Bear",
"to Large Bear",
"to Small Bull",
"to Large Bull"),
lty = c(1,1,1,1),
lwd = c(2,2,2,2), col = c('red','blue','green','black'))
plot(state.shift.prob$lg.br.sm.br.prob, type = 'l', col = 'red', ylim = c(0,1),
main = "Large 'Bull' Sate Shift Probability")
points(state.shift.prob$lg.bl.lg.br.prob, type = 'l', col = 'blue' )
points(state.shift.prob$lg.bl.sm.bl.prob, type = 'l', col = 'green' )
points(state.shift.prob$lg.bl.lg.bl.prob, type = 'l', col = 'black' )
legend(0,1,
c("to Small Bear",
"to Large Bear",
"to Small Bull",
"to Large Bull"),
lty = c(1,1,1,1),
lwd = c(2,2,2,2), col = c('red','blue','green','black'))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment