Sigmoid

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rnn
 Title: Recurrent Neural Network
-Version: 0.6.0
+Version: 0.6.0.9000
 Authors@R: c(person("Bastiaan", "Quast", email = "bquast@gmail.com", role = c("aut", "cre")),
              person("Dimitri", "Fichou", email = "dimitrifichou@gmail.com", role = "ctb"))
 Description: Implementation of a Recurrent Neural Network in R.

NAMESPACE

@@ -6,7 +6,6 @@ export(predictr)
 export(run.finance_demo)
 export(trainr)
 importFrom(shiny,runApp)
-importFrom(sigmoid,logistic)
 importFrom(sigmoid,sigmoid)
 importFrom(sigmoid,sigmoid_output_to_derivative)
 importFrom(stats,runif)

R/predictr.R

@@ -109,13 +109,11 @@ predictr <- function(model, X, hidden = FALSE, ...) {
       layers <- list()
       for(i in seq(length(synapse_dim) - 1)){
         if(i == 1){ # first hidden layer, need to take x as input
-          layers[[i]] <- sigmoid::logistic((x%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
-        }
-        if(i != length(synapse_dim) - 1 & i != 1){ #hidden layers not linked to input layer, depends of the last time step
-          layers[[i]] <- sigmoid::logistic((layers[[i-1]]%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
-        }
-        if(i == length(synapse_dim) - 1){ # output layer depend only of the hidden layer of bellow
-          layers[[i]] <- sigmoid::logistic(layers[[i-1]] %*% time_synapse[[i]])
+          layers[[i]] <- sigmoid((x%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
+        } else if(i != length(synapse_dim) - 1 & i != 1){ #hidden layers not linked to input layer, depends of the last time step
+          layers[[i]] <- sigmoid((layers[[i-1]]%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
+        } else { # output layer depend only of the hidden layer of bellow
+          layers[[i]] <- sigmoid(layers[[i-1]] %*% time_synapse[[i]])
         }
         # storing
         store[[i]][j,position,] = layers[[i]]

R/trainr.R

@@ -1,14 +1,15 @@
 #' @name trainr
 #' @export
 #' @importFrom stats runif
-#' @importFrom sigmoid logistic sigmoid_output_to_derivative
+#' @importFrom sigmoid sigmoid sigmoid_output_to_derivative
 #' @title Recurrent Neural Network
 #' @description Trains a Recurrent Neural Network.
 #' @param Y array of output values, dim 1: samples (must be equal to dim 1 of X), dim 2: time (must be equal to dim 2 of X), dim 3: variables (could be 1 or more, if a matrix, will be coerce to array)
 #' @param X array of input values, dim 1: samples, dim 2: time, dim 3: variables (could be 1 or more, if a matrix, will be coerce to array)
 #' @param learningrate learning rate to be applied for weight iteration
 #' @param numepochs number of iteration, i.e. number of time the whole dataset is presented to the network
 #' @param hidden_dim dimension(s) of hidden layer(s)
+#' @param sigmoid method to be passed on the to the sigmoid function
 #' @param start_from_end should the sequence start from the end
 #' @param learningrate_decay coefficient to apply to the learning rate at each weight iteration
 #' @param momentum coefficient of the last weight iteration to keep for faster learning
@@ -37,7 +38,10 @@
 #'                 start_from_end = TRUE )
 #'     
 
-trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hidden_dim = c(10), numepochs = 1, start_from_end=FALSE) {
+trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hidden_dim = c(10), numepochs = 1, sigmoid = c('logistic', 'Gompertz', 'tanh'), start_from_end=FALSE) {
+
+  #  find sigmoid
+  sigmoid <- match.arg(sigmoid)
 
   # check the consistency
   if(dim(X)[2] != dim(Y)[2]){
@@ -65,10 +69,10 @@ trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hid
   time_synapse      = list() # synapse in a time step, link input to hidden, hidden to hidden, hidden to output
   recurrent_synapse = list() # synapse between time step, link hidden to hidden
   for(i in seq(length(synapse_dim) - 1)){
-    time_synapse[[i]] <- matrix(stats::runif(n = synapse_dim[i]*synapse_dim[i+1], min=-1, max=1), nrow=synapse_dim[i])
+    time_synapse[[i]] <- matrix(runif(n = synapse_dim[i]*synapse_dim[i+1], min=-1, max=1), nrow=synapse_dim[i])
   }
   for(i in seq(length(hidden_dim))){
-    recurrent_synapse[[i]] <- matrix(stats::runif(n = hidden_dim[i]*hidden_dim[i], min=-1, max=1), nrow=hidden_dim[i])
+    recurrent_synapse[[i]] <- matrix(runif(n = hidden_dim[i]*hidden_dim[i], min=-1, max=1), nrow=hidden_dim[i])
   }
 
   # initialize the update, stored in two lists
@@ -124,15 +128,14 @@ trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hid
 
         layers <- list()
         for(i in seq(length(synapse_dim) - 1)){
-          if(i == 1){ # first hidden layer, need to take x as input
-            layers[[i]] <- sigmoid::logistic((x%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
-          }
-          if(i != length(synapse_dim) - 1 & i != 1){ #hidden layers not linked to input layer, depends of the last time step
-            layers[[i]] <- sigmoid::logistic((layers[[i-1]]%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]))
-          }
-          if(i == length(synapse_dim) - 1){ # output layer depend only of the hidden layer of bellow
-            layers[[i]] <- sigmoid::logistic(layers[[i-1]] %*% time_synapse[[i]])
+          if (i == 1) { # first hidden layer, need to take x as input
+            layers[[i]] <- sigmoid((x%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]), method=sigmoid)
+          } else if (i != length(synapse_dim) - 1 & i != 1){ #hidden layers not linked to input layer, depends of the last time step
+            layers[[i]] <- sigmoid((layers[[i-1]]%*%time_synapse[[i]]) + (layers_values[[i]][dim(layers_values[[i]])[1],] %*% recurrent_synapse[[i]]), method=sigmoid)
+          } else { # output layer depend only of the hidden layer of bellow
+            layers[[i]] <- sigmoid(layers[[i-1]] %*% time_synapse[[i]], method=sigmoid)
           }
+
           # storing
           store[[i]][j,position,] = layers[[i]]
           if(i != length(synapse_dim) - 1){ # for all hidden layers, we need the previous state, looks like we duplicate the values here, it is also in the store list
@@ -143,7 +146,7 @@ trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hid
 
         # did we miss?... if so, by how much?
         layer_2_error = y - layers[[length(synapse_dim) - 1]]
-        layer_2_deltas = rbind(layer_2_deltas, layer_2_error * sigmoid::sigmoid_output_to_derivative(layers[[length(synapse_dim) - 1]]))
+        layer_2_deltas = rbind(layer_2_deltas, layer_2_error * sigmoid_output_to_derivative(layers[[length(synapse_dim) - 1]]))
         overallError = overallError + sum(abs(layer_2_error))
 
       }
@@ -170,7 +173,7 @@ trainr <- function(Y, X, learningrate, learningrate_decay = 1, momentum = 0, hid
             prev_layer_current = layers_values[[i-1]][dim(layers_values[[i-1]])[1]-(position+1),]
             # error at hidden layers
             layer_current_delta = (future_layer_delta[[i-1]] %*% t(recurrent_synapse[[i-1]]) + layer_up_delta %*% t(time_synapse[[i]])) *
-              sigmoid::sigmoid_output_to_derivative(layer_current)
+              sigmoid_output_to_derivative(layer_current)
             time_synapse_update[[i]] = time_synapse_update[[i]] + matrix(layer_current) %*% layer_up_delta
             recurrent_synapse_update[[i-1]] = recurrent_synapse_update[[i-1]] + matrix(prev_layer_current) %*% layer_current_delta
             layer_up_delta = layer_current_delta

tests/testthat/test_rnn.R

@@ -21,8 +21,8 @@ Y <- array( Y, dim=c(dim(Y),1) )
 model <- trainr(Y=Y,
                 X=X,
                 learningrate   =  0.1,
-                hidden_dim     = 10,
-                numepochs      = 10,
+                hidden_dim     =  c(10,10),
+                numepochs      =  2,
                 start_from_end = TRUE )
 
 # create test inputs
@@ -33,8 +33,7 @@ A2 = int2bin( sample(0:127, 7000, replace=TRUE) )
 A <- array( c(A1,A2), dim=c(dim(A1),2) )
 
 # predict
-B  <- predictr(model,
-               A     )
+B  <- predictr(model, A)
 
 # inspect the differences              
-expect_equal(sum(bin2int(B)), 886614)
+expect_equal(sum(bin2int(B)), 886211)