Tiefe Neuronale Netzwerke (Teil VIII). Erhöhung der Klassifizierungsqualität von Ensembles mit Bagging

3 Oktober 2018, 08:42
Vladimir Perervenko
0
64

Inhalt

Einführung

In den beiden vorhergehenden Artikeln (1, 2) haben wir ein Ensemble von ELM-Klassifikatoren für neuronale Netze erstellt. Damals diskutierten wir, wie die Klassifizierungsqualität verbessert werden kann. Unter den vielen möglichen Lösungen wurden zwei gewählt: Reduzierung der Auswirkungen von Rauschproben und Auswahl des optimalen Schwellenwerts, durch den die kontinuierlichen Vorhersagen der neuronalen Netzwerke des Ensembles in Klassenlabels umgewandelt werden. In diesem Artikel schlage ich vor, experimentell zu testen, wie sich das auf die Klassifizierungsqualität auswirkt: 

  • Methoden zur Rauschminderung,
  • Schwellenwerttypen,
  • Optimierung der Hyperparameter der neuronalen Netze des Ensembles und der Nachbearbeitung.

Dann vergleichen wir die Qualität der Klassifizierung, die durch Mittelwertbildung und einfache Mehrheitsabstimmung des Superensembles, das sich aus den besten Ensembles zusammensetzt, nach den Optimierungsergebnissen. Alle Berechnungen werden in der Umgebung von R 3.4.4.4 durchgeführt.

1. Vorbereitung der Anfangsdaten

Zur Vorbereitung der ersten Daten verwenden wir die zuvor beschriebenen Skripte.

Wir laden im ersten Block (Library) die notwendigen Funktionen und Bibliotheken.

Im zweiten Block (prepare) werden unter Verwendung der Anführungszeichen mit vom Terminal übergebenen Zeitstempeln die Indikatorwerte (in diesem Fall sind dies digitale Filter) und zusätzliche Variablen auf OHLC-Basis berechnet. Wir kombinieren diesen Datensatz in den Datenrahmen dt. Dann definieren wir die Parameter von Ausreißern in diesen Daten und berechnen sie. Wir definieren dann die Normierungsparameter und normieren die Daten. Wir erhalten den resultierenden Satz von Eingangsdaten DTcap.n.

Wir erzeugen im dritten Block (Daten X1) zwei Gruppen:

  • data1 - enthält alle 13 Indikatoren mit den Zeitstempeln Data und dem Ziel Class;
  • X1 - der gleiche Satz von Prädiktoren, aber ohne Zeitstempel. Das Ziel wird in einen Zahlenwert (0, 1) umgewandelt.

Wir erzeugen im vierten Block (Daten X2) auch zwei Sätze:

  • data2 - enthält 7 Prädiktoren und einen Zeitstempel (Daten, CO, HO, LO, HL, dC, dH, dL);
  • Х - die gleichen Prädiktoren, aber ohne Zeitstempel.
Der Pfad patch zum Speicherort von Dateien mit den Skripten ist benutzerdefiniert.
#--1--Library-------------
patch <- "C:/Users/Vladimir/Documents/Market/Statya_DARCH2/PartVIII/PartVIII/"
source(file = paste0(patch,"importar.R"))
source(file = paste0(patch,"Library.R"))
source(file = paste0(patch,"FunPrepareData_VII.R"))
source(file = paste0(patch,"FUN_Stacking_VIII.R"))
import_fun(NoiseFiltersR, GE, noise)
#--2-prepare----
evalq({
  dt <- PrepareData(Data, Open, High, Low, Close, Volume)
  DT <- SplitData(dt$features, 4000, 1000, 500, 250, start = 1)
  pre.outl <- PreOutlier(DT$pretrain)
  DTcap <- CappingData(DT, impute = T, fill = T, dither = F, pre.outl = pre.outl)
  meth <- qc(expoTrans, range)# "spatialSign" "expoTrans" "range" "spatialSign",
  preproc <- PreNorm(DTcap$pretrain, meth = meth, rang = c(-0.95, 0.95))
  DTcap.n <- NormData(DTcap, preproc = preproc)
}, env)

#--3-Data X1-------------
evalq({
  subset <- qc(pretrain, train, test, test1)
  foreach(i = 1:length(DTcap.n)) %do% {
    DTcap.n[[i]] ->.;  
    dp$select(., Data, ftlm, stlm, rbci, pcci, fars, 
              v.fatl, v.satl, v.rftl, v.rstl,v.ftlm, 
              v.stlm, v.rbci, v.pcci, Class)} -> data1
  names(data1) <- subset
  X1 <- vector(mode = "list", 4)
  foreach(i = 1:length(X1)) %do% {
    data1[[i]] %>% dp$select(-c(Data, Class)) %>% as.data.frame() -> x
    data1[[i]]$Class %>% as.numeric() %>% subtract(1) -> y
    list(x = x, y = y)} -> X1
  names(X1) <- subset
}, env)
#--4-Data-X2-------------
evalq({
  foreach(i = 1:length(DTcap.n)) %do% {
    DTcap.n[[i]] ->.;  
    dp$select(., Data, CO, HO, LO, HL, dC, dH, dL)} -> data2
  names(data2) <- subset
  X2 <- vector(mode = "list", 4)
  foreach(i = 1:length(X2)) %do% {
    data2[[i]] %>% dp$select(-Data) %>% as.data.frame() -> x
    DT[[i]]$dz -> y
    list(x = x, y = y)} -> X2
  names(X2) <- subset
  rm(dt, DT, pre.outl, DTcap, meth, preproc)
}, env)

Im fünften Block (bestF) sortieren wir die Prädiktoren der Menge Х in aufsteigender Reihenfolge ihrer Bedeutung (orderX1). Wir wählen diejenigen von ihnen mit einem Koeffizienten über 0,5 (featureX1). Wir drucken die Koeffizienten und Namen der ausgewählten Prädiktoren.

#--5--bestF-----------------------------------
#require(clusterSim)
evalq({
  orderF(x = X1$pretrain$x %>% as.matrix(), type = "metric", s = 1, 4, 
         distance =  NULL, # "d1" - Manhattan, "d2" - Euclidean, 
         #"d3" - Chebychev (max), "d4" - squared Euclidean, 
         #"d5" - GDM1, "d6" - Canberra, "d7" - Bray-Curtis
         method = "kmeans" ,#"kmeans" (default) , "single", 
         #"ward.D", "ward.D2", "complete", "average", "mcquitty", 
         #"median", "centroid", "pam"
         Index = "cRAND") -> rx1
  rx1$stopri[ ,1] -> orderX1
  featureX1 <- dp$filter(rx1$stopri %>% as.data.frame(), rx1$stopri[ ,2] > 0.5) %>% 
    dp$select(V1) %>% unlist() %>% unname()
}, env)
print(env$rx1$stopri)
      [,1]      [,2]
 [1,]    6 1.0423206
 [2,]   12 1.0229287
 [3,]    7 0.9614459
 [4,]   10 0.9526798
 [5,]    5 0.8884596
 [6,]    1 0.8055126
 [7,]    3 0.7959655
 [8,]   11 0.7594309
 [9,]    8 0.6960105
[10,]    2 0.6626440
[11,]    4 0.4905196
[12,]    9 0.3554887
[13,]   13 0.2269289
colnames(env$X1$pretrain$x)[env$featureX1]
[1] "v.fatl" "v.rbci" "v.satl" "v.ftlm" "fars"   "ftlm"   "rbci"   "v.stlm" "v.rftl"
[10] "stlm"

Die gleiche Berechnung wird mit dem zweiten Datensatz Х2 durchgeführt. Wir erhalten orderX2 und featureX2.

evalq({
  orderF(x = X2$pretrain$x %>% as.matrix(), type = "metric", s = 1, 4, 
         distance =  NULL, # "d1" - Manhattan, "d2" - Euclidean, 
         #"d3" - Chebychev (max), "d4" - squared Euclidean, 
         #"d5" - GDM1, "d6" - Canberra, "d7" - Bray-Curtis
         method = "kmeans" ,#"kmeans" (default) , "single", 
         #"ward.D", "ward.D2", "complete", "average", "mcquitty", 
         #"median", "centroid", "pam"
         Index = "cRAND") -> rx2 
  rx2$stopri[ ,1] -> orderX2
  featureX2 <- dp$filter(rx2$stopri %>% as.data.frame(), rx2$stopri[ ,2] > 0.5) %>% 
    dp$select(V1) %>% unlist() %>% unname()
}, env)
print(env$rx2$stopri)
     [,1]      [,2]
[1,]    1 1.6650259
[2,]    5 1.6636689
[3,]    3 0.7751799
[4,]    2 0.7751351
[5,]    6 0.5692846
[6,]    7 0.5496889
[7,]    4 0.4970882
colnames(env$X2$pretrain$x)[env$featureX2]
[1] "CO" "dC" "LO" "HO" "dH" "dL"

Damit ist die Vorbereitung der ersten Daten für die Experimente abgeschlossen. Wir haben zwei Datensätze X1/data1, X2/data2 und Prädiktoren orderX1, orderX2 nach Bedeutung geordnet vorbereitet. Alle oben genannten Skripte befinden sich in der Datei Prepare_VIII.R.

2. Verarbeiten des Rauschens in der Untermenge pretrain

Viele Autoren von Artikeln, darunter auch ich, widmeten ihre Publikationen der Filterung von verrauschten Vorhersagen. Hier schlage ich vor, ein weiteres, ebenso wichtiges, aber weniger genutztes Merkmal zu untersuchen - die Identifizierung und Verarbeitung von verrauschten Stichproben in Datensätzen. Warum werden also einige Beispiele in Datensätzen als Rauschen betrachtet und mit welchen Methoden können sie verarbeitet werden? Ich werde versuchen, es zu erklären.

So stehen wir vor der Aufgabe der Klassifizierung, während wir über einen Trainingssatz von Prädiktoren und ein Ziel verfügen. Das Ziel wird als gut auf die interne Struktur des Trainingssets abgestimmt angesehen. Aber in Wirklichkeit ist die Datenstruktur der Prädiktoren viel komplizierter als die vorgeschlagene Struktur des Ziels. Es stellt sich heraus, dass das Set Beispiele enthält, die dem Ziel gut entsprechen, während es einige gibt, die ihm überhaupt nicht entsprechen und das Modell beim Lernen stark verzerren. Dies führt zu einer Qualitätsminderung der Modellklassifizierung. Die Ansätze zur Identifizierung und Verarbeitung der Rauschproben wurden bereits detailliert betrachtet. Hier wird überprüft, wie sich drei Verarbeitungsmethoden auf die Klassifizierungsqualität auswirken:

  • Korrektur der fälschlicherweise beschrifteten Beispiele;
  • Entfernen dieser aus dem Datensatz;
  • Zuordnen zu einer eigenen Klasse.

Die Rauschproben werden mit der Funktion NoiseFiltersR::GE() identifiziert und verarbeitet. Sie sucht nach den Rauschproben und modifiziert deren Kennzeichnung (korrigiert fehlerhafte Kennzeichnungen). Beispiele, die nicht mit neuer Kennzeichnung versehen werden können, werden entfernt. Die identifizierten Rauschproben können auch manuell aus dem Set entfernt oder in eine separate Klasse verschoben werden, indem ihnen ein neues Kennzeichnung zugewiesen wird. Alle oben genannten Berechnungen werden auf der Teilmenge "pretrain" durchgeführt, da sie für das Training des Ensembles verwendet werden. Das ist dann das Ergebnis der Funktion:

#---------------------------
import_fun(NoiseFiltersR, GE, noise)
#-----------------------
evalq({
  out <- noise(x = data1[[1]] %>% dp$select(-Data))
  summary(out, explicit = TRUE)
}, env)
Filter GE applied to dataset 

Call:
GE(x = data1[[1]] %>% dp$select(-Data))

Parameter:
k: 5
kk: 3

Results:
Number of removed instances: 0 (0 %)
Number of repaired instances: 819 (20.46988 %)

Explicit indexes for removed instances:
.......

Ausgegebene Struktur der Funktion out:

> str(env$out)
List of 7
 $ cleanData :'data.frame':     4001 obs. of  14 variables:
  ..$ ftlm  : num [1:4001] 0.293 0.492 0.47 0.518 0.395 ...
  ..$ stlm  : num [1:4001] 0.204 0.185 0.161 0.153 0.142 ...
  ..$ rbci  : num [1:4001] -0.0434 0.1156 0.1501 0.25 0.248 ...
  ..$ pcci  : num [1:4001] -0.0196 -0.0964 -0.4455 0.2685 -0.0349 ...
  ..$ fars  : num [1:4001] 0.208 0.255 0.246 0.279 0.267 ...
  ..$ v.fatl: num [1:4001] 0.4963 0.4635 0.0842 0.3707 0.0542 ...
  ..$ v.satl: num [1:4001] -0.0146 0.0248 -0.0353 0.1797 0.1205 ...
  ..$ v.rftl: num [1:4001] -0.2695 -0.0809 0.1752 0.3637 0.5305 ...
  ..$ v.rstl: num [1:4001] 0.398 0.362 0.386 0.374 0.357 ...
  ..$ v.ftlm: num [1:4001] 0.5244 0.4039 -0.0296 0.1088 -0.2299 ...
  ..$ v.stlm: num [1:4001] -0.275 -0.226 -0.285 -0.11 -0.148 ...
  ..$ v.rbci: num [1:4001] 0.5374 0.4811 0.0978 0.2992 -0.0141 ...
  ..$ v.pcci: num [1:4001] -0.8779 -0.0706 -0.3125 0.6311 -0.2712 ...
  ..$ Class : Factor w/ 2 levels "-1","1": 2 2 2 2 2 1 1 1 1 1 ...
 $ remIdx    : int(0) 
 $ repIdx    : int [1:819] 16 27 30 31 32 34 36 38 46 58 ...
 $ repLab    : Factor w/ 2 levels "-1","1": 2 2 2 1 1 2 2 2 1 1 ...
 $ parameters:List of 2
  ..$ k : num 5
  ..$ kk: num 3
 $ call      : language GE(x = data1[[1]] %>% dp$select(-Data))
 $ extraInf  : NULL
 - attr(*, "class")= chr "filter"

Wobei:

  • out$cleanData - der Datensatz nach Korrektur der Kennzeichnung der Rauschproben, 
  • out$remIdx - - Indexe der entfernten Samples (keine im Out-Beispiel), 
  • out$repIdx - Indexe der Teilmengen mit umbenannten Zielen,
  • out$repLab - neue Kennzeichnungen dieser Rauschproben. So können wir sie aus dem Datensatz entfernen oder ihnen mit out$repIdx eine neue Kennzeichnung zuweisen.

