R/neural_network.r

In ArithmeticR/TOmisc:

#' neuralNetwork
#'
#' Bulding a simple neural network
#'
#' @name neuralNetwork
#' @examples
#' input_nodes = 2
#' hidden_nodes1 = 10
#' hidden_nodes2 = 10
#' output_nodes = 1
#' learning_rate = 0.3
#'
#' nn <- neuralNetwork$new(c(input_nodes,hidden_nodes1,hidden_nodes2, output_nodes), learning_rate)
#'
#' n = 10000
#' df <- data.frame(id=1:n)
#' df$rnorm <- rnorm(n,0,0.2)
#' df$age <- sample(x=20:80, size=n, replace = T)
#' df$weight <- sample(x=140:300, size=n, replace = T)
#' df$BI <- 5+df$age *.5 + df$weight*.5 + df$age * df$weight * .01 + df$rnorm
#' df$age_scale <- (df$age/80)-.01
#' df$weight_scale <- (df$weight/300)-.01
#' df$BI_scale <- (df$BI/max(df$BI))-.01
#'
#' for(i in 1:10){
#'   random_sample <- sample(1:nrow(df))
#'   nn$train(as.matrix(df[random_sample,c('age_scale', 'weight_scale'),drop=T]), matrix(df[random_sample,c('BI_scale'),drop=T],ncol=1))
#' }
#'
#' difference2 <- matrix(NA,n,1)
#' predicted2 <- matrix(NA,n,1)
#' for(i in 1:n){
#'   predicted2[i,1] <- nn$query(unlist(df[i,c('age_scale', 'weight_scale'),drop=T]))
#'   difference2[i,1] <- predicted2[i,1] - df[i,c('BI_scale'),drop=T]
#' }
#'
#'
#' (R2 <- 1 - (sum((df[,c('BI_scale'),drop=T]-predicted2[,1] )^2)/sum((df[,c('BI_scale'),drop=T]-mean(df[,c('BI_scale'),drop=T]))^2)))
#'
#' plot(predicted2[,1],df[,c('BI_scale'),drop=T])
NULL


#' @export
neuralNetwork <- R6::R6Class(
  "neuralNetwork",
  private = list(
    ..weights=NULL,
    ..input_sizes=NULL,
    ..learning_rate=NULL
  ),
  public = list(
    initialize = function(input_sizes, learning_rate) {
      private$..input_sizes <- input_sizes
      private$..weights <- list()
      private$..learning_rate = learning_rate
      for(item_i in 2:length(private$..input_sizes)){
        private$..weights[[item_i-1]] = matrix(rnorm(private$..input_sizes[item_i]*private$..input_sizes[item_i-1],
                                                     mean =0, sd=sqrt(private$..input_sizes[item_i-1])),
                                               nrow=private$..input_sizes[item_i], ncol=private$..input_sizes[item_i-1])
      }
    },
    train = function(inputs_list, targets_list){
      for(i in 1:nrow(inputs_list)){
        # convert inputs list to 2d array
        inputs = inputs_list[i,]
        targets = targets_list[i,]
        outputs <- list()
        outputs[[1]] <- inputs
        for(item_i in 2:length(private$..input_sizes)){
          outputs_placeholder = private$..weights[[item_i-1]] %*% outputs[[item_i-1]]
          outputs[[item_i]] = self$activation_function(outputs_placeholder)
        }
        errors = targets - outputs[[item_i]]
        for(item_i in length(private$..input_sizes):2){
          next_errors = t(private$..weights[[item_i-1]]) %*% errors
          private$..weights[[item_i-1]] = private$..weights[[item_i-1]] + private$..learning_rate * (errors * outputs[[item_i]] * (1.0 - outputs[[item_i]])) %*% t(outputs[[item_i-1]])
          errors = next_errors
        }
      }
    },
    query = function(inputs_list){
      inputs = inputs_list
      for(item_i in 2:length(private$..input_sizes)){
        inputs = private$..weights[[item_i-1]] %*% inputs
        inputs = self$activation_function(inputs)
      }
      return(inputs)
    },
    activation_function = function(x){
      return(1/(1+exp(-x)))
    },
    lr = function(value) {
      if(missing(value)) {
        private$..learning_rate
      } else {
        private$..learning_rate <- value
      }
    }
  )
)