Nnet-example.r

rm(list = ls())
gc()

library(knitr)
library(blotter)
if (!exists('.blotter')) .blotter <- new.env()

suppressWarnings(try(rm(list=c("account.forex","portfolio.forex"),pos=.blotter),silent=TRUE))
suppressWarnings(try(rm(list=c("b.strategy","myTheme","EURUSD",".getSymbols")),silent=TRUE))

## ------------------------------------------------------------------------
ticksize  <- 0.00001
pipmultiplier <- 10000
posmultiplier <- 1

library(FinancialInstrument)
library(doParallel)
currency(c("EUR","USD")); 
exchange_rate(currency = "USD", counter_currency = "EUR", tick_size = ticksize,  pos.multiplier = posmultiplier, pip.multiplier= pipmultiplier) #primary_id = symbol

ls(all=T)
ls(envir=FinancialInstrument:::.instrument)


## ------------------------------------------------------------------------
get("USD",envir=FinancialInstrument:::.instrument)
get("EUR",envir=FinancialInstrument:::.instrument)
get("EURUSD",envir=FinancialInstrument:::.instrument)


## ------------------------------------------------------------------------
# system settings
data.dir <- 'g:\\fxmotif\\data\\EURUSD\\D1'
rdata.dir <- 'g:\\fxmotif\\R\\data\\fx\\'
initDate <- '2004-12-31'
startDate <- '2005-01-01'
endDate <-  '2015-12-31'
initEq <- 1e4
portfolio <- account <- "forex"
B <- 200

## ------------------------------------------------------------------------
Sys.setenv(TZ="UTC")

##----
# preprocess data
##----
#LOAD EURUSD DATA
dtfun <- function(x) as.POSIXct(strptime(x, format = "%d.%m.%Y %H:%M:%S", tz = "UTC"))
EURUSD <- as.xts(read.zoo(file = paste(data.dir, "EURUSD_Candlestick_1_D_BID_01.01.2005-31.12.2015.csv", sep="\\"), 
                          header=T, sep=',', FUN=dtfun))
colnames(EURUSD) <- c("Open","High","Low","Close","Volume")

symbols = c("EURUSD")
symbol = symbols[1]
library(TTR)
## ------------------------------------------------------------------------
# Init portfolio
## ------------------------------------------------------------------------
b.strategy <- "forex"
initPortf(b.strategy, 'EURUSD', initDate=initDate)
initAcct(b.strategy, portfolios=b.strategy, initDate=initDate, initEq=initEq)
## ------------------------------------------------------------------------

EURUSD <- EURUSD[EURUSD[,"Volume"] > 0,]
EURUSD$ret1 <- diff(Cl(EURUSD))
EURUSD$ret2 <- lag(EURUSD$ret1,1)
EURUSD$ret3 <- lag(EURUSD$ret1,2)
EURUSD$ret4 <- lag(EURUSD$ret1,3)
EURUSD$ret5 <- lag(EURUSD$ret1,4)
EURUSD$ret6 <- lag(EURUSD$ret1,5)
EURUSD$ret7 <- lag(EURUSD$ret1,6)
EURUSD$ret8 <- lag(EURUSD$ret1,7)
EURUSD$ret9 <- lag(EURUSD$ret1,8)
EURUSD$ret10 <- lag(EURUSD$ret1,9)

## Target 
EURUSD$Target <- lag(diff(Cl(EURUSD)), -1)

require(caret)
library(nnet)

trainMethod <- function(y){
  #y <- EURUSD[1:201,]
  cols <- c("ret1", "ret2", "ret3", "ret4", "ret5","ret6", "ret7", "ret8", "ret9", "ret10") 
  y.scaled <- y[,cols]
  y.scaled <- merge(as.xts(y.scaled), y[, "Target"])
  cols <- colnames(y.scaled)
  ctrl <- trainControl(method = "cv", number = 10) 
  nnet_grid <- expand.grid(.decay = 10^seq(-6,-4,1), .size = seq(3,13,2))
  
  cl <- makeCluster(detectCores())
  registerDoParallel(cl)  
  nnfit3 <- train(Target ~ . , y.scaled[1:B,], method = "nnet", maxit = 10^7, trControl = ctrl, tuneGrid = nnet_grid, 
                  linout=T, trace=F,preProcess = c("center", "scale"), allowParallel=T)
  pred <- predict(nnfit3, y.scaled[nrow(y.scaled), cols[-c(length(cols))]])
  stopCluster(cl)
  return(pred)
}  