Sobald die Indizes der Rauschproben bestimmt sind, bereiten wir vier Datensätze für das Training der Ensembles vor, die in der Struktur denoiseX1pretrain kombiniert sind.

  • denoiseX1pretrain$origin - das ursprüngliche Vorübungs-Set;
  • denoiseX1pretrain$reparated - Datensatz mit der Kennzeichnung der korrigierten Rauschproben;
  • denoiseX1pretrain$removed - Datensatz mit den entfernten Rauschproben;
  • denoiseX1pretrain$relabe - Datensatz mit den Rauschproben, den eine neuee Kennzeichnung zugewiesen wurde (d.h. das Ziel hat nun drei Klassen).
#--2-Data Xrepair-------------
#library(NoiseFiltersR)
evalq({
  out <- noise(x = data1$pretrain %>% dp$select(-Data))
  Yrelab <- X1$pretrain$y
  Yrelab[out$repIdx] <- 2L
  X1rem <- data1$pretrain[-out$repIdx, ] %>% dp$select(-Data) 
  denoiseX1pretrain <- list(origin = list(x = X1$pretrain$x,  y = X1$pretrain$y),
                            repaired = list(x = X1$pretrain$x, y = out$cleanData$Class %>% 
                                             as.numeric() %>% subtract(1)), 
                             removed = list(x = X1rem %>% dp$select(-Class), 
                                          y = X1rem$Class %>% as.numeric() %>% subtract(1)),
                             relabeled = list(x = X1$pretrain$x, y = Yrelab))
  rm(out, Yrelab, X1rem)     
}, env)

Die Teilmengen denoiseX1pretrain$origin|repaired|relabeled haben die gleichen Prädiktoren х, aber das Ziel у ist in jedem Satz unterschiedlich. Werfen wir einen Blick auf ihre Struktur:

#-------------------------
env$denoiseX1pretrain$repaired$x  %>% str()
'data.frame':   4001 obs. of  13 variables:
 $ ftlm  : num  0.293 0.492 0.47 0.518 0.395 ...
 $ stlm  : num  0.204 0.185 0.161 0.153 0.142 ...
 $ rbci  : num  -0.0434 0.1156 0.1501 0.25 0.248 ...
 $ pcci  : num  -0.0196 -0.0964 -0.4455 0.2685 -0.0349 ...
 $ fars  : num  0.208 0.255 0.246 0.279 0.267 ...
 $ v.fatl: num  0.4963 0.4635 0.0842 0.3707 0.0542 ...
 $ v.satl: num  -0.0146 0.0248 -0.0353 0.1797 0.1205 ...
 $ v.rftl: num  -0.2695 -0.0809 0.1752 0.3637 0.5305 ...
 $ v.rstl: num  0.398 0.362 0.386 0.374 0.357 ...
 $ v.ftlm: num  0.5244 0.4039 -0.0296 0.1088 -0.2299 ...
 $ v.stlm: num  -0.275 -0.226 -0.285 -0.11 -0.148 ...
 $ v.rbci: num  0.5374 0.4811 0.0978 0.2992 -0.0141 ...
 $ v.pcci: num  -0.8779 -0.0706 -0.3125 0.6311 -0.2712 ...
env$denoiseX1pretrain$relabeled$x  %>% str()
'data.frame':   4001 obs. of  13 variables:
 $ ftlm  : num  0.293 0.492 0.47 0.518 0.395 ...
 $ stlm  : num  0.204 0.185 0.161 0.153 0.142 ...
 $ rbci  : num  -0.0434 0.1156 0.1501 0.25 0.248 ...
 $ pcci  : num  -0.0196 -0.0964 -0.4455 0.2685 -0.0349 ...
 $ fars  : num  0.208 0.255 0.246 0.279 0.267 ...
 $ v.fatl: num  0.4963 0.4635 0.0842 0.3707 0.0542 ...
 $ v.satl: num  -0.0146 0.0248 -0.0353 0.1797 0.1205 ...
 $ v.rftl: num  -0.2695 -0.0809 0.1752 0.3637 0.5305 ...
 $ v.rstl: num  0.398 0.362 0.386 0.374 0.357 ...
 $ v.ftlm: num  0.5244 0.4039 -0.0296 0.1088 -0.2299 ...
 $ v.stlm: num  -0.275 -0.226 -0.285 -0.11 -0.148 ...
 $ v.rbci: num  0.5374 0.4811 0.0978 0.2992 -0.0141 ...
 $ v.pcci: num  -0.8779 -0.0706 -0.3125 0.6311 -0.2712 ...
env$denoiseX1pretrain$repaired$y  %>% table()
.
   0    1 
1888 2113 
env$denoiseX1pretrain$removed$y  %>% table()
.
   0    1 
1509 1673
env$denoiseX1pretrain$relabeled$y  %>% table()
.
   0    1    2 
1509 1673  819 

Da die Anzahl der Proben im Datensatz denoiseX1pretrain$removed sich änderte, prüfen wir, wie sich die Signifikanz der Prädiktoren verändert hat:

evalq({
  orderF(x = denoiseX1pretrain$removed$x %>% as.matrix(), 
         type = "metric", s = 1, 4, 
         distance =  NULL, # "d1" - Manhattan, "d2" - Euclidean, 
         #"d3" - Chebychev (max), "d4" - squared Euclidean, 
         #"d5" - GDM1, "d6" - Canberra, "d7" - Bray-Curtis
         method = "kmeans" ,#"kmeans" (default) , "single", 
         #"ward.D", "ward.D2", "complete", "average", "mcquitty", 
         #"median", "centroid", "pam"
         Index = "cRAND") -> rx1rem
  rx1rem$stopri[ ,1] -> orderX1rem
  featureX1rem <- dp$filter(rx1rem$stopri %>% as.data.frame(), 
                            rx1rem$stopri[ ,2] > 0.5) %>% 
    dp$select(V1) %>% unlist() %>% unname()
}, env)
print(env$rx1rem$stopri)
     [,1]      [,2]
 [1,]    6 1.0790642
 [2,]   12 1.0320772
 [3,]    7 0.9629750
 [4,]   10 0.9515987
 [5,]    5 0.8426669
 [6,]    1 0.8138830
 [7,]    3 0.7934568
 [8,]   11 0.7682185
 [9,]    8 0.6720211
[10,]    2 0.6355753
[11,]    4 0.5159589
[12,]    9 0.3670544
[13,]   13 0.2170575
colnames(env$X1$pretrain$x)[env$featureX1rem]
[1] "v.fatl" "v.rbci" "v.satl" "v.ftlm" "fars"   "ftlm"   "rbci"   "v.stlm" "v.rftl"
[10] "stlm"   "pcci" 

Die Reihenfolge und Zusammensetzung der besten Prädiktoren hat sich geändert. Dies muss beim Training von Ensembles berücksichtigt werden.

Also, wir haben 4 Teilmengen bereit: denoiseX1pretrain$origin, repaired, removed, relabeled. Sie werden für die Ausbildung der ELM-Ensembles verwendet. Skripte zur Rauschminderung der Daten befinden sich in der Datei Denoise.R. Die Struktur der Ausgangsdaten Х und denoiseX1pretrain sieht wie folgt aus:


Abb. 1. Die Struktur der Anfangsdaten.

3. Trainieren von Ensembles der Klassifikatoren von Neuronalen Netzen Training mit rauschgeminderten Anfangsdaten und berechnen kontinuierlicher Prognosen der Neuronalen Netze mit der Untermenge test

Schreiben wir eine Funktion zum Trainieren des Ensembles und zum Empfangen von Vorhersagen, die später als Eingabedaten für den trainierbaren Kombinierer im Stapel-Ensemble dienen.

Solche Berechnungen wurden bereits im vorherigen Artikel durchgeführt, daher werden deren Details nicht diskutiert. Kurz gesagt:

  • In Block 1 (Eingang) die Konstanten definieren;
  • In Block 2 (createEns) die Funktion CreateEns() definieren, die ein Ensemble von einzelnen neuronalen Netzwerk-Klassifikatoren mit konstanten Parametern und reproduzierbarer Initialisierung erzeugen würde;
  • In Block 3 (GetInputData) berechnet die Funktion GetInputData() die Vorhersagen von drei Teilmengen Х$ train/test/test1 mit dem Ensemble Ens.
  Die Reproduzierbarkeit wird durch eine konstante und identische Initialisierung des Zufallszahlengenerators (RNG) gewährleistet. Die Skripte befinden sich in der Datei FUN_Stacking_VIII.R.
#--1--Input-------------
evalq({
  #type of activation function. 
  Fact <- c("sig", #: sigmoid
            "sin", #: sine
            "radbas", #: radial basis
            "hardlim", #: hard-limit
            "hardlims", #: symmetric hard-limit
            "satlins", #: satlins
            "tansig", #: tan-sigmoid
            "tribas", #: triangular basis
            "poslin", #: positive linear
            "purelin") #: linear
  n <- 500
  r = 7L
  SEED <- 12345
  #--2-createENS----------------------
  createEns <- function(r = 7L, nh = 5L, fact = 7L, X, Y){
    Xtrain <- X[ , featureX1] 
    k <- 1
    rng <- RNGseq(n, SEED)
    #---creste Ensemble---
    Ens <- foreach(i = 1:n, .packages = "elmNN") %do% {
      rngtools::setRNG(rng[[k]])
      idx <- rminer::holdout(Y, ratio = r/10, mode = "random")$tr
      k <- k + 1
      elmtrain(x = Xtrain[idx, ], y = Y[idx], nhid = nh, actfun = Fact[fact])
    }
    return(Ens)
  }
  #--3-GetInputData -FUN-----------
  GetInputData <- function(Ens, X, Y){
    #---predict-InputPretrain--------------
    Xtrain <- X[ ,featureX1]
    k <- 1
    rng <- RNGseq(n, SEED)
    #---create Ensemble---
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      rngtools::setRNG(rng[[k]])
      idx <- rminer::holdout(Y, ratio = r/10, mode = "random")$tr
      k <- k + 1
      predict(Ens[[i]], newdata = Xtrain[-idx, ])
    } %>% unname() -> InputPretrain
    #---predict-InputTrain--
    Xtest <- X1$train$x[ , featureX1]
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      predict(Ens[[i]], newdata = Xtest)
    } -> InputTrain #[ ,n]
    #---predict--InputTest----
    Xtest1 <- X1$test$x[ , featureX1]
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      predict(Ens[[i]], newdata = Xtest1)
    } -> InputTest #[ ,n]
    #---predict--InputTest1----
    Xtest2 <- X1$test1$x[ , featureX1]
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      predict(Ens[[i]], newdata = Xtest2)
    } -> InputTest1 #[ ,n]
    #---res-------------------------
    return(list(InputPretrain = InputPretrain,
                InputTrain = InputTrain,
                InputTest = InputTest,
                InputTest1 = InputTest1))
  }
}, env) 

Wir haben bereits den Satz denoiseX1pretrain mit vier Datengruppen für Trainingsensembles: Originale (origin), korrigierte (repaired), entfernte (removed) und neu gekennzeichnete (relabeled) Rauschproben. Nach dem Training des Ensembles auf jeder dieser Datengruppen erhalten wir vier Ensembles. Unter Verwendung dieser Ensembles mit der Funktion GetInputData() erhalten wir vier Gruppen von Vorhersagen in drei Teilmengen: train, test und test1. Nachfolgend sind die Skripte für jedes Ensemble in der erweiterten Form separat aufgeführt (nur zum Debuggen und besseren Verständnis).

#---4--createEns--origin--------------
evalq({
  Ens.origin <- vector(mode = "list", n)
  res.origin <- vector("list", 4)
  x <- denoiseX1pretrain$origin$x %>% as.matrix()
  y <- denoiseX1pretrain$origin$y
  createEns(r = 7L, nh = 5L, fact = 7L, X = x, Y = y) -> Ens.origin
  GetInputData(Ens = Ens.origin, X = x, Y = y) -> res.origin
}, env)
#---4--createEns--repaired--------------
evalq({
  Ens.repaired <- vector(mode = "list", n)
  res.repaired <- vector("list", 4)
  x <- denoiseX1pretrain$repaired$x %>% as.matrix()
  y <- denoiseX1pretrain$repaired$y
  createEns(r = 7L, nh = 5L, fact = 7L,  X = x, Y = y) -> Ens.repaired
  GetInputData(Ens = Ens.repaired, X = x, Y = y) -> res.repaired
}, env)
#---4--createEns--removed--------------
evalq({
  Ens.removed <- vector(mode = "list", n)
  res.removed <- vector("list", 4)
  x <- denoiseX1pretrain$removed$x %>% as.matrix()
  y <- denoiseX1pretrain$removed$y
  createEns(r = 7L, nh = 5L, fact = 7L, X = x, Y = y) -> Ens.removed
  GetInputData(Ens = Ens.removed,  X = x, Y = y) -> res.removed
}, env)
#---4--createEns--relabeled--------------
evalq({
  Ens.relab <- vector(mode = "list", n)
  res.relab <- vector("list", 4)
  x <- denoiseX1pretrain$relabeled$x %>% as.matrix()
  y <- denoiseX1pretrain$relabeled$y
  createEns(r = 7L, nh = 5L, fact = 7L, X = x, Y = y) -> Ens.relab
  GetInputData(Ens = Ens.relab,  X = x, Y = y) -> res.relab
}, env)

Die Struktur der Vorhersageergebnisse der Ensembles ist nachfolgend gezeigt:

> env$res.origin %>% str()
List of 4
 $ InputPretrain: num [1:1201, 1:500] 0.747 0.774 0.733 0.642 0.28 ...
 $ InputTrain   : num [1:1001, 1:500] 0.742 0.727 0.731 0.66 0.642 ...
 $ InputTest    : num [1:501, 1:500] 0.466 0.446 0.493 0.594 0.501 ...
 $ InputTest1   : num [1:251, 1:500] 0.093 0.101 0.391 0.547 0.416 ...
> env$res.repaired %>% str()
List of 4
 $ InputPretrain: num [1:1201, 1:500] 0.815 0.869 0.856 0.719 0.296 ...
 $ InputTrain   : num [1:1001, 1:500] 0.871 0.932 0.889 0.75 0.737 ...
 $ InputTest    : num [1:501, 1:500] 0.551 0.488 0.516 0.629 0.455 ...
 $ InputTest1   : num [1:251, 1:500] -0.00444 0.00877 0.35583 0.54344 0.40121 ...
> env$res.removed %>% str()
List of 4
 $ InputPretrain: num [1:955, 1:500] 0.68 0.424 0.846 0.153 0.242 ...
 $ InputTrain   : num [1:1001, 1:500] 0.864 0.981 0.784 0.624 0.713 ...
 $ InputTest    : num [1:501, 1:500] 0.755 0.514 0.439 0.515 0.156 ...
 $ InputTest1   : num [1:251, 1:500] 0.105 0.108 0.511 0.622 0.339 ...
