使用MLP神经网络进行预测

时间:2019-10-27 16:07:09

标签: r neural-network mlp

我正在尝试使用MLP神经网络在R中编写代码以预测USD / EUR的货币汇率我正面临函数Neuronet的问题,它显示了一个错误:

  

神经元错误[[i]]%*%体重[[i]]:
  需要数字/复杂矩阵/矢量参数

这是我到目前为止编写的代码

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)

数据集包含500行和3列,第一列是日期,它包含从2011年10月到2013年10月的日期(500个数据)。第二列是Wdy,它包含弱日,最后一列是USD,包含货币汇率。这是我的数据集的一个示例:

 part of the data-set

2 个答案:

答案 0 :(得分:0)

在上面的示例中,您尝试使用日期来训练模型,这是错误的,因为neuralnet只能理解factorsnumerics进行训练。如果要在模型中包括一些时间序列因素,请使用R提供的time-series analysis

此外,您正尝试仅使用一个或两个预测变量来训练neural-net,因此它会严重拟合过度,并且您的分析将有偏差。

您的问题仅由三列组成;即; datewdy(实际上是工作日)和USD(价格)。在这种情况下,使用神经网络毫无意义,因为您没有训练模型的功能。您的数据基本上是一个时间序列,因此请使用回归和其他线性算法。 (也可以如前所述使用timeseries

尽管我在下面分享了如何训练良好的mlp模型。

以下是使用RSNNS包在R中使用多层感知器模型的简单示例。我使用了非常基本的iris数据集。

下面是代码:

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)

输出:

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

neuralnet软件包的主要问题在于,它仅创建简单且非常基础的神经网络,而定制化却很少。与RSNNS相比,以上neuralnet软件包提供了更多的附加功能。

但是,如果您想尝试更多的深层网络,建议您使用mxnetkeras扩展名作为R。

答案 1 :(得分:0)

对于此时间序列分析,您可以使用自回归模型。首先,您必须创建滞后输入集并创建一个数据帧。在下面的代码块中有 4 个输入集,其中包含一个滞后、两个滞后和三个滞后。(阅读有关自回归模型的更多信息 - [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()

标准化数据

# 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

针对不同架构测试神经网络

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)