# trade

assign("sl", 0, .GlobalEnv)
assign("tp", 0, .GlobalEnv)
assign("balance", initEq, .GlobalEnv)

slMul <- 0.8; tpMul <- 1
initUnitSize <- as.numeric(10000)

#data <- EURUSD; symbol = "EURUSD"; pft <- "forex"; i = 150
tradeLogic <- function(data, symbol, i, pft){
  # update values for this date
  tp <- get("tp", .GlobalEnv)
  sl <- get("sl", .GlobalEnv)
  balance <- get("balance", .GlobalEnv)
  CurrentDate <- time(data)[i]
  equity = getEndEq("forex", CurrentDate)
  OpenPrice <- as.numeric(Op(data[i,]))
  ClosePrice <- as.numeric(Cl(data[i,]))
  HighPrice <- as.numeric(Hi(data[i,]))
  LowPrice <- as.numeric(Lo(data[i,]))
  Target <- trainMethod(data[(i-B):(i)])
  Atr <- as.numeric(data[i,]$atr)
  Posn <- getPosQty(pft, Symbol=symbol, Date=CurrentDate)
  posMultiplier <- get(symbol,envir=FinancialInstrument:::.instrument)$pos.multiplier
  pipMultiplier <- get(symbol,envir=FinancialInstrument:::.instrument)$pip.multiplier
  pips = (round(Atr * pipMultiplier)/pipMultiplier)
  UnitSize = initUnitSize * posMultiplier
  txnFees <- -0.4

  if(Posn > 0){ 
      addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = -Posn , TxnFees=txnFees)
  }
  else if(Posn < 0){
      addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = -Posn , TxnFees=txnFees)
  }
  if( Target > 0) {
      # enter long position
      addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = UnitSize , TxnFees=txnFees) 
      sl <- OpenPrice - slMul*Target; tp <- ClosePrice + tpMul*pips;
  }
  else if(Target < 0) {
    addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = -UnitSize , TxnFees=txnFees) 
    sl <- OpenPrice + abs(slMul*Target);tp <- ClosePrice - abs(tpMul*pips);
  }
  else {
    if( i==nrow(data)) # exit on last day
    {
      if(Posn > 0 ) addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = -UnitSize , TxnFees=0)
      if(Posn < 0 ) addTxn(pft, Symbol=symbol, TxnDate=CurrentDate, TxnPrice=ClosePrice, TxnQty = -UnitSize , TxnFees=0)
    }
  }
  assign("sl", sl, .GlobalEnv)
  assign("tp", tp, .GlobalEnv)
  assign("balance", balance, .GlobalEnv)
}


library(PerformanceAnalytics)
printRets <- function(){
  rets <- PortfReturns(Account=account)
  rownames(rets) <- NULL
  charts.PerformanceSummary(rets, ylog = F, main = symbol[1],colorset=bluefocus)
  table.AnnualizedReturns(rets)
}

# offset <- which(index(quote) == "2005-10-11 02:00:00") + 1
quote <- EURUSD
offset <- i <- B+1
idx <- 1
for( i in offset:nrow(quote)) {
  CurrentDate <- time(quote[i])# as.Date(day)
  tradeLogic(quote, symbols[1], i, "forex")
  updatePortf("forex", Dates=CurrentDate)
  idx = idx + 1;
  if(idx == 5){
    idx = 0
    printRets();
  }
  
} # End dates loop
#printRets();

tail(getTxns(Portfolio=portfolio, Symbol=symbols[1]),20)

rets <- PortfReturns(Account=account)
rownames(rets) <- NULL
charts.PerformanceSummary(rets, ylog = T, main = symbol[1],colorset=bluefocus)
table.AnnualizedReturns(rets)