Hands-on: Actual Classification problem:
1. Before we begin, let us create training and test samples:
What if the training data has a bias, the entire model can have the bias carry forwarded. To avoid this it is really important for us that we identify the bias and figure out the training data accordingly.
Here the bias is very less (delta of <30 observations). However, its good to split data on the basis of target variables equally distributed.
# Get subset of dataframe with all the 1's
heartDfTransOnes<-subset(heartDfTrans,heartDfTrans$target==1)
dim(heartDfTransOnes)
#> [1] 116 14
# Get subset of dataframe with all the 0's
heartDfTransZeros<-subset(heartDfTrans,heartDfTrans$target==0)
dim(heartDfTransZeros)
#> [1] 33 14
#Seed is a simple atomic integer vector, the first element of which specifies the kind of normal generator
set.seed(100)
heartDfTransOnesTrainingSet<-sample(1:nrow(heartDfTransOnes),0.7*nrow(heartDfTransOnes))
heartDfTransZerosTrainingSet<-sample(1:nrow(heartDfTransZeros),0.7*nrow(heartDfTransZeros))
trainingDataOnes<-heartDfTransOnes[heartDfTransOnesTrainingSet,]
dim(trainingDataOnes)
#> [1] 81 14
trainingDataZeros<-heartDfTransZeros[heartDfTransZerosTrainingSet,]
dim(trainingDataZeros)
#> [1] 23 14
trainingData<-rbind(trainingDataOnes,trainingDataZeros)
dim(trainingData)
#> [1] 104 14
testDataOnes<-heartDfTransOnes[-heartDfTransOnesTrainingSet,]
dim(testDataOnes)
#> [1] 35 14
testDataZeros<-heartDfTransZeros[-heartDfTransZerosTrainingSet,]
dim(testDataZeros)
#> [1] 10 14
testData<-rbind(testDataOnes,testDataZeros)
dim(testData)
#> [1] 45 14
#We now have exactly divided the training data and test data into 70% & 30% respectively2. Logistic Regression:
One more important point is regarding the error has more levels. To avoid this make sure of three things: - The levels in R dataframe test & training dataset are exactly the same. - Make sure that factor data has no missing values.
We have used glm() function with binomial option to implement a logistic regression function. Post then once the model characteristics are captured in the predictor variable then we use the predict function to derive the log(odds) of the Y variable, in our case the variable name is target. But this will be a logarithmic variable however we wish to have values as between 0 and 1. So, to convert it into prediction probability scores that is bound between 0 and 1, we use the plogis()
library(InformationValue)
logisticRegressionModel<-glm(target ~ age+
sex+
chest_pain_type+
resting_blood_pressure+
cholesterol+
fasting_blood_sugar+
rest_ecg+
max_heart_rate_achieved+
exercise_induced_angina+
st_depression+
st_slope+
num_major_vessels+
thalassemia, data=trainingData, family=binomial(link="logit"))
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
sapply(trainingData, levels)
#> $age
#> NULL
#>
#> $sex
#> [1] "F" "M"
#>
#> $chest_pain_type
#> [1] "Atypical Angina" "Non-Anginal Pain" "Typical Angina"
#>
#> $resting_blood_pressure
#> NULL
#>
#> $cholesterol
#> NULL
#>
#> $fasting_blood_sugar
#> [1] "Greater than 120mg/ml" "Lower than 120mg/ml"
#>
#> $rest_ecg
#> [1] "Left Ventricular Hypertrophy" "Normal"
#> [3] "ST-T wave abnormality"
#>
#> $max_heart_rate_achieved
#> NULL
#>
#> $exercise_induced_angina
#> [1] "No" "Yes"
#>
#> $st_depression
#> NULL
#>
#> $st_slope
#> [1] "Flat" "Upsloping"
#>
#> $num_major_vessels
#> [1] "0" "1" "2" "3" "4"
#>
#> $thalassemia
#> [1] "Fixed Defect" "Normal" "Reversable Defect"
#>
#> $target
#> [1] "0" "1"
sapply(testData, levels)
#> $age
#> NULL
#>
#> $sex
#> [1] "F" "M"
#>
#> $chest_pain_type
#> [1] "Atypical Angina" "Non-Anginal Pain" "Typical Angina"
#>
#> $resting_blood_pressure
#> NULL
#>
#> $cholesterol
#> NULL
#>
#> $fasting_blood_sugar
#> [1] "Greater than 120mg/ml" "Lower than 120mg/ml"
#>
#> $rest_ecg
#> [1] "Left Ventricular Hypertrophy" "Normal"
#> [3] "ST-T wave abnormality"
#>
#> $max_heart_rate_achieved
#> NULL
#>
#> $exercise_induced_angina
#> [1] "No" "Yes"
#>
#> $st_depression
#> NULL
#>
#> $st_slope
#> [1] "Flat" "Upsloping"
#>
#> $num_major_vessels
#> [1] "0" "1" "2" "3" "4"
#>
#> $thalassemia
#> [1] "Fixed Defect" "Normal" "Reversable Defect"
#>
#> $target
#> [1] "0" "1"The default cutoff prediction probability score is 0.5 or the ratio of 1’s and 0’s in the training data. But sometimes, tuning the probability cutoff can improve the accuracy in both the development and validation samples. The InformationValue::optimalCutoff function provides ways to find the optimal cutoff to improve the prediction of 1’s, 0’s, both 1’s and 0’s and o reduce the misclassification error. Lets compute the optimal score that minimizes the misclassification error for the above model.
2.1 Model Diagnostics:
Sensitivity measures how often a test correctly generates a positive result for people who have the condition that’s being tested for (also known as the “true positive” rate). A test that’s highly sensitive will flag almost everyone who has the disease and not generate many false-negative results. (Example: a test with 90% sensitivity will correctly return a positive result for 90% of people who have the disease, but will return a negative result — a false-negative — for 10% of the people who have the disease and should have tested positive.)
Specificity measures a test’s ability to correctly generate a negative result for people who don’t have the condition that’s being tested for (also known as the “true negative” rate). A high-specificity test will correctly rule out almost everyone who doesn’t have the disease and won’t generate many false-positive results. (Example: a test with 90% specificity will correctly return a negative result for 90% of people who don’t have the disease, but will return a positive result — a false-positive — for 10% of the people who don’t have the disease and should have tested negative.)
A receiver operating characteristic curve, or ROC curve, is a graphical plot that illustrates the diagnostic ability of a binary classifier system as its discrimination threshold is varied. The ROC curve is created by plotting the true positive rate against the false positive rate at various threshold settings.
summary(logisticRegressionModel)
#>
#> Call:
#> glm(formula = target ~ age + sex + chest_pain_type + resting_blood_pressure +
#> cholesterol + fasting_blood_sugar + rest_ecg + max_heart_rate_achieved +
#> exercise_induced_angina + st_depression + st_slope + num_major_vessels +
#> thalassemia, family = binomial(link = "logit"), data = trainingData)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -4.0765 0.0003 0.0329 0.2864 0.9101
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) 1.933e+01 6.523e+03 0.003 0.99764
#> age 4.529e-02 8.402e-02 0.539 0.58987
#> sexM -4.799e+00 1.972e+00 -2.433 0.01496
#> chest_pain_typeNon-Anginal Pain 3.819e+00 1.820e+00 2.099 0.03585
#> chest_pain_typeTypical Angina -4.660e+00 1.765e+00 -2.639 0.00830
#> resting_blood_pressure -4.304e-02 3.573e-02 -1.205 0.22833
#> cholesterol -5.212e-03 1.087e-02 -0.479 0.63168
#> fasting_blood_sugarLower than 120mg/ml -1.320e+00 1.417e+00 -0.931 0.35167
#> rest_ecgNormal -1.443e+01 6.523e+03 -0.002 0.99823
#> rest_ecgST-T wave abnormality -1.583e+01 6.523e+03 -0.002 0.99806
#> max_heart_rate_achieved 9.684e-02 4.477e-02 2.163 0.03053
#> exercise_induced_anginaYes 1.916e+00 1.501e+00 1.277 0.20154
#> st_depression -2.684e+00 8.902e-01 -3.015 0.00257
#> st_slopeUpsloping -4.112e+00 1.670e+00 -2.462 0.01383
#> num_major_vessels1 -6.260e+00 2.112e+00 -2.963 0.00304
#> num_major_vessels2 -9.741e+00 3.222e+00 -3.023 0.00250
#> num_major_vessels3 -8.785e+00 5.097e+00 -1.724 0.08479
#> num_major_vessels4 2.228e+01 2.644e+03 0.008 0.99328
#> thalassemiaNormal 6.059e+00 3.692e+00 1.641 0.10078
#> thalassemiaReversable Defect -3.096e+00 1.457e+00 -2.125 0.03357
#>
#> (Intercept)
#> age
#> sexM *
#> chest_pain_typeNon-Anginal Pain *
#> chest_pain_typeTypical Angina **
#> resting_blood_pressure
#> cholesterol
#> fasting_blood_sugarLower than 120mg/ml
#> rest_ecgNormal
#> rest_ecgST-T wave abnormality
#> max_heart_rate_achieved *
#> exercise_induced_anginaYes
#> st_depression **
#> st_slopeUpsloping *
#> num_major_vessels1 **
#> num_major_vessels2 **
#> num_major_vessels3 .
#> num_major_vessels4
#> thalassemiaNormal
#> thalassemiaReversable Defect *
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 109.900 on 103 degrees of freedom
#> Residual deviance: 34.318 on 84 degrees of freedom
#> AIC: 74.318
#>
#> Number of Fisher Scoring iterations: 17
plotROC(testData$target, predicted)
Concordance(testData$target, predicted)
#> $Concordance
#> [1] 0.7571429
#>
#> $Discordance
#> [1] 0.2428571
#>
#> $Tied
#> [1] 2.775558e-17
#>
#> $Pairs
#> [1] 350
sensitivity(testData$target, predicted, threshold = optCutOff)
#> [1] 0.9428571
specificity(testData$target, predicted, threshold = optCutOff)
#> [1] 0.3
confusionMatrix(testData$target, predicted, threshold = optCutOff)
#> 0 1
#> 0 3 2
#> 1 7 33
head(testData)
#> age sex chest_pain_type resting_blood_pressure cholesterol
#> 3 41 F Typical Angina 130 204
#> 10 57 M Atypical Angina 150 168
#> 13 49 M Typical Angina 130 266
#> 15 58 F Non-Anginal Pain 150 283
#> 16 50 F Atypical Angina 120 219
#> 20 69 F Non-Anginal Pain 140 239
#> fasting_blood_sugar rest_ecg max_heart_rate_achieved
#> 3 Lower than 120mg/ml Normal 172
#> 10 Lower than 120mg/ml ST-T wave abnormality 174
#> 13 Lower than 120mg/ml ST-T wave abnormality 171
#> 15 Greater than 120mg/ml Normal 162
#> 16 Lower than 120mg/ml ST-T wave abnormality 158
#> 20 Lower than 120mg/ml ST-T wave abnormality 151
#> exercise_induced_angina st_depression st_slope num_major_vessels
#> 3 No 1.4 Flat 0
#> 10 No 1.6 Flat 0
#> 13 No 0.6 Flat 0
#> 15 No 1.0 Flat 0
#> 16 No 1.6 Upsloping 0
#> 20 No 1.8 Flat 2
#> thalassemia target
#> 3 Fixed Defect 1
#> 10 Fixed Defect 1
#> 13 Fixed Defect 1
#> 15 Fixed Defect 1
#> 16 Fixed Defect 1
#> 20 Fixed Defect 1
colnames(testData)
#> [1] "age" "sex"
#> [3] "chest_pain_type" "resting_blood_pressure"
#> [5] "cholesterol" "fasting_blood_sugar"
#> [7] "rest_ecg" "max_heart_rate_achieved"
#> [9] "exercise_induced_angina" "st_depression"
#> [11] "st_slope" "num_major_vessels"
#> [13] "thalassemia" "target"2.3 How do we use the model ?
predicted_case <- plogis(predict(logisticRegressionModel, data.frame(
age=as.integer(30),
sex=as.factor('F'),
chest_pain_type=as.factor('Atypical Angina'),
resting_blood_pressure=as.integer(100),
cholesterol=as.integer(30),
fasting_blood_sugar=as.factor('Lower than 120mg/ml'),
rest_ecg=as.factor('Normal'),
max_heart_rate_achieved=as.integer(120),
exercise_induced_angina=as.factor('No'),
st_depression=as.numeric(1.2),
st_slope=as.factor('Flat'),
num_major_vessels=as.factor('0'),
thalassemia=as.factor('Fixed Defect')
)))
sprintf("The chances of patient being diagnosed with a heart disease is %0.2f %%", predicted_case*100)
#> [1] "The chances of patient being diagnosed with a heart disease is 99.99 %"… To be continued