案例:该数据集的是一个关于美国2017年犯罪的一个数据集,接下来我们对该数据集进行分析
字段:
#### S# ：数据编号 #### Location：案件发生城市，州 #### Date：时间 #### Summary：案件总结 #### Fatalities：死亡人数 #### Injured：受伤人数 #### Total victims：受害者总人数 #### Mental Health Issues：精神状况 #### Race：种族 #### Gender：性别 #### Latitude：纬度 #### Longitude：经度
1.导入包
library(tidyverse)
library(stringr)
library(data.table)
library(maps)
library(lubridate)
library(leaflet)
2.导入并查看数据集
shooting <- read.csv('Mass Shootings Dataset Ver 2.csv',stringsAsFactors = F,header = T) summary(shooting) glimpse(shooting)
结论:一共是320行数据,13个变量数据量不大,但是要对数据进行重构
3.数据重构
# 将Date字段进行转化,同时创建新的变量year shooting <- shooting %>% select(1:13) %>% mutate(Date=mdy(shooting$Date),year=year(Date)) summary(shooting$year) # 对性别进行提取 shooting$Gender<-if_else(shooting$Gender=="M","Male",shooting$Gender) # 对种族字段进行提取 shooting$Race<-if_else(str_detect(shooting$Race,"Black American or African American"),"Black",shooting$Race) shooting$Race<-if_else(str_detect(shooting$Race,"White American or European American"),"White",shooting$Race) shooting$Race<-if_else(str_detect(shooting$Race,"Asian American"),"Asian",shooting$Race) shooting$Race<-if_else(str_detect(shooting$Race,"Some other race"),"Other",shooting$Race) shooting$Race<-if_else(str_detect(shooting$Race,"Native American or Alaska Native"),"Native American",shooting$Race) # 对时间数据进行切分 shooting$yearcut<-cut(shooting$year,breaks = 10) # 对是否有心理疾病进行处理 shooting$Mental.Health.Issues<-if_else(str_detect(shooting$Mental.Health.Issues,"Un"),"Unknown",shooting$Mental.Health.Issues) shooting$Race<-str_to_upper(shooting$Race) shooting$Mental.Health.Issues<-str_to_upper(shooting$Mental.Health.Issues) # 把location分解成city和state两个变量 shooting$city <- sapply(shooting$Location,function(x){ return(unlist(str_split(x,','))[1] %>% str_trim()) }) shooting$state <- sapply(shooting$Location,function(x){ return(unlist(str_split(x,','))[2] %>% str_trim()) })
4.EDA分析
4.1每年的枪击的死亡人数的变化
# 每年受到枪击的死亡人数 shooting %>% group_by(year) %>% summarise(total=sum(Total.victims)) %>% ggplot(aes(x=year,y=total)) + geom_bar(stat = 'identity',fill='blue') + geom_text(aes(label=total),vjust=-0.2) + xlim(1969,2020) + geom_line(color='red') + ylab('Total victims every year') + ggtitle('People died because of gun shoot every year')
结论:在2015年之后,美国的枪击案频发,2017年的因为枪击案的死亡人数上升特别明显
4.2 发生枪击案的地点
# 受伤人数的地理位置分布 shooting %>% select(Total.victims,Fatalities,Longitude,Latitude,Summary) %>% na.omit() %>% leaflet() %>% addProviderTiles(providers$OpenStreetMap) %>% fitBounds(-124,30,-66,43) %>% addCircles(color='#8A0707',lng = ~Longitude,lat = ~Latitude,weight = 1, radius = ~sqrt(Total.victims) * 20000,popup = ~Summary) # 死亡人数的地理位置分布 shooting %>% select(Total.victims,Fatalities,Longitude,Latitude,Summary) %>% na.omit() %>% leaflet() %>% addProviderTiles(providers$OpenStreetMap) %>% fitBounds(-124,30,-66,43) %>% addCircles(color='blue',lng = ~Longitude,lat = ~Latitude,weight = 1, radius = ~sqrt(Fatalities) * 20000,popup = ~Summary)
受伤人数分布 死亡人数分布
结论:从地理信息结合人口信息来看,美国东部发生枪击案的概率要高于美国西部
4.3 枪手的性别分布
shooting %>% ggplot(aes(x=factor(Gender),fill=factor(Gender)))+ geom_bar()+ xlab('Gender')+ ylab('Number of each Gender')+ ggtitle('The distribution of gender')
结论:男性作案的可能性远远大于女性
4.4 枪击案的种族分布
shooting %>% na.omit() %>% group_by(Race) %>% summarise(num=sum(Total.victims)) %>% ggplot(aes(x=factor(Race),y=num,fill=factor(Race)))+ geom_bar(stat = 'identity')+ coord_polar(theta = 'y')+ labs(x='Race',y='Number of killed people',fill='Race')+ ggtitle('People killed by different race')
结论:白人作案很多,但是黑人作案的数量也在上升
4.5 枪击案的月份分布
shooting %>% mutate(month=month(Date)) %>% group_by(month) %>% summarise(n=sum(Total.victims)) %>% ggplot(aes(x=factor(month),y=n)) + geom_bar(stat = 'identity')+ labs(x='month',y='Number of killed people')+ ggtitle('The distribution of killed people every month')+ geom_text(aes(label=n),vjust=-0.2,color='red')+ theme_bw()
结论:10月份发生枪击案的数量最高,最危险
4.5 枪手是否有精神疾病
shooting %>% na.omit() %>% ggplot(aes(x=Mental.Health.Issues)) + geom_bar()+ scale_x_discrete(limits=c("NO","YES"))+ theme_bw()
结论:凶手是否患有精神疾病并不是一个主要原因
4.6 患有精神疾病的和没有患有精神疾病的人是否是数量的差异
shooting %>% na.omit() %>% group_by(Mental.Health.Issues) %>% summarise(n=sum(Total.victims)) %>% ggplot(aes(x=factor(Mental.Health.Issues),y=n,group=1)) + geom_bar(stat = 'identity',fill='pink')+ scale_x_discrete(limits=c('NO','YES'))+ geom_text(aes(label=n),vjust=-0.2)+ geom_line(color='red')
结论:患有精神疾病的凶手杀人的数量是没患有精神病人的一倍,精神病枪手的危害更大
4.7不同的时间段内,枪手种族的统计
shooting %>% na.omit() %>% group_by(yearcut) %>% ggplot(aes(x=yearcut,fill=Race))+ geom_bar(position = 'dodge')
结论:可以看出虽然枪击案是以白人为主,但是在近几年来黑人翻案的数量也在不断增多
4.8枪手的年龄分布
# 通过正则表达式从摘要中提取年龄 tmp <- mutate(shooting,age=str_extract_all(shooting$Summary,pattern = '(,\\s)\\d{2}(,)'), age2 = str_extract_all(shooting$Summary,pattern = '(a\\s)\\d{2}(-year)')) tmp$age <- str_sub(tmp$age,3,4) tmp$age2 <- str_sub(tmp$age2,3,4) # 去掉年龄不明的字段 te <- subset(tmp,tmp$age != 'ar') te2 <- subset(tmp,tmp$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,S.) te$age <- as.integer(te$age) te3 <- te %>% select(S.,age) %>% mutate(agecut=cut(te$age,breaks = 10*(1:7))) shoot_age <- left_join(te3,shooting)
ggplot(data=shoot_age,aes(x=agecut))+ geom_bar(fill='blue')+ theme_bw()
结论:从年龄分布上来看,年轻人作案的几率较大,冲动是魔鬼
4.9 不同年龄段精神疾病的分布
ggplot(data=shoot_age,aes(x=agecut,fill=Mental.Health.Issues))+
geom_bar()
结论:10~20,和30~40岁之间的枪手群是精神疾病的高发群体
4.10 枪击案件的城市分布和州分布
# 城市分布 shooting %>% group_by(city) %>% summarise(count=n()) %>% filter(city != '' & count >= 2) %>% ggplot(aes(x=reorder(city,count),y=count))+ geom_bar(stat = 'identity',fill='lightblue')+ coord_flip()+ labs(x='City',y='Number of gun-shot happended')+ ggtitle('The number of case happened in each city') # 州分布 shooting %>% group_by(state) %>% summarise(count=n()) %>% filter(state != '' & count >= 2) %>% ggplot(aes(reorder(state,count),y=count))+ geom_bar(stat='identity',fill='lightblue')+ coord_flip()+ labs(x='State',y='Number of gun-shot happended')+ ggtitle('The number of case happened in each state')
城市分布 州分布
结论:发生枪击案件最多的是加州
总结:
1.从枪手的性别来看,男性作案是极大多数
2.从枪手的种族来看,白人是作案的主体,但是黑人作案的数量也在逐年上升
3.从枪手的年龄分布来看10~50岁之间的青中年占了绝大多数
4.从枪手的精神疾病来看,虽然枪手患有精神疾病和没有患有精神疾病的数量并不显著,但是患有精神疾病的枪手会造成更大的伤害,一定要重点控制
5.从枪击案件的时间上来看,枪支犯罪在2015年上升的最多,但是到了2017年有了一个极端的上升,可见控枪的重要性
6.从枪支案件的地理信息来看,总体上东部发生枪击案件的数量要大于西部
7.从枪击案发生的数量上来看,加州这几年发生枪击案的数量最多
代码:https://github.com/Mounment/R-Project
请发表评论