1##################################################
2sim <-function (net,P,...) {
3UseMethod("sim")
4}
5
6##################################################
7sim.MLPnet <- function(net,P,...) {
8   if (class(net)!="MLPnet") {
9      stop("Your net parameter does not belong to the MLPnet class. Are you aware that the result from the train function is now a list instead of a net? Check parameters and try again");
10   }
11   P <- as.matrix(P)
12   ytrans <- matrix(0, nrow=length(net$layer[[length(net$layer)]]), ncol=nrow(P))
13   ytrans <- .Call("sim_Forward_MLPnet", net, t(P), ytrans, .GlobalEnv, PACKAGE="AMORE")
14   return(t(ytrans))
15}
16###############################################################################################
17
18train <- function(net, P, T, Pval=NULL, Tval=NULL, error.criterium="LMS", report=TRUE, n.shows, show.step, Stao=NA, prob=NULL, n.threads=0L) {
19   if (class(net)!="MLPnet") {
20      stop("Your net parameter does not belong to the MLPnet class. Are you aware that the result from the train function is now a list instead of a net? Check parameters and try again");
21   }
22   P <- as.matrix(P)
23   T <- as.matrix(T)
24
25   epoch.show.step <- 0
26   n.muestras <- nrow(P)
27
28   net$deltaE$fname <- as.integer(0)  # custom case
29   if(error.criterium=="LMS") {
30     net$deltaE$fname <- as.integer(1)
31     net$deltaE$f <- deltaE.LMS
32   } else if(error.criterium=="LMLS") {
33     net$deltaE$fname <- as.integer(2)
34     net$deltaE$f <- deltaE.LMLS
35   } else if(error.criterium=="TAO") {
36     if (missing(Stao)) {
37        stop("You should enter the value of Stao")
38     } else {
39	net$deltaE$fname <- as.integer(3)
40	net$deltaE$f    <- deltaE.TAO
41        net$deltaE$Stao <- Stao
42     }
43   }
44
45   method <- net$neurons[[1]]$method
46
47   if (method =="ADAPTgd") {
48      train.method <- ADAPTgd.MLPnet
49   } else if (method =="ADAPTgdwm") {
50      train.method <- ADAPTgdwm.MLPnet
51   } else if (method =="BATCHgd") {
52      train.method <- BATCHgd.MLPnet
53   } else if (method =="BATCHgdwm") {
54      train.method <- BATCHgdwm.MLPnet
55   }
56
57   if (is.null(prob)) {
58      if (!is.null(Pval) & !is.null(Tval)) {
59	Merror <- matrix(NA, ncol=2, nrow=n.shows)
60         Pval <- as.matrix(Pval)
61         Tval <- as.matrix(Tval)
62         min.error.val <- Inf
63         bestnet <- net
64         for (idx.show in 1:n.shows) {
65            net <- train.method(net, P, T, show.step, n.threads=n.threads)
66            P.sim    <- sim.MLPnet(net,P)
67            Pval.sim <- sim.MLPnet(net,Pval)
68            if(error.criterium=="LMS") {
69               error     <- error.LMS(list(prediction=P.sim,    target=T    ))
70               error.val <- error.LMS(list(prediction=Pval.sim, target=Tval ))
71            } else if(error.criterium=="LMLS") {
72               error     <- error.LMLS(list(prediction=P.sim,    target=T    ))
73               error.val <- error.LMLS(list(prediction=Pval.sim, target=Tval ))
74            } else if(error.criterium=="TAO") {
75               error.aux  <- error.TAO(list(prediction=P.sim, target=T, net=net))
76               error      <- error.aux$perf
77               new.tao    <- error.aux$Stao
78               error.val  <- error.TAO(list(prediction=Pval.sim, target=Tval, net=net))$perf
79               cat("Stao:", new.tao, " ")
80            }
81            Merror [idx.show,] <- c(error,error.val)
82            if (error.val <= min.error.val ) {
83               min.error.val <- error.val
84               bestnet <- net
85               cat(paste("index.show:", idx.show, error.criterium,"\tTRAIN:",error,"\tVAL:",error.val,"\t BEST NET\n", sep=" "))
86            } else {
87               cat(paste("index.show:", idx.show, error.criterium,"\tTRAIN:",error,"\tVAL:",error.val,"\n", sep=" "))
88            }
89         }
90         net <- bestnet
91      } else {
92	Merror <- matrix(NA, ncol=1, nrow=n.shows)
93         for (idx.show in 1:n.shows) {
94            net <- train.method(net, P, T, show.step, n.threads=n.threads)
95            if (report) {
96		auxReport <-  training.report(net, P, T, idx.show, error.criterium)
97		net$other.elements$Stao <- auxReport$new.tao
98		Merror [idx.show,1] <- auxReport$error
99            }
100         }
101     }
102   } else {
103      if (!is.null(Pval) & !is.null(Tval)) {
104	Merror <- matrix(NA, ncol=2, nrow=n.shows)
105         Pval <- as.matrix(Pval)
106         Tval <- as.matrix(Tval)
107         min.error.val <- Inf
108         bestnet <- net
109         for (idx.show in 1:n.shows) {
110            orden <- sample(1:n.muestras, n.muestras, replace=TRUE , prob=prob)
111            net   <- train.method(net, P[orden, , drop=FALSE], T[orden, , drop=FALSE], show.step, n.threads=n.threads)
112            P.sim    <- sim.MLPnet(net,P)
113            Pval.sim <- sim.MLPnet(net,Pval)
114            if(error.criterium=="LMS") {
115               error     <- error.LMS(list(prediction=P.sim,    target=T    ))
116               error.val <- error.LMS(list(prediction=Pval.sim, target=Tval ))
117            } else if(error.criterium=="LMLS") {
118               error     <- error.LMLS(list(prediction=P.sim,    target=T    ))
119               error.val <- error.LMLS(list(prediction=Pval.sim, target=Tval ))
120            } else if(error.criterium=="TAO") {
121               error.aux  <- error.TAO(list(prediction=P.sim, target=T, net=net))
122               error      <- error.aux$perf
123               new.tao    <- error.aux$Stao
124               error.val  <- error.TAO(list(prediction=Pval.sim, target=Tval, net=net))$perf
125               cat("Stao:", new.tao, " ")
126            }
127            Merror [idx.show,] <- c(error,error.val)
128            if (error.val <= min.error.val ) {
129               min.error.val <- error.val
130               bestnet <- net
131               cat(paste("index.show:", idx.show, error.criterium,"\tTRAIN:",error,"\tVAL:",error.val,"\t BEST NET\n", sep=" "))
132            } else {
133               cat(paste("index.show:", idx.show, error.criterium,"\tTRAIN:",error,"\tVAL:",error.val,"\n", sep=" "))
134            }
135         }
136         net <- bestnet
137      } else {
138   	Merror <- matrix(NA, ncol=1, nrow=n.shows)
139         for (idx.show in 1:n.shows) {
140            orden <- sample(1:n.muestras, n.muestras, replace=TRUE , prob=prob)
141            net <- train.method(net, P[orden, , drop=FALSE], T[orden, , drop=FALSE], show.step, n.threads=n.threads)
142            if (report) {
143		auxReport <-  training.report(net, P, T, idx.show, error.criterium)
144		net$other.elements$Stao <- auxReport$new.tao
145		Merror [idx.show,1] <- auxReport$error
146            }
147         }
148     }
149   }
150   return(list(net=net,Merror=Merror))
151
152}
153
154
155###############################################################################################
156training.report <- function(net,P,T, idx.show, error.criterium) {
157
158
159########### BEGIN do not delete ##########
160   if (class(net)!="MLPnet") {
161      stop("Your net parameter does not belong to the MLPnet class. Are you aware that the result from the train function is now a list instead of a net? Check parameters and try again");
162   }
163   new.tao      <- NA
164
165########### END do not delete ############
166
167   P.sim <- sim.MLPnet(net,P)
168#          par(mfrow=c(1,2))
169#          plot(P,T, col="red", pch="*", ylim=range(rbind(T,P.sim)))
170#          points(P,P.sim, col="blue", pch="+")
171#          plot(P, ideal, col="red", pch=".", ylim=range(rbind(ideal,P.sim)))
172#          points(P,P.sim, col="blue", pch=".")
173   if(error.criterium=="LMS") {
174           error <- error.LMS(list(prediction=P.sim, target=T))
175   } else if(error.criterium=="LMLS") {
176           error <- error.LMLS(list(prediction=P.sim, target=T))
177
178########### BEGIN do not delete (only minor changes allowed) ##########
179   } else if(error.criterium=="TAO") {
180           error.aux <- error.TAO(list(prediction=P.sim, target=T, net=net))
181           error     <- error.aux$perf
182           new.tao   <- error.aux$Stao
183           cat("Stao:", new.tao, " ")
184   }
185########### END do not delete ############
186
187   cat(paste("index.show:", idx.show, error.criterium,error,"\n", sep=" "))
188
189########### BEGIN do not delete ##########
190return(list(error=error,new.tao=new.tao))
191########### END do not delete ############
192}
193