# # Perceptorn type Neural Network with BP Learning. # Minoru Asogawa, NEC. Copyright 2005/2/18. # This program is for educational, only. NO guarantee.... # #parameter definition; Eta <- 0.01; Alpha <- 0.9; Maxv <- 1.0; Minv <- 0.0; #definition of sigmoid; sigmoid <- function( net ){#; return((Maxv-Minv)/(1+exp(-net)) + Minv); } #definition of sigmoid derivative, USE output value; dsigmoid <- function( out ){#; return((out-Minv)*(Maxv-out)/(Maxv-Minv)); } #layer definition fucntion; layer <- function(no){ return(list(net=vector("numeric", no), out=vector("numeric", no), bias=vector("numeric", no), delta=vector("numeric", no), dbias=vector("numeric", no))); } #connection definition fucntion; connection <- function(prevl, nextl){ return(list(w=matrix(0, ncol=length(prevl$net), nrow=length(nextl$net)), dw=matrix(0, ncol=length(prevl$net), nrow=length(nextl$net)))); } # network definition; # layers Input <- layer(2); Hidden <- layer(3); Output <- layer(2); # connections InputHidden <- connection(Input, Hidden); HiddenOutput <- connection(Hidden, Output); # randomize InputHidden$w randMag <- 0.01 InputHidden$w <- matrix(runif(length(Input$net)*length(Hidden$net),min=-randMag,max=randMag), length(Hidden$net), length(Input$net)); Hidden$bias <- runif(length(Hidden$net),min=-randMag,max=randMag); HiddenOutput$w <- matrix(runif(length(Hidden$net)*length(Output$net),min=-randMag,max=randMag), length(Output$net), length(Hidden$net)); Output$bias <- runif(length(Output$net),min=-randMag,max=randMag); activate <- function(iset){ #foward propagation; Input$out <<- BufInput[,iset]; Hidden$net <<- Hidden$bias + drop(InputHidden$w %*% Input$out); Hidden$out <<- sapply(Hidden$net, sigmoid); Output$net <<- Output$bias + drop(HiddenOutput$w %*% Hidden$out); Output$out <<- sapply(Output$net, sigmoid); target <<- BufTarget[,iset]; Output$delta <<- target - Output$out; Error <<- sum(Output$delta^2)/2.0/length(Output$delta); } learn <- function(iset){ activate(iset); #delta calculation; Output$delta <<- Output$delta * sapply(Output$out, dsigmoid); Hidden$delta <<- drop(t(HiddenOutput$w) %*% Output$delta) * sapply(Hidden$out, dsigmoid); InputHidden$dw <<- Eta * Hidden$delta %*% t(Input$out) + Alpha * InputHidden$dw; InputHidden$w <<- InputHidden$w + InputHidden$dw; HiddenOutput$dw <<- Eta * Output$delta %*% t(Hidden$out) + Alpha * HiddenOutput$dw; HiddenOutput$w <<- HiddenOutput$w + HiddenOutput$dw; #bias update; Hidden$dbias <<- Eta * Hidden$delta + Alpha * Hidden$dbias; Hidden$bias <<- Hidden$dbias + Hidden$bias; Output$dbias <<- Eta * Output$delta + Alpha* Output$dbias; Output$bias <<- Output$dbias + Output$bias; Error; } calDerivative <- function(iset){ activate(iset); ##solamente delta calculation; Output$delta <<- Output$delta * sapply(Output$out, dsigmoid); Hidden$delta <<- drop(t(HiddenOutput$w) %*% Output$delta) * sapply(Hidden$out, dsigmoid); Input$delta <<- drop(t(InputHidden$w) %*% Hidden$delta) * sapply(Input$out, dsigmoid); }