Forecasting using MLP neural network

Question

I'm trying to write a code in R to predict the currency rate of USD/EUR using MLP neural Network I'm facing a problem with the function neuralnet it shows an error:

Error in neurons[[i]] %*% weights[[i]] :
requires numeric/complex matrix/vector arguments

This is the code that I have written so far

library(readxl)
ExchangeUSD <- read_excel("C:/Users/GTS/Desktop/ML project/ExchangeUSD.xlsx")
plot(ExchangeUSD$USD)

#traning and test data 
trainset <- ExchangeUSD[1:350,]
testset <- ExchangeUSD[351:500,]

set.seed(12345)
library(neuralnet)
nn <- neuralnet(USD ~ date + Wdy, data = trainset,hidden = 2)

the data-set contains 500 rows and 3 columns the first column is date and it contains the date from October 2011 until October 2013 (500 data). the second column is Wdy and it contain the weakly days the final column is the USD and contains the currency rate. This is a sample of my dataset:

Answer 1

In the above example you are trying to use date to train a model, which is wrong, as neuralnet can only understand factors and numerics for training. If you want to include some time-series factors in your model use time-series analysis provided by R.

Moreover you are trying to train a neural-net using just one or two predictors, thus it will overfit badly and your analysis will be biased.

And your problem as only consists of three columns, namely; date, wdy (which is actually week day) and USD (price). In this scenario, it makes no sense to use neural networks as you have no features to train the model. Your data is basically a time series, so use regression and other linear algos. (can also go for timeseries as mentioned earlier)

Despite I have shared on how to train a good mlp model below.

Below is a simple example using the multi-layer-perceptron model in R using the RSNNS package. I have used the very basic iris dataset.

Below is the code:

library(RSNNS)
data(iris)


iris <- iris[sample(1:nrow(iris),length(1:nrow(iris))),1:ncol(iris)]

irisValues <- iris[,1:4]
irisTargets <- decodeClassLabels(iris[,5])


iris <- splitForTrainingAndTest(irisValues, irisTargets, ratio=0.15)
iris <- normTrainingAndTestSet(iris)

model <- mlp(iris$inputsTrain, iris$targetsTrain, size=5, learnFuncParams=c(0.1), 
             maxit=50, inputsTest=iris$inputsTest, targetsTest=iris$targetsTest)

summary(model)
#model
#weightMatrix(model)
#extractNetInfo(model)

par(mfrow=c(2,2))
#plotIterativeError(model)

#predictions <- predict(model,iris$inputsTest)
#plotRegressionError(predictions[,2], iris$targetsTest[,2])

confusionMatrix(iris$targetsTrain,fitted.values(model))
confusionMatrix(iris$targetsTest,predictions)

Output:

SNNS network definition file V1.4-3D
generated at Sun Oct 27 23:15:12 2019

network name : RSNNS_untitled
source files :
no. of units : 12
no. of connections : 35
no. of unit types : 0
no. of site types : 0


learning function : Std_Backpropagation
update function   : Topological_Order


unit default section :

act      | bias     | st | subnet | layer | act func     | out func
---------|----------|----|--------|-------|--------------|-------------
 0.00000 |  0.00000 | i  |      0 |     1 | Act_Logistic | Out_Identity 
---------|----------|----|--------|-------|--------------|-------------


unit definition section :

