Father Child Relationship Prediction Using DTR Model
Importing Library
library(ggplot2)Importing data set
df<-read.csv("C:/Users/ONKAR/OneDrive/Desktop/SEM-4/Projects/Data Science/dataset.csv")Projecting 5 head rows of data set
head(df,5)Projecting bottom 5 rows of data set
tail(df,5)Dimensions of data set
dim(df)## [1] 501 12List of all columns names in data set
colnames(df)## [1] "gender" "age"
## [3] "native_place" "quality_time"
## [5] "qualification_of_father" "sharing_emotions"
## [7] "deep_conversations" "role_father"
## [9] "advice_from_father" "improve_relationship"
## [11] "relationship_in_future" "relationship_with_father"Structure of data set
str(df)## 'data.frame': 501 obs. of 12 variables:
## $ gender : chr "Male" "Male" "Male" "Male" ...
## $ age : int 20 25 19 19 19 20 20 19 19 21 ...
## $ native_place : chr "City" "Village" "City" "City" ...
## $ quality_time : chr "Regularly" "Sometimes" "Sometimes" "Rarely" ...
## $ qualification_of_father : chr "Graduate" "Graduate" "Graduate" "Graduate" ...
## $ sharing_emotions : chr "Yes" "Sometimes" "Sometimes" "No" ...
## $ deep_conversations : chr "Regularly" "Sometimes" "Rarely" "Rarely" ...
## $ role_father : chr "Consultant (offering advice)" "Consultant (offering advice)" "Consultant (offering advice)" "Not involved" ...
## $ advice_from_father : chr "Regularly" "Regularly" "Required time only" "Never" ...
## $ improve_relationship : chr "Yes" "Yes" "Yes" "Yes" ...
## $ relationship_in_future : chr "More open communication and honesty" "More open communication and honesty" "More open communication and honesty" "More open communication and honesty" ...
## $ relationship_with_father: chr "Very close" "Neutral" "Close" "Neutral" ...Summary of data set
summary(df)## gender age native_place quality_time
## Length:501 Min. :12.00 Length:501 Length:501
## Class :character 1st Qu.:18.00 Class :character Class :character
## Mode :character Median :19.00 Mode :character Mode :character
## Mean :20.78
## 3rd Qu.:21.00
## Max. :77.00
## qualification_of_father sharing_emotions deep_conversations
## Length:501 Length:501 Length:501
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## role_father advice_from_father improve_relationship
## Length:501 Length:501 Length:501
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## relationship_in_future relationship_with_father
## Length:501 Length:501
## Class :character Class :character
## Mode :character Mode :character
##
##
## Describing Gender column
Frequency table of gender
freq_table<-table(df$gender)
freq_table##
## Female Male
## 223 278Bar plot of Frequency table
x_labels<-c('Female','Male')
barplot(freq_table,
main = "Gender Proportion Graph",
xlab = "Gender",
ylab = "Frequency",
col = "skyblue",
border = "black",
)
Describing age column
Min Age
min(df$age)## [1] 12Max Age
max(df$age)## [1] 77Mean of Age
mean(df$age)## [1] 20.77844Median Age
median(df$age)## [1] 19Representing Age through histogram
hist(df$age,
main = "Age Distribution",
xlab = "Age",
ylab = "Frequency",
col = "skyblue")
Describing Native Place column
Frequency table of Native Place column
freq_table_native_place<-table(df$native_place)
freq_table_native_place##
## City Village
## 357 144Presenting Native Place using histogram
barplot(freq_table_native_place,
main = "Native Place Distribution",
xlab = "Native Places",
ylab = "Frequency",
col = "skyblue")
Describing relationship_with_father column
Frequency table of relationship_with_father column
freq_table_relationship_with_father <- table(df$relationship_with_father)
freq_table_relationship_with_father##
## Close Neutral Very close
## 210 121 170Representing relationship_with_father columns through graph
barplot(freq_table_relationship_with_father,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("lightgreen","skyblue","darkgreen")
)
Describing quality_time
Frequency table of quality_time column
freq_table_quality_time <- table(df$quality_time)
freq_table_quality_time##
## Rarely Regularly Sometimes
## 76 191 234Representing quality_time columns through graph
barplot(freq_table_quality_time,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("skyblue","darkgreen","lightgreen")
)
Describing qualification_of_father
Frequency table of qualification_of_father column
freq_table_qualification_of_father <- table(df$qualification_of_father)
freq_table_qualification_of_father##
## Graduate Not graduate
## 359 142Representing qualification_of_father columns through graph
barplot(freq_table_qualification_of_father,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
)
Describing sharing_emotions column
Frequency table of sharing_emotions column
freq_table_sharing_emotions <- table(df$sharing_emotions)
freq_table_sharing_emotions##
## No Sometimes Yes
## 91 206 204Representing sharing_emotions columns through graph
barplot(freq_table_sharing_emotions,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("red","lightgreen","darkgreen")
)
Describing deep_conversations column
Frequency table of deep_conversations column
freq_table_deep_conversations <- table(df$deep_conversations)
freq_table_deep_conversations##
## Rarely Regularly Sometimes Very frequently
## 136 107 237 21Representing deep_conversations columns through graph
barplot(freq_table_deep_conversations,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("red","darkgreen","lightgreen","green")
)
Describing advice_from_father column
Frequency table of advice_from_father column
freq_table_advice_from_father <- table(df$advice_from_father)
freq_table_advice_from_father##
## Never Rarely Regularly Required time only
## 23 62 211 205Representing advice_from_father columns through graph
barplot(freq_table_advice_from_father,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("red","skyblue","darkgreen","lightgreen")
)
Describing improve_relationship column
Frequency table of improve_relationship column
freq_table_improve_relationship <- table(df$improve_relationship)
freq_table_improve_relationship##
## No Unsure Yes
## 18 48 435Representing improve_relationship columns through graph
barplot(freq_table_improve_relationship,
main = "Relationship With Father",
xlab = "Relationship type",
ylab = "Frequency",
col = c("red","lightgreen","darkgreen")
)
library(ggplot2)
library(lattice)
library(caret)## Warning: package 'caret' was built under R version 4.3.3Splitting data into train and test set
set.seed(123)
trainIndex <- createDataPartition(df$relationship_in_future,p = 0.8,list = FALSE,times = 1)
train_data<-df[ trainIndex,]
test_labels<-df[-trainIndex,12]
test_data<-df[-trainIndex,-12]Applying Algorithm
dtr_model<-train(relationship_with_father~.,
data = train_data,
method="rpart")predictions<-predict(dtr_model,newdata = test_data)
predictions<-as.factor(predictions)test_labels<-as.factor(test_labels)
conf_matrix<-confusionMatrix(predictions,test_labels)conf_matrix## Confusion Matrix and Statistics
##
## Reference
## Prediction Close Neutral Very close
## Close 26 10 9
## Neutral 7 10 1
## Very close 9 2 24
##
## Overall Statistics
##
## Accuracy : 0.6122
## 95% CI : (0.5085, 0.709)
## No Information Rate : 0.4286
## P-Value [Acc > NIR] : 0.0001919
##
## Kappa : 0.3923
##
## Mcnemar's Test P-Value : 0.8344077
##
## Statistics by Class:
##
## Class: Close Class: Neutral Class: Very close
## Sensitivity 0.6190 0.4545 0.7059
## Specificity 0.6607 0.8947 0.8281
## Pos Pred Value 0.5778 0.5556 0.6857
## Neg Pred Value 0.6981 0.8500 0.8413
## Prevalence 0.4286 0.2245 0.3469
## Detection Rate 0.2653 0.1020 0.2449
## Detection Prevalence 0.4592 0.1837 0.3571
## Balanced Accuracy 0.6399 0.6746 0.7670conf_matrix$overall["Accuracy"]*100## Accuracy
## 61.22449data_vector <- c(gender = "Male",
age = 20,
native_place = "City",
quality_time = "Regularly",
qualification_of_father = "Graduate",
sharing_emotions = "Yes",
deep_conversations = "Regularly",
role_father = "Consultant (offering advice)",
advice_from_father = "Regularly",
improve_relationship = "Yes",
relationship_in_future = "More open communication and honesty"
)
test_data_sample = data.frame(t(data_vector))
test_data_sample$age<-as.numeric(test_data_sample$age)sample_predictions<-predict(dtr_model,newdata = test_data_sample)
sample_predictions## [1] Very close
## Levels: Close Neutral Very close