library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(neuralnet)
## 
## Attaching package: 'neuralnet'
## The following object is masked from 'package:dplyr':
## 
##     compute
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
#Load the dataset
haberman <- read.csv("C:\\Users\\HP_VICTUS\\Music\\r\\haberman.csv", header = FALSE, 
                     col.names = c("Age", "Op_year", "Axil_nodes", "Surv_status"))

# Convert the relevant columns to numeric
haberman <- haberman %>%
  mutate(Age = as.numeric(Age),
         Op_year = as.numeric(Op_year),
         Axil_nodes = as.numeric(Axil_nodes),
         Surv_status = as.factor(Surv_status))
## Warning: There were 3 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `Age = as.numeric(Age)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 2 remaining warnings.
# Check for NA values
sum(is.na(haberman))
## [1] 3
# Remove rows with NA values
haberman <- haberman[complete.cases(haberman), ]

# Summary statistics after removing NA values
summary(haberman)
##       Age           Op_year        Axil_nodes     Surv_status 
##  Min.   :30.00   Min.   :58.00   Min.   : 0.000   1     :225  
##  1st Qu.:44.00   1st Qu.:60.00   1st Qu.: 0.000   2     : 80  
##  Median :52.00   Median :63.00   Median : 1.000   status:  0  
##  Mean   :52.36   Mean   :62.87   Mean   : 4.033               
##  3rd Qu.:60.00   3rd Qu.:66.00   3rd Qu.: 4.000               
##  Max.   :78.00   Max.   :69.00   Max.   :52.000
# Age Distributions
ggplot(haberman, aes(x = Age)) + 
  geom_histogram(binwidth = 5, fill = "green", color = "orange") + 
  labs(title = "Age Distribution", x = "Age", y = "Frequency")

#Axillary Nodes
ggplot(haberman, aes(x = Axil_nodes)) + 
  geom_histogram(binwidth = 5, fill = "black", color = "white") + 
  labs(title = "Axillary Nodes Distribution", x = "Number of Nodes", y = "Frequency")

# Distribution of Operation Year 
ggplot(haberman, aes(x = as.factor(Op_year))) + 
  geom_bar(fill = "yellow", color = "white") + 
  labs(title = "Operation Year Distribution", x = "Year of Operation", y = "Frequency")

pairs(haberman[,1:3], col = ifelse(haberman$Surv_status == 1, "black", "orange"), 
      main = "Pairwise Scatter Plots", pch = 19)

Variable Selection The dataset includes three features:

Age: A continuous variable. Year of operation: A continuous variable. Number of positive axillary nodes: A continuous variable. The target variable is:

Survival status (Surv_status): A binary variable indicating survival outcomes (1 = survived 5 years or more, 2 = died within 5 years). Data Encoding No encoding is required, as the target variable is already in binary form.

Normalization Normalize the features to a 0–1 range to enhance the neural network’s performance.

# Normalization function
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x)))
}

# Normalize the numeric columns
haberman_norm <- as.data.frame(lapply(haberman[,1:3], normalize))
haberman_norm$Surv_status <- as.numeric(haberman$Surv_status) - 1  # Convert factor to numeric (0 and 1)

# Check for NA values after normalization
sum(is.na(haberman_norm))
## [1] 0
haberman_norm <- haberman_norm[complete.cases(haberman_norm), ]

Model Selection Architecture We’ll design a basic feedforward neural network with a single hidden layer.

Loss Function Binary cross-entropy will be used as the loss function, given the binary nature of this classification task.

Hyperparameters Number of hidden neurons: Test with 3–5 neurons. Learning rate: 0.01 Epochs: 100 Activation function: Sigmoid for the hidden layer, Softmax for the output layer.

# Load the neural network library
library(neuralnet)

# Split the data
set.seed(123)
index <- sample(1:nrow(haberman_norm), round(0.80 * nrow(haberman_norm)))
trainset <- haberman_norm[index,]
testset <- haberman_norm[-index,]

# Train the neural network
nn <- neuralnet(Surv_status ~ Age + Op_year + Axil_nodes, 
                data = trainset, hidden = 3, 
                linear.output = FALSE, 
                act.fct = "tanh", 
                err.fct = "ce", 
                likelihood = TRUE)
## Warning in log(x): NaNs produced
## Warning: 'err.fct' does not fit 'data' or 'act.fct'
# Save the neural network plot as PDF
plot(nn)
# Predict on test data
predicted <- compute(nn, testset[,1:3])$net.result
predicted <- ifelse(predicted > 0.5, 1, 0)

# Convert predicted to factor for comparison with Surv_status
predicted <- factor(predicted, levels = c(0, 1))

# Confusion matrix
confusion_matrix <- table(predicted, testset$Surv_status)
print(confusion_matrix)
##          
## predicted  0  1
##         0 43 18
##         1  0  0
# Calculate accuracy
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Accuracy:", round(accuracy, 2)))
## [1] "Accuracy: 0.7"
mse <- mean((as.numeric(predicted) - 1 - testset$Surv_status)^2)
print(paste("MSE:", round(mse, 2)))
## [1] "MSE: 0.3"