no. | typeName | unitName          | act      | bias     | st | position | act func     | out func | sites
----|----------|-------------------|----------|----------|----|----------|--------------|----------|-------
  1 |          | Input_1           | -0.04652 |  0.21414 | i  | 1,0,0    | Act_Identity |          | 
  2 |          | Input_2           | -1.03059 | -0.09038 | i  | 2,0,0    | Act_Identity |          | 
  3 |          | Input_3           |  0.11214 | -0.19132 | i  | 3,0,0    | Act_Identity |          | 
  4 |          | Input_4           | -0.02205 |  0.28695 | i  | 4,0,0    | Act_Identity |          | 
  5 |          | Hidden_2_1        |  0.36322 |  0.16864 | h  | 1,2,0    |||
  6 |          | Hidden_2_2        |  0.04875 | -1.57745 | h  | 2,2,0    |||
  7 |          | Hidden_2_3        |  0.19143 | -1.59699 | h  | 3,2,0    |||
  8 |          | Hidden_2_4        |  0.94317 |  1.33032 | h  | 4,2,0    |||
  9 |          | Hidden_2_5        |  0.87133 |  2.55066 | h  | 5,2,0    |||
 10 |          | Output_setosa     |  0.04954 | -1.01308 | o  | 1,4,0    |||
 11 |          | Output_versicolor |  0.86560 | -1.31827 | o  | 2,4,0    |||
 12 |          | Output_virginica  |  0.06732 | -0.42084 | o  | 3,4,0    |||
----|----------|-------------------|----------|----------|----|----------|--------------|----------|-------


connection definition section :

target | site | source:weight
-------|------|---------------------------------------------------------------------------------------------------------------------
     5 |      |  4:-1.36576,  3:-1.01049,  2: 0.62411,  1: 0.07838
     6 |      |  4:-1.49537,  3:-1.41137,  2: 1.26386,  1:-0.73716
     7 |      |  4: 1.87337,  3: 1.25094,  2:-0.05512,  1:-0.00999
     8 |      |  4: 1.25223,  3: 1.55905,  2:-1.32439,  1: 0.71672
     9 |      |  4:-2.56181,  3:-1.92910,  2: 0.45272,  1: 0.24772
    10 |      |  9: 0.68890,  8:-3.19830,  7:-0.96376,  6: 1.87789,  5: 1.56411
    11 |      |  9: 2.69797,  8: 1.74343,  7:-2.49599,  6:-2.91350,  5:-0.53523
    12 |      |  9:-3.50718,  8: 1.59391,  7: 1.75725,  6:-1.66021,  5:-2.50714
-------|------|---------------------------------------------------------------------------------------------------------------------

       predictions
targets  1  2  3
      1 40  0  0
      2  0 43  3
      3  0  1 40

       predictions
targets  1  2  3
      1 10  0  0
      2  0  4  0
      3  0  0  9

The major problem with neuralnet package is that it only creates simple and very basic neural networks with very less customisation. The above RSNNS package provides some more additional features as compared to neuralnet.

But if you want to try some more deep-networks I would suggest you to use mxnet, and keras extensions for R.

Answer 2

For this time series analysis you can use autoregressive model. first you have to create lag input sets and crete a dataframe.In below code block there are 4 input sets containing one lag two lag and three lag.(read more about autoregressive models - [https://otexts.com/fpp2/AR.html][1])

exchangeEUR <- read_excel("ExchangeUSD.xlsx") %>%
  janitor::clean_names() %>%
  mutate(date_in_ymd = ymd(yyyy_mm_dd)) %>%
  select(-1) %>%
  select(date_in_ymd,everything())

eur_exchange_full = exchangeEUR %>%
      mutate(previous_one_day_set_a = lag(exchangeEUR$usd_eur,1),
             previous_one_day_set_b = lag(exchangeEUR$usd_eur,1),
             previous_two_day_set_b = lag(exchangeEUR$usd_eur,2),
             previous_one_day_set_c = lag(exchangeEUR$usd_eur,1),
             previous_two_day_set_c = lag(exchangeEUR$usd_eur,2),
             previous_three_day_set_c = lag(exchangeEUR$usd_eur,3),
             previous_one_day_set_d = lag(exchangeEUR$usd_eur,1),
             previous_two_day_set_d = lag(exchangeEUR$usd_eur,2),
             five_day_rolling = rollmean(usd_eur,5, fill = NA),
             ten_day_rolling = rollmean(usd_eur,10, fill = NA)) %>%
      
   drop_na()

normalizing data

# We can create a function to normalize the data from 0 to 1
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x))) }
# All the variables are normalized
normalized_eur = eur_exchange_full %>%
  mutate(across(2:12, ~normalize(.x)))
# Look at the data that has been normalized
summary(normalized_eur)

