Car Evaluation based on Parameters

Objective

We have a cars data set with few parameters and a decision column. We are going to use a Random Forest classifier and predict the decision.

Loading Libraries

library(dplyr)
library(randomForest)
library(caTools)
library(kableExtra)
library(skimr)
library(ggplot2)
library(corrplot)
library(ggcorrplot)
library(gridExtra)
library(superml)
library(caret)

Reading the data

car<-read.csv("./car_evaluation.csv", stringsAsFactors = T)

Viewing and Summarizing Data

Glimpse

car %>% 
  head(5) %>% 
  kable() %>% 
  kable_styling()

buying.price	maintenance.cost	number.of.doors	number.of.persons	lug_boot	safety	decision
high	vhigh	2	2	small	low	unacc
high	vhigh	2	2	small	med	unacc
high	vhigh	2	2	small	high	unacc
high	vhigh	2	2	med	low	unacc
high	vhigh	2	2	med	med	unacc

Summary

car %>% 
  summary() %>% 
  kable() %>% 
  kable_styling()

	buying.price	maintenance.cost	number.of.doors	number.of.persons	lug_boot	safety	decision
	high:864	high :432	2 :432	2 :576	big :576	high:576	acc : 384
	low :864	low :432	3 :432	4 :576	med :576	low :576	good : 69
	NA	med :432	4 :432	more:576	small:576	med :576	unacc:1210
	NA	vhigh:432	5more:432	NA	NA	NA	vgood: 65

Structure

car %>% 
  str()

'data.frame':   1728 obs. of  7 variables:
 $ buying.price     : Factor w/ 2 levels "high","low": 1 1 1 1 1 1 1 1 1 1 ...
 $ maintenance.cost : Factor w/ 4 levels "high","low","med",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ number.of.doors  : Factor w/ 4 levels "2","3","4","5more": 1 1 1 1 1 1 1 1 1 1 ...
 $ number.of.persons: Factor w/ 3 levels "2","4","more": 1 1 1 1 1 1 1 1 1 2 ...
 $ lug_boot         : Factor w/ 3 levels "big","med","small": 3 3 3 2 2 2 1 1 1 3 ...
 $ safety           : Factor w/ 3 levels "high","low","med": 2 3 1 2 3 1 2 3 1 2 ...
 $ decision         : Factor w/ 4 levels "acc","good","unacc",..: 3 3 3 3 3 3 3 3 3 3 ...

Skim

car %>% 
  skim() %>% 
  kable() %>% 
  kable_styling()

skim_type	skim_variable	n_missing	complete_rate	factor.ordered	factor.n_unique	factor.top_counts
factor	buying.price	0	1	FALSE	2	hig: 864, low: 864
factor	maintenance.cost	0	1	FALSE	4	hig: 432, low: 432, med: 432, vhi: 432
factor	number.of.doors	0	1	FALSE	4	2: 432, 3: 432, 4: 432, 5mo: 432
factor	number.of.persons	0	1	FALSE	3	2: 576, 4: 576, mor: 576
factor	lug_boot	0	1	FALSE	3	big: 576, med: 576, sma: 576
factor	safety	0	1	FALSE	3	hig: 576, low: 576, med: 576
factor	decision	0	1	FALSE	4	una: 1210, acc: 384, goo: 69, vgo: 65

Checking if there are any NA values in the dataset

  kable (colSums(is.na(car)))

	x
buying.price	0
maintenance.cost	0
number.of.doors	0
number.of.persons	0
lug_boot	0
safety	0
decision	0

Since there are no missing values and other issues with the data set. We need not manipulate it further.

Exploring the data through Plots

Bar charts

