title: “Multi-Layer Perceptron in R”

author: “Harsh Sharma”

output: html_document

Introduction

This document demonstrates the creation and training of a multi-layer perceptron (MLP) in R using basic functions.

Load Required Libraries

library(DiagrammeR)   # For visualizing the neural network structure
library(datasets)      # Contains the iris dataset

Define Activation Functions and Weight Initialization

# Sigmoid function
sigmoid <- function(x) {
  return(1 / (1 + exp(-x)))
}

# Derivative of sigmoid for backpropagation
sigmoid_derivative <- function(x) {
  return(x * (1 - x))
}

# Initialize weights randomly for each layer
initialize_weights <- function(n_input, n_hidden1, n_hidden2, n_output) {
  list(
    w1 = matrix(runif(n_input * n_hidden1, min = -1, max = 1), nrow = n_input, ncol = n_hidden1),
    w2 = matrix(runif(n_hidden1 * n_hidden2, min = -1, max = 1), nrow = n_hidden1, ncol = n_hidden2),
    w3 = matrix(runif(n_hidden2 * n_output, min = -1, max = 1), nrow = n_hidden2, ncol = n_output)
  )
}

Define Forward and Backward Propagation Functions

# Forward propagation through the network
forward_propagation <- function(input, weights) {
  z1 <- sigmoid(input %*% weights$w1)
  z2 <- sigmoid(z1 %*% weights$w2)
  output <- sigmoid(z2 %*% weights$w3)
  list(z1 = z1, z2 = z2, output = output)
}

# Backward propagation for weight adjustment
backward_propagation <- function(input, output, actual, z1, z2, weights, learning_rate) {
  error_output <- actual - output
  delta_output <- error_output * sigmoid_derivative(output)
  
  error_hidden2 <- delta_output %*% t(weights$w3)
  delta_hidden2 <- error_hidden2 * sigmoid_derivative(z2)
  
  error_hidden1 <- delta_hidden2 %*% t(weights$w2)
  delta_hidden1 <- error_hidden1 * sigmoid_derivative(z1)
  
  weights$w3 <- weights$w3 + learning_rate * t(z2) %*% delta_output
  weights$w2 <- weights$w2 + learning_rate * t(z1) %*% delta_hidden2
  weights$w1 <- weights$w1 + learning_rate * t(input) %*% delta_hidden1
  
  return(weights)
}

Training Function

# Train function with specified epochs and learning rate
train_perceptron <- function(input, actual, weights, epochs, learning_rate) {
  for (i in 1:epochs) {
    forward <- forward_propagation(input, weights)
    weights <- backward_propagation(input, forward$output, actual, forward$z1, forward$z2, weights, learning_rate)
    
    # Display loss every 100 epochs
    if (i %% 100 == 0) {
      cat("Epoch:", i, "Loss:", sum((actual - forward$output)^2) / length(actual), "\n")
    }
  }
  return(weights)
}

Data Preprocessing on the Iris Dataset

# Load and preprocess the Iris dataset
data <- iris
data <- data[data$Species != "virginica", ]  # Binary classification (versicolor or setosa)
data$Species <- as.numeric(data$Species == "versicolor")  # Convert species to binary (0 and 1)
input <- as.matrix(data[, 1:4])  # Use sepal and petal measurements as input
actual <- as.matrix(data$Species)  # Target labels

# Scale input data
input <- scale(input)

Initialize Weights and Train the Model

# Initialize weights
weights <- initialize_weights(n_input = 4, n_hidden1 = 5, n_hidden2 = 3, n_output = 1)

# Train the perceptron
trained_weights <- train_perceptron(input, actual, weights, epochs = 1000, learning_rate = 0.01)

## Epoch: 100 Loss: 0.05507123 
## Epoch: 200 Loss: 0.01358418 
## Epoch: 300 Loss: 0.006778422 
## Epoch: 400 Loss: 0.004359182 
## Epoch: 500 Loss: 0.003165932 
## Epoch: 600 Loss: 0.002466684 
## Epoch: 700 Loss: 0.002011264 
## Epoch: 800 Loss: 0.001692755 
## Epoch: 900 Loss: 0.001458304 
## Epoch: 1000 Loss: 0.001278952

Visualize Perceptron Structure

# Visualize the perceptron structure
visualize_perceptron <- function() {
  grViz("
  digraph neural_network {
    node [shape = circle, style = filled, color = lightblue, label = 'Input\nX1'] x1;
    node [shape = circle, style = filled, color = lightblue, label = 'Input\nX2'] x2;
    
    # Hidden layers
    node [shape = circle, style = filled, color = green, label = 'Hidden\nLayer 1'] h1;
    node [shape = circle, style = filled, color = green, label = 'Hidden\nLayer 2'] h2;
    
    # Output layer
    node [shape = circle, style = filled, color = orange, label = 'Output\nY'] y;

    # Connections
    x1 -> h1; x2 -> h1;
    h1 -> h2; 
    h2 -> y;
  }
  ")
}
visualize_perceptron()

Testing the Model

# Test with sample input
test_input <- matrix(input[1, ], nrow = 1)  # Use the first row as test input
output <- forward_propagation(test_input, trained_weights)$output
print(output)

##            [,1]
## [1,] 0.03326782