boxplot(normalized_eur$usd_eur)

set.seed(123)
eur_train <- normalized_eur[1:400,]
eur_test <- normalized_eur[401:491,]

# We can create a function to unnormalize the data=
unnormalize <- function(x, min, max) {
  return( (max - min)*x + min ) }
# Get the min and max of the original training values
eur_min_train <- min(eur_exchange_full[1:400,2])
eur_max_train <- max(eur_exchange_full[1:400,2])
# Get the min and max of the original testing values
eur_min_test <- min(eur_exchange_full[401:491,2])
eur_max_test <- max(eur_exchange_full[401:491,2])
# Check the range of the min and max of the training dataset
eur_min_test

eur_min_train

eur_max_test
eur_max_train

testing neural network for different architectures

set.seed(12345)
# function setup that creates 2 layer model
model_two_hidden_layers = function(hidden,sec_hidden) {
  nn_model_true = neuralnet(usd_eur ~ previous_one_day_set_b+previous_two_day_set_b, data=eur_train, hidden=c(
    hidden,sec_hidden), linear.output=TRUE)
  
  #plot(nn_model_true)
  pred <- predict(nn_model_true, eur_test)
  
  validation_df <- data.frame(c(eur_test$date_in_ymd),c(pred),c(eur_test$usd_eur))
  

  p = ggplot() + 
    geom_line(data = validation_df, aes(x = c.eur_test.date_in_ymd., y = c.pred.), color = "blue") +
    geom_line(data = validation_df, aes(x = c.eur_test.date_in_ymd., y = c.eur_test.usd_eur.), color = "red") +
    xlab('Dates') +
    ylab('percent.change')
  print(p)
  
  train_results = compute(nn_model_true,eur_test[,2:3])
  truthcol = eur_exchange_full[401:491,2]$usd_eur
  predcol = unnormalize(train_results$net.result,eur_min_train, eur_max_train)[,1]
  relevant_pred_stat(truthcol,predcol,
                     "Two Hidden Layers") %>%
    mutate(hiddel_layers = paste0(hidden, " and ",sec_hidden),
           input_set = "B") %>%
    filter(.metric != "rsq")
}

model_two_hidden_layers(2,3)

# save the stat indices to a dataframe
set_a_models_two_layers = results_two_hidden_layers %>%
  select(-estimator) %>%
  pivot_wider(names_from = metric, values_from = estimate) %>%
  arrange(rmse)
kable(set_a_models_two_layers[1:10,])


##########################################################################
# three layer model
set.seed(12345)
# function setup that creates 3 layer model
model_three_hidden_layers = function(hidden,sec_hidden,third_hidden) {
  nn_model_true = neuralnet(usd_eur ~ previous_one_day_set_b+previous_two_day_set_b, data=eur_train, hidden=c(hidden,sec_hidden,third_hidden), linear.output=TRUE)
  
  #plot(nn_model_true)
  pred <- predict(nn_model_true, eur_test)
  
  validation_df <- data.frame(c(eur_test$date_in_ymd),c(pred),c(eur_test$usd_eur))
  
  
  ################
  p = ggplot() + 
    geom_line(data = validation_df, aes(x = c.eur_test.date_in_ymd., y = c.pred.), color = "blue") +
    geom_line(data = validation_df, aes(x = c.eur_test.date_in_ymd., y = c.eur_test.usd_eur.), color = "red") +
    xlab('Dates') +
    ylab('percent.change')
  print(p)
  ################
  
  train_results = compute(nn_model_true,eur_test[,2:3])
  truthcol = eur_exchange_full[401:491,2]$usd_eur
  predcol = unnormalize(train_results$net.result,eur_min_train, eur_max_train)[,1]
  relevant_pred_stat(truthcol,predcol,
                     "Three Hidden Layers") %>%
    mutate(hiddel_layers = paste0(hidden, " and ",sec_hidden," and ",third_hidden),
           input_set = "A") %>%
    filter(.metric != "rsq")
}


model_three_hidden_layers(7,4,1)