FXEZ's Quantitative Research In R | Forex Factory

Options

Go to
Permalinks
Print Thread

Similar Threads

Quantitative Approach to Backtesting 24 replies

applications using quantitative data on the NYSE 0 replies

FXEZ's E/J Gravy Train 26 replies

The Shark's Trading Book - Quantitative Trading 2 replies

Quantitative Qualitative Estimation for MT4? 0 replies

Attachments: FXEZ's Quantitative Research In R
Exit Attachments

FXEZ's Quantitative Research In R

  • #1
  • First Post: Edited Dec 27, 2016 5:34pm Dec 25, 2016 11:04pm | Edited Dec 27, 2016 5:34pm
In this space I will post from time to time current or past research. I may or may not post code for each research item, sometimes just results from interesting tests. Most of my research is done in R. Google "R Project" if you don't know what "R" means and want to follow along with the code I post or wish to contribute your own R code. But note that this isn't an R for beginners tutorial or "get me up to speed" thread.

Some of the code I write assumes you have data already imported into R in a certain format. I don't foresee myself uploading data each time due to size (not sure what FF's attachment size limit is) / convenience so you may be on your own with regards to getting your own data into R.

How you can contribute:
1) Write good questions
2) Write code from your tests / research (no matter what language, despite what the thread title says) and post it here
3) Show results from your extensions / tests or validate my results
4) Post great insights regarding the study at hand
5) Post interesting future research items
6) Share interesting R functions or packages
7) Point out flaws in my analysis/research

