AIML_DNN_Human_MF_Data

# ============================================================
# TWO-LAYER NEURAL NETWORK (WITH MATHEMATICAL ANNOTATION)
# ============================================================

# -----------------------------
# 1. Load data
# -----------------------------
data <- read.csv("SM_data.csv", stringsAsFactors = FALSE)

# X ∈ R^{n × 4}
X <- as.matrix(data[, c("H", "AL", "FL", "PL")])

# y ∈ {0,1}
y <- ifelse(data$MF == "M", 1, 0)
y <- matrix(y, ncol = 1)

# -----------------------------
# 2. Standardization
# -----------------------------
# X_scaled = (X - μ) / σ
X <- scale(X)

# -----------------------------
# 3. Train-test split
# -----------------------------
set.seed(123)
n <- nrow(X)
idx <- sample(1:n, size = round(0.8*n))

X_train <- X[idx, ]
y_train <- y[idx, ]

X_test  <- X[-idx, ]
y_test  <- y[-idx, ]

# -----------------------------
# 4. Define sigmoid function
# -----------------------------
# σ(z) = 1 / (1 + e^{-z})
sigmoid <- function(z) {
  1 / (1 + exp(-z))
}

# -----------------------------
# 5. Initialize parameters
# -----------------------------
# Dimensions:
# W1 ∈ R^{m × 4}, b1 ∈ R^{m × 1}
# W2 ∈ R^{1 × m}, b2 ∈ R

input_dim <- 4
hidden_dim <- 5

set.seed(123)

W1 <- matrix(rnorm(hidden_dim * input_dim, 0, 0.1),
             nrow = hidden_dim)

b1 <- matrix(0, nrow = hidden_dim)

W2 <- matrix(rnorm(hidden_dim, 0, 0.1),
             nrow = 1)

b2 <- 0

# -----------------------------
# 6. Forward propagation
# -----------------------------
forward <- function(X, W1, b1, W2, b2) {

  # Z1 = X W1^T + b1
  Z1 <- X %*% t(W1) + matrix(b1, nrow = nrow(X), ncol = hidden_dim, byrow = TRUE)

  # A1 = σ(Z1)
  A1 <- sigmoid(Z1)

  # Z2 = A1 W2^T + b2
  Z2 <- A1 %*% t(W2) + b2

  # A2 = σ(Z2)
  A2 <- sigmoid(Z2)

  list(Z1 = Z1, A1 = A1, Z2 = Z2, A2 = A2)
}

# -----------------------------
# 7. Loss function
# -----------------------------
# L = -[y log(ŷ) + (1-y) log(1-ŷ)]
loss_fn <- function(y, y_hat) {
  eps <- 1e-8
  y_hat <- pmin(pmax(y_hat, eps), 1 - eps)
  -mean(y * log(y_hat) + (1 - y) * log(1 - y_hat))
}

# -----------------------------
# 8. Training (Backpropagation)
# -----------------------------
lr <- 0.05
epochs <- 5000

loss_history <- numeric(epochs)

for (e in 1:epochs) {

  # ===== Forward =====
  fp <- forward(X_train, W1, b1, W2, b2)
  Z1 <- fp$Z1
  A1 <- fp$A1
  Z2 <- fp$Z2
  A2 <- fp$A2

  # Compute loss
  loss <- loss_fn(y_train, A2)
  loss_history[e] <- loss

  m <- nrow(X_train)

  # ===== Backpropagation =====

  # (1) Output error:
  # δ^(2) = A2 - y
  dZ2 <- A2 - y_train

  # (2) Gradients:
  # ∂L/∂W2 = (1/m) * dZ2^T A1
  dW2 <- t(dZ2) %*% A1 / m

  # ∂L/∂b2 = mean(dZ2)
  db2 <- mean(dZ2)

  # (3) Hidden error:
  # δ^(1) = (dZ2 W2) ⊙ A1 ⊙ (1-A1)
  dA1 <- dZ2 %*% W2
  dZ1 <- dA1 * A1 * (1 - A1)

  # (4) Gradients:
  # ∂L/∂W1 = (1/m) * dZ1^T X
  dW1 <- t(dZ1) %*% X_train / m

  # ∂L/∂b1 = mean(dZ1)
  db1 <- colMeans(dZ1)

  # ===== Parameter updates =====

  # W2 ← W2 - η ∂L/∂W2
  W2 <- W2 - lr * dW2

  # b2 ← b2 - η ∂L/∂b2
  b2 <- b2 - lr * db2

  # W1 ← W1 - η ∂L/∂W1
  W1 <- W1 - lr * dW1

  # b1 ← b1 - η ∂L/∂b1
  b1 <- matrix(b1 - lr * db1, nrow = hidden_dim)

  if (e %% 500 == 0) {
    cat("Epoch:", e, " Loss:", round(loss, 5), "\n")
  }
}

Epoch: 500  Loss: 0.6457 
Epoch: 1000  Loss: 0.47905 
Epoch: 1500  Loss: 0.39651 
Epoch: 2000  Loss: 0.36086 
Epoch: 2500  Loss: 0.34907 
Epoch: 3000  Loss: 0.34307 
Epoch: 3500  Loss: 0.33873 
Epoch: 4000  Loss: 0.33455 
Epoch: 4500  Loss: 0.32981 
Epoch: 5000  Loss: 0.32445 

# -----------------------------
# 9. Prediction
# -----------------------------
predict_nn <- function(X) {
  fp <- forward(X, W1, b1, W2, b2)
  probs <- fp$A2
  class <- ifelse(probs > 0.5, 1, 0)
  list(prob = probs, class = class)
}

# -----------------------------
# 10. Evaluation
# -----------------------------
train_pred <- predict_nn(X_train)
test_pred  <- predict_nn(X_test)

train_acc <- mean(train_pred$class == y_train)
test_acc  <- mean(test_pred$class == y_test)

cat("\nTraining Accuracy:", train_acc, "\n")

Training Accuracy: 0.8813559 

cat("Test Accuracy:", test_acc, "\n")

Test Accuracy: 1 

# Confusion matrix
table(Predicted = test_pred$class, Actual = y_test)

         Actual
Predicted  0  1
        0  2  0
        1  0 13

# -----------------------------
# 11. Plot loss
# -----------------------------
plot(loss_history, type = "l", lwd = 2,
     main = "Training Loss",
     xlab = "Epoch", ylab = "Loss")