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