> env$res.relab %>% str()
List of 4
 $ InputPretrain: num [1:1201, 1:500] 1.11 1.148 1.12 1.07 0.551 ...
 $ InputTrain   : num [1:1001, 1:500] 1.043 0.954 1.088 1.117 1.094 ...
 $ InputTest    : num [1:501, 1:500] 0.76 0.744 0.809 0.933 0.891 ...
 $ InputTest1   : num [1:251, 1:500] 0.176 0.19 0.615 0.851 0.66 ...

Schauen wir, wie die Verteilung dieser Ausgaben/Eingaben aussehen. Hier die ersten 10 Ausgaben des Satzes InputTrain[ ,1:10]:

#------Ris InputTrain------
par(mfrow = c(2, 2), mai = c(0.3, 0.3, 0.4, 0.2))
boxplot(env$res.origin$InputTrain[ ,1:10], horizontal = T, main = "res.origin$InputTrain[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.repaired$InputTrain[ ,1:10], horizontal = T, main = "res.repaired$InputTrain[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.removed$InputTrain[ ,1:10], horizontal = T, main = "res.removed$InputTrain[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.relab$InputTrain[ ,1:10], horizontal = T, main = "res.relab$InputTrain[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
par(mfrow = c(1, 1))

InputTrain_range

Abb. 2. Verteilung der Vorhersagen der Ausgabe von InputTrain unter Verwendung verschiedener Ensembles.

Sehen wir hier die 10 ersten Ausgaben des Satzes InputTest[ ,1:10]:

#------Ris InputTest------
par(mfrow = c(2, 2), mai = c(0.3, 0.3, 0.4, 0.2), las = 1)

boxplot(env$res.origin$InputTest[ ,1:10], horizontal = T, main = "res.origin$InputTest[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.repaired$InputTest[ ,1:10], horizontal = T, main = "res.repaired$InputTest[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.removed$InputTest[ ,1:10], horizontal = T, main = "res.removed$InputTest[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.relab$InputTest[ ,1:10], horizontal = T, main = "res.relab$InputTest[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
par(mfrow = c(1, 1))

InputTest_range

Abb. 3. Verteilung der Vorhersagen der Ausgabe von InputTest unter Verwendung verschiedener Ensembles.

Sehen wir hier die 10 ersten Ausgaben des Satzes InputTest1[ ,1:10]:

#------Ris InputTest1------
par(mfrow = c(2, 2), mai = c(0.3, 0.3, 0.4, 0.2))
boxplot(env$res.origin$InputTest1[ ,1:10], horizontal = T, main = "res.origin$InputTest1[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.repaired$InputTest1[ ,1:10], horizontal = T, main = "res.repaired$InputTest1[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.removed$InputTest1[ ,1:10], horizontal = T, main = "res.removed$InputTest1[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
boxplot(env$res.relab$InputTest1[ ,1:10], horizontal = T, main = "res.relab$InputTest1[ ,1:10]")
abline(v = c(0, 0.5, 1.0), col = 2)
par(mfrow = c(1, 1))

InputTest1_range

Abb. 4. Verteilung der Vorhersagen der Ausgabe von InputTest1 unter Verwendung verschiedener Ensembles.

Die Verteilung aller Vorhersagen unterscheidet sich stark von den Vorhersagen, die aus den Daten gewonnen wurden, die durch die Methode SpatialSign in den vorangegangenen Experimenten normiert wurden. Sie können mit verschiedenen Normalisierungsmethoden selbst experimentieren.

Nach der Berechnung der Vorhersage von Teilmengen X1$train/test/test1 mit jedem Ensemble erhalten wir vier Datengruppen - res.origin, res.repaired, res.removed und res.relab, mit Verteilungen in den Abbildungen 2 - 4. 

Bestimmen wir die Klassifizierungsqualität jedes Ensembles und wandeln die kontinuierlichen Vorhersagen in Klassenlabel. 

4. Bestimmen der Schwellenwerte der erhaltenen kontinuierlichen Prognosen, ihr konvertieren Klassenlables und berechnen der Metriken der Neuronalen Netze

Um die fortlaufenden Daten in Klassenlables umzuwandeln, werden eine oder mehrere Schwellenwerte für die Aufteilung in diese Klassen verwendet. Die kontinuierlichen Vorhersagen der Satzes InputTrain, die aus dem fünften neuronalen Netz aller Ensembles stammen, sehen wie folgt aus:


InputTrainLine_range

Abb. 5. Kontinuierliche Vorhersagen des fünften neuronalen Netzes verschiedener Ensembles.

Wie wir sehen können, sind die Diagramme der kontinuierlichen Vorhersage der origin, repaired, relabeled Modelle ähnlich in der Form, haben aber einen anderen Bereich. Die Linie der Vorhersage des removed Modells ist in ihrer Form erheblich unterschiedlich.

Um die nachfolgenden Berechnungen zu vereinfachen, sammeln wir alle Modelle und deren Vorhersagen in einer Struktur predX1. Schreiben wir dazu eine kompakte Funktion, die alle Berechnungen in einem Zyklus wiederholt. Es gibt das Skript und ein Bild der predX1 Struktur:

library("doFuture")
#---predX1------------------
evalq({
  group <- qc(origin, repaired, removed, relabeled)
  predX1 <- vector("list", 4)
  foreach(i = 1:4, .packages = "elmNN") %do% {
    x <- denoiseX1pretrain[[i]]$x %>% as.matrix()
    y <- denoiseX1pretrain[[i]]$y
    SEED = 12345
    createEns(r = 7L, nh = 5L, fact = 7L, X = x, Y = y) -> ens  
    GetInputData(Ens = ens, X = x, Y = y) -> pred 
    return(list(ensemble = ens, pred = pred))
  } -> predX1
  names(predX1) <- group
}, env)  


Abb. 6. Struktur des Satzes predX1

Vergessen wir nicht dass, um die Metriken der Vorhersagequalität des Ensembles zu erhalten, zwei Operationen durchgeführt werden müssen: Bereinigung (pruning) und Mittelung (oder einfache Mehrheitsentscheidung). Für die Bereinigung ist es notwendig, alle Ausgaben der einzelnen neuronalen Netze des Ensembles von der Endlosform in Klassenlabels zu konvertieren. Definiere dann die Metriken der einzelnen neuronalen Netze und wähle eine bestimmte Anzahl von ihnen mit den besten Ergebnissen. Dann mitteln wir die kontinuierlichen Vorhersagen dieser besten neuronalen Netze und erhalten eine kontinuierliche durchschnittliche Vorhersage des Ensembles. Definieren wir noch einmal den Schwellenwert, wandeln ihn die gemittelte Vorhersage in Klassenlabel um und berechnen die Endwerte der Klassifizierungsqualität des Ensembles.

Daher ist es notwendig, die kontinuierliche Vorhersage zweimal in Klassenlabels umzuwandeln. Die Umwandlungsschwellenwerte in diesen beiden Phasen können entweder gleich oder unterschiedlich sein. Welche Varianten von Schwellenwerten können verwendet werden?

  1. Der voreingestellte Schwellenwert. In diesem Fall ist er gleich 0,5.
  2. Schwellenwert gleich dem Median. Ich denke, er ist zuverlässiger. Der Median kann jedoch nur auf dem Validierungssatz bestimmt werden, während er nur beim Testen der nachfolgenden Teilmengen angewendet werden kann. Zum Beispiel definieren wir die Schwellenwerte für die Teilmenge InputTrain, die später für die Teilmengen InputTest und InputTest1 verwendet werden.
  3. Schwellenwert optimiert für verschiedene Kriterien. Dies kann beispielsweise der minimale Klassifizierungsfehler, die maximale Genauigkeit "1" oder "0" usw. sein. Die optimalen Schwellenwerte werden immer auf der Teilmenge InputTrain bestimmt und auf der Teilmenge InputTest und InputTest1 verwendet.
  4. Bei der Mittelung der Ergebnisse der besten neuronalen Netze kann die Kalibrierung verwendet werden. Einige Autoren schreiben, dass nur gut kalibrierte Ergebnisse gemittelt werden können. Die Bestätigung dieser Aussage ist außerhalb des Anwendungsbereichs dieses Artikels.

Der optimale Schwellenwert wird mit der Funktion InformationValue::optimalCutoff() bestimmt. Sie ist im Paket ausführlich beschrieben.

Um die Schwellenwerte für die Punkte 1 und 2 festzulegen, sind keine zusätzlichen Berechnungen erforderlich. Um die optimalen Schwellenwerte für Punkt 3 zu berechnen, schreiben wir die Funktion GetThreshold().

#--function-------------------------
evalq({
  import_fun("InformationValue", optimalCutoff, CutOff)
  import_fun("InformationValue", youdensIndex, th_youdens)
  GetThreshold <- function(X, Y, type){
    switch(type,
           half = 0.5,
           med = median(X),
           mce = CutOff(Y, X, "misclasserror"),
           both = CutOff(Y, X,"Both"),
           ones = CutOff(Y, X, "Ones"),
           zeros = CutOff(Y, X, "Zeros")
    )
  }
}, env)

Es werden nur die ersten vier in dieser Funktion beschriebenen Arten von Schwellenwerten (half, med, mce, mce, both) berechnet. Die ersten beiden sind die Schwellenwerte von half und median. Der Schwellenwert mce liefert den minimalen Klassifizierungsfehler, der Schwellenwert both - den maximalen Wert des Koeffizienten youdensIndex = (sensitivity + specificity —1). Die Berechnungsreihenfolge sieht wie folgt aus:

1. Wir berechnen im Satz predX1 die vier Arten von Schwellenwerten für jedes der 500 neuronalen Netze des Ensembles auf der Untermenge InputTrain, getrennt in jeder Datengruppe (origin, repaired, removed und relabeled).

2. Anschließend werden unter Verwendung dieser Schwellenwerte die kontinuierlichen Vorhersagen aller neuronalen Netzwerke in allen Teilmengen (train|test|test1) in Klassen umgewandelt und die Durchschnittswerte F1 bestimmt. Wir erhalten vier Gruppen von Metriken, die jeweils drei Teilmengen enthalten. Nachfolgend ein Schritt-für-Schritt-Skript für die Gruppe origin.

Wir definiere 4 Arten von Schwellenwerten für die Teilmenge predX1$origin$pred$InputTrain:

#--threshold--train--origin--------
evalq({
  Ytest = X1$train$y
  Ytest1 = X1$test$y
  Ytest2 = X1$test1$y
  testX1 <- vector("list", 4)
  names(testX1) <- group
  type <- qc(half, med, mce, both)
  registerDoFuture()
  cl <- makeCluster(4)
  plan(cluster, workers = cl)
  foreach(i = 1:4, .combine = "cbind") %dopar% {# type
     foreach(j = 1:500, .combine = "c") %do% { 
        GetThreshold(predX1$origin$pred$InputTrain[ ,j], Ytest, type[i])
     } 
  }  -> testX1$origin$Threshold
  stopCluster(cl)
  dimnames(testX1$origin$Threshold) <- list(NULL,type)
  }, env)

Wir verwenden zwei verschachtelte Schleifen in jeder Berechnung. Wir wählen in der äußeren Schleife den Schwellentyp aus, erstellen einen Cluster und parallelisieren die Berechnung auf 4 Kerne. In der inneren Schleife iterieren wir über die Vorhersagen InputTrain von jedem der 500 neuronalen Netze, die das Ensemble umfassen. Es werden 4 Arten von Schwellenwerten definiert. Die Struktur der erhaltenen Daten schaut so aus:

> env$testX1$origin$Threshold %>% str()
 num [1:500, 1:4] 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:4] "half" "med" "mce" "both"
> env$testX1$origin$Threshold %>% head()
     half       med       mce      both
[1,]  0.5 0.5033552 0.3725180 0.5125180
[2,]  0.5 0.4918041 0.5118821 0.5118821
[3,]  0.5 0.5005034 0.5394191 0.5394191
[4,]  0.5 0.5138439 0.4764055 0.5164055
[5,]  0.5 0.5241393 0.5165478 0.5165478
[6,]  0.5 0.4673319 0.4508287 0.4608287

Unter Verwendung der erhaltenen Schwellenwerte konvertieren wir die kontinuierlichen Vorhersagen der Gruppe origin der Untermenge train, test und test1 in Klassenlables und berechnen die Metriken (mean(F1)).

#--train--------------------
evalq({
  foreach(i = 1:4, .combine = "cbind") %do% {# type
    foreach(j = 1:500, .combine = "c") %do% { 
      ifelse(predX1$origin$pred$InputTrain[ ,j] > testX1$origin$Threshold[j, i], 1, 0) ->.; 
      Evaluate(actual = Ytest, predicted = .)$Metrics$F1 %>% mean()
    }
  } -> testX1$origin$InputTrainScore
  dimnames(testX1$origin$InputTrainScore)[[2]] <- type
}, env)
#--test-----------------------------
evalq({
  foreach(i = 1:4, .combine = "cbind") %do% {# type
    foreach(j = 1:500, .combine = "c") %do% { 
      ifelse(predX1$origin$pred$InputTest[ ,j] > testX1$origin$Threshold[j, i], 1, 0) ->.; 
      Evaluate(actual = Ytest1, predicted = .)$Metrics$F1 %>% mean()
    }
  } -> testX1$origin$InputTestScore
  dimnames(testX1$origin$InputTestScore)[[2]] <- type
}, env)
#--test1-----------------------------
evalq({
  foreach(i = 1:4, .combine = "cbind") %do% {
    foreach(j = 1:500, .combine = "c") %do% { 
      ifelse(predX1$origin$pred$InputTest1[ ,j] > testX1$origin$Threshold[j, i], 1, 0) ->.; 
      Evaluate(actual = Ytest2, predicted = .)$Metrics$F1 %>% mean()
    }
  } -> testX1$origin$InputTest1Score
  dimnames(testX1$origin$InputTest1Score)[[2]] <- type
}, env)

Hier ist die Verteilung der Metriken in der Gruppe origin und drei ihrer Teilmengen. Das folgende Skript für die Gruppe origin:

k <- 1L #origin
# k <- 2L #repaired
# k <- 3L #removed
# k <- 4L #relabeling
par(mfrow = c(1,4), mai = c(0.3, 0.3, 0.4, 0.2))
boxplot(env$testX1[[k]]$Threshold, horizontal = F,
        main = paste0(env$group[k],"$$Threshold"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTrainScore, horizontal = F,
        main = paste0(env$group[k],"$$InputTrainScore"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTestScore, horizontal = F,
        main = paste0(env$group[k],"$$InputTestScore"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTest1Score, horizontal = F,
        main = paste0(env$group[k],"$$InputTest1Score"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
par(mfrow = c(1, 1))

OriginScore

Abb. 7. Verteilung der Schwellenwerte und Metriken der Gruppe origin

Die Visualisierung zeigte, dass die Verwendung von "med" als Schwellenwert für die Datengruppe origin keine sichtbare Verbesserung der Qualität gegenüber dem Schwellenwert "half" bewirkt.

Wir berechnen alle 4 Arten von Schwellenwerten in allen Gruppen (man sollte darauf vorbereitet sein, dass es ziemlich viel Zeit und Speicher in Anspruch nimmt).

library("doFuture")
#--threshold--train---------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  type <- qc(half, med, mce, both)
  Ytest = X1$train$y
  Ytest1 = X1$test$y
  Ytest2 = X1$test1$y
  registerDoFuture()
  cl <- makeCluster(4)
  plan(cluster, workers = cl)
  while (k <= 4) { # group
    foreach(i = 1:4, .combine = "cbind") %dopar% {# type
      foreach(j = 1:500, .combine = "c") %do% { 
        GetThreshold(predX1[[k]]$pred$InputTrain[ ,j], Ytest, type[i])
      } 
    }  -> testX1[[k]]$Threshold
    dimnames(testX1[[k]]$Threshold) <- list(NULL,type)
    k <- k + 1
  }
  stopCluster(cl)
}, env)

Unter Verwendung der erhaltenen Schwellenwerte berechnen wir in allen Gruppen und Untermengen:

#--train--------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  while (k <= 4) {
    foreach(i = 1:4, .combine = "cbind") %do% {
      foreach(j = 1:500, .combine = "c") %do% { 
        ifelse(predX1[[k]]$pred$InputTrain[ ,j] > testX1[[k]]$Threshold[j, i], 1, 0) ->.; 
        Evaluate(actual = Ytest, predicted = .)$Metrics$F1 %>% mean()
      }
    } -> testX1[[k]]$InputTrainScore
    dimnames(testX1[[k]]$InputTrainScore)[[2]] <- type
    k <- k + 1
  }
}, env)
#--test-----------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  while (k <= 4) {
    foreach(i = 1:4, .combine = "cbind") %do% {
      foreach(j = 1:500, .combine = "c") %do% { 
        ifelse(predX1[[k]]$pred$InputTest[ ,j] > testX1[[k]]$Threshold[j, i], 1, 0) ->.; 
        Evaluate(actual = Ytest1, predicted = .)$Metrics$F1 %>% mean()
      }
    } -> testX1[[k]]$InputTestScore
    dimnames(testX1[[k]]$InputTestScore)[[2]] <- type
    k <- k + 1
  }
}, env)
#--test1-----------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  while (k <= 4) {
    foreach(i = 1:4, .combine = "cbind") %do% {
      foreach(j = 1:500, .combine = "c") %do% { 
        ifelse(predX1[[k]]$pred$InputTest1[ ,j] > testX1[[k]]$Threshold[j, i], 1, 0) ->.; 
        Evaluate(actual = Ytest2, predicted = .)$Metrics$F1 %>% mean()
      }
    } -> testX1[[k]]$InputTest1Score
    dimnames(testX1[[k]]$InputTest1Score)[[2]] <- type
    k <- k + 1
  }
}, env)

Zu jeder Datengruppe haben wir Metriken von jedem der 500 neuronalen Netze des Ensembles mit vier verschiedenen Schwellenwerten in drei Teilmengen hinzugefügt.

Sehen wir, wie die Metriken in jeder Gruppe und Teilmenge verteilt sind. Das Skript wird für die Teilmenge repaired bereitgestellt. Es ist ähnlich für andere Gruppen, nur die Gruppennummer ändert sich. Aus Gründen der Übersichtlichkeit werden die Diagramme aller Gruppen in einem dargestellt.

# k <- 1L #origin
 k <- 2L #repaired
# k <- 3L #removed
# k <- 4L #relabeling
par(mfrow = c(1,4), mai = c(0.3, 0.3, 0.4, 0.2))
boxplot(env$testX1[[k]]$Threshold, horizontal = F,
        main = paste0(env$group[k],"$$Threshold"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTrainScore, horizontal = F,
        main = paste0(env$group[k],"$$InputTrainScore"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTestScore, horizontal = F,
        main = paste0(env$group[k],"$$InputTestScore"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
boxplot(env$testX1[[k]]$InputTest1Score, horizontal = F,
        main = paste0(env$group[k],"$$InputTest1Score"),
        col = c(2,4,5,6))
abline(h = c(0, 0.5, 0.7), col = 2)
par(mfrow = c(1, 1))

VarScore_range

Abb. 8. Verteilungsgrafiken der Vorhersagemetriken der einzelnen neuronalen Netze des Ensembles in drei Datengruppen mit drei Teilmengen und vier verschiedenen Schwellenwerten.

Gemeinsam in allen Gruppen:

  • Metriken der Untergruppe test (InputTestScore) sind viel besser als Metriken der Validierungsgruppe (InputTrainScore);
  • Metriken der zweiten Untergruppe test (InputTest1Score) sind deutlich schlechter als Metriken der ersten Testsubgruppe;
  • Schwellenwert vom Typ "half" zeigt in allen Teilmengen nicht schlechtere Ergebnisse als andere, mit Ausnahme von relabeled.
Alle in diesem Abschnitt verwendeten Skripte sind in der Datei Threshold.R verfügbar.

5. Testen der Ensembles

5.1. Bestimmung von 7 neuronalen Netzwerken mit den besten Metriken in jedem Ensemble und in jeder Datengruppe im InputTrain Teilmenge

Durchführung der Bereinigung (pruning). In jeder Datengruppe des testX1-Subsets ist es notwendig, 7 Werte von InputTrainScoremit den größten Werten des Mittelwerts F1 auszuwählen. Ihre Indizes werden die Indizes der besten neuronalen Netze im Ensemble sein. Das Skript ist unten angegeben und befindet sich auch in der Datei Test.R.

#--bestNN----------------------------------------
evalq({
  nb <- 3L
  k <- 1L
while (k <= 4) {
  foreach(j = 1:4, .combine = "cbind") %do% {
    testX1[[k]]$InputTrainScore[ ,j] %>% order(decreasing = TRUE) %>% head(2*nb + 1)
  } -> testX1[[k]]$bestNN
  dimnames(testX1[[k]]$bestNN) <- list(NULL, type)
  k <- k + 1
  }
}, env)

Wir erhielten Indizes der neuronalen Netze mit den besten Ergebnissen in vier Datengruppen (origin, repaired, removed, relabeled). Betrachten wir sie genauer und vergleichen wir, wie sehr sich diese besten neuronalen Netze je nach Datengruppe und Schwellentyp unterscheiden.

> env$testX1$origin$bestNN
     half med mce both
[1,]  415  75 415  415
[2,]  191 190 220  220
[3,]  469 220 191  191
[4,]  220 469 469  469
[5,]  265 287  57  444
[6,]  393 227 393   57
[7,]   75 322 444  393
> env$testX1$repaired$bestNN
     half med mce both
[1,]  393 393 154  154
[2,]  415  92 205  205
[3,]  205 154 220  220
[4,]  462 190 393  393
[5,]  435 392 287  287
[6,]  392 220  90   90
[7,]  265 287 415  415
> env$testX1$removed$bestNN
     half med mce both
[1,]  283 130 283  283
[2,]  207 110 300  300
[3,]  308 308 110  110
[4,]  159 134 192  130
[5,]  382 207 207  192
[6,]  192 283 130  308
[7,]  130 114 134  207
env$testX1$relabeled$bestNN
     half med mce both
[1,]  234 205 205  205
[2,]   69 287 469  469
[3,]  137 191 287  287
[4,]  269  57 191  191
[5,]  344 469 415  415
[6,]  164  75 444  444
[7,]  184 220  57   57

Man sieht, dass die Indizes neuronaler Netze mit den Schwellentypen "mce" und "both" sehr oft übereinstimmen.

5.2. Mittelung kontinuierlicher Vorhersagen dieser 7 besten neuronalen Netze.

Nach der Auswahl der 7 besten neuronalen Netze, berechnen wir diese in jeder Datengruppe, in Teilmengen InputTrain, InputTest, InputTest1 und nach jedem Schwellentyp. Skript zur Verarbeitung der InputTrain Teilmenge in 4 Gruppen:

#--Averaging--train------------------------
evalq({
  k <- 1L
  while (k <= 4) {# group
    foreach(j = 1:4, .combine = "cbind") %do% {# type
      bestNN <- testX1[[k]]$bestNN[ ,j]
      predX1[[k]]$pred$InputTrain[ ,bestNN] %>% 
        apply(1, function(x) sum(x)) %>% 
        divide_by((2*nb + 1))
    } -> testX1[[k]]$TrainYpred
    dimnames(testX1[[k]]$TrainYpred) <- list(NULL, paste0("Y.aver_", type))
    k <- k + 1
  }
}, env)

Schauen wir uns die Struktur und die statistischen Zahlen der erhaltenen, gemittelten, kontinuierlichen Vorhersagen ind dr Datengruppe repaired:

> env$testX1$repaired$TrainYpred %>% str()
 num [1:1001, 1:4] 0.849 0.978 0.918 0.785 0.814 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:4] "Y.aver_half" "Y.aver_med" "Y.aver_mce" "Y.aver_both"
> env$testX1$repaired$TrainYpred %>% summary()
  Y.aver_half        Y.aver_med        Y.aver_mce       Y.aver_both     
 Min.   :-0.2202   Min.   :-0.4021   Min.   :-0.4106   Min.   :-0.4106  
 1st Qu.: 0.3348   1st Qu.: 0.3530   1st Qu.: 0.3512   1st Qu.: 0.3512  
 Median : 0.5323   Median : 0.5462   Median : 0.5462   Median : 0.5462  
 Mean   : 0.5172   Mean   : 0.5010   Mean   : 0.5012   Mean   : 0.5012  
 3rd Qu.: 0.7227   3rd Qu.: 0.7153   3rd Qu.: 0.7111   3rd Qu.: 0.7111  
 Max.   : 1.1874   Max.   : 1.0813   Max.   : 1.1039   Max.   : 1.1039

Die Statistik der letzten beiden Schwellenwerte ist auch hier identisch. HIer sind die Skripte für die beiden verbleibenden Untermengen InputTest, InputTest1:

#--Averaging--test------------------------
evalq({
  k <- 1L
  while (k <= 4) {# group
    foreach(j = 1:4, .combine = "cbind") %do% {# type
      bestNN <- testX1[[k]]$bestNN[ ,j]
      predX1[[k]]$pred$InputTest[ ,bestNN] %>% 
        apply(1, function(x) sum(x)) %>% 
        divide_by((2*nb + 1))
    } -> testX1[[k]]$TestYpred
    dimnames(testX1[[k]]$TestYpred) <- list(NULL, paste0("Y.aver_", type))
    k <- k + 1
  }
}, env)
#--Averaging--test1------------------------
evalq({
  k <- 1L
  while (k <= 4) {# group
    foreach(j = 1:4, .combine = "cbind") %do% {# type
      bestNN <- testX1[[k]]$bestNN[ ,j]
      predX1[[k]]$pred$InputTest1[ ,bestNN] %>% 
        apply(1, function(x) sum(x)) %>% 
        divide_by((2*nb + 1))
    } -> testX1[[k]]$Test1Ypred
    dimnames(testX1[[k]]$Test1Ypred) <- list(NULL, paste0("Y.aver_", type))
    k <- k + 1
  }
}, env)

Schauen wir uns die Statistik der Untermenge InputTest der Datengruppe repaired:

> env$testX1$repaired$TestYpred %>% summary()
  Y.aver_half        Y.aver_med        Y.aver_mce       Y.aver_both     
 Min.   :-0.1524   Min.   :-0.5055   Min.   :-0.5044   Min.   :-0.5044  
 1st Qu.: 0.2888   1st Qu.: 0.3276   1st Qu.: 0.3122   1st Qu.: 0.3122  
 Median : 0.5177   Median : 0.5231   Median : 0.5134   Median : 0.5134  
 Mean   : 0.5114   Mean   : 0.4976   Mean   : 0.4946   Mean   : 0.4946  
 3rd Qu.: 0.7466   3rd Qu.: 0.7116   3rd Qu.: 0.7149   3rd Qu.: 0.7149  
 Max.   : 1.1978   Max.   : 1.0428   Max.   : 1.0722   Max.   : 1.0722  

Die Statistik der letzten beiden Schwellenwerttypen ist auch hier identisch.

5.3. Definition der Schwellenwerte für die gemittelten kontinuierlichen Vorhersagen

Jetzt haben wir die Vorhersagen für jedes Ensemble gemittelt. Sie müssen in Klassenlabels und die endgültigen Qualitätskennzahlen für alle Datengruppen und Schwellentypen umgewandelt werden. Um dies zu erreichen, bestimmen wir, ähnlich wie bei den vorherigen Berechnungen, die besten Schwellenwerte, indem wir nur die InputTrain-Subsets verwenden. Das untenstehende Skript berechnet die Schwellenwerte in jeder Gruppe und in jeder Teilmenge:

#-th_aver------------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  type <- qc(half, med, mce, both)
  Ytest = X1$train$y
  Ytest1 = X1$test$y
  Ytest2 = X1$test1$y
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type subset
      foreach(i = 1:4, .combine = "c") %do% {# type threshold
        GetThreshold(testX1[[k]]$TrainYpred[ ,j], Ytest, type[i])
      } 
    }  -> testX1[[k]]$th_aver
    dimnames(testX1[[k]]$th_aver) <- list(type, colnames(testX1[[k]]$TrainYpred))
    k <- k + 1
  }
}, env)

