Haberman

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

haberman <- read.csv("C:/Users/ASUS/Desktop/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.

sum(is.na(haberman))

## [1] 3

Remove rows

haberman <- haberman[complete.cases(haberman), ]

Summary statistics

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

Distribution of Age

ggplot(haberman, aes(x = Age)) + 
  geom_histogram(binwidth = 5, fill = "pink", color = "white") + 
  labs(title = "Age Distribution", x = "Age", y = "Frequency")

# Distribution of Axillary Nodes (continuous)

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

# Distribution of Operation Year (discrete, so we use geom_bar)

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

# Survival status distribution (discrete, use geom_bar)

ggplot(haberman, aes(x = Surv_status)) + 
  geom_bar(fill = "green", color = "white") + 
  labs(title = "Survival Status Distribution", x = "Survival Status", y = "Frequency")

# Pairwise scatter plots

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

3 PREPROCESSING THE DATA

Normalization

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  

Check for NA values after normalization

sum(is.na(haberman_norm))

## [1] 0

Handle NA values by removing rows with NA

haberman_norm <- haberman_norm[complete.cases(haberman_norm), ]

4 Model Selection

Load the neural library

library(neuralnet)

Split

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

Train nn

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 nn

plot(nn)

5 Performance Evaluation

Predict test data

predicted <- compute(nn, testset[,1:3])$net.result
predicted <- ifelse(predicted > 0.5, 1, 0)

Convert factor for comparison

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"

Calculate MSE

mse <- mean((as.numeric(predicted) - 1 - testset$Surv_status)^2)
print(paste("MSE:", round(mse, 2)))

## [1] "MSE: 0.3"