p1<-ggplot(car,aes(fill=buying.price,x=decision))+geom_bar()+ggtitle("Buying Price vs Decision")+labs(x="Buying Price")+coord_flip()
p2<- ggplot(car,aes(fill=maintenance.cost,x=decision))+geom_bar()+ggtitle("Maintenance Cost vs Decision")+labs(x="Buying Price")+coord_flip()+guides(fill=guide_legend(title="Maint. Cost"))
p3<- ggplot(car,aes(fill=number.of.doors,x=decision))+geom_bar()+ggtitle("Number of Doors vs Decision")+labs(x="Buying Price")+coord_flip()+guides(fill=guide_legend(title="Doors"))
p4<-ggplot(car,aes(fill=number.of.persons,x=decision))+geom_bar()+ggtitle("Seating Capacity vs Decision")+labs(x="Buying Price")+coord_flip()+guides(fill=guide_legend(title="Seating"))
p5<-ggplot(car,aes(fill=lug_boot,x=decision))+geom_bar(position = "dodge")+ggtitle("Bootspace vs Decision")+labs(x="Buying Price")
p6<-ggplot(car,aes(fill=safety,x=decision))+geom_bar(position = "dodge")+ggtitle("Safety vs Decision")+labs(x="Buying Price")


grid.arrange(p1,p2,p3,p4, ncol=2)

grid.arrange(p5,p6, ncol=2)

Density Plot

ggplot(car,aes(fill=maintenance.cost,x=decision))+geom_density()+facet_wrap(~decision)+ggtitle("Maintenance Cost")

ggplot(car,aes(fill=safety,x=decision))+geom_density()+facet_wrap(~decision)+ggtitle("Safety")

Correlation Plot

# First step is to convert the factors to numeric variables so that we can plot the corrplot.
# Saving car to a duplicate variable
car1<-car
label<-LabelEncoder$new()
car1$buying.price<-label$fit_transform(car1$buying.price)
car1$maintenance.cost<-label$fit_transform(car1$maintenance.cost)
car1$number.of.doors<-label$fit_transform(car1$number.of.doors)
car1$number.of.persons<-label$fit_transform(car1$number.of.persons)
car1$lug_boot<-label$fit_transform(car1$lug_boot)
car1$safety<-label$fit_transform(car1$safety)
car1$decision<-label$fit_transform(car1$decision)

cor(car1[sapply(car1, is.numeric)])->corr
corrplot(corr,method = "number")

ggcorrplot(corr)

Model Building

Splitting the data into train and test

sample.split(car,SplitRatio = .8)->tag
train<-subset(car,tag==T)
test<-subset(car,tag==F)

dim(train)

[1] 1234    7

dim(test)

[1] 494   7

Building the model

mod<-randomForest(decision~.,data=train,ntree=500)

mod %>% 
  importance() %>% 
  kable() %>% 
  kable_styling()

	MeanDecreaseGini
buying.price	47.26270
maintenance.cost	57.83491
number.of.doors	21.82956
number.of.persons	119.23026
lug_boot	32.66588
safety	146.45231

varImpPlot(mod)

Predction and Evaluation

Predict

result<-predict(mod,test,type="class")
result %>% head()

    2     6     9    13    16    20 
unacc unacc unacc unacc unacc unacc 
Levels: acc good unacc vgood

Evaluating with a confusion matrix

confusionMatrix(result,test$decision)

Confusion Matrix and Statistics

          Reference
Prediction acc good unacc vgood
     acc    91    5     7     4
     good    5   13     0     0
     unacc  14    0   339     0
     vgood   1    0     0    15

Overall Statistics
                                          
               Accuracy : 0.9271          
                 95% CI : (0.9005, 0.9484)
    No Information Rate : 0.7004          
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.8374          
                                          
 Mcnemar's Test P-Value : NA              

Statistics by Class:

                     Class: acc Class: good Class: unacc Class: vgood
Sensitivity              0.8198     0.72222       0.9798      0.78947
Specificity              0.9582     0.98950       0.9054      0.99789
Pos Pred Value           0.8505     0.72222       0.9603      0.93750
Neg Pred Value           0.9483     0.98950       0.9504      0.99163
Prevalence               0.2247     0.03644       0.7004      0.03846
Detection Rate           0.1842     0.02632       0.6862      0.03036
Detection Prevalence     0.2166     0.03644       0.7146      0.03239
Balanced Accuracy        0.8890     0.85586       0.9426      0.89368

We have a 92% Accuracy in the prediction.