5.4. Umwandlung der gemittelten kontinuierlichen Vorhersagen der Ensembles in Klassenbezeichnungen und Berechnung der Metriken der Ensembles auf den Teilmengen InputTrain, InputTest und InputTest1 aller Datengruppen.

Mit den oben berechneten th_aver Schwellenwerten bestimmen wir die Kennzahlen:

#---Metrics--train-------------------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type subset
      foreach(i = 1:4, .combine = "c") %do% {# type threshold
        ifelse(testX1[[k]]$TrainYpred[ ,j] > testX1[[k]]$th_aver[i,j], 1, 0) -> clAver
        Evaluate(actual = Ytest, predicted = clAver)$Metrics$F1 %>%
          mean() %>% round(3)
      } 
    }  -> testX1[[k]]$TrainScore
    dimnames(testX1[[k]]$TrainScore) <- list(type, colnames(testX1[[k]]$TrainYpred))
    k <- k + 1
  }
}, env)
#---Metrics--test-------------------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type subset
      foreach(i = 1:4, .combine = "c") %do% {# type threshold
        ifelse(testX1[[k]]$TestYpred[ ,j] > testX1[[k]]$th_aver[i,j], 1, 0) -> clAver
        Evaluate(actual = Ytest1, predicted = clAver)$Metrics$F1 %>%
          mean() %>% round(3)
      } 
    }  -> testX1[[k]]$TestScore
    dimnames(testX1[[k]]$TestScore) <- list(type, colnames(testX1[[k]]$TestYpred))
    k <- k + 1
  }
}, env)
#---Metrics--test1-------------------------------------
evalq({
  k <- 1L #origin
  #k <- 2L #repaired
  #k <- 3L #removed
  #k <- 4L #relabeling
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type subset
      foreach(i = 1:4, .combine = "c") %do% {# type threshold
        ifelse(testX1[[k]]$Test1Ypred[ ,j] > testX1[[k]]$th_aver[i,j], 1, 0) -> clAver
        Evaluate(actual = Ytest2, predicted = clAver)$Metrics$F1 %>%
          mean() %>% round(3)
      } 
    }  -> testX1[[k]]$Test1Score
    dimnames(testX1[[k]]$Test1Score) <- list(type, colnames(testX1[[k]]$Test1Ypred))
    k <- k + 1
  }
}, env)

