Understanding Crimes in Human race¶
This is an attempt to understand the correlations of various variables using R, in a dataset recorded for the period of 35 years.
** (Assumption is made that the dataset records applies and holds true for entire world and not just for the USA)
hc<-read.csv("E:/Analytics/Datasets/hc.csv",header=T)
This dataset records the homicide crimes over the period of 1980 to 2015. It has been downloaded for the analysis from the link : https://www.kaggle.com/murderaccountability/homicide-reports
Preprocessing the dataset¶
** Here, we are not going to smooth the data for noise. That will be done prior to using data for predictive model. Noise reduction will leave us a small dataset.
as.data.frame(sapply(hc,class))
Most number of the variables in the dataset are of Categorical in nature.
Let's check the dataset for the "na"
sum(is.na(hc))
"na" fields will create a problem while plotting the data and using few of the correlation algorithms. Let's omit all "na" values in next process
hc.1<-na.omit(hc)
For this analysis we'll skip using the first five columns. There is no particular reason behind this step, though including those five columns will not help the analysis any better.
hc.1<-hc[,-c(1:5)]
dim(hc.1)
Now let's find out how the dataset looks like after the preprocessing step.
head(hc.1)
Understanding correlations and implications¶
Now, let's first understand what sex is the most victimized over these years.
table(hc.1$Victim.Sex)/nrow(hc.1)*100
This means that, in the dataset 77.4% of the victims are of male sex. This could mean that the extreme incidents of rage or anger which leads to a homicide crime occurs mostly in males. This holds true even in Chimps. This artical http://www.bbc.com/news/science-environment-29237276 notes that this phenomenon.
For an alien outsider race, just this analysis is enough to understand a typical characteristic of the Human race. Many more conclusions can be made using the above one figures; e.g., in Humans, male sex should more involved in cultural and societal structure leading to a cut throat competition for scarce resources available to demonstrate the domination of any single male over the group or any single individual.
Now, let's understands the relative effect of the above deduction. If the males denote any domination in being the Victims in the dataset, the domination should also verify the same for the Perpetrators.
table(hc.1$Perpetrator.Sex)/nrow(hc.1)*100
If the Crime is assumed/understood as a social tool to establish the territory, gang and domination in Chimps or to express the most extreme Human emotions; we can dig down the roles and responsibilities of males in Chimps and males in humans. The above figures suggests that, since long, the few of the tools in social structures, over the evolutions, are more acceptable in males than in females.
There are well noted and understood evidences, according to a school of thought which advocates Extinction by violence of Denisovans by Neanderthals. Most of the wars fought were led by males.
** References are understood from book: The Sapiens by Yuval Harrari
Let's now understand the environmental effect on the Crime rates. If this effect holds true, the rates should change over the months.
sort(table(hc.1$Month)/nrow(hc.1)*100,decreasing=T)
Figures show kind of an even distribution of the crime rates (near about 8%) over the months. Although, there can be a significant effect of environmental condition playing a role on one month over the others, we will exclude those for this analysis.
** (These effects are considered significant in nature as the change of just 0.097% in Crime rate compared to August in July (9.193458-9.095722) would convert into a 619 incidents July than in August. One can further understand the states where the number of crimes are higher in July as compared to August)
** (One could also find out a typical timeline when these 619 incidents took place over the recorded 35 years to take into account of any socio eco political effect playing a role)
Let's find out the top 10 States with highest numbers of recorded Crimes.
head(sort(table(hc.1$State)/nrow(hc.1)*100,decreasing=T),n=10)
This shows that the CA state has a crime rate almost 1.6 times than the second in line state of TX. There can be ecological and socio economic explanation factors of such a high number of crimes in the state of CA, but for our further analysis we choose not to drill down into these factors.
Let's understand the distribution of Crime rates over the Victim Race
(For this we'll use the help of dplyr package in R)
warn.conflicts = FALSE
suppressMessages(library(dplyr))
hc.1 %>% group_by(Victim.Race) %>% count(sort=T)%>% mutate(percentage=n/nrow(hc.1)*100)
This table show that the Crime rates are concentrated over just White and Black race. The Asian Pacific and Native Americans have a Victimization rate of ~ 1%. This could mean either both of the race have low numbers in populations, or could mean that the socio economical shares of both the race are limited.
Again, we'll choose to move forward and not to analyse playing factors for Victim Race.
It will be meaningful to understand if the Ethnicity of the Victims have a concentrated distribution or not.
hc.1 %>% group_by(Victim.Ethnicity) %>% count(sort=T)%>% mutate(percentage=n/nrow(hc.1)*100)
Well, this doesn't help much; though we can see that the "Not Hispanic" population showcase a crime rate 2.7 times more than those are of "Hispanic". This could help us to reiterate our earlier hypothesis on crime rates based on Race.
Let's understand that if the number of crimes solved have any concentration over the Victim's ethnicity or not.
table(hc.1$Crime.Solved)
hc.1 %>% group_by(Victim.Ethnicity,Crime.Solved) %>% count(sort=T) %>% mutate(pecentage=n/nrow(hc.1)*100)
This shows that the % of crimes solved have less concentration over the Victim's Ethnicity. We can see that out of 100 incidents, 30 are against Not Hispanic victims of which 22 are solved, leading to 77% success. In 100 incidents, 11 are recorded against Hispanic victims and of which 7 are solved, leading to ~66% success.
Let's now try to understand the correlations over all the variables in the dataset. This will help us to decide a positive or negative relationship of one variable with other. We will also plot these relationships over for a simple visual observation.
For any correlation formulae to work on this dataset, we need to convert the categorical variable records containing character strings into numeric. We'll do this with a for loop for each column.
as.list(levels(hc.1$State))
There are 51 names (unique record) in the variable State. We can convert each of them into a number.
for (i in 1:51) {
levels(hc.1$State)[i] <- i
}
head(hc.1, n=3)
The for loop finds each character record of all the unique 51 records and replaces it will a unique number. Using head command we can check if the loop has done the work as we expected or not.
Let's now repeat the same process for Month variable. First we'll rearrange the dataset based on months. We know that, the year starts with Jan. Let's convert the variable month according to this need.
cm<-c("January","February","March","April",
"May","June","July","August","September",
"October","November","December")
hc.1$Month<-factor(hc.1$Month,levels=cm)
for (i in 1:12) {
levels(hc.1$Month)[i] <- i
}
head(hc.1, n=3)
We can see that the loop has worked well and converted Jan to "1" and March to "3"
We'll repeat the same process for Crime.Type, Crime.Solved & Victim.Sex
for (i in 1:2) {
levels(hc.1$Crime.Type)[i] <- i
}
for (i in 1:2) {
levels(hc.1$Crime.Solved)[i] <- i
}
for (i in 1:3) {
levels(hc.1$Victim.Sex)[i] <- i
}
We'll continue the same process Race, Ethnicity, Perpetrator Sex,Race & Ethnicity
for (i in 1:5) {
levels(hc.1$Victim.Race)[i] <- i
}
for (i in 1:3) {
levels(hc.1$Victim.Ethnicity)[i] <- i
}
for (i in 1:3) {
levels(hc.1$Perpetrator.Sex)[i] <- i
}
for (i in 1:5) {
levels(hc.1$Perpetrator.Race)[i] <- i
}
for (i in 1:3) {
levels(hc.1$Perpetrator.Ethnicity)[i] <- i
}
We have converted all of the above variables to numeric. For each variable the range for the conversion has been defined based on how many unique levels that particular variable has; e.g. Perpetrator Race has 5 levels whereas Perpetrator Ethnicity has only 3
We'll now code the final two variables; Relationship and Weapon with this process.
for (i in 1:28) {
levels(hc.1$Relationship)[i] <- i
}
for (i in 1:16) {
levels(hc.1$Weapon)[i] <- i
}
Let's find out how our dataset has been changed
head(hc.1, n=5)
This is the point from where the correlation analysis begins. The dataset is not changed to a numeric format yet. We will have to change it from the data.frame to numeric.
hc.2<-sapply(hc.1,as.numeric)
This formulae will convert each of the column and row to a numeric matrix. Earlier conversions may have coerce na, to be on safer side, it is easy to omit na with following function.
hc.2<-na.omit(hc.2)
Finally, we have our dataset ready into a matrix format. We can now run the correlation analysis for each variable against each of the other.
hc.3<-round(cor(hc.2,hc.2),digits=2)
hc.3<-hc.3[-19,-19]
hc.3
This correlation matrix shows the values of a positive or negative correlation. Positive are those which are directly proportionate to each other. Negatives are those which are inversely proportionate to each other.
Apart from correlation matrix we can also understand the relationship in terms of the variance. Following code does the same. It shows us that how strong one variable co-varies with the other on a positive or a negative line.
hc.4<-round(cov(hc.2,hc.2),digits=2)
hc.4<-hc.4[-19,-19]
hc.4
We can take help from the graphical packages to showcase the above correlation on a visual plot.
suppressMessages(library(ggcorrplot))
options(repr.plot.size=400)
p1<-ggcorrplot(hc.3,lab = T,lab_size = 2.5,title="Correlations")
p1
We can see many relationships from the plot, e.g., Perpetrator Age has positive relationship with Crime solved. This relationship can be verified using below code.
p2<-ggcorrplot(hc.4,lab = T,lab_size = 2,title = "Scores")
p2
d1<-hc.1 %>% group_by(Crime.Solved,Perpetrator.Age) %>%
filter(Crime.Solved==2) %>%
count() %>%
ungroup()
d2<-hc.1 %>% group_by(Crime.Solved,Perpetrator.Age) %>%
filter(Crime.Solved==1) %>%
count() %>%
ungroup()
q2<-qplot(data=d1,x=Perpetrator.Age,y=n)
q1<-qplot(data = d2,x=Perpetrator.Age,y=n)
gridExtra::grid.arrange(q1,q2)
This code first counts all the records where Crime was Solved (all the observations with record = 1 means crime solved, 2 means crime not solved) Perpetrator age wise and then counts all the records where Crime was Unsolved. The number of Crimes solved in the Age range of 25-50 are quite higher. In fact, as the correlation figures(0.74) suggested, the rate of success for solving the crime increases from age 15, reaches peak around 19 and then start decreasing till 75.
This analysis can bring out one more important rule of thumb in understanding the crime. The success probability of solving the crime is at peak in the age range of 19-50. Perpetrators of age range more than 55-60 either do not attempt homicide or do not get caught.
Age range can also suggest that the probability of using the Crime as social expression tool is quite higher.
Another relation from the above correlation plot can be seen between Perpetrator's Sex (whether a female(1), or male(2)) Crime Solved. The ratio of Male perpetrator it self is higher than Female, but the ratio of Crime being solved when the perpetrator is a male is also high. This can be seen from the following graph.
This could mean two inferences;
Male Perpetrator crimes are very common in nature and easy to solve
Female Perpetrator crimes are very rare in nature and difficult to solve
Nonetheless, in this analysis we will not dig down into this inference
## Perpetrator Sex v Crime Solved
## We're converting the Y axis to *log* for a better visulisation
## Though, it may show only a fraction of height diffrence in the bar plot because of log conversion,
## the actual difference in numbers of crime solved are much higher
d<- hc.1 %>% group_by(Perpetrator.Sex,Crime.Solved) %>%
filter(Perpetrator.Sex==1 | Perpetrator.Sex==2)%>%
count() %>%
mutate(ratio=sum(n)) %>%
as.data.frame()
qplot(data = d,Crime.Solved,n) +
geom_bar(stat = "identity",position = "dodge",
aes(color=Perpetrator.Sex,
fill=Perpetrator.Sex)) +
scale_y_log10()
The same correlation plot we made with simple ggcorrplot package can be made with plotly in 3d surface. Below code will do the same.
((require(plotly) p3<-plot_ly(z=hc.3,type = "surface",
#x=row.names(hc.3),y=colnames(hc.3),
#size = c(10,100),showscale=T,reversescale=F,
#opacity=1,cauto=F)
p3))
** This code is silent. You'll have to convert the cell to CODE from MARKDOWN
Understanding predictive modelling¶
In this section we will use some of the predictive algorithm to predict the few of the variable. The process flow till now looks like;
1) We filtered and cleaned the data in Pre-processing section
2) We understood the correlations and variance of variables with each other
3) During some of the instances we also understood the inferences one can make from Pre-processing and Correlations
Now we will try understand if the data variance and correlation can help use to build the predictive model or not.
We will start with PCA (Principle Component Analysis) technique. PCA will tell us the principle data fields on which the dataset's variation/standard deviation is dependent.
## PCA using princomp function
pca<-princomp(hc.2[,-19],cor=T,scores=T)
pca
summary(pca)
This analysis shows the Standard Deviation (SD) that each component(variable) is responsible for. The above table showcase the cumulative proportion of SD for the comps. First 9 comps totals a 72% of SD, meaning out of 18 comps if we consider first 9, we will be able to understand the 72% deviation in data.
The same can be plotted like the following graph. Conventionally we select variable which have Variance of >=1.
plot(pca, main="Var V Components")
The same graph for the Standard Deviations (SD) can be plotted like the following.
pca_sdev<-`colnames<-`(as.data.frame(pca$sdev),"sdv")
pca_sdev$names<- c(1:18)
p1<-qplot(pca_sdev,y=pca_sdev$sdv,x=pca_sdev$names) +
labs(x="Components",y="SD") + geom_line() +
scale_x_continuous(breaks=c(1:18)) +
scale_y_continuous(breaks=c(seq(0,2,0.25))) +
theme_bw() + ggtitle("Raw Data")
p1
This graph shows the Standard Deviation (SD) and Components(variables) that are responsible for them.
We now can understand one definite chracteristic of the dataset from PCA. This is not a highly correlated dataset, meaninng that, each componenet adds a little bit variation to the data. When we will set up the Machine Learning algorithm in the next section, this information will help us to choose the impartant parameters/components/features/variables to consider. And form PCA we can justify a very well reconstruction using first 9 variables of the dataset.
Understanding the predictive & learning models¶
In this section, we will try to implement few predictive and Machine Learning (ML) models to understand the dataset. These models will help us to get a knack on predictive nature of the Crimes. This is last section in Understanding the data, in the next section we will try to come up with the significant and important questions that can be asked and answered by Understanding the dataset.
Prior to using any predictive & learning models we'll reduce the noise in the dataset. This will help us to define reliable predictors.
Since, most of the variables are factors/categorical variables, we can start with Classification models. We'll use two models, Naive bayes and Random forest.
In smoothing the noise out we will consider two variables. Perpetrator Age & Victim Age.
hc_smooth<-as.data.frame(hc.2) %>% filter(Victim.Age>=0,
Victim.Age<=99,
Perpetrator.Age>=5,
Perpetrator.Age<=99) %>% select(-Record.Source)
head(hc_smooth)
dim(hc_smooth)
dim(hc.2)
As you can notice, Smoothing has reduced the data by almost 200,000 data points/rows. If we plot the correlations with the new data you can observe the difference clearly. Let's do it.
hc.5<-round(cor(hc_smooth,hc_smooth),digits = 2)
ggcorrplot(hc.5,lab = T,lab_size = 2.5)
pca2<-princomp(hc_smooth,cor=T,scores=T)
plot(pca2)
summary(pca2)
pca2_sdev<-`colnames<-`(as.data.frame(pca2$sdev),"sdv")
pca2_sdev$names<- c(1:18)
q1<-qplot(pca2_sdev,y=pca2_sdev$sdv,x=pca2_sdev$names) +
labs(x="Components",y="SD") + geom_line() +
scale_x_continuous(breaks=c(1:18)) +
scale_y_continuous(breaks=c(seq(0,2,0.25))) +
theme_bw() + ggtitle("Smoothened Data")
gridExtra::grid.arrange(p1,q1)
This shows the changes in the behaviour of the Data. In the Raw form, the SD (Standard Deviation) starts to decline from the 13th Component whereas in Smoothened version, this drops steeply from the 15th Component.
In the Coorelations plot also, the change of function is evidential.
For e.g., in the Raw Data version the function of Crime Solved can be written as,
f(CS) ~ Perpetrator Sex (-0.89) + Perpetrator Age (0.75) + Perpetrator Race (-0.18) + Perpetrator Ethnicity(-0.39) + Relationship (-0.45)
If we consider the Smoothened Data the function of Crime Solved has only one Strong Correlation (-0.13) with Perpetrator Sex
f(CS) ~ Perpetrator Sex (-0.13)
This changes the scenarios a lot while selecting the features to generate the learning and predictive models.
Let's try to build a predictive model with a classification algorithm - Naive Bayes. We'll use the SparklyR package and Spark to build this model.
suppressMessages(require(sparklyr))
sc<-spark_connect(master="local")
#First, Import the local data as spark dataframe
import_hc<- copy_to(sc,hc_smooth,"hc_spark",overwrite = T)
#Now, let's partition the data for training and testing
partition<- sdf_partition(import_hc,training=0.8, testing=0.2,seed = 2017)
#Lastly, let's register the spark tables for training and testing
partitioned_hc<-sdf_register(partition,c("spark_hc_training","spark_hc_test"))
train_hc <- tbl(sc,"spark_hc_training")
test_hc <- tbl(sc,"spark_hc_test")
This code has created a local spark cluster, imported the data to that cluster, partitioned it in 8:2 ratio for training and testing and registered two spark tables containing the partitioned data.
Let's now develop the Naive Bayes learning model.
model_nb <- train_hc %>% ml_naive_bayes(Crime_Solved~.,lambda = 2)
This code has developed the model. We are interested in the learning the Crime Solved variable. How it behaves in the dataset and can we learn its magnitude and pattern in a way that we can later on predict it using the developed model over the test dataset.
Let see the summary of the model.
summary(model_nb)
This summary shows how the NB worked on the dataset provided. It found the prior probabilities and then compared it with conditional probabilities for Yes(2) and No(1)
We have trained the model on the train dataset, now let's use the model to predict the Crime Solved parameter in test dataset. The following code will take in the trained model and test dataset in the arguments and creates a separate prediction column in the stored vector. This prediction column can be used to compare the original v predicted results.
pred_nb <- sdf_predict(model_nb,test_hc) %>% collect()
Now, let's prepare a comparative table of Actual Yes and No in the Crime Solved column v the Predicted column Yes and No
t2<-table(pred_nb$Crime_Solved,pred_nb$prediction)
t2
This small table shows that, when in Actual it was No(1) the algorithm predicted 26 times No(0) and 103 times Yes(1). This means that the algorithm was wrong 115 times out of 26+103 = 129 times.
The same calculation goes for Yes(2). It predicted 5181 times No(0) and 79136 times Yes(1). The accuracy is 79136 out of 5181+79136 = 84317.
In total, the algorithm was accurate 26+79136 = 79162 times out of 26+103+5181+79136 = 84446. So, the accuracy is 79162/84446 = 0.937427468 ... or 93.74%.
Same calculation is shown below.
((t2[1,1] + t2[2,2])/nrow(pred_nb)*100)
We have set seed as 2017 prior to running the algorithm so in each run the accuracy level will be the same.
Now we have set in a process flow on how to train the algorithm, build the model, predict it with the test data and measure the accuracy level. We can use this process flow and observe the other algorithms also. Let's try with RFM (Random Forest Model).
Below codes will repeat the process flow; build and train the model, predict with it and measure the accuracy level.
model_rfm <- train_hc %>%
ml_random_forest(Crime_Solved~.,num.trees = 25,type = "classification")
pred_rfm <- sdf_predict(model_rfm, test_hc) %>% collect()
t<-table(pred_rfm$Crime_Solved,pred_rfm$prediction)
t
((t[1,1] + t[2,2])/nrow(pred_rfm)*100)
As we can see that, the RFM worked at a better level of accuracy than of NB.
Let's now use the K-means model. We'll build and train the model, predict the model and measure the accuracy.
model_kmeans<- train_hc %>% select(Crime_Solved,
State,
Crime_Type,
Victim_Sex,
Victim_Age,
Victim_Race,
Victim_Ethnicity,
Perpetrator_Sex,
Perpetrator_Age,
Perpetrator_Race,
Perpetrator_Ethnicity,
Relationship,
Weapon) %>%
ml_kmeans(centers=2,iter.max = 1000,compute.cost = T,ml.options = ml_options(only.model = F))
print(model_kmeans)
pred_kmeans<-sdf_predict(model_kmeans,test_hc) %>% collect()
t2<-table(pred_kmeans$Crime_Solved,pred_kmeans$prediction)
t2
((t2[1,1] + t2[2,2])/nrow(pred_kmeans)*100)
As we can notice that, the accuracy of K-means algorithm is just ~69% as compared to NB (~94%) and RFM (~99.99%).
** There are many parameters on which these models can be compared aprt from the Accuracy. Accuracy may not be the only and final measure to understand the model's efficiency over the given data.
This section now lead us to the end of this article. There are still few aspects of the data which I wasn't able to cover in this article because of limited time available. Some of them are listed below.
Questions to dataset !¶
One can ask some of the given questions to this dataset. This questions' answers will help to understand the dataset more in depth.
1) Is there any specific distribution pertaining to Years?
If the Crime Incidents are higher than normal average in any particular Year, one can understand the situations or socio-eco-political events, state-wise to evaluate the reasoning.
2) Is there any specific Crime Type common over the Years, State with Specific Weapon over the Victim & Perpetrator Age range, Sex, Race and Ethnicity? Does the relation between Victim and Perpetrator showcase any specific deduction?
(In depth analysis done by -- Kheirallah Samaha http://bit.ly/2m1dH1z)
3) Is there any specific crime pattern State-wise which can be predicted?
May be one can train the model specific to any state to predict the Age range, Relationship based on Victim and Perpetrator Race & Ethnicity.
This will help the authorities to understand the involvement of a perpetrator where most of the details are hard to define or not available at all.Covered and missed !¶
Though, I was able to cover the data pre-processing, correlations & implications of them, model development and prediction using them, I have missed many of the crucial aspects of process in each segment. I may try to make few anecdotals to this version in future containing my understanding of these sections.
Disclaimer !!¶
In no way, this is the complete and only work that can be prepared on this dataset, neither this work is immune to fatal error. This is just a try to understand and explore individual skill-set in data-science.
I had to silent the Modelling part in Spark as I am yet to learn how Spark can be rolled out over the Kaggle scripting frames, but it is very easy if one wants to reproduce this part; just convert the MARKDOWN cells to CODE and run it on the local system
** All the codes are reproducible
Comments are always welcomed & if you like the effort please share & vote
Thanks !