Please avoid:
1) Stating your opinion - back up opinions with research and post it here
2) Off topic comments or disrupting the thread (I'm pretty quick with the ignore button and my tolerance is low, so consider yourself pre-warned).

Please stay on topic - keep posts related to the research items I'm posting or your own interesting quantitative research. I'm not a teacher or guru. I'm just posting some of the research I've been doing or am doing currently to elicit comments and discussion that may help me/you move one step ahead. My time is limited so please respect that.

Welcome! Let's have fun and learn something!

Github QuantitativeResearch repository: this thread's files saved on Github
Quandl Data with easy access to lots of free daily data from many languages including R, Python.
  • #2
  • Dec 25, 2016 11:14pm Dec 25, 2016 11:14pm
FXEZ,

Subscribed! I also use R extensively for trading research and analysis. I will also post some of my results and source code here. I'm sure if enough folks contribute we can all learn from each other.

Merry Christmas!

EZcurrency
  • #3
  • Dec 25, 2016 11:27pm Dec 25, 2016 11:27pm
Random walks - there are many ways to build these but just using some of the functions in R to produce a cumulative series of random numbers shows the same principle: That while in a 50/50 coin flip you should get an equal number of heads and tails, but in practice with a long series there tends to be significant drift and the series seem to rarely center around zero (as in the red line in the pic). In fact, there is no guarantee that the up/down moves will equalize. Most of the time they do not. (I'll post some code later than helps ensure equal up/down moves in a given series for a real 50/50 outcome.)

Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot2.png Size: 27 KB


Inserted Code
end = 100000; eq = rep(0, end)
trials = 1
for (i in 1:end) {
  #eq[i] = sign(sum(sample(c(-1,1), trials, replace=T)))
  #eq[i] = sign(sum(runif(trials)-0.5))
  eq[i] = sign(sum(sign(rnorm(trials))))
}
blackplot(2,1); plot(cumsum(eq), t='l')
abline(h=0, col='red')
plot(density(cumsum(eq)), col='gold', lwd = 3)
abline(v=0, col='red')

Here is code for the blackplot function (make a black background for an R plot):
Inserted Code
blackplot = function (rows = 1, cols = 1, color = "white")
par(mar = c(2, 4, 1, 1), mfrow = c(rows, cols), bg = "black",
    fg = "white", col = color, col.axis = "white", col.lab = "white",
    col.main = "white", col.sub = "white", lwd = 2)
As can be seen from the code above, blackplot is basically a takeoff/extension of the par function for simplicity and I use it in all my plots.

In the shot below we end up about zero (top chart) but the distribution is not centered around zero. If a different length (end) were used, the "price" probably wouldn't have ended up at the zero line.
Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot1.png Size: 28 KB


So to summarize: even though this pseudo-price "should" end up centered around zero due to the 50/50 odds of the random number generator, fairly often there is significant drift/trend away from the zero line (as errors cumulate) and this drift tends to be persistent or semi-persistent. I tried doing 10 million trials with this code to see if it would converge around the zero line eventually, but ran out of memory and had to kill R.
  • #4
  • Dec 25, 2016 11:35pm Dec 25, 2016 11:35pm
Quoting ezcurrency
FXEZ, Subscribed! I also use R extensively for trading research and analysis. I will also post some of my results and source code here. I'm sure if enough folks contribute we can all learn from each other. Merry Christmas! EZcurrency
Hey ezcurrency,

Great to have you here! Yes I think that's exactly what this thread is all about - learning from each other. Merry Christmas!
  • #5
  • Dec 25, 2016 11:51pm Dec 25, 2016 11:51pm
Here is my screenshot for the same for 50:50 chance (random walk) coin flip:

Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot1.png Size: 33 KB


Code:
Inserted Code
sequenceOfCoinTosses <- sample(c(-1,1), 10000, replace = TRUE, prob=c(0.5,0.5))
plot(cumsum(sequenceOfCoinTosses), type = 'l', ylab="", main="Sum of 10000 coin tosses")
abline(h=0)

Now change the above code to reflect probabilities of 0.52 and 0.48 we get this:

Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot2.png Size: 32 KB


So if there is just a 2% edge we get a trend instead of a random walk.

That is our goal. Just get a slight edge.

In trading that edge is ever elusive. Systems tend to work for a while, then falter. Over all my years of trading, I am of the opinion that you need multiple systems trading many currency pairs (or multiple markets) on various separate timeframes, or many timeframes giving input into the signal.

Also, you can't backtest and optimize one system across multiple pairs. Each pair moves differently, so each system must be backtested and optimized for each pair separately. Additionally, after backtesting with out of sample data, you then test over a different set of out of sample data to see if results agree with the first test within acceptable statistical parameters. After that, its time to do real life (demo) testing for a while to get an appropriate # of real life trades (statistically determined) to compare to the previous backtest results. After that if everything is ok, then move on to real live trading with a small account and low leverage. If trading statistics agree with demo results over enough time, then slowly increase trading size and leverage.

I digress on a tangent ... but I'm just trying to point out good trading takes time and lots of work and analysis. R is a great tool for this, and lightens the workload and speeds up the development process.

EZ
  • #6
  • Dec 26, 2016 12:06am Dec 26, 2016 12:06am
Quoting ezcurrency
Here is my screenshot for the same for 50:50 chance (random walk) coin flip: {image} Code: sequenceOfCoinTosses <- sample(c(-1,1), 10000, replace = TRUE, prob=c(0.5,0.5)) plot(cumsum(sequenceOfCoinTosses), type = 'l', ylab="", main="Sum of 10000 coin tosses") abline(h=0) Now change the above code to reflect probabilities of 0.52 and 0.48 we get this: {image} So if there is just a 2% edge we get a trend instead of a random walk. That is our goal. Just get a slight edge. In trading that edge is ever elusive. Systems tend to work for a while, then...
Thanks for your post. Yes this shows how just a small difference in the probabilities can tilt the game quite dramatically. In fact with a 1:1 reward:risk ratio and the cost of executing a scalping system in terms of fills/spreads the equity chart often looks a lot like your second downward sloping chart (52/48). I've seen that more times than I'd like! Also throw in the fact that the real market up/down or system win/loss probabilities shift over time as you alluded, its far from an exact science and requires diversification.

I like how short your code is. Mine is in a loop because I was playing around with the "trials" variable in an attempt to see if using different numbers of trials and summing them up together would result in anything that was more predictably centered around zero. I didn't find that this was the case.
  • #7
  • Edited 2:35pm Dec 26, 2016 12:39am | Edited 2:35pm
#1) POE The percent of equity money management method is of interest to me. Essentially your trade size varies with your account (bank) size. This is a quick investigation some of the issues with this MM strategy:
Inserted Code
# % of equity simple example
# take a series of wl trades where wl is an even number
# with an equal number of wins and losses
bank = 1000; lev = 1 # bank and leverage
 
wl = c(1,-1,1,-1) # 1 is a win, -1 is a loss
tpsl = 0.002; wl = wl * tpsl # make each win/loss 20 pips
 
eq = rep(0,  length(wl)) # calculate equity over time
size = rep(0, length(wl)) # trade size over time
for (i in 1:length(wl)) {
  size[i] = bank * lev
  bank = bank + size[i] * wl[i]
  eq[i] = bank
}
cbind(wl, size, eq)
output with leverage == 1:
Inserted Code
         wl     size       eq
[1,]  0.002 1000.000 1002.000
[2,] -0.002 1002.000  999.996
[3,]  0.002  999.996 1001.996
[4,] -0.002 1001.996  999.992
As the equity varies over time the trade size is more after wins and less after losses. So after 4 "trades" in the series WLWL with equal sizing (not shown) we would start/end with a $1000 bank/account or no negative drag effect.

However with % of equity sizing we start with $1000 but end up with less ($999.992: see above).

If we increase the leverage from 1 up to 20, the results of this negative drag are even more egregious ($996.8026) after just 4 trades - like a negative interest rate.
Inserted Code
         wl     size        eq
[1,]  0.002 20000.00 1040.0000
[2,] -0.002 20800.00  998.4000
[3,]  0.002 19968.00 1038.3360
[4,] -0.002 20766.72  996.8026
So to summarize, there is a negative drag caused by this % of equity MM strategy given no advantage (a 50/50 outcome where the number of wins is exactly equal to the number of losses). Can the MM strategy be found that is the inverse of the % of equity sizing such that instead of a negative drag we get a positive boost to the account? What are the properties of this inverse MM strategy and how do they compare with the regular % of equity method in terms of pro/con? More to come later...
  • #8
  • Edited 2:35pm Dec 26, 2016 11:43am | Edited 2:35pm
#2) POE More with percent of equity money management:

Again starting with the assumption that you have exactly a 50% win/lose rate and a 1:1 reward:risk ratio and in this case a 20 pip take profit/stop loss. When using a leverage of 1 and 1000 trials it appears that the percent of equity MM is almost breaking even.
Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot1.png Size: 18 KB
But it is slightly below the starting red line $1000 (998.002). The effect is more pronounced when you increase leverage. This toy example is set up in a way so that the wins and losses are exactly equal each time. As previously mentioned in studies of random number generators and random walks, this isn't a valid assumption. However doing it this way isolates just the effect of the money management rather than the effects of the increasing/decreasing win/loss rate over time. Here is the picture with leverage of 5, 20 and 100 from top to bottom with ending bank balances of 951.227, 449.0412 and 0.8477 respectively.
Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot2.png Size: 26 KB
You can repeat this experiment multiple times with the same leverage values and you always end up with the exact same ending bank balance due to the constraint on exactly a 50% win rate. Some curves spend more time above the red line (in profit) and note that the top curve spends more time, while the bottom curve doesn't spend much time in positive territory at all.

Note the bottom subgraph above only has 277 trials. The code jumps out when equity < $1 where the account is effectively "blown". Also note the asymptotic approach to zero. One of the nice features of percent of equity MM is that it doesn't go to zero, just approaches zero, thus by that criteria it isn't possible to "blow out" an account. However for practical purposes at some point the account becomes permanently impaired and unable to recoup in practical terms.

Inserted Code
# % of equity simple example
# take a series of wl trades where wl is an even number
# with an equal number of wins and losses
bank = 1000; lev = 100; startbank = bank# bank and leverage
trials = 1000
tpsl = 0.002; wl = 1 # make each win/loss 20 pips
while (sum(wl) !=0) wl = sample(c(-tpsl, tpsl), trials, replace=T, prob=c(0.5, 0.5))
eq = rep(0,  length(wl)) # calculate equity over time
size = rep(0, length(wl)) # trade size over time
for (i in 1:length(wl)) {
  size[i] = bank * lev
  bank = bank + size[i] * wl[i] #take a position*wl
  eq[i] = bank
  if (eq[i] < 1) break # allow for early termination when equity declines below 1
}
eq = eq[1:i]; size = size[1:i]
plot(eq, t='l', ylab='Equity'); abline(h=startbank, col='red')
So I think I can summarize these posts on percent of equity money management by saying that applying this MM strategy to a system with no edge is extremely dangerous and using high leverage with % of equity MM with no edge will kill an account very quickly! By contrast, let's remember that equal sizing with an edgeless system will break even when win/loss rate is 50% and will lose when the win rate is below 50% for even odds: 1:1 reward to risk, but will not asymtotically approach zero as % of equity money management will do.

So based on this, my advice for new traders and traders with untested or edgeless systems is to use fixed lot sizing and avoid percent of equity money management, or better yet not to trade at all until you develop a system with a proven edge.
  • #9
  • Edited 2:35pm Dec 26, 2016 12:46pm | Edited 2:35pm
#3) POE Percent of Equity money management comparison using opposite signals, and combined equity curve:

What if we took regular and opposite signals and traded two POE accounts? And what if we averaged these two POE curves into a single equity curve? I kept the leverage value at 100 (high leverage) so the conclusion would be obvious. It is apparent that both POE and opposite POE (subgraphs #1 and #2 respectively) approach zero but with different shapes. The combined curve also approaches zero but with a smoother curve due to the averaging.
Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot1.png Size: 23 KB

But there is a great deal of variation in the curves depending on how the series of wins/losses come in (the unique path of wins/losses). I ran it again several times and in case you're getting ideas (as I am) about how this POE MM could be inverted and traded the other way, there is significant volatility in some of the outcomes as shown in this chart. Even the averaged chart makes a valiant run up at the start into profit territory even though during that time equity curve #1 is tanking.
Attached Image (click to enlarge)
Click to Enlarge Name: Screenshot2.png Size: 22 KB

Inserted Code
# % of equity comparison with two curves example
# take a series of wl trades where wl is an even number
# with an equal number of wins and losses
bank = 1000; lev = 100; startbank = bank# bank and leverage
bank2 = bank # compute opposite signals for this account
trials = 1000
tpsl = 0.002; wl = 1 # make each win/loss 20 pips
while (sum(wl) !=0) wl = sample(c(-tpsl, tpsl), trials, replace=T, prob=c(0.5, 0.5))
eq = rep(0,  length(wl)) # calculate equity over time
size = rep(0, length(wl)) # trade size over time
eq2 = eq; size2 = size # compute equity, size variables for opposite
for (i in 1:length(wl)) {
  size[i] = bank * lev;   size2[i] = bank2 * lev
  bank = bank + size[i] * wl[i] #take a position*wl
  bank2 = bank2 + size2[i] *-wl[i] # do opposite trades
  eq[i] = bank; eq2[i] = bank2
  if (eq[i] + eq2[i] < 1) break # allow for early termination when equity declines
}
eq = eq[1:i]; size = size[1:i]
eq2 = eq2[1:i]; size2 = size2[1:i]
blackplot(3,1)
plot(eq, t='l', ylab='Equity'); abline(h=startbank, col='red')
plot(eq2, t='l', ylab='Equity #2'); abline(h=startbank, col='red')
plot((eq+eq2)/2, t='l', ylab='Combined Equity'); abline(h=startbank, col='red')
  • #10
  • Edited 2:48pm Dec 26, 2016 2:32pm | Edited 2:48pm
Although I have zero experience with R (or things like matlab) and relatively modest experience with other languages (mostly mql, c and some web, html..) over the years I've managed to make quite a few experiments regarding algo trading (and trading prob.stats. as a whole).
So, I am able to share some of my experiences and insights.
I have no intention to post my code here, only my theoretical conclusions and philosophical insights based on my research.

If the OP considers the following for off topic - feel free to delete my post!
------------------------------------------------------------------------------------------------

What most people don't realize, is that forex trading by default is a NEGATIVE sum game for the retail trader! The reason for this is the combined effect of the spread, the commissions and the negative swaps and slippage. In short this is the COST of trading.

It is not exaggeration to say that the COST is the real reason why 99% of unprofitable traders are losing money in the long run.
The COST is the number one enemy of the retail trader!

In the context of retail trading, to beat the market, means to beat the cost!
Things are getting ever worse for retail traders, when you add leverage, because with leverage you magnify the cost, so you make the problem even larger. (Leverage gives more power to your major enemy!)

By the way, do you believe me if i tell you this:
You give me only 5 parameters of your strategy, and I will predict,(roughly) after how many days you account balance will equal 0(zero $)?
I only need to know :
1. The balance of your trading account ($$).
2. The spreads and the commissions(from your broker).
3. The % of winning trades.
4. The average leverage per trade.
5. How many trades per day you make on average.
That's all i need.....

You see, the reality is this:
Without the COST and the leverage, losing(and winning) money by Forex trading is almost impossible! The account will just fluctuate around zero in the long run.

So from all this, the obvious conclusion is, that if you cannot beat the COST (consistently) you will lose money in the long run.
The cost is the equivalent of the zero on the roulette......
HOWEVER, it is possible to beat the market! There are ways......just like there are ways to beat the roulette! (The casinos hate this!!!)

To beat the market (and to overcome the cost) you need statistical edge.
Statistical edge means positive mathematical expectancy per trade.

Look, It's very simple equation:
if your edge = 0 (as is the case with 95% of traders) then your expectancy per trade = the COST .
if your edge > the COST then you will you make A LOT of money in the long run, as long as you maintain the edge and as long as you stay away from too high leverage.

Of course the next logical questions is - how to find statistical edge?

I already wrote about this in one of my previous posts in another thread, so without repeating myself too much, i will say this:

The only way to find statistical edge is to search for market anomalies***! That's it.
*** market anomalies means any type of repeatable and recognizable models of market/price behavior which represents significant deviation from random walk.
We are looking for "fat tails" on the bell curve!
We are looking for extremes.
Either trend/momentum extremes, or unusually stable ranges.
And of course we are looking for any type of information advantage.

Everything else(along with 98% of technical analysis) falls in the category "random walk" and there is no real edge there!
------------------------------------------------------------------------------------
Almost all traders seriously underestimate the cost!
NEVER underestimate your enemy! NEVER!

Just an example:

Assuming you have no edge (like 95% of traders)

account = 1000
cost = 1pips (this is optimistic)
with leverage 1:1:
After 1000 trades ---> account = 900+- net P/L (if any)
(you lose 10% of the account JUST by the COST!)

with leverage 10:1:
After 1000 trades ---> account = 0 +- net P/L (if any) (you lose 100% of the account JUST by the COST)

And if you think that 1000 trades is a lot.... THINK AGAIN!

1000 trades is approximately 4 trades per day for one year! Most active day traders make a lot more than that!

Have you heard the statistic that the majority of traders lose their entire account within 6 months (on average)?

Now you know exactly why and how it happens!
  • #11
  • Dec 26, 2016 4:14pm Dec 26, 2016 4:14pm
Thanks FXEZ for putting up this thread and thanks guys for your valuable contributions. Very interesting stuff here that really helps seperate the wheat from the chaff. :-)
  • #12
  • Edited Dec 27, 2016 2:18am Dec 26, 2016 9:50pm | Edited Dec 27, 2016 2:18am
Quoting FXEZ
Random walks - there are many ways to build these but just using some of the functions in R to produce a cumulative series of random numbers shows the same principle: That while in a 50/50 coin flip you should get an equal number of heads and tails, but in practice with a long series there tends to be significant drift and the series seem to rarely center around zero (as in the red line in the pic). In fact, there is no guarantee that the up/down moves will equalize. Most of the time they do not. (I'll post some code later than helps ensure equal...
FXEZ,

Great post

Though I do have to point out that random number algo in R or any other algo-based RN generators are pseudo-random and assumptions made base on pseudo random could deviate from their intended purposes. A solution to this problem is to use hardware random number generators.

http://ubld.it/products/truerng-hard...ber-generator/
https://en.wikipedia.org/wiki/Hardwa...mber_generator

Carry on
No Highs? No Lows? Must be Bose!
  • #13
  • Dec 26, 2016 10:03pm Dec 26, 2016 10:03pm
R code for Cointegrated baskets (Part 1)

This post will be long (code-wise), so will be in parts. I was looking through my old R files, and found this which I was working on a year or so ago. The idea was to find co-integrated baskets of 2 pairs or 3 pairs to trade. The analysis was done in R, then I was working on a MT4 EA to monitor select baskets for moves at X number of standard deviations (1 to 2) to enter the basket. The R code is complete, but the EA was never finished. If you are not familiar with cointegrated pairs or baskets, Google it, as there is a lot of background info on the web.

I first ran a script to download 1 hr data into a folder (I can't seem to find the script though). The R code then imported the data and cleaned it. It calculated the approximate dollar value for a 1 pip move. The analysis is then based off of this.

** FXEZ (or anyone else) -- do you think this is the best way to do this? The other way is to do the linear regression analysis on raw prices ... but the problem is that some currency pairs are orders magnitude different (think JPY crosses: xxx.xx and EURUSD: x.xxxx). This makes the coefficient very small or very large. I have thought of doing % change from previous bar also ... but want to get the opinion of others here.

Inserted Code
# function to read in and clean data
clean <- function(x, y) {
  #read in data
  setwd("C:/Users/Don/Documents/FX data/1 hr data test")
  f <- paste(y, ".csv", sep="")
  z <- read.csv(f, header=FALSE)
  z$DateTime <- as.factor(paste(z$V1, z$V2))
  z<- z[,c(8,6)]
  colnames(z) <- c("date",y)
  return(z)
}
# read in data and clean for all pairs, using approximate $ value of 1 pip move
# this essentially scales everything so its same order of magnitue, and also 
# accounts (approximately) for the different dollar values of each pair movement 
audcad <- clean(audcad, "AUDCAD"); audcad$AUDCAD <- audcad$AUDCAD*0.91*10000
audchf <- clean(audchf, "AUDCHF"); audchf$AUDCHF <- audchf$AUDCHF*1.07*10000
audjpy <- clean(audjpy, "AUDJPY"); audjpy$AUDJPY <- audjpy$AUDJPY*0.92*100
audnzd <- clean(audnzd, "AUDNZD"); audnzd$AUDNZD <- audnzd$AUDNZD*0.82*10000
audusd <- clean(audusd, "AUDUSD"); audusd$AUDUSD <- audusd$AUDUSD*10000
cadchf <- clean(cadchf, "CADCHF"); cadchf$CADCHF <- cadchf$CADCHF*0.86*10000
cadjpy <- clean(cadjpy, "CADJPY"); cadjpy$CADJPY <- cadjpy$CADJPY*0.92*100
chfjpy <- clean(chfjpy, "CHFJPY"); chfjpy$CHFJPY <- chfjpy$CHFJPY*0.92*100
euraud <- clean(euraud, "EURAUD"); euraud$EURAUD <- euraud$EURAUD*0.89*10000
eurcad <- clean(eurcad, "EURCAD"); eurcad$EURCAD <- eurcad$EURCAD*0.91*10000
eurchf <- clean(eurchf, "EURCHF"); eurchf$EURCHF <- eurchf$EURCHF*1.07*10000
eurgbp <- clean(eurgbp, "EURGBP"); eurgbp$EURGBP <- eurgbp$EURGBP*1.64*10000
eurjpy <- clean(eurjpy, "EURJPY"); eurjpy$EURJPY <- eurjpy$EURJPY*0.92*100
eurnzd <- clean(eurnzd, "EURNZD"); eurnzd$EURNZD <- eurnzd$EURNZD*0.81*10000
eurusd <- clean(eurusd, "EURUSD"); eurusd$EURUSD <- eurusd$EURUSD*10000
gbpaud <- clean(gbpaud, "GBPAUD"); gbpaud$GBPAUD <- gbpaud$GBPAUD*0.89*10000
gbpcad <- clean(gbpcad, "GBPCAD"); gbpcad$GBPCAD <- gbpcad$GBPCAD*0.90*10000
gbpchf <- clean(gbpchf, "GBPCHF"); gbpchf$GBPCHF <- gbpchf$GBPCHF*1.06*10000
gbpjpy <- clean(gbpjpy, "GBPJPY"); gbpjpy$GBPJPY <- gbpjpy$GBPJPY*0.92*100
gbpusd <- clean(gbpusd, "GBPUSD"); gbpusd$GBPUSD <- gbpusd$GBPUSD*1.00*10000
nzdcad <- clean(nzdcad, "NZDCAD"); nzdcad$NZDCAD <- nzdcad$NZDCAD*0.9*10000
nzdchf <- clean(nzdchf, "NZDCHF"); nzdchf$NZDCHF <- nzdchf$NZDCHF*1.06*10000
nzdjpy <- clean(nzdjpy, "NZDJPY"); nzdjpy$NZDJPY <- nzdjpy$NZDJPY*0.92*100
nzdusd <- clean(nzdusd, "NZDUSD"); nzdusd$NZDUSD <- nzdusd$NZDUSD*1.00*10000
usdcad <- clean(usdcad, "USDCAD"); usdcad$USDCAD <- usdcad$USDCAD*0.90*10000
usdchf <- clean(usdchf, "USDCHF"); usdchf$USDCHF <- usdchf$USDCHF*1.06*10000
usdjpy <- clean(usdjpy, "USDJPY"); usdjpy$USDJPY <- usdjpy$USDJPY*0.92*100

# merge data
tmp1 <- merge (audcad, audchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, audjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, audnzd, by="date", all=TRUE)
tmp1 <- merge (tmp1, audusd, by="date", all=TRUE)
tmp1 <- merge (tmp1, cadchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, cadjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, chfjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, euraud, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurcad, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurgbp, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurnzd, by="date", all=TRUE)
tmp1 <- merge (tmp1, eurusd, by="date", all=TRUE)
tmp1 <- merge (tmp1, gbpaud, by="date", all=TRUE)
tmp1 <- merge (tmp1, gbpcad, by="date", all=TRUE)
tmp1 <- merge (tmp1, gbpchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, gbpjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, gbpusd, by="date", all=TRUE)
tmp1 <- merge (tmp1, nzdcad, by="date", all=TRUE)
tmp1 <- merge (tmp1, nzdchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, nzdjpy, by="date", all=TRUE)
tmp1 <- merge (tmp1, nzdusd, by="date", all=TRUE)
tmp1 <- merge (tmp1, usdcad, by="date", all=TRUE)
tmp1 <- merge (tmp1, usdchf, by="date", all=TRUE)
tmp1 <- merge (tmp1, usdjpy, by="date", all=TRUE)
##tmp1 <- merge (tmp1, usdmxn, by="date", all=TRUE)
x<-tmp1
  • #14
  • Dec 26, 2016 10:19pm Dec 26, 2016 10:19pm
R code for Cointegrated baskets (part 2)

Now that we have the data frame 'x' of all prices (data massaged and scaled as described above), we normally would do a linear regression of each pair on each other to calculated the coefficients and then calculate the spread. The problem is if we use linear regression of x on y, we get coefficient c. Now if we do a linear regression of y on x, we might not get coefficient 1/c.

The way around this is to use PCA (Principal Component Analysis). That way you get coefficient c regardless if you regress x on y or y on x.

Now, once we have the coefficient, we calculate the spread, and run an ADF (Augmented Dickey Fuller) test to see if the spread is cointegrated (mean reverting), and use a p-value of 0.05 as the cutoff. All pairs which meet this criteria are outputted to an excel spreadsheet. We can then rapidly sort and see which pairs have the spread beyond the +/- 1 standard deviation. This will give a bunch of cointegrated pairs which are statistically over bought or oversold, and candidates for taking a position.

The next post will create functions to create graphs of the spreads.

Inserted Code
################ test all pairs
## loop through all combinations of 2 pairs to put p value into matrix
library("tseries")
file.remove("C:\\Users\\Don\\Documents\\Cointegrated baskets\\2 pairs\\2pairs.csv")
for(i in 2:dim(x)[2]) {
  for(j in 2:dim(x)[2]) {
    if (i==j){
    }
    else {
      # TLS
      r <- princomp ( ~ x[,i] + x[,j], data=x)
      cf <- r$loadings [1 ,1] / r$loadings [2 ,1]
      spread <- x[,i] - cf *x[,j]
      ht <- tryCatch(adf.test(spread, alternative="stationary", k=0))
      if (inherits(ht, "try-error"))
      {continue}
      if (ht$p.value < 0.05) {
        z <- paste(i, j, names(x[i]),names(x[j]),
                   format(cf, format="f", digits=6),
                   format(ht$p.value, format="f", digits=6), 
                   format((mean(spread)), format="f", digits=6), 
                   format((sd(spread)), format="f", digits=6),
                   spread[dim(x)[1]], sep = ",")
        write.table(z, file ="C:\\Users\\Don\\Documents\\Cointegrated baskets\\2 pairs\\2pairs.csv", sep = ",", 
                    row.names=FALSE, col.names=FALSE, quote=FALSE, append=TRUE)
      }  
    }
  }
}
  • #15
  • Dec 26, 2016 10:22pm Dec 26, 2016 10:22pm
Quoting ezcurrency
... The other way is to do the linear regression analysis on raw prices ... but the problem is that some currency pairs are orders magnitude different (think JPY crosses: xxx.xx and EURUSD: x.xxxx). This makes the coefficient very small or very large.
One can use correlation coefficient which does not depend on absolute values of tested variables.
I am also not sure that prices are normally distributed.
  • #16
  • Dec 26, 2016 10:27pm Dec 26, 2016 10:27pm
R for Cointegrated baskets (Part 3)

Now that we have our spreadsheet with good candidates for trade entry, we need to visualize the spread along with its mean and +/- 1 and 2 stdev. I created a function to do this. Once the function is loaded, you type 'f2(x,y)' where x, y are #'s corresponding to each pair from the spreadsheet. You then get graphs like the samples attached here.

Attached Image


Attached Image


Attached Image


Inserted Code
# function to plot spread of 2 pair basket
#
f2 <- function(a,b){
  # TLS
  r <- princomp ( ~ x[,a] + x[,b], data=x)
  cf <- r$loadings [1 ,1] / r$loadings [2 ,1]
  spread <- x[,a] - cf * x[,b]
  ht <- adf.test(spread, alternative="stationary", k=0)
  plot(spread, type="l", main = paste(names(x[a]), "-", formatC(cf, format="f",
                                                                digits=3),"*", names(x[b]), "p-value:",formatC(ht$p.value, format="f", digits=3)))
  abline(h=mean(spread))
  abline(h=mean(spread)+sd(spread), col="green")
  abline(h=mean(spread)+2*sd(spread), col="green")
  abline(h=mean(spread)-sd(spread), col="red")
  abline(h=mean(spread)-2*sd(spread), col="red")
  #points(EMA(spread, n=7), col="blue", type="l")
}
  • #17
  • Dec 26, 2016 10:49pm Dec 26, 2016 10:49pm
R for Cointegrated baskets (Part 4)

Referring to the last graph above of GBPJPY - 1.107*USDJPY:

We have about 1000 hours of data to produce this graph. If price were to go to the -1 stdev, we can they buy 1 unit of GJ, and short 1.1 units of UJ, and exit at the mean line for a profit. Vice versa, if it goes to the +1 stdev line, we short 1 unit of GJ, and buy 1.1 units of UJ.

But what is the optimal place to enter? 1 stdev? 1.5? 1.8? 2? I created a function below which uses the PerformanceAnalytics package to plot an equity curve and drawdown. The function takes input of pairs a and b (#'s as before), # of stdev to enter the position, and also an EMA length as an additional filter. The EMA is an EMA of the spread. If the spread is < -1 stdev for instance and still going down, the spread must be above the EMA (so uptrending) in order to go long. This reduces DD.

Inserted Code
# simulate trading for 2 pairs
library("PerformanceAnalytics")
library("gplots")
library("ggplot2")
library("TTR")
library("quantmod")

st2 <- function(a,b,nStd,emaLength){
  count <- 0
  r <- princomp ( ~ x[,a] + x[,b], data=x )
  cf <- r$loadings [1 ,1] / r$loadings [2 ,1]
  spread <- x[,a] - cf *x[,b]
  ht <- adf.test(spread, alternative="stationary", k=0)
  upperThreshold = mean(spread) + nStd*sd(spread)
  lowerThreshold = mean(spread) - nStd*sd(spread)  
  aboveMAvg <- spread>mean(spread)
  belowMAvg <- spread<mean(spread)
  aboveUpperBand <- spread>upperThreshold
  belowLowerBand <- spread<lowerThreshold
  aboveUpperBand[is.na(aboveUpperBand)]<-0
  belowLowerBand[is.na(belowLowerBand)]<-0
  
  #The cappedCumSum function is where the magic happens
  #Its a nice trick to avoid writing a while loop
  #Hence since using vectorisation is faster than the while loop
  #The function basically does a cumulative sum, but caps the sum to a min and max value
  #It's used so that if we get many 'short sell triggers' it will only execute a maximum of 1 position
  #Short position - Go short if spread is above upper threshold and go long if below the moving avg
  #Note: shortPositionFunc only lets us GO short or close the position
  cappedCumSum <- function(g, h,max_value,min_value) max(min(g + h, max_value), min_value)
  shortPositionFunc <- function(g,h) { cappedCumSum(g,h,0,-1) }
  longPositionFunc <- function(g,h) { cappedCumSum(g,h,1,0) }
  shortPositions <- Reduce(shortPositionFunc,-1*aboveUpperBand+belowMAvg,accumulate=TRUE)
  longPositions <- Reduce(longPositionFunc,-1*aboveMAvg+belowLowerBand,accumulate=TRUE)
  positions = longPositions + shortPositions
  
  dev.new()
  plot(spread, type="l",main = paste(names(x[a]), " ", formatC(cf, format="f",
                                                               digits=3),"*", names(x[b]), "p-value: ",formatC(ht$p.value, format="f", digits=3)))
  abline(h=mean(spread))
  abline(h=mean(spread)+sd(spread), col="green")
  abline(h=mean(spread)+2*sd(spread), col="green")
  abline(h=mean(spread)-sd(spread), col="red")
  abline(h=mean(spread)-2*sd(spread), col="red")
  plot((positions),type='l')
  abline(h=0)
  
  # Calculate spread daily return with actual price data
  aRet <- Delt(x[,a],k=1,type="arithmetic")
  bRet <- Delt(x[,b],k=1,type="arithmetic")
  aRet <- x[,a]
  bRet <- x[,b]
  dailyRet <- aRet + cf*bRet
  dailyRet[is.na(dailyRet)] <- 0
  tradingRet <- spread * positions
  
  plot(cumsum(tradingRet), type="l")
  
  tradingRet <- Delt(tradingRet, k=1, type="arithmetic")
  tradingRet[is.na(tradingRet)] <- 0
  tradingRet[is.infinite(tradingRet)] <- 0
  tst <- data.frame(date = as.Date(x$date, "%Y%m%d"), ret=tradingRet)
  tst1 <<- read.zoo(tst)
  # output to chart
  charts.PerformanceSummary(tst1[2:1560],main="Performance",geometric=TRUE)
  simulateTrading <- tradingRet
  print(Return.cumulative(tst1))
}
  • #18
  • Dec 26, 2016 11:29pm Dec 26, 2016 11:29pm
Seasonality and Pivot Point Probabilities

The below code requires TeX to be installed, but produces great pdf's of your analysis. Refer to the attached pdf for this post.

This code below analyzed several years of data to produce seasonality graphs. Many currency pairs have very strong seasonal moves, which we can take advantage of. Ex: USDJPY from Feb to March, or Nov till the end of the year.

So if we know that statistically in the past, UJ has gone up for certain months of the year, we can create a trading system to take advantage of that. The trading system is based off of probabilities of pivot point levels being exceeded. If we know historically that seasonality may occur and UJ runs up at the end of the year, then refer to the 'CURRENT UP MONTH, WEEK, and DAY pivot analysis' table. This has the historical probabilities for all up months, weeks, and days.

Lets refer to the weekly part of the table. The probability of the L being < Pivot is 0.77, the prob. of L < S1 is 0.17, and prob. of H > R1 is 0.68.

We can set limit orders at the start of the week to buy at the pivot (chances are it will get filled), with TP at R1 and SL at S1. If you know the distance from P to S1 and P to R1, you can calculate an expected gain for the trade.

Do this consistently across pairs which have strong seasonality, and statistically you have a high chance of making a lot of pips! ;-)

Inserted Code
\documentclass{article}
\usepackage[top=0.5in, bottom=1in, left=0.5in, right=0.in]{geometry}
\usepackage[labelformat=empty]{caption} % remove table 1 etc...
\usepackage{subfig}
\begin{document}
<<load1, echo=FALSE, results='hide', warning=FALSE, message=FALSE>>=
require(ggplot2)
require(xtable)
require(gplots)
require(MASS)
@
\title{USDJPY analysis}
<<Range, eval=TRUE, echo=FALSE, fig.width=7, fig.height=4, warning=FALSE>>=
wd <- "C:/Users/Don/Documents/FX data/daily"
setwd(wd)
x <- read.csv("USDJPY1440.csv", header=FALSE)
x1 <- x
x1$V1 <- as.Date(x1$V1, "%Y.%m.%d")

y2015 <- subset(x1, x1$V1 > as.Date("2015-01-01"))
y2015$date <- as.Date(y2015$V1, "%Y-%m-%d")
y2015$a <- y2015$V6/y2015$V6[1]
y2014 <- subset(x1, x1$V1 > as.Date("2014-01-01") & (x1$V1 < as.Date("2015-01-01")))
y2013 <- subset(x1, x1$V1 > as.Date("2013-01-01") & (x1$V1 < as.Date("2014-01-01")))
y2012 <- subset(x1, x1$V1 > as.Date("2012-01-01") & (x1$V1 < as.Date("2013-01-01")))
y2011 <- subset(x1, x1$V1 > as.Date("2011-01-01") & (x1$V1 < as.Date("2012-01-01")))
y2010 <- subset(x1, x1$V1 > as.Date("2010-01-01") & (x1$V1 < as.Date("2011-01-01")))
y2009 <- subset(x1, x1$V1 > as.Date("2009-01-01") & (x1$V1 < as.Date("2010-01-01")))
y2008 <- subset(x1, x1$V1 > as.Date("2008-01-01") & (x1$V1 < as.Date("2009-01-01")))
y2007 <- subset(x1, x1$V1 > as.Date("2007-01-01") & (x1$V1 < as.Date("2008-01-01")))
y2006 <- subset(x1, x1$V1 > as.Date("2006-01-01") & (x1$V1 < as.Date("2007-01-01")))

y2014$a <- y2014$V6/y2014$V6[1]
y2013$a <- y2013$V6/y2013$V6[1]
y2012$a <- y2012$V6/y2012$V6[1]
y2011$a <- y2011$V6/y2011$V6[1]
y2010$a <- y2010$V6/y2010$V6[1]
y2009$a <- y2009$V6/y2009$V6[1]
y2008$a <- y2008$V6/y2008$V6[1]
y2007$a <- y2007$V6/y2007$V6[1]
#length(y2012$V1)
avg3 <- (y2014$a+y2013$a+y2012$a)/3
avg5 <- (y2014$a+y2013$a+y2012$a+y2011$a+y2010$a)/5
avg7 <- (y2014$a+y2013$a+y2012$a+y2011$a+y2010$a+y2009$a+y2008$a)/7
#avg7<-avg7[1:260]
require(ggplot2)
dt <- format(y2012$V1, format = "%m-%d") 
df <- data.frame(date=y2012$V1, price3=avg3, price5=avg5, price7=avg7)
df2 <- data.frame(date=y2015$V1, y15=y2015$a)
p <- ggplot(df, aes(x=date, y=price3)) + geom_line(size=0.7) + ylab("% move") +  labs(title = "USDJPY historical % moves") 
p + geom_line(aes(x = date, y = price5, colour="5 yr"), colour="red") + 
  geom_line(aes(x = date, y = price7), colour="blue") 
 
@
Black = 3 year average \hspace{3.0cm}
Red = 5 year average \hspace{3.0cm}
Blue = 7 year average \hspace{3.0cm}

\section*{CURRENT UP MONTH, WEEK, and DAY pivot analysis}
<<label=tab1, echo = FALSE, eval=TRUE, results='asis'>>=
# monthly
wd <- "C:/Users/Don/Documents/FX data/monthly"
setwd(wd)
x <- read.csv("USDJPY43200.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# UP WEEKS
up <- df[df$close > df$open,]
# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
monthlyUP <- data.frame(PivotLevels, HL, Close)
# Weekly
wd <- "C:/Users/Don/Documents/FX data/weekly"
setwd(wd)
x <- read.csv("USDJPY10080.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# UP WEEKS
up <- df[df$close > df$open,]
# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
weeklyUP <- data.frame(PivotLevels, HL, Close)
# daily
wd <- "C:/Users/Don/Documents/FX data/daily"
setwd(wd)
x <- read.csv("USDJPY1440.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# UP DATS
up <- df[df$close > df$open,]
# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
dailyUP <- data.frame(PivotLevels, HL, Close)

# output to files
setwd("C:/Users/Don/Documents/R scripts for MT4 report analysis/FINAL Report weekly and daily range analysis")
print(xtable(monthlyUP), file="monthlyUP.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(weeklyUP), file="weeklyUP.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(dailyUP), file="dailyUP.tex", floating=FALSE,include.rownames=FALSE)
#print(xtable(cbind(monthly,weekly)),include.rownames=FALSE)
@
\begin{table}[ht]
\centering
\subfloat[Monthly]{\label{tab:tab1a}\scalebox{1.1}{\input{./monthlyUP}}}\quad
\subfloat[Weekly]{\label{tab:tab1b}\scalebox{1.1}{\input{./weeklyUP}}}
\subfloat[Daily]{\label{tab:tab1b}\scalebox{1.1}{\input{./dailyUP}}}

\caption{Probabilities of H/L moves and Close beyond pivot levels}
\label{tab:tab1}
\end{table}
\section*{CURRENT DOWN MONTH, WEEK, and DAY pivot analysis}
<<label=tab2, echo = FALSE, eval=TRUE, results='asis'>>=
# monthly
wd <- "C:/Users/Don/Documents/FX data/monthly"
setwd(wd)
x <- read.csv("USDJPY43200.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# DOWN WEEKS
down <- df[df$close < df$open,]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
monthly <- data.frame(PivotLevels, HL, Close)
# Weekly
wd <- "C:/Users/Don/Documents/FX data/weekly"
setwd(wd)
x <- read.csv("USDJPY10080.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# DOWN WEEKS
down <- df[df$close < df$open,]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
weekly <- data.frame(PivotLevels, HL, Close)
# daily
wd <- "C:/Users/Don/Documents/FX data/daily"
setwd(wd)
x <- read.csv("USDJPY1440.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
}
# DOWN DAYS
down <- df[df$close < df$open,]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
daily <- data.frame(PivotLevels, HL, Close)

# output to files
setwd("C:/Users/Don/Documents/R scripts for MT4 report analysis/FINAL Report weekly and daily range analysis")
print(xtable(monthly), file="monthly.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(weekly), file="weekly.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(daily), file="daily.tex", floating=FALSE,include.rownames=FALSE)
#print(xtable(cbind(monthly,weekly)),include.rownames=FALSE)
@
\begin{table}[ht]
\centering
\subfloat[Monthly]{\label{tab:tab1a}\scalebox{1.1}{\input{./monthly}}}\quad
\subfloat[Weekly]{\label{tab:tab1b}\scalebox{1.1}{\input{./weekly}}}
\subfloat[Daily]{\label{tab:tab1b}\scalebox{1.1}{\input{./daily}}}

\caption{Probabilities of H/L moves and Close beyond pivot levels}
\label{tab:tab1}
\end{table}
\newpage
\section*{PREVIOUS UP MONTH, WEEK, and DAY pivot analysis}
<<label=tab3, echo = FALSE, eval=TRUE, results='asis'>>=
# monthly
wd <- "C:/Users/Don/Documents/FX data/monthly"
setwd(wd)
x <- read.csv("USDJPY43200.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
}
# UP MONTHS
up <- df[df$prev==1,]
# if prev period up, percent chance current period is up
monthUP <- up[up$close>up$open,]
probMonthUp <- dim(monthUP)[1]/dim(up)[1]

# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
monthlyUPprev <- data.frame(PivotLevels, HL, Close)
# Weekly
wd <- "C:/Users/Don/Documents/FX data/weekly"
setwd(wd)
x <- read.csv("USDJPY10080.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
df$prevS1 <- vector(mode="numeric", length=dim(df)[1])
df$prevR1 <- vector(mode="numeric", length=dim(df)[1])
df$prevS2 <- vector(mode="numeric", length=dim(df)[1])
df$prevR2 <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
  df$prevS1[i] <-ifelse(df$low[i-1]<df$S1[i-1],1,-1)
  df$prevR1[i] <-ifelse(df$high[i-1]>df$R1[i-1],1,-1)
  df$prevR2[i] <-ifelse(df$high[i-1]>df$R2[i-1],1,-1)
  df$prevS2[i] <-ifelse(df$low[i-1]<df$S2[i-1],1,-1)
}
# UP WEEKS
up <- df[(df$prevR2==1),]
# if prev period up, percent chance current period is up
weekUP <- up[up$close>up$open,]
probWeekUp <- dim(weekUP)[1]/dim(up)[1]
# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
weeklyUPprev <- data.frame(PivotLevels, HL, Close)
# daily
wd <- "C:/Users/Don/Documents/FX data/daily"
setwd(wd)
x <- read.csv("USDJPY1440.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
}
# UP DAYS
up <- df[df$prev==1,]
# if prev period up, percent chance current period is up
dayUP <- up[up$close>up$open,]
probDayUp <- dim(dayUP)[1]/dim(up)[1]
# Prob H > R2 for up weeks
tmp <- up$P[(up$high > up$R2)]
upPHR2 <- length(tmp)/dim(up)[1]
# Prob H > R1 for up weeks
tmp <- up$P[(up$high > up$R1)]
upPHR1 <- length(tmp)/dim(up)[1]
# Prob L < Pivot for up weeks
tmp <- up$P[(up$low < up$P)]
upPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$low < up$S1)]
upPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$low < up$S2)]
upPLS2 <- length(tmp)/dim(up)[1]
# UP WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for up weeks
tmp <- up$P[(up$close > up$R2)]
upcPHR2 <- length(tmp)/dim(up)[1]
# Prob C > R1 for up weeks
tmp <- up$P[(up$close > up$R1)]
upcPHR1 <- length(tmp)/dim(up)[1]
# Prob C < Pivot for up weeks
tmp <- up$P[(up$close < up$P)]
upcPivot <- length(tmp)/dim(up)[1]
# Prob L < S1 for up weeks
tmp <- up$P[(up$close < up$S1)]
upcPLS1 <- length(tmp)/dim(up)[1]
# Prob L < S2 for up weeks
tmp <- up$P[(up$close < up$S2)]
upcPLS2 <- length(tmp)/dim(up)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(upPHR2, upPHR1, upPivot, upPLS1, upPLS2)
Close <- c(upcPHR2, upcPHR1, upcPivot, upcPLS1, upcPLS2)
dailyUPprev <- data.frame(PivotLevels, HL, Close)

# output to files
setwd("C:/Users/Don/Documents/R scripts for MT4 report analysis/FINAL Report weekly and daily range analysis")
print(xtable(monthlyUPprev), file="monthlyUPprev.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(weeklyUPprev), file="weeklyUPprev.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(dailyUPprev), file="dailyUPprev.tex", floating=FALSE,include.rownames=FALSE)
#print(xtable(cbind(monthly,weekly)),include.rownames=FALSE)
@
\begin{table}[ht]
\centering
\subfloat[Monthly]{\label{tab:tab1a}\scalebox{1.1}{\input{./monthlyUPprev}}}\quad
\subfloat[Weekly]{\label{tab:tab1b}\scalebox{1.1}{\input{./weeklyUPprev}}}
\subfloat[Daily]{\label{tab:tab1b}\scalebox{1.1}{\input{./dailyUPprev}}}

\caption{Probabilities of H/L moves and Close beyond pivot levels}
\label{tab:tab1}
\end{table}

Probability of up month if prev. month up:  \Sexpr{probMonthUp} 
Probability of up week if prev. week up:  \Sexpr{probWeekUp} 
Probability of up day if prev. day up:  \Sexpr{probDayUp}  \hspace{3.0cm}
 
\section*{PREVIOUS DOWN MONTH, WEEK, and DAY pivot analysis}
<<label=tab4, echo = FALSE, eval=TRUE, results='asis'>>=
# monthly
wd <- "C:/Users/Don/Documents/FX data/monthly"
setwd(wd)
x <- read.csv("USDJPY43200.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
 }
# DOWN WEEKS
down <- df[df$prev==-1,]
# if prev period down, percent chance current period is down
dayDOWN <- down[down$close<down$open,]
probMonthDown <- dim(dayDOWN)[1]/dim(down)[1]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
monthly <- data.frame(PivotLevels, HL, Close)
# Weekly
wd <- "C:/Users/Don/Documents/FX data/weekly"
setwd(wd)
x <- read.csv("USDJPY10080.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
}
# DOWN WEEKS
down <- df[df$prev == -1,]
# if prev period down, percent chance current period is down
dayDOWN <- down[down$close<down$open,]
probWeekDown <- dim(dayDOWN)[1]/dim(down)[1]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
weekly <- data.frame(PivotLevels, HL, Close)
# daily
wd <- "C:/Users/Don/Documents/FX data/daily"
setwd(wd)
x <- read.csv("USDJPY1440.csv", header=FALSE)
x$range <- 10000*(x$V4 - x$V5)
# rename columns
colnames(x) <- c("date","time","open","high","low","close","vol","range")
df <-(data.frame(date = as.Date(x$date, "%Y.%m.%d"), open=x$open, high=x$high, low=x$low, close=x$close)) 
# calculate Weekly pivot points from previous week's values
df$P <- vector(mode="numeric", length=dim(df)[1])
df$R1 <- vector(mode="numeric", length=dim(df)[1])
df$R2 <- vector(mode="numeric", length=dim(df)[1])
df$S1 <- vector(mode="numeric", length=dim(df)[1])
df$S2 <- vector(mode="numeric", length=dim(df)[1])
df$S3 <- vector(mode="numeric", length=dim(df)[1])
df$R3 <- vector(mode="numeric", length=dim(df)[1])
df$prev <- vector(mode="numeric", length=dim(df)[1])
# calculate Traditional pivot points
for (i in 2:dim(df)[1]){
  PP <- ((df$high[i-1]+df$low[i-1]+df$close[i-1])/3)
  df$P[i] <- PP
  df$S2[i] <- PP-(df$high[i-1]-df$low[i-1])
  df$R2[i] <- PP+(df$high[i-1]-df$low[i-1])
  df$S1[i] <- 2*PP-df$high[i-1]              
  df$R1[i] <- 2*PP-df$low[i-1]
  df$R3[i] <- PP + 2*(df$high[i-1]-df$low[i-1])
  df$S3[i] <- PP - 2*(df$high[i-1]-df$low[i-1])
  df$prev[i] <-ifelse(df$close[i-1]<df$open[i-1],-1,1)
}
# DOWN DAYS
down <- df[df$prev==-1,]
# if prev period down, percent chance current period is down
dayDOWN <- down[down$close<down$open,]
probDayDown <- dim(dayDOWN)[1]/dim(down)[1]
# Prob H > R2 for down weeks
tmp <- down$P[(down$high > down$R2)]
downPHR2 <- length(tmp)/dim(down)[1]
# Prob H > R1 for down weeks
tmp <- down$P[(down$high > down$R1)]
downPHR1 <- length(tmp)/dim(down)[1]
# Prob L < Pivot for down weeks
tmp <- down$P[(down$low < down$P)]
downPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$low < down$S1)]
downPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$low < down$S2)]
downPLS2 <- length(tmp)/dim(down)[1]
# DOWN WEEKS PROB OF CLOSING BEYOND PIVOTS
# Prob C > R2 for down weeks
tmp <- down$P[(down$close > down$R2)]
downcPHR2 <- length(tmp)/dim(down)[1]
# Prob C > R1 for down weeks
tmp <- down$P[(down$close > down$R1)]
downcPHR1 <- length(tmp)/dim(down)[1]
# Prob C < Pivot for down weeks
tmp <- down$P[(down$close < down$P)]
downcPivot <- length(tmp)/dim(down)[1]
# Prob L < S1 for down weeks
tmp <- down$P[(down$close < down$S1)]
downcPLS1 <- length(tmp)/dim(down)[1]
# Prob L < S2 for down weeks
tmp <- down$P[(down$close < down$S2)]
downcPLS2 <- length(tmp)/dim(down)[1]
PivotLevels <- c('R2', 'R1', 'P', 'S1', 'S2')
HL <- c(downPHR2, downPHR1, downPivot, downPLS1, downPLS2)
Close <- c(downcPHR2, downcPHR1, downcPivot, downcPLS1, downcPLS2)
daily <- data.frame(PivotLevels, HL, Close)

# output to files
setwd("C:/Users/Don/Documents/R scripts for MT4 report analysis/FINAL Report weekly and daily range analysis")
print(xtable(monthly), file="monthlydn.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(weekly), file="weeklydn.tex", floating=FALSE,include.rownames=FALSE)
print(xtable(daily), file="dailydn.tex", floating=FALSE,include.rownames=FALSE)
#print(xtable(cbind(monthly,weekly)),include.rownames=FALSE)
@
\begin{table}[ht]
\centering
\subfloat[Monthly]{\label{tab:tab1a}\scalebox{1.1}{\input{./monthlydn}}}\quad
\subfloat[Weekly]{\label{tab:tab1b}\scalebox{1.1}{\input{./weeklydn}}}
\subfloat[Daily]{\label{tab:tab1b}\scalebox{1.1}{\input{./dailydn}}}

\caption{Probabilities of H/L moves and Close beyond pivot levels}
\label{tab:tab1}
\end{table}
Probability of down month if prev. month down:  \Sexpr{probMonthDown} 
Probability of down week if prev. week down:  \Sexpr{probWeekDown} 
Probability of down day if prev. day down:  \Sexpr{probDayDown}  \hspace{3.0cm}
\end{document}
Attached File(s)
File Type: pdf FINAL_Report_weekly_and_daily_range_and_historical_trend_analysis.pdf   54 KB | 731 downloads
  • #19
  • Dec 27, 2016 6:35am Dec 27, 2016 6:35am
Hi FXEZ,


Some great stuff being posted in this thread!
Given we can't attach R/S scripts to posts maybe we should start a git repo?

Folder structure could be:
Inserted Code
<root>
   +-<topic1>
    |     +- R
    |     +- Julia
    |     +- Python
    |     README.md
   +-<topic2>
    |     +- R
    |     +- Julia
    |     +- Python
          README.md
    .
    .
    .

Just a thought... also subtle way of asking if other languages can be included? ☺

Maybe the criteria for other languages and tools is that they are freely available, like R and Python?

9047.
  • #20
  • Dec 27, 2016 5:53pm Dec 27, 2016 5:53pm
Quoting 9047
Hi FXEZ, Some great stuff being posted in this thread! Given we can't attach R/S scripts to posts maybe we should start a git repo? Folder structure could be: <root> +-<topic1> | +- R | +- Julia | +- Python | README.md +-<topic2> | +- R | +- Julia | +- Python README.md . . . Just a thought... also subtle way of asking if other languages can be included? ☺ Maybe the criteria for other languages and tools is that they are freely available, like R and Python? 9047.
That's a great idea 9047! I created: https://github.com/autotr8de/QuantitativeResearch for this thread and have started moving over some of the files. This should help us stay more organized and make it much easier to find stuff rather than scrolling through the thread.

I also added the link to the first post, as well as a link to Quandl, which offers free daily data from a number of different sources that can be easily retrieved from within R, Python and other environments.

I'm not opposed to other languages. In fact I'd like to learn more about Python and Julia so if you're wanting to post samples from another language, it would give me (and others) something to try out, so I see it as a plus.
0 traders viewing now