Erstellen wir eine Übersichtstabelle und analysieren die erhaltenen Kennzahlen. Beginnen wir mit der Gruppe origin (ihre Rauschproben wurden in keiner Weise verarbeitet). Wir suchen die Ergebnisse TestScore und Test1Score. Die Ergebnisse der Untermengen TestTrain sind indikativ, sie werden zum Vergleich mit den Testergebnissen benötigt:

> env$testX1$origin$TrainScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.711      0.708      0.712       0.712
med        0.711      0.713      0.707       0.707
mce        0.712      0.704      0.717       0.717
both       0.711      0.706      0.717       0.717
> env$testX1$origin$TestScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.750      0.738      0.745       0.745
med        0.748      0.742      0.746       0.746
mce        0.742      0.720      0.747       0.747
both       0.748      0.730      0.747       0.747
> env$testX1$origin$Test1Score
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.735      0.732      0.716       0.716
med        0.733      0.753      0.745       0.745
mce        0.735      0.717      0.716       0.716
both       0.733      0.750      0.716       0.716

Was zeigt die vorgeschlagene Tabelle?

Das beste Ergebnis von 0,750 in TestScore zeigte die Variante mit dem Schwellenwert "half" in beiden Transformationen (sowohl beim Beschneiden als auch bei der Mittelung). Die Qualität sinkt jedoch auf 0,735 in der Untermenge Test1Score.

Ein stabileres Ergebnis von ~0,745 in beiden Teilmengen zeigen die Schwellenvarianten (med, mce, both) beim Bereinigen und med bei der Mittelwertbildung.

Siehe nächste Datengruppe - repaired (mit der korrigierten Kennzeichnung der Rauschproben):

> env$testX1$repaired$TrainScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.713      0.711      0.717       0.717
med        0.709      0.709      0.713       0.713
mce        0.728      0.714      0.709       0.709
both       0.728      0.711      0.717       0.717
> env$testX1$repaired$TestScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.759      0.761      0.756       0.756
med        0.754      0.748      0.747       0.747
mce        0.758      0.755      0.743       0.743
both       0.758      0.732      0.754       0.754
> env$testX1$repaired$Test1Score
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.719      0.744      0.724       0.724
med        0.738      0.748      0.744       0.744
mce        0.697      0.720      0.677       0.677
both       0.697      0.743      0.731       0.731

Das beste in der Tabelle angezeigte Ergebnis ist 0,759 in der Kombination half/half. Ein stabileres Ergebnis von ~0,750 in beiden Untermengen zeigen die Schwellenvarianten (halb, med, mce, both) beim Bereinigen und med bei der Mittelwertbildung.

Siehe nächste Datengruppe - removed (wobei die Rauschproben aus dem Set entfernt wurden):

> env$testX1$removed$TrainScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.713      0.720      0.724       0.718
med        0.715      0.717      0.715       0.717
mce        0.721      0.722      0.725       0.723
both       0.721      0.720      0.725       0.723
> env$testX1$removed$TestScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.761      0.769      0.761       0.751
med        0.752      0.749      0.760       0.752
mce        0.749      0.755      0.753       0.737
both       0.749      0.736      0.753       0.760
> env$testX1$removed$Test1Score
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.712      0.732      0.716       0.720
med        0.729      0.748      0.740       0.736
mce        0.685      0.724      0.721       0.685
both       0.685      0.755      0.721       0.733

Analysieren wir die Tabelle. Das beste Ergebnis von 0,769 in TestScore zeigte die Variante mit den Schwellenwerten med/half. Die Qualität sinkt jedoch auf 0,732 in der Teilmenge Test1Score. Für die Teilmenge TestScore ergibt die beste Kombination von Schwellenwerten beim Bereinigen (halb, med, mce, both) und half, wenn die Mittelung die besten Werte aller Gruppen ergibt.

Siehe die letzte Datengruppe - relabeled (mit den Rauschproben isoliert zu einer separaten Klasse):

> env$testX1$relabeled$TrainScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.672      0.559      0.529       0.529
med        0.715      0.715      0.711       0.711
mce        0.712      0.715      0.717       0.717
both       0.710      0.718      0.720       0.720
> env$testX1$relabeled$TestScore
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.719      0.572      0.555       0.555
med        0.736      0.748      0.746       0.746
mce        0.739      0.747      0.745       0.745
both       0.710      0.756      0.754       0.754
> env$testX1$relabeled$Test1Score
     Y.aver_half Y.aver_med Y.aver_mce Y.aver_both
half       0.664      0.498      0.466       0.466
med        0.721      0.748      0.740       0.740
mce        0.739      0.732      0.716       0.716
both       0.734      0.737      0.735       0.735

Die besten Ergebnisse für diese Gruppe werden durch die folgende Kombination von Schwellenwerten erzielt: (med, mce, both) beim Bereinigen und beides oder med bei der Mittelung.

Denken wir daran, dass man andere Werte als meine bekommen kann.

Die folgende Abbildung zeigt die Datenstruktur von testX1 nach allen oben genannten Berechnungen:


Abb. 9. Die Datenstruktur von testX1.

6. Optimieren der Hyperparameter von Ensembles von Klassifikatoren von Neuronalen Netzen

Alle bisherigen Berechnungen wurden an Ensembles mit den gleichen Hyperparametern neuronaler Netze durchgeführt, die auf persönlichen Erfahrungen basieren. Wie man weiß, müssen die Hyperparameter neuronaler Netze, wie auch andere Modelle, für einen bestimmten Datensatz optimiert werden, um bessere Ergebnisse zu erzielen. Für das Training verwenden wir die Daten nach der Rauschminderung, die in 4 Gruppen unterteilt sind (origin, repaired, removed und relabeled). Daher ist es notwendig, optimale Hyperparameter der neuronalen Netze des Ensembles genau für diese Mengen zu erhalten. Alle Fragen zur Bayes'schen Optimierung wurden im vorherigen Artikel ausführlich diskutiert, so dass ihre Details hier nicht weiter besprochen werden.

4 Hyperparameter neuronaler Netze werden optimiert:

  • Die Anzahl der Prädiktoren - numFeature = c(3L, 13L) im Bereich von 3 bis 13;
  • Der Prozentsatz der in der Ausbildung verwendeten Proben - r = c(1L, 10L) im Bereich von 10 % bis 100 %;
  • Die Anzahl der Neuronen in der verborgenen Schicht - nh = c(1L, 51L) im Bereich von 1 bis 51;
  • Typ der Aktivierungsfunktion - fact = c(1L, 10L) Index in der Liste der Aktivierungsfunktionen Fact.

Setzten der Konstanten:

##===OPTIM===============================
evalq({
  #type of activation function. 
  Fact <- c("sig", #: sigmoid
            "sin", #: sine
            "radbas", #: radial basis
            "hardlim", #: hard-limit
            "hardlims", #: symmetric hard-limit
            "satlins", #: satlins
            "tansig", #: tan-sigmoid
            "tribas", #: triangular basis
            "poslin", #: positive linear
            "purelin") #: linear
  bonds <- list(
    numFeature = c(3L, 13L),
    r = c(1L, 10L),
    nh = c(1L, 51L),
    fact = c(1L, 10L)
  )
}, env)

Wir schreiben eine Fitnessfunktion, die den Qualitätsindikator Score = meаn(F1) und die Vorhersage des Ensembles in Klassenlabels zurückgibt. Die Bereinigung (Auswahl der besten neuronalen Netze im Ensemble) und die Mittelung der kontinuierlichen Vorhersage erfolgt mit dem gleichen Schwellenwert = 0,5. Es erwies sich früher als eine sehr gute Option - zumindest für die erste Annäherung. Hier ist das Skript:

#---Fitnes -FUN-----------
evalq({
  n <- 500
  numEns <- 3
  # SEED <- c(12345, 1235809)
  fitnes <- function(numFeature, r, nh, fact){
    bestF <- orderX %>% head(numFeature)
    k <- 1
    rng <- RNGseq(n, SEED)
    #---train---
    Ens <- foreach(i = 1:n, .packages = "elmNN") %do% {
      rngtools::setRNG(rng[[k]])
      idx <- rminer::holdout(Ytrain, ratio = r/10, mode = "random")$tr
      k <- k + 1
      elmtrain(x = Xtrain[idx, bestF], y = Ytrain[idx], 
               nhid = nh, actfun = Fact[fact])
    }
    #---predict---
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      predict(Ens[[i]], newdata = Xtest[ , bestF])
    } -> y.pr #[ ,n]
    #---best---
    foreach(i = 1:n, .combine = "c") %do% {
      ifelse(y.pr[ ,i] > 0.5, 1, 0) -> Ypred
      Evaluate(actual = Ytest, predicted = Ypred)$Metrics$F1 %>%
        mean() 
    } -> Score
    Score %>% order(decreasing = TRUE) %>% head((numEns*2 + 1)) -> bestNN
    #---test-aver--------
    foreach(i = 1:n, .packages = "elmNN", .combine = "+") %:%
      when(i %in% bestNN) %do% {
        predict(Ens[[i]], newdata = Xtest1[ , bestF])} %>%
      divide_by(length(bestNN)) -> ensPred
    ifelse(ensPred > 0.5, 1, 0) -> ensPred
    Evaluate(actual = Ytest1, predicted = ensPred)$Metrics$F1 %>%
      mean() %>% round(3) -> Score
    return(list(Score = Score, Pred = ensPred))
  }
}, env)  

Die auskommentierte SEED-Variable hat zwei Werte. Dies ist notwendig, um die Auswirkungen dieses Parameters auf das Ergebnis experimentell zu überprüfen. Ich habe die Optimierung mit den gleichen Anfangsdaten und Parametern durchgeführt, aber mit zwei verschiedenen Werten von SEED. Das beste Ergebnis wurde mit SEED = 1235809 erzielt. Dieser Wert wird in den folgenden Skripten verwendet. Aber die erhaltenen Hyperparameter und Klassifizierungsqualitätswerte werden für beide Werte von SEED bereitgestellt. Jeder kann mit anderen Werten experimentieren.

Überprüfen wir, ob die Fitnessfunktion funktioniert, wie lange ein Durchlauf ihrer Berechnungen dauert und das Ergebnis sehen:

evalq({
   Ytrain <- X1$pretrain$y
   Ytest <- X1$train$y
   Ytest1 <- X1$test$y
   Xtrain <- X1$pretrain$x
   Xtest <- X1$train$x
   Xtest1 <- X1$test$x 
   orderX <- orderX1
   SEED <- 1235809
  system.time(
    res <- fitnes(numFeature = 10, r = 7, nh = 5, fact = 2)
  )
 }, env)
user  system elapsed 
   5.89    0.00    5.99 
env$res$Score
[1] 0.741

Nachfolgend ist das Skript zur Optimierung der Hyperparameter neuronaler Netze nacheinander für jede Gruppe von Rauschunterdrückungen. Wir verwenden 20 Punkte der anfänglichen zufälligen Initialisierung und 20 nachfolgende Iterationen. 

#---Optim Ensemble-----
library(rBayesianOptimization)
evalq({
  Ytest <- X1$train$y
  Ytest1 <- X1$test$y
  Xtest <- X1$train$x
  Xtest1 <- X1$test$x 
  orderX <- orderX1
  SEED <- 1235809
  OPT_Res <- vector("list", 4)
  foreach(i = 1:4) %do% {
    Xtrain <- denoiseX1pretrain[[i]]$x
    Ytrain <- denoiseX1pretrain[[i]]$y
    BayesianOptimization(fitnes, bounds = bonds,
                                  init_grid_dt = NULL, init_points = 20, 
                                  n_iter = 20, acq = "ucb", kappa = 2.576, 
                                  eps = 0.0, verbose = TRUE,
                                  maxit = 100, control = c(100, 50, 8))
  } -> OPT_Res1
  group <- qc(origin, repaired, removed, relabeled)
  names(OPT_Res1) <- group
}, env)

Sobald man mit der Ausführung des Skripts beginnt, muss man sich etwa eine halbe Stunde gedulden (je nach Hardware). Wir sortieren die erhaltenen Werte in absteigender Reihenfolge und wählen die drei besten aus. Diese Werte werden den Variablen best.res (für SEED = 12345) und best.res1 (für SEED = 1235809) zugeordnet. 

#---OptPar------
evalq({
  foreach(i = 1:4) %do% {
    OPT_Res[[i]] %$% History %>% dp$arrange(desc(Value)) %>% head(3)
  } -> best.res
  names(best.res) <- group
}, env)
evalq({
  foreach(i = 1:4) %do% {
     OPT_Res1[[i]] %$% History %>% dp$arrange(desc(Value)) %>% head(3)
  } -> best.res1
  names(best.res1) <- group
}, env)

Hier die Werte von best.res

env$best.res
# $origin
#    Round numFeature r nh fact Value
# 1     39         10 7 20    2 0.769
# 2     12          6 4 38    2 0.766
# 3     38          4 3 15    2 0.766

# 
# $repaired
#    Round numFeature  r nh fact Value
# 1      5         10  5 20    7 0.767
# 2      7          5  2 36    9 0.766
# 3     28          5 10  6    8 0.766

# 
# $removed
#    Round numFeature  r nh fact Value
# 1      1         11  6 44    9 0.764
# 2      8          8  6 26    7 0.764
# 3     19         12  1 40    5 0.763

# 
# $relabeled
#    Round numFeature  r nh fact Value
# 1     24          9 10  1   10 0.746
# 2      7          9  9  2    8 0.745
# 3     32          4  1  1   10 0.738

Das Gleiche für die Werte von best.res1:

