R语言-美国枪杀案分析

案例:该数据集的是一个关于美国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)

R语言-美国枪杀案分析

　　结论:一共是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')

R语言-美国枪杀案分析

　　结论:在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)

R语言-美国枪杀案分析

　　　　　　　　　　　　受伤人数分布　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　死亡人数分布

　　结论:从地理信息结合人口信息来看,美国东部发生枪击案的概率要高于美国西部

　　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')

R语言-美国枪杀案分析

　　结论:男性作案的可能性远远大于女性

　　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')

R语言-美国枪杀案分析

　　结论:白人作案很多,但是黑人作案的数量也在上升

　　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()

R语言-美国枪杀案分析

　　结论:10月份发生枪击案的数量最高,最危险

　　4.5 枪手是否有精神疾病

shooting %>%

  na.omit() %>%

  ggplot(aes(x=Mental.Health.Issues)) +

  geom_bar()+

  scale_x_discrete(limits=c("NO","YES"))+

  theme_bw()

R语言-美国枪杀案分析

　　结论:凶手是否患有精神疾病并不是一个主要原因

　　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')

R语言-美国枪杀案分析

　　结论:患有精神疾病的凶手杀人的数量是没患有精神病人的一倍,精神病枪手的危害更大

　　4.7不同的时间段内,枪手种族的统计

shooting %>%

  na.omit() %>%

  group_by(yearcut) %>%

  ggplot(aes(x=yearcut,fill=Race))+

  geom_bar(position = 'dodge')

R语言-美国枪杀案分析

　　结论:可以看出虽然枪击案是以白人为主,但是在近几年来黑人翻案的数量也在不断增多

　　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()

R语言-美国枪杀案分析

　　结论:从年龄分布上来看,年轻人作案的几率较大,冲动是魔鬼

　　4.9 不同年龄段精神疾病的分布

ggplot(data=shoot_age,aes(x=agecut,fill=Mental.Health.Issues))+

  geom_bar()

R语言-美国枪杀案分析

　　结论: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')

R语言-美国枪杀案分析

　　　　　　　　　　　　　　　　　　城市分布州分布

　　结论:发生枪击案件最多的是加州

总结:

　　1.从枪手的性别来看,男性作案是极大多数

　　2.从枪手的种族来看,白人是作案的主体,但是黑人作案的数量也在逐年上升

　　3.从枪手的年龄分布来看10~50岁之间的青中年占了绝大多数

　　4.从枪手的精神疾病来看,虽然枪手患有精神疾病和没有患有精神疾病的数量并不显著,但是患有精神疾病的枪手会造成更大的伤害,一定要重点控制

　　5.从枪击案件的时间上来看,枪支犯罪在2015年上升的最多,但是到了2017年有了一个极端的上升,可见控枪的重要性

　　6.从枪支案件的地理信息来看,总体上东部发生枪击案件的数量要大于西部

　　7.从枪击案发生的数量上来看,加州这几年发生枪击案的数量最多

代码:https://github.com/Mounment/R-Project

秒客网

R语言-美国枪杀案分析

相关文章