Kaggle案例~R可视化分析美国枪击案（附数据集和代码）
作者：邬书豪，车联网数据挖掘工程师 ，R语言中文社区专栏作者。微信ID：wsh137552775
知乎专栏：https://www.zhihu.com/people/wu-shu-hao-67/activities
数据集：自1966~2017年发生在美国的大规模枪击案（死伤人数在三人以上的枪击案）
一、探索数据
#加载此次所要用到的包
library(lubridate)#日期处理
library(data.table)#更改数据框的格式，使之更为易用
library(dplyr)#包含诸多常用函数
library(ggplot2)#绘图
library(stringr)#对文本进行处理
library(tidyr)#对数据分类汇总
library(ggmap)#进行地图绘制
#设置工作路径
setwd("D:/US Mass Shootings")
#导入数据
shoot <- fread("Mass Shootings Dataset.csv",header = TRUE,stringsAsFactors = FALSE)
#将过长过大的数据集转换为显示更友好的 tbl_df 类型:
shoot <- tbl_df(shoot)
#对部分列名进行重命名
shoot<- rename(shoot,ID=`S#`,Total=`Total victims`,Mental=`Mental Health Issues`)
#观察数据
glimpse(shoot)ID：各案件编号
Title:案件名称
Location:案件发生所在的州
Date:案件发生日期，时间跨度：1966-08-01 ~ 2017-10-01
Summary:对案件的概述，如枪手名字，年龄，事件经过等
Fatalities:该次案件中死亡人数
Injured:该次案件中受伤人数
Total:该次案件中总计伤亡人数
Mental:枪手是否有精神问题
Race:枪手的种族/肤色，有White、Black、Asian等等
Gender:枪手性别
Latitude:纬度
Longitude经度
二、数据整理
由于第一条关于Las vegas枪击案不完善，据最近新闻报道对其进行修改补充
shoot$Injured[shoot$ID==1] <- 527
shoot$Fatalities[shoot$ID==1] <- 59
shoot$Total[shoot$ID==1] <- 586
shoot$Race[shoot$ID==1] <- "White"
shoot$Gender[shoot$ID==1] <- "Male"
shoot$Latitude[shoot$ID==1] <- 36.0918365
shoot$Longitude[shoot$ID==1] <- -115.1754113
shoot$Summary[shoot$ID==1] <- "Stephen Paddock, a 64-year-old gunman opened fire on a large crowd of concertgoers at the Route 91 Harvest music festival on the Las Vegas Strip, killing 59 people and injuring 527"数据集（Gender、Mental、Race）变量下的观测值命名较为混乱，咱们将它修补统一哈！
shoot$Gender[shoot$Gender=="M"] <- "Male"
shoot$Gender[shoot$Gender=="M/F"] <- "Male/Female"
shoot$Mental[shoot$Mental=="Unclear" | shoot$Mental=="unknown"] <- "Unknown"
shoot$Race[shoot$Race=="black" | shoot$Race=="Black American or African American" | shoot$Race=="Black American or African American/Unknown"] <- "Black"
shoot$Race[shoot$Race=="white" | shoot$Race=="White American or European American" | shoot$Race=="White American or European American/Some other Race"] <- "White"
shoot$Race[shoot$Race=="unclear" | shoot$Race==""] <- "Unknown"
shoot$Race[shoot$Race=="Asian American/Some other race" | shoot$Race=="Asian American"] <- "Asian"
shoot$Race[shoot$Race=="Latino" | shoot$Race=="Native American" | shoot$Race=="Native American or Alaska Native" | shoot$Race=="Some other race" | shoot$Race=="Two or more races"] <- "Other"通过浏览对比发现一部分事件存在重复，即Summary不同但所描述事件过程基本一样，经纬度及伤亡人数上区别很小，可能是数据集录入之初产生的错误，故去重！
shoot<- distinct(shoot,Location,Date,Mental,Gender,.keep_all=TRUE)
shoot<- distinct(shoot,Date,Total,Gender,.keep_all=TRUE)
shoot<- distinct(shoot,Date,Fatalities,Gender,.keep_all=TRUE)三、数据可视化分析
按年份、月份、性别以及精神问题进行可视化分析！
shoot$Date <- as.Date(shoot$Date,"%m/%d/%Y")
#增加一个新变量year。按照年份统计枪击频率
shoot$year <- year(shoot$Date)
#直方图设置为6个组数，故设置breaks = 6
hist(shoot$year,breaks = 6,col = "lightblue",xlab = "year",main = "Frequency of shoot")枪击案发生频率连年递增，尤其近几年来显著增多
#按照月份统计枪击频率
hist(month(shoot$Date),xlab="Month",ylab="Count",main="the distribution of month")发生在一月份的枪击案的频率较其它月份相对显著
#将plot()函数绘制的四幅图形组合在一个大的1×2的图中,按照性别及种族统计枪击频率
par(mfrow=c(1,2))
barplot(table(shoot$Gender),xlab = "Gender",ylab="Count",main="the distribution of Gender")
barplot(table(shoot$Mental),xlab = "Mental Health Issue",ylab="Count",main="the distribution of mental")绝大多数枪手都是男性
在已知的枪手中，过半数人有精神问题
#增加一个Level变量，按照死伤人数多少对案件划分严重程度。
shoot$Level <- NA
shoot$Level[shoot$Total<5] <- "Under 5"
shoot$Level[shoot$Total>=5 & shoot$Total<=10] <- "5 to 10"
shoot$Level[shoot$Total>10] <- "Above 10"
#统计各Level的频次
ggplot(shoot,aes(factor(Level,levels=c("Under 5","5 to 10","Above 10"))))+geom_bar(fill="orange")+xlab("Level")
#统计各Level累计死伤人数
Levelsum<- as.data.frame(tapply(shoot$Total,shoot$Level,sum))
colnames(Levelsum) <- "Sum"
ggplot(Levelsum,aes(reorder(row.names(Levelsum),Sum),Sum))+geom_bar(stat="identity",fill="red")+xlab("Level")本数据集只包含死伤三人及以上的数据集，5至10人发生频次较高。然而论死伤总人数，超过10人死伤的案件虽然只占总体案件的约20%，然而累计死伤人数却占了近60%。
#精神问题与伤亡，subset()函数抽取出已知枪手精神问题的部分
mental<- subset(shoot,Mental!="Unknown")
mental_cas<- data.frame(table(mental$Mental,mental$Level))
colnames(mental_cas) <- c("Mental","Level","Freq")
ggplot(mental_cas,aes(x=factor(Level,levels=c("Under 5","5 to 10","Above 10")),y=Freq,fill=Mental))+geom_bar(stat="identity",position = "dodge")+xlab("Level")从前两个与第三个箱线图的比较来看，被杀死的受害者中，明显被有精神问题杀害的人居多！
#先用tapply()函数计算被是否患有精神问题的枪手导致的伤亡累计，然后绘图！
barplot(tapply(mental$Total,mental$Mental,sum),main="Shooter with mental health issue",col = "lightblue",ylab = "No. of Casualties")有精神问题的枪手导致的伤亡甚至占到了三分之二。
#分析枪手所属种族所占比例
shooter <- data.frame(table(shoot$Race))
colnames(shooter) <- c("Race","Freq")
ggplot(shooter,aes(x=reorder(Race,Freq),y=Freq,fill=Race))+geom_bar(stat="identity",width = 1)+coord_polar(theta = "y")枪手里面，白人以及黑人占绝大多数！！而亚裔枪手只占一小丢丢！
#cut()函数将变量year按值域切割为多个区间，赋值为新变量yearcut，对年份进行分段
shoot$yearcut <- cut(year(shoot$Date),breaks = 10)
shoot_year<- select(shoot,yearcut,Fatalities,Injured)
shoot_year<- gather(shoot_year,type,victim,-yearcut)
#随年份的改变枪手种族比例的变化
ggplot(shoot,aes(yearcut,fill=Race))+geom_bar()在2012年以前枪手主要是白人，最近5年来黑人以及其它族裔的种族枪手所占比例提升较大！
#年份与死伤人数统计
shoot_year2<- group_by(shoot_year,yearcut,type) %>% summarise(Sum=sum(victim))
ggplot(shoot_year2,aes(yearcut,Sum,fill=type))+geom_bar(stat="identity",position = "dodge")在2012年以前，死亡人数一直保持在与受伤人数相差无几的状态下，而2012年以后受伤人群-大幅增加！~~~~~其主要原因在于2017-10-01日发生的拉斯维加斯露天音乐会枪击案！！！！~~~~死59人，伤527人，实乃美国枪击案件之最也！！！
~~~~看到这幅图，我们无比震惊！！！仿佛可以听到拉斯维加斯露天音乐会枪击案现场“哒哒哒哒哒哒哒哒哒哒哒哒”的子弹声！！！
#各年份中各Level所占比例
ggplot(shoot,aes(yearcut,fill=Level))+geom_bar(position = "fill")+ggtitle("How year impact Level")综上~虽然近5年来死伤人数远超以往！！
但超过10人死伤的严重枪击案反而只占很小一部分，更反映出小规模枪击案的频繁！
#从文本概述中运用正则表达式抽取出年龄
tem <- mutate(shoot,age=str_extract_all(shoot$Summary,pattern="(,\\s)\\d{2}(,)"),age2=str_extract_all(shoot$Summary,pattern="(a\\s)\\d{2}(-year)"))
tem$age<- str_sub(tem$age,3,4)
tem$age2<- str_sub(tem$age2,3,4)
te <- subset(tem,tem$age!="ar")
te2 <- subset(tem,tem$age2!="ar")
te <- rbind(te,te2)
for(i in 1:nrow(te))
if(te$age[i]=="ar") te$age[i] <- te$age2[i]
te <- arrange(te,age)
te<- te[-c(1:4),]#去除非数字部分
te <- arrange(te,ID)
te$age <- as.integer(te$age)
te3 <- te %>% select(ID,age) %>% mutate(agecut=cut(te$age,breaks = 10*(1:7))) #将年龄分段
shoot_age <- left_join(te3,shoot,by="ID")
#年龄分布
ggplot(shoot_age,aes(agecut))+geom_bar(fill="lightblue")+ggtitle("the distribution of age")#绘制出各年龄段中是否有精神问题的比例
ggplot(shoot_age,aes(agecut,fill=Mental))+geom_bar(position = "fill")+ggtitle("The relationship between Age and Mental")已知年龄的犯罪分子中，有精神问题者居多，其中30岁至40岁的人比例略大一些！
#年龄与种族的关系
ggplot(shoot_age,aes(agecut,fill=Race))+geom_bar(position="fill")+ggtitle("the relationhship between Age and Race")在20岁以下及50岁以上，白人占比都超过六成；黑人枪手则主要集中于20岁至50岁的年龄段
ggplot2包它精致唯美博大精深，万言不如一图！
掌握ggplot2包可视化技巧对于数据分析至关重要！
就像一门顶尖 的厨师，它的厨艺技能绝对不是看来跟师傅看来的，而是十年如一日的孜孜不倦的练习！学习ggplot2可视化也一样，需要孜孜不倦的对大量数据集进行练习！
公众号后台回复“枪击”获取数据集下载链接。
公众号后台回复关键字即可学习
回复 R R语言快速入门免费视频
回复 统计 统计方法及其在R中的实现
回复 用户画像 民生银行客户画像搭建与应用
回复 大数据 大数据系列免费视频教程
回复 可视化 利用R语言做数据可视化
回复 数据挖掘 数据挖掘算法原理解释与应用
回复 机器学习 R&Python机器学习入门