> env$best.res1
$origin
  Round numFeature r nh fact Value
1    19          8 3 41    2 0.777
2    32          8 1 33    2 0.777
3    23          6 1 35    1 0.770

$repaired
  Round numFeature r nh fact Value
1    26          9 4 17    3 0.772
2    33         11 9 30    9 0.771
3    38          5 4 17    2 0.770

$removed
  Round numFeature r nh fact Value
1    30          5 4 17    2 0.770
2     8          8 2 13    6 0.769
3    32          5 3 22    7 0.766

$relabeled
  Round numFeature r nh fact Value
1    34         12 5  8    9 0.777
2    33          9 5  4    9 0.763
3    36         12 7  4    9 0.760

Wie man erkennen kann, sehen diese Ergebnisse besser aus. Zum Vergleich: Wir können nicht die ersten drei Ergebnisse drucken, sondern zehn: Die Unterschiede werden noch deutlicher sichtbar. 

Jeder Optimierungslauf erzeugt unterschiedliche Hyperparameterwerte und Ergebnisse. Die Hyperparameter können durch verschiedene RNG-Einstellungen sowie durch eine spezifische Start-Initialisierung optimiert werden.

Sammeln wir die besten Hyperparameter der neuronalen Netze der Ensembles für 4 Datengruppen. Sie werden später benötigt, um Ensembles mit optimalen Hyperparametern zu bilden.

#---best.param-------------------
evalq({
  foreach(i = 1:4, .combine = "rbind") %do% {
    OPT_Res1[[i]]$Best_Par %>% unname()
  } -> best.par1
  dimnames(best.par1) <- list(group, qc(numFeature, r, nh, fact))
}, env)

The hyperparameters:

> env$best.par1
          numFeature r nh fact
origin             8 3 41    2
repaired           9 4 17    3
removed            5 4 17    2
relabeled         12 5  8    9

Alle Skripte dieses Skripte befinden sich in der Datei Optim_VIII.R.

7. Optimierung der Hyperparameter der Nachbearbeitung (Schwellenwerte für die Bereinigung und Mittelung)

Die Optimierung der Hyperparameter der neuronalen Netze führt zu einer leichten Erhöhung der Klassifizierungsqualität. Wie bereits erwähnt, hat die Kombination von Schwellentypen beim Bereinigen und Mitteln einen stärkeren Einfluss auf die Klassifizierungsqualität. 

Wir haben die Hyperparameter bereits mit einer konstanten Kombination von Schwellenwerten half/half optimiert. Vielleicht ist diese Kombination nicht optimal. Wiederholen wir die Optimierung mit zwei zusätzlichen optimierten Parametern th1 = c(1L, 2L)) - Schwellentyp beim Beschneiden des Ensembles (Auswahl der besten neuronalen Netze) - und th2 = c(1L, 4L) - Schwellentyp beim Umwandeln der gemittelten Vorhersage des Ensembles in Klassenbezeichnungen. Definieren wir die Konstanten und die Wertebereiche der zu optimierenden Hyperparameter.

##===OPTIM===============================
evalq({
  #type of activation function. 
  Fact <- c("sig", #: sigmoid
            "sin", #: sine
            "radbas", #: radial basis
            "hardlim", #: hard-limit
            "hardlims", #: symmetric hard-limit
            "satlins", #: satlins
            "tansig", #: tan-sigmoid
            "tribas", #: triangular basis
            "poslin", #: positive linear
            "purelin") #: linear
  bonds_m <- list(
    numFeature = c(3L, 13L),
    r = c(1L, 10L),
    nh = c(1L, 51L),
    fact = c(1L, 10L),
    th1 = c(1L, 2L),
    th2 = c(1L, 4L)
  )
}, env)

Nun zur Fitnessfunktion. Es wurde leicht modifiziert: zwei Parameter, th1, th2 wurden hinzugefügt. Wir berechnen im Funktionskörper und im 'best' Block den Schwellenwert in Abhängigkeit von th1. Im Block "Testdurchschnitt" bestimmen wir den Schwellenwert mit der Funktion GetThreshold() in Abhängigkeit vom Schwellentyp th2.

#---Fitnes -FUN-----------
evalq({
  n <- 500L
  numEns <- 3L
  # SEED <- c(12345, 1235809)
  fitnes_m <- function(numFeature, r, nh, fact, th1, th2){
    bestF <- orderX %>% head(numFeature)
    k <- 1L
    rng <- RNGseq(n, SEED)
    #---train---
    Ens <- foreach(i = 1:n, .packages = "elmNN") %do% {
      rngtools::setRNG(rng[[k]])
      idx <- rminer::holdout(Ytrain, ratio = r/10, mode = "random")$tr
      k <- k + 1
      elmtrain(x = Xtrain[idx, bestF], y = Ytrain[idx], 
               nhid = nh, actfun = Fact[fact])
    }
    #---predict---
    foreach(i = 1:n, .packages = "elmNN", .combine = "cbind") %do% {
      predict(Ens[[i]], newdata = Xtest[ , bestF])
    } -> y.pr #[ ,n]
    #---best---
    ifelse(th1 == 1L, 0.5, median(y.pr)) -> th
    foreach(i = 1:n, .combine = "c") %do% {
      ifelse(y.pr[ ,i] > th, 1, 0) -> Ypred
      Evaluate(actual = Ytest, predicted = Ypred)$Metrics$F1 %>%
        mean() 
    } -> Score
    Score %>% order(decreasing = TRUE) %>% head((numEns*2 + 1)) -> bestNN
    #---test-aver--------
    foreach(i = 1:n, .packages = "elmNN", .combine = "+") %:%
      when(i %in% bestNN) %do% {
        predict(Ens[[i]], newdata = Xtest1[ , bestF])} %>%
      divide_by(length(bestNN)) -> ensPred
    th <- GetThreshold(ensPred, Yts$Ytest1, type[th2])
    ifelse(ensPred > th, 1, 0) -> ensPred
    Evaluate(actual = Ytest1, predicted = ensPred)$Metrics$F1 %>%
      mean() %>% round(3) -> Score
    return(list(Score = Score, Pred = ensPred))
  }
}, env) 

Prüfen wir wie viel Zeit ein Iteration dieser Funktion benötigt und ob sie arbeitet:

#---res fitnes-------
evalq({
  Ytrain <- X1$pretrain$y
  Ytest <- X1$train$y
  Ytest1 <- X1$test$y
  Xtrain <- X1$pretrain$x
  Xtest <- X1$train$x
  Xtest1 <- X1$test$x 
  orderX <- orderX1
  SEED <- 1235809
  th1 <- 1
  th2 <- 4
  system.time(
    res_m <- fitnes_m(numFeature = 10, r = 7, nh = 5, fact = 2, th1, th2)
  )
}, env)
   user  system elapsed 
   6.13    0.04    6.32 
> env$res_m$Score
[1] 0.748

Die Ausführungszeit der Funktion hat sich deutlich geändert. Danach starten wit die Optimierung und warten auf das Ergebnis:

#---Optim Ensemble-----
library(rBayesianOptimization)
evalq({
  Ytest <- X1$train$y
  Ytest1 <- X1$test$y
  Xtest <- X1$train$x
  Xtest1 <- X1$test$x 
  orderX <- orderX1
  SEED <- 1235809
  OPT_Res1 <- vector("list", 4)
  foreach(i = 1:4) %do% {
    Xtrain <- denoiseX1pretrain[[i]]$x
    Ytrain <- denoiseX1pretrain[[i]]$y
    BayesianOptimization(fitnes_m, bounds = bonds_m,
                         init_grid_dt = NULL, init_points = 20, 
                         n_iter = 20, acq = "ucb", kappa = 2.576, 
                         eps = 0.0, verbose = TRUE,
                         maxit = 100) #, control = c(100, 50, 8))
  } -> OPT_Res_m
  group <- qc(origin, repaired, removed, relabeled)
  names(OPT_Res_m) <- group
}, env)

Die Auswahl der besten 10 erhaltenen Hyperparameter für jede Datengruppe:

#---OptPar------
evalq({
  foreach(i = 1:4) %do% {
    OPT_Res_m[[i]] %$% History %>% dp$arrange(desc(Value)) %>% head(10)
  } -> best.res_m
  names(best.res_m) <- group
}, env)
$origin
   Round numFeature  r nh fact th1 th2 Value
1     19          8  3 41    2   2   4 0.778
2     25          6  8 51    8   2   4 0.778
3     39          9  1 22    1   2   4 0.777
4     32          8  1 21    2   2   4 0.772
5     10          6  5 32    3   1   3 0.769
6     22          7  2 30    9   1   4 0.769
7     28          6 10 25    5   1   4 0.769
8     30          7  9 33    2   2   4 0.768
9     40          9  2 48   10   2   4 0.768
10    23          9  1  2   10   2   4 0.767

$repaired
   Round numFeature  r nh fact th1 th2 Value
1     39          7  8 39    8   1   4 0.782
2      2          5  8 50    3   2   3 0.775
3      3         12  6  7    8   1   1 0.769
4     24          5 10 45    5   2   3 0.769
5     10          7  8 40    2   1   4 0.768
6     13          5  8 40    2   2   4 0.768
7      9          6  9 13    2   2   3 0.766
8     19          5  7 46    6   2   1 0.765
9     40          9  8 50    6   1   4 0.764
10    20          9  3 28    9   1   3 0.763

$removed
   Round numFeature  r nh fact th1 th2 Value
1     40          7  2 39    8   1   3 0.786
2     13          5  3 48    3   2   3 0.776
3      8          5  6 18    1   1   1 0.772
4      5          5 10 24    3   1   3 0.771
5     29         13  7  1    1   1   4 0.771
6      9          7  3 25    7   1   4 0.770
7     17          9  2 17    1   1   4 0.770
8     19          7  7 25    2   1   3 0.768
9      4         10  6 19    7   1   3 0.765
10     2          4  4 47    7   2   3 0.764

$relabeled
   Round numFeature  r nh fact th1 th2 Value
1      7          8  1 13    1   2   4 0.778
2     26          8  1 19    6   2   4 0.768
3      3          6  3 45    4   2   2 0.766
4     20          6  2 40   10   2   2 0.766
5     13          4  3 18    2   2   3 0.762
6     10         10  6  4    8   1   3 0.761
7     31         11 10 16    1   2   4 0.760
8     15         13  7  7    1   2   3 0.759
9      5          7  3 20    2   1   4 0.758
10     9          9  3 22    8   2   3 0.758

Es gibt eine kleine Verbesserung der Qualität. Die besten Hyperparameter für jede Datengruppe unterscheiden sich stark von den Hyperparametern, die bei der vorherigen Optimierung erhalten wurden, ohne Berücksichtigung der unterschiedlichen Kombination von Schwellenwerten. Die beste Qualität der Ergebnisse wird durch Datengruppen von Rauschproben mit neuer Kennzeichnung (repaired) und den entfernten ( removed) erreicht.

#---best.param-------------------
evalq({
  foreach(i = 1:4, .combine = "rbind") %do% {
    OPT_Res_m[[i]]$Best_Par %>% unname()
  } -> best.par_m
  dimnames(best.par_m) <- list(group, qc(numFeature, r, nh, fact, th1, th2))
}, env)
# > env$best.par_m------------------------
#           numFeature r nh fact th1 th2
# origin             8 3 41    2   2   4
# repaired           7 8 39    8   1   4
# removed            7 2 39    8   1   3
# relabeled          8 1 13    1   2   4

Die verwendeten Skripte dieses Teils befinden sich in der Datei Optim_mVIII.R.

8. Kombinieren der besten Ensembles zum Superensemble inklusive deren Ausgaben

Wir kombinieren mehrere beste Ensembles zu einem Superensemble, und deren Ergebnisse werden mit einfacher Mehrheit kaskadiert.

Zuerst kombinieren wir die Ergebnisse mehrerer bester Ensembles, die während der Optimierung erhalten wurden. Nach der Optimierung gibt die Funktion nicht nur die besten Hyperparameter zurück, sondern auch die Historie der Vorhersagen in Klassenlabels bei allen Iterationen. Wir erzeugen ein Superensemble aus den 5 besten Ensembles jeder Datengruppe und überprüfen mit einfacher Mehrheit, ob sich die Klassifizierungsqualität in dieser Variante verbessert. 

Die Berechnungen werden in der folgenden Reihenfolge durchgeführt:

  • Sequentiell über 4 Datengruppen in einer Schleife iterieren;
  • Bestimmen der Indizes der 5 besten Vorhersagen in jeder Datengruppe;
  • Die Vorhersagen mit diesen Indizes zu einem Datenrahmen zusammenfassen;
  • Die Klassenbezeichnung in allen Vorhersagen von "0" auf "-1" ändern;
  • Summe dieser Vorhersagen Zeile für Zeile;
  • Umwandeln dieser summierten Werte gemäß der Bedingung in Klassenbeschriftungen (-1, 0, 1): wenn der Wert größer als 3 ist, dann Klasse = 1; wenn kleiner als -3, dann Klasse = -1; ansonsten Klasse = 0 

Hier ist das Skript, das diese Berechnungen durchführt:

#--Index-best-------------------
evalq({
  prVot <- vector("list", 4)
  foreach(i = 1:4) %do% { #group
    best.res_m[[i]]$Round %>% head(5) -> ind 
    OPT_Res_m[[i]]$Pred  %>% dp$select(ind)  ->.; 
    apply(., 2, function(.) ifelse(. == 0, -1, 1)) ->.; 
    apply(., 1, function(x) sum(x)) ->.; 
    ifelse(. > 3, 1, ifelse(. < -3, -1, 0))
 } -> prVot
  names(prVot) <- group
}, env)

Wir haben eine zusätzliche dritte Klasse "0". Wenn "-1", ist es "Verkaufen", "1" ist "Kaufen" und "0" ist "nicht sicher". Wie der Expert Advisor auf dieses Signal reagiert, liegt in der Verantwortung des Benutzers. Er kann sich vom Markt fernhalten, oder er kann auf dem Markt sein und nichts tun und auf ein neues Signal zum Handeln warten. Die Verhaltensmodelle sollten beim Testen des Experten erstellt und überprüft werden. 

Um die Metriken zu erhalten, ist es notwendig:

  • Sequentiell über jede Datengruppe in einer Schleife iterieren;
  • Im Istwert des Ziels Ytest1, das Klassenlabel "0" durch das Label "-1" ersetzen;
  • Das oben erhaltene tatsächliche und vorhergesagte Ziel PRVot in einem Datenrahmen kombinieren;
  • Entfernen der Zeilen mit dem Wert von prVot = 0 aus dem Datenrahmen;
  • Berechnen der Metrik.

Berechnen wir das Ergebnis und sehen es uns an.

