This document presents an analysis of the Haberman dataset using a neural network model to predict the survival status of patients. The dataset contains information about patients who underwent surgery for breast cancer.
library(neuralnet)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:neuralnet':
##
## compute
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
library(caret)
## Loading required package: lattice
##Load Dataset
# Load the Haberman dataset
survival_df <- read.table("C:\\Users\\Harsh sharma\\Downloads\\haberman_data.txt", sep = ',', header = FALSE)
names(survival_df) <- c("Age", "Year", "Num_Axillary", "Survival_Status")
# Convert Survival_Status to a factor
survival_df$Survival_Status <- factor(survival_df$Survival_Status)
##Data Exploration
# Display the structure and summary of the data
str(survival_df)
## 'data.frame': 306 obs. of 4 variables:
## $ Age : int 30 30 30 31 31 33 33 34 34 34 ...
## $ Year : int 64 62 65 59 65 58 60 59 66 58 ...
## $ Num_Axillary : int 1 3 0 2 4 10 0 0 9 30 ...
## $ Survival_Status: Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 2 2 1 ...
summary(survival_df)
## Age Year Num_Axillary Survival_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: 81
## Median :52.00 Median :63.00 Median : 1.000
## Mean :52.46 Mean :62.85 Mean : 4.026
## 3rd Qu.:60.75 3rd Qu.:65.75 3rd Qu.: 4.000
## Max. :83.00 Max. :69.00 Max. :52.000
##Data Preprocessing
Split the Data
# Split the data into training and test sets
set.seed(33)
index <- sample(1:nrow(survival_df), round(0.9 * nrow(survival_df)))
train_data <- survival_df[index, ]
test_data <- survival_df[-index, ]
Scale the Input Features
# Scale the input features
train_data_scaled <- train_data
train_data_scaled[1:3] <- scale(train_data[1:3]) # Scale Age, Year, and Num_Axillary
test_data_scaled <- test_data
test_data_scaled[1:3] <- scale(test_data[1:3]) # Scale Age, Year, and Num_Axillary
Neural Network Model
# Define and train the neural network model with increased stepmax
nn_model <- neuralnet(Survival_Status ~ Age + Year + Num_Axillary, data = train_data_scaled,
hidden = c(5), linear.output = FALSE, stepmax = 1e6)
# Visualize the neural network
plot(nn_model)
##Predictions
# Make predictions on the test set
predictions <- predict(nn_model, test_data_scaled[,-4])
predicted_classes <- ifelse(predictions[,1] > predictions[,2], "1", "2")
##Confusion Matrix
# Create a confusion matrix
conf_matrix <- confusionMatrix(factor(predicted_classes), factor(test_data$Survival_Status))
# Display the confusion matrix
print(conf_matrix)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 2
## 1 18 6
## 2 3 4
##
## Accuracy : 0.7097
## 95% CI : (0.5196, 0.8578)
## No Information Rate : 0.6774
## P-Value [Acc > NIR] : 0.4328
##
## Kappa : 0.2791
##
## Mcnemar's Test P-Value : 0.5050
##
## Sensitivity : 0.8571
## Specificity : 0.4000
## Pos Pred Value : 0.7500
## Neg Pred Value : 0.5714
## Prevalence : 0.6774
## Detection Rate : 0.5806
## Detection Prevalence : 0.7742
## Balanced Accuracy : 0.6286
##
## 'Positive' Class : 1
##