evalq({
  foreach(i = 1:4) %do% { #group
   Ytest1  ->.; 
    ifelse(. == 0, -1, 1) ->.; 
    cbind(actual = ., pred = prVot[[i]]) %>% as.data.frame() ->.; 
    dp$filter(., pred != 0) -> tabl
    Eval(tabl$actual, tabl$pred)
  } -> Score
  names(Score) <- group
}, env) 
env$Score
$origin
$origin$metrics
   Accuracy Precision Recall    F1
-1    0.806     0.809  0.762 0.785
1     0.806     0.804  0.845 0.824

$origin$confMatr
Confusion Matrix und Statistik

      predicted
actual  -1   1
    -1 157  49
    1   37 201
                                         
               Accuracy : 0.8063         
                 95% CI : (0.7664, 0.842)
    No Information Rate : 0.5631         
    P-Value [Acc > NIR] : <2e-16         
                                         
                  Kappa : 0.6091         
 Mcnemar's Test P-Value : 0.2356         
                                         
            Sensitivity : 0.8093         
            Specificity : 0.8040         
         Pos Pred Value : 0.7621         
         Neg Pred Value : 0.8445         
             Prevalence : 0.4369         
         Detection Rate : 0.3536         
   Detection Prevalence : 0.4640         
      Balanced Accuracy : 0.8066         
                                         
       'Positive' Class : -1             
                                         


$repaired
$repaired$metrics
   Accuracy Precision Recall    F1
-1     0.82     0.826  0.770 0.797
1      0.82     0.816  0.863 0.839

$repaired$confMatr
Confusion Matrix und Statistik

      predicted
actual  -1   1
    -1 147  44
    1   31 195
                                          
               Accuracy : 0.8201          
                 95% CI : (0.7798, 0.8558)
    No Information Rate : 0.5731          
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.6358          
 Mcnemar's Test P-Value : 0.1659          
                                          
            Sensitivity : 0.8258          
            Specificity : 0.8159          
         Pos Pred Value : 0.7696          
         Neg Pred Value : 0.8628          
             Prevalence : 0.4269          
         Detection Rate : 0.3525          
   Detection Prevalence : 0.4580          
      Balanced Accuracy : 0.8209          
                                          
       'Positive' Class : -1              
                                          


$removed
$removed$metrics
   Accuracy Precision Recall    F1
-1    0.819     0.843  0.740 0.788
1     0.819     0.802  0.885 0.841

$removed$confMatr
Confusion Matrix und Statistik

      predicted
actual  -1   1
    -1 145  51
    1   27 207
                                          
               Accuracy : 0.8186          
                 95% CI : (0.7789, 0.8539)
    No Information Rate : 0.6             
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.6307          
 Mcnemar's Test P-Value : 0.009208        
                                          
            Sensitivity : 0.8430          
            Specificity : 0.8023          
         Pos Pred Value : 0.7398          
         Neg Pred Value : 0.8846          
             Prevalence : 0.4000          
         Detection Rate : 0.3372          
   Detection Prevalence : 0.4558          
      Balanced Accuracy : 0.8227          
                                          
       'Positive' Class : -1              
                                          


$relabeled
$relabeled$metrics
   Accuracy Precision Recall    F1
-1    0.815     0.809  0.801 0.805
1     0.815     0.820  0.828 0.824

$relabeled$confMatr
Confusion Matrix und Statistik

      predicted
actual  -1   1
    -1 157  39
    1   37 178
                                          
               Accuracy : 0.8151          
                 95% CI : (0.7741, 0.8515)
    No Information Rate : 0.528           
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.6292          
 Mcnemar's Test P-Value : 0.9087          
                                          
            Sensitivity : 0.8093          
            Specificity : 0.8203          
         Pos Pred Value : 0.8010          
         Neg Pred Value : 0.8279          
             Prevalence : 0.4720          
         Detection Rate : 0.3820          
   Detection Prevalence : 0.4769          
      Balanced Accuracy : 0.8148          
                                          
       'Positive' Class : -1   
#---------------------------------------

Die Qualität hat sich in allen Gruppen deutlich verbessert. Die besten Ergebnisse von "Balanced Accuracy" wurden in den Gruppen removed (0.8227) und repaired (0.8209) erzielt.                                        

Kombinieren wir die Prognosen der Gruppe auch mit einfacher Mehrheit. Führen wir die Kombination in Kaskade durch:

  • Über alle Datengruppen in einer Schleife iterieren;
  • Bestimmen der Indizes der Durchläufe mit den besten Ergebnissen;
  • Auswählen der Vorhersagen für diese besten Durchläufe;
  • Ersetzen in jeder Spalte das Klassenlabel "0" durch das Label "-1";
  • Zeilenweise summieren der Vorhersagen in der Gruppe.

Sehen wir uns das erzielte Ergebnis an:

#--Index-best-------------------
evalq({
  foreach(i = 1:4, .combine = "+") %do% { #group
    best.res_m[[i]]$Round %>% head(5) -> ind 
    OPT_Res_m[[i]]$Pred  %>% dp$select(ind)  ->.; 
    apply(., 2, function(x) ifelse(x == 0, -1, 1)) ->.; 
    apply(., 1, function(x) sum(x)) 
 } -> prVotSum
}, env)
> env$prVotSum %>% table()
.
-20 -18 -16 -14 -12 -10  -8  -6  -4  -2   0   2   4   6   8  10  12  14  16  18  20 
166  12   4   6   7   6   5   3   6   1   4   4   5   6   5  10   7   3   8  24 209

Belassen wir nur den größten Wert für die Abstimmung und Berechnung der Metrik:

evalq({
    pred <- {prVotSum ->.; 
       ifelse(. > 18, 1, ifelse(. < -18, -1, 0))}
    Ytest1  ->.; 
    ifelse(. == 0, -1, 1) ->.; 
    cbind(actual = ., pred = pred) %>% as.data.frame() ->.; 
    dp$filter(., pred != 0) -> tabl
    Eval(tabl$actual, tabl$pred) -> ScoreSum
}, env) 
env$ScoreSum
> env$ScoreSum
$metrics
   Accuracy Precision Recall    F1
-1    0.835     0.849  0.792 0.820
1     0.835     0.823  0.873 0.847

$confMatr
Confusion Matrix und Statistik

      predicted
actual  -1   1
    -1 141  37
    1   25 172
                                          
               Accuracy : 0.8347          
                 95% CI : (0.7931, 0.8708)
    No Information Rate : 0.5573          
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.6674          
 Mcnemar's Test P-Value : 0.1624          
                                          
            Sensitivity : 0.8494          
            Specificity : 0.8230          
         Pos Pred Value : 0.7921          
         Neg Pred Value : 0.8731          
             Prevalence : 0.4427          
         Detection Rate : 0.3760          
   Detection Prevalence : 0.4747          
      Balanced Accuracy : 0.8362          
                                          
       'Positive' Class : -1    

Dies ergab eine sehr gute Bewertung der Balanced Accuracy = 0,8362.

Die in diesem Abschnitt beschriebenen Skripte befinden sich in der Datei Voting.R.

Aber wir dürfen eine Kleinigkeit nicht vergessen. Bei der Optimierung der Hyperparameter haben wir das Testset InputTest verwendet. Das bedeutet, dass wir mit dem nächsten Testset InputTest1 arbeiten können. Die Kombination der Ensembles beim Kaskadieren führt höchstwahrscheinlich zu dem gleichen positiven Effekt ohne Optimierung der Hyperparameter. Überprüfen wir die zuvor erhaltenen Durchschnittswerte.

Wir kombinieren die gemittelten Ergebnisse der in Abschnitt 5.2 erhaltenen Ensembles. 

Wir wiederholen die in Abschnitt 5.4 beschriebenen Berechnungen mit einer Änderung. Bei der Konvertierung der kontinuierlichen gemittelten Vorhersage in Klassenbezeichnungen sind diese Bezeichnungen[-1, 0, 1]. Die Reihenfolge der Berechnung in jeder Teilmenge Train/Test/Test1:

  • Sequentiell über 4 Datengruppen in einer Schleife iterieren;
  • Durch 4 Arten der bereinigten Schwellenwerte;
  • Durch 4 Arten der gemittelten Schwellenwerte;
  • Umwandeln der kontinuierlich gemittelten Vorhersage des Ensembles in Klassenlabels[-1, 1];
  • Diese summieren durch 4 Arten von gemittelten Schwellenwerte;
  • Umbenennen der Summe mit neuen Kennzeichnungen[-1, 0, 1];
  • Hinzufügen des erhaltenen Ergebnisses zur Struktur VotAver.
#---train-------------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  VotAver <- vector("list", 4)
  names(VotAver) <- group
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type aver
      foreach(i = 1:4, .combine = "+") %do% {# type threshold
        ifelse(testX1[[k]]$TrainYpred[ ,j] > testX1[[k]]$th_aver[i,j], 1, -1)
      } ->.; 
      ifelse(. > 2, 1, ifelse(. < -2, -1, 0))  
    }  -> VotAver[[k]]$Train.clVoting
    dimnames(VotAver[[k]]$Train.clVoting) <- list(NULL, type)
    k <- k + 1
  }
}, env)
#---test------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type aver
      foreach(i = 1:4, .combine = "+") %do% {# type threshold
        ifelse(testX1[[k]]$TestYpred[ ,j] > testX1[[k]]$th_aver[i,j], 1, -1)
      } ->.; 
      ifelse(. > 2, 1, ifelse(. < -2, -1, 0))  
    }  -> VotAver[[k]]$Test.clVoting
    dimnames(VotAver[[k]]$Test.clVoting) <- list(NULL, type)
    k <- k + 1
  }
}, env)
#---test1-------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(j = 1:4, .combine = "cbind") %do% {# type aver
      foreach(i = 1:4, .combine = "+") %do% {# type threshold
        ifelse(testX1[[k]]$Test1Ypred[ ,j] > testX1[[k]]$th_aver[i,j], 1, -1)
      } ->.; 
      ifelse(. > 2, 1, ifelse(. < -2, -1, 0))  
    }  -> VotAver[[k]]$Test1.clVoting
    dimnames(VotAver[[k]]$Test1.clVoting) <- list(NULL, type)
    k <- k + 1
  }
}, env)

Sobald die neu benannten gemittelten Vorhersagen in Teilmengen und Gruppen bestimmt sind, berechnen wir deren Metriken. Reihenfolge der Berechnungen:

  • Iterieren über die Gruppen in einer Schleife;
  • Iterieren über 4 Arten der gemittelten Schwellenwerte;
  • Umbenennen der die Klassenlables in der aktuellen Vorhersage von "0" auf "-1" ändern;
  • Kombinieren der aktuellen und der umbenannten Vorhersage im Datenrahmen;
  • Entfernen der Zeilen mit der Vorhersage gleich 0 aus dem Datenrahmen;
  • Berechnen der Kennzahlen und hinzufügen zur Struktur VotAver.
#---Metrics--train-------------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
      foreach(i = 1:4) %do% {# type threshold
        Ytest ->.; 
        ifelse(. == 0, -1, 1) ->.;
        cbind(actual = ., pred = VotAver[[k]]$Train.clVoting[ ,i]) %>% 
          as.data.frame() ->.; 
          dp$filter(., pred != 0) -> tbl 
        Evaluate(actual = tbl$actual, predicted = tbl$pred)$Metrics$F1 %>% 
          mean() %>% round(3)
        #Eval(tbl$actual,tbl$pred)
      } -> VotAver[[k]]$TrainScoreVot
    names(VotAver[[k]]$TrainScoreVot) <- type
    k <- k + 1
  }
}, env)
#---Metrics--test-------------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(i = 1:4) %do% {# type threshold
      Ytest1 ->.; 
      ifelse(. == 0, -1, 1) ->.;
      cbind(actual = ., pred = VotAver[[k]]$Test.clVoting[ ,i]) %>% 
        as.data.frame() ->.; 
      dp$filter(., pred != 0) -> tbl
      Evaluate(actual = tbl$actual, predicted = tbl$pred)$Metrics$F1 %>% 
        mean() %>% round(3)
      #Eval(tbl$actual,tbl$pred)
    } -> VotAver[[k]]$TestScoreVot
    names(VotAver[[k]]$TestScoreVot) <- type
    k <- k + 1
  }
}, env)
#---Metrics--test1-------------------------------------
evalq({
  k <- 1L #origin
  type <- qc(half, med, mce, both)
  while (k <= 4) { # group
    foreach(i = 1:4) %do% {# type threshold
      Ytest2 ->.; 
      ifelse(. == 0, -1, 1) ->.;
      cbind(actual = ., pred = VotAver[[k]]$Test1.clVoting[ ,i]) %>% 
        as.data.frame() ->.; 
      dp$filter(., pred != 0) -> tbl 
      Evaluate(actual = tbl$actual, predicted = tbl$pred)$Metrics$F1 %>% 
        mean() %>% round(3)
      #Eval(tbl$actual,tbl$pred)
    } -> VotAver[[k]]$Test1ScoreVot
    names(VotAver[[k]]$Test1ScoreVot) <- type
    k <- k + 1
  }
}, env)

Sammeln wir die Daten in lesbarer Form und schauen wir sie uns an:

#----TrainScoreVot-------------------
evalq({
  foreach(k = 1:4, .combine = "rbind") %do% {   # group
    VotAver[[k]]$TrainScoreVot %>% unlist() %>% unname()
  } -> TrainScoreVot
  dimnames(TrainScoreVot) <- list(group, type)
}, env)
> env$TrainScoreVot
           half   med   mce  both
origin    0.738 0.750 0.742 0.752
repaired  0.741 0.743 0.741 0.741
removed   0.748 0.755 0.755 0.755
relabeled 0.717 0.741 0.740 0.758
#-----TestScoreVot----------------------------
evalq({
  foreach(k = 1:4, .combine = "rbind") %do% {   # group
    VotAver[[k]]$TestScoreVot %>% unlist() %>% unname()
  } -> TestScoreVot
  dimnames(TestScoreVot) <- list(group, type)
}, env)
> env$TestScoreVot
           half   med   mce  both
origin    0.774 0.789 0.797 0.804
repaired  0.777 0.788 0.778 0.778
removed   0.801 0.808 0.809 0.809
relabeled 0.773 0.789 0.802 0.816
#----Test1ScoreVot--------------------------
evalq({
  foreach(k = 1:4, .combine = "rbind") %do% {   # group
    VotAver[[k]]$Test1ScoreVot %>% unlist() %>% unname()
  } -> Test1ScoreVot
  dimnames(Test1ScoreVot) <- list(group, type)
}, env)
> env$Test1ScoreVot
           half   med   mce  both
origin    0.737 0.757 0.757 0.755
repaired  0.756 0.743 0.754 0.754
removed   0.759 0.757 0.745 0.745
relabeled 0.734 0.705 0.697 0.713

Die besten Ergebnisse wurden mit der getesteten Untergruppe in der Datengruppe "removed" mit der Verarbeitung von Rauschproben erzielt.

Kombinieren wir die Ergebnisse in jeder Teilmenge jeder Datengruppe durch Typen der Mittelung.

#==Variant-2==========================================
#--TrainScoreVotSum-------------------------------
evalq({
  k <- 1L
  while(k <= 4){ # group
    VotAver[[k]]$Train.clVoting ->.; 
    apply(., 1, function(x) sum(x)) ->.;
    ifelse(. > 3, 1, ifelse(. < -3, -1, 0)) -> VotAver[[k]]$Train.clVotingSum
    ifelse(Ytest == 0, -1, 1) ->.;
    cbind(actual = ., pred = VotAver[[k]]$Train.clVotingSum) ->.; 
    as.data.frame(.) ->.; 
    dp$filter(., pred != 0) ->.; 
    Evaluate(actual = .$actual, predicted = .$pred)$Metrics$F1 ->.; 
    mean(.) %>% round(3) -> VotAver[[k]]$TrainScoreVotSum
    #Eval(tbl$actual,tbl$pred)
    k <- k + 1
  }
}, env)

#--TestScoreVotSum-------------------------------     
evalq({
  k <- 1L
  while(k <= 4){ # group                
    VotAver[[k]]$Test.clVoting ->.; 
    apply(., 1, function(x) sum(x))->.; 
    ifelse(. > 3, 1, ifelse(. < -3, -1, 0)) -> VotAver[[k]]$Test.clVotingSum
    ifelse(Ytest1 == 0, -1, 1) ->.;
    cbind(actual = ., pred = VotAver[[k]]$Test.clVotingSum) ->.; 
    as.data.frame(.) ->.; 
    dp$filter(., pred != 0) ->.; 
    Evaluate(actual = .$actual, predicted = .$pred)$Metrics$F1 ->.; 
    mean(.) %>% round(3) -> VotAver[[k]]$TestScoreVotSum
    #Eval(tbl$actual,tbl$pred)
    k <- k + 1
  }
}, env)

#--Test1ScoreVotSum-------------------------------  
evalq({
  k <- 1L
  while(k <= 4){ # group                
    VotAver[[k]]$Test1.clVoting ->.; 
    apply(., 1, function(x) sum(x))->.; 
    ifelse(. > 3, 1, ifelse(. < -3, -1, 0)) -> VotAver[[k]]$Test1.clVotingSum
    ifelse(Ytest2 == 0, -1, 1) ->.;
    cbind(actual = ., pred = VotAver[[k]]$Test1.clVotingSum) ->.; 
    as.data.frame(.) ->.; 
    dp$filter(., pred != 0) ->.; 
    Evaluate(actual = .$actual, predicted = .$pred)$Metrics$F1 ->.; 
    mean(.) %>% round(3) -> VotAver[[k]]$Test1ScoreVotSum
    #Eval(tbl$actual,tbl$pred)
    k <- k + 1
  }
}, env)

Sammeln wir die Ergebnisse in lesbarer Form.

evalq({
  foreach(k = 1:4, .combine = "c") %do% {   # group
    VotAver[[k]]$TrainScoreVotSum %>% unlist() %>% unname()
  } -> TrainScoreVotSum
  
  foreach(k = 1:4, .combine = "c") %do% {   # group
    VotAver[[k]]$TestScoreVotSum %>% unlist() %>% unname()
  } -> TestScoreVotSum
  
  foreach(k = 1:4, .combine = "c") %do% {   # group
    VotAver[[k]]$Test1ScoreVotSum %>% unlist() %>% unname()
  } -> Test1ScoreVotSum
  
  ScoreVotSum <- cbind(TrainScoreVotSum, TestScoreVotSum, Test1ScoreVotSum)
  dimnames(ScoreVotSum ) <- list(group, qc(TrainScoreVotSum, TestScoreVotSum, 
                                 Test1ScoreVotSum))
}, env)
> env$ScoreVotSum
          TrainScoreVotSum TestScoreVotSum Test1ScoreVotSum
origin               0.763           0.807            0.762
repaired             0.752           0.802            0.748
removed              0.761           0.810            0.765
relabeled            0.766           0.825 (!!)       0.711  

Berücksichtigen wir die Ergebnisse des Testsets. Überraschenderweise hatte die Methode relabeled das beste Ergebnis. Die Ergebnisse in allen Gruppen sind viel besser als die in Abschnitt 5.4 erzielten. Das Verfahren zur Kombination der Ensemble-Ausgaben in Kaskade durch einfache Mehrheitsabstimmung führt zu einer Verbesserung der Klassifizierungsqualität (Genauigkeit) von 5% auf 7%. 

Die Skripte aus diesem Abschnitt befinden sich in der Datei Voting_aver.R. Die Struktur der erhaltenen Daten ist in der folgenden Abbildung dargestellt:


Abb. 10. Die Datenstruktur von VotAver.


Das Bild unten bietet ein vereinfachtest Schema aller Berechnungen: Es zeigt die Entwicklungsschritte, die verwendeten Skripte und Datenstrukturen.


Abb. 11. Struktur und die Abfolge der wichtigsten Berechnungen in diesem Artikel.

8. Analyse der Versuchsergebnisse

Wir haben die Rauschproben aus den Anfangsdatensätzen in den Untermengen Pretrain (!) auf drei Arten verarbeitet:

  • Die mit "erroneously" gekennzeichneten Daten neu zugeordnet, ohne die Anzahl der Klassen zu ändern (repaired);
  • Die "Rauschproben" aus der Teilmenge entfernt (removed);
  • Die "Rauschproben" in einer separaten Klasse isoliert (relabeled).

Vier Gruppen von Daten (origin, repaired, removed, relabeled) wurden in der Struktur denoiseX1pretrain erhalten. Verwenden wir sie, um das aus 500 neuronalen ELM-Netzwerkklassifikatoren bestehende Ensemble zu trainieren. Wir erhalten vier Ensembles. Wir berechnen die kontinuierlichen Vorhersagen von drei Teilmengen Х$train/test/test1 mit diesen 4 Ensembles und sammeln sie in der Struktur predX1. 

Dann berechnen wir 4 Arten von Schwellenwerten für kontinuierliche Vorhersagen von jedem der 500 neuronalen Netze jedes Ensembles auf der Untergruppe InputTrain (!). Wir konvertieren anhand dieser Schwellenwerte die kontinuierlichen Vorhersagen in die Klassenlables (0, 1). Wir berechnen die Metriken (mean(F1)) für jedes neuronale Netzwerk der Ensembles und sammeln sie in der Struktur testX1$$$(InputTrainScore|InputTestScore|InputTestScore|InputTest1Score). Visualisierung der Verteilung der Metriken in 4 Datengruppen und 3 Teilmengen zeigt: 

  • Erstens sind die Metriken auf der ersten Testuntermenge in allen Gruppen höher als auf InputTrainS;
  • Zweitens sind die Metriken in den Gruppen repaired und removed optisch höher als in zwei anderen.

Wählen wir nun die 7 besten neuronalen Netze mit den größten Werten von mean(F1) in jedem Ensemble aus und berechnen deren kontinuierliche Vorhersagen. Wir fügen deren Werte zur Struktur testX1$$$(TrainYpred|TestYpred|TestYpred|Test1Ypred) hinzu. Wir berechnen die Schwellenwerte th_aver auf der Teilmenge TrainYpred, bestimmen die Metriken aller gemittelten kontinuierlichen Vorhersagen und fügen sie der Struktur testX1$$$(TrainScore|TestScore|TestScore|Test1Score) hinzu. Jetzt können sie analysiert werden.

Mit einer unterschiedlichen Kombination der Bereinigungs- und Mittelwertschwellen in verschiedenen Datengruppen erhalten wir Kennzahlen im Bereich von 0,75 - 0,77. Das beste Ergebnis wurde in der Gruppe removed erzielt, wobei die "Rauschproben" entfernt wurden. 

Die Optimierung der Hyperparameter der neuronalen Netze ermöglicht einen stabilen Anstieg der Kennzahlen um 0,77+ in allen Gruppen.    

Die Optimierung der Hyperparameter der neuronalen Netze und die Schwellenwerte für die Nachbearbeitung (Beschneiden und Mitteln) liefern ein stabil hohes Ergebnis von etwa 0,78+ in allen Gruppen mit den verarbeiteten "Rausch"-Samples.

Wir erstellen ein Superensemble aus mehreren Ensembles mit den optimalen Hyperparametern, nehmen die Vorhersagen dieser Ensembles und kombinieren sie mit einfacher Mehrheit in jeder Datengruppe. Als Ergebnis erhalten wir die Metriken in den Gruppen repaired und removed im Bereich von 0,82+. Kombiniert man diese Vorhersagen der Superensembles auch mit einfacher Mehrheit, erhält man den Endwert von 0,836. So führt die Kombination der Vorhersagen in einer Kaskade mit einfacher Mehrheit zu einer Qualitätsverbesserung von 6-7%. 

Überprüfen wir diese Aussage auf die gemittelten Vorhersagen des frühher erhaltenen Ensembles. Nachdem wir die Berechnungen und Konvertierungen in den Gruppen wiederholt haben, erhalten wir Metriken von 0,8+ in der Gruppe entfernt der Teilmenge Test. Wenn wir die Kombination in einer Kaskade fortsetzen, erhalten wir in der Untermenge Test in allen Datengruppen Kennzahlen mit Werten von 0,8+. 

Es kann der Schluss gezogen werden, dass die Kombination der Ensemble-Vorhersagen in einer Kaskade durch einfache Abstimmung die Klassifizierungsqualität tatsächlich verbessert. 

Schlussfolgerung

In diesem Artikel wurden drei Methoden zur Verbesserung der Qualität von Bagging-Ensembles betrachtet, sowie die Optimierung von Hyperparametern der neuronalen Netzwerke und der Nachbearbeitung des Ensembles. Basierend auf den Ergebnissen der Experimente können die folgenden Schlussfolgerungen gezogen werden:

  • Die Verarbeitung der Rauschproben mit den Methoden repaired und removed verbessert die Klassifizierungsqualität von Ensembles erheblich;
  • Die Wahl der Schwellenwertart für die Bereinigung und Mittelwertbildung sowie deren Kombination hat einen wesentlichen Einfluss auf die Klassifizierungsqualität;
  • Die Kombination mehrerer Ensembles zu einem Superensemble mit ihren Vorhersagen, die in einer Kaskade mit einfacher Mehrheitsentscheidung kombiniert werden, ergibt die größte Steigerung der Klassifizierungsqualität;
  • Die Optimierung der Hyperparameter der neuronalen Netze des Ensembles und der Nachbearbeitung verbessert leicht die Klassifizierungsqualität. Es ist ratsam, die erste Optimierung an neuen Daten durchzuführen und sie regelmäßig zu wiederholen, wenn die Qualität nachlässt. Die Periodizität wird experimentell bestimmt.

Anlagen

GitHub/PartVIII hält folgende Dateien bereit:

  1. Importar.R — Paket-Import Funktionen.
  2. Library.R — benötigte Bibliotheken.
  3. FunPrepareData_VII.R — Funktionen zur Vorbereitung der Anfangsdaten.
  4. FunStacking_VIII.R — Funktion für das Erstellen und Testen von Ensembles.
  5. Prepare_VIII.R — Funktionen und Skripte zur Vorbereitung der Anfangsdaten für trainierbare Kombinierer.
  6. Denoise.R — Skripte zur Verarbeitung von Rauschproben.
  7. Ensemles.R — Skripte zum Erstellen von Ensembles.
  8. Threshold.R — Skript zur Bestimmung von Schwellenwerte.
  9. Test.R — Skripte zum Testen von Ensembles.
  10. Averaging.R — Skripte zum Mitteln von kontinuierlichen Ausgaben von Ensembles.
  11. Voting_aver.R — Kombinieren gemittelter Ausgaben in einer Kaskade durch einfach Mehrheitsabstimmung.
  12. Optim_VIII.R — Skripte zum Optimieren der Hyperparameter von Neuronalen Netzen.
  13. Optim_mVIII.R — Skripte zum Optimieren der Hyperparameter von Neuronalen Netzen und der Nachbearbeitung.
  14. Voting.R — kombinieren der Ausgaben von Superensembles in einer Kaskade durch einfache Mehrheitsabstimmung.
  15. SessionInfo_VII.txt — Liste der in diesem Artikel verwendeten Pakete.


Übersetzt aus dem Russischen von MetaQuotes Software Corp.
Originalartikel: https://www.mql5.com/ru/articles/4722

Beigefügte Dateien |
PartVIII.zip (23.24 KB)
50.000 ausgeführte Aufträge im Rahmen des Freelance-Service bei MQL5.com 50.000 ausgeführte Aufträge im Rahmen des Freelance-Service bei MQL5.com

Mitglieder des offiziellen MetaTrader Freelance-Service haben bis Oktober 2018 mehr als 50.000 Aufträge ausgeführt. Dies ist die weltweit größte Freelance-Website für MQL-Programmierer: mehr als tausend Entwickler, Dutzende neuer Aufträge täglich und 7 Sprachlokalisierungen.

Entwicklung von Bestandsindikatoren mit Volumensteuerung am Beispiel des Delta-Indikators Entwicklung von Bestandsindikatoren mit Volumensteuerung am Beispiel des Delta-Indikators

Der Artikel beschäftigt sich mit dem Algorithmus der Entwicklung von Bestandsindikatoren auf Basis von realen Volumina mit den Funktionen CopyTicks() und CopyTicksRange(). Einige subtile Aspekte der Entwicklung solcher Indikatoren sowie deren Betrieb in Echtzeit und im Strategietester werden ebenfalls beschrieben.

PairPlot basiert auf CGraphic dient der Analyse von Korrelationen zwischen Datenarrays (Zeitreihen) PairPlot basiert auf CGraphic dient der Analyse von Korrelationen zwischen Datenarrays (Zeitreihen)

Der Vergleich mehrerer Zeitreihen während einer technischen Analyse ist eine recht häufige Aufgabe, die entsprechende Werkzeuge erfordert. In diesem Artikel schlage ich vor, ein Werkzeug für die grafische Analyse zu entwickeln und Korrelationen zwischen zwei oder mehr Zeitreihen zu erkennen.

Kombinieren der Strategien von Trend- und Seitwärtsbewegung Kombinieren der Strategien von Trend- und Seitwärtsbewegung

Es gibt viele Handelsstrategien 'da draußen'. Einige suchen nach Trends, andere definieren Preisspannen von Preisbewegungen und handeln dann diese. Ist es möglich beide Ansätze zu kombinieren, um die Profitabilität zu erhöhen?