Gun vs Vehicle Deaths

Summary

The data seems to contradict what you read in the media:

1. Gun related deaths outnumber vehicle deaths.
2. White race related gun deaths are the highest.
3. White race and gun deaths seem somewhat correlated with vehicle deaths.

A few things to note: Whites in the 50+ age group, may make up the largest part of the population. kaggle: 2013 American Community Survey

Also note the following two ICD10codes:

1. Icd10Code x74 Description: “Intentional self-harm by other and unspecified firearm discharge.” If you jump to the bottom, you’ll see that there are 12,921 deaths that fit this classification.
2. The 2nd total highest Icd10Code is X95 Description: “Assault by other and unspecified firearm discharge.”

Running the Analysis

Below taking a look at Gun vs. Vehicle deaths by age.

library(ggplot2)
library(RSQLite)
library(scales)
library(dplyr)
library(tidyr)
library(knitr)

library(DT)

db <- dbConnect(dbDriver("SQLite"), "../input/database.sqlite")

query <-paste("

select 
    v.Age,v.Total Vehicle_Total ,v.White Vehicle_White,
    v.Black Vehicle_Black,v.All_Other  Vehicle_Other,
    g.Total Gun_Total,
    g.White Gun_White,g.Black Gun_Black,g.All_Other Gun_Other
from (
  select 
      Age,count(*) Total ,sum(Race == 1) as White, 
      sum(Race == 2) as Black, sum(Race >=3 or   Race == 0) All_Other
   from DeathRecords d,
     (
     select 
       distinct e.DeathRecordId as id 
       from 
         EntityAxisConditions e,
         (
            select * 
            from Icd10Code where Description like ('%vehicle%')
 
         ) as c 
        where e.Icd10Code = c.code) as f
    where d.id = f.id and AgeType = 1 
    group by Age
    ) as v, -- Vehicle

(
 select 
     Age,count(*) Total ,sum(Race == 1) as White, 
     sum(Race == 2) as Black, sum(Race >=3 or   Race == 0) All_Other
   from DeathRecords d,
       (select 
           distinct e.DeathRecordId as id 
           from 
              EntityAxisConditions e,
              (

        -- Every Firearm discharge, except Legal intervention
        select 
           Code,Description 
           from Icd10Code
           where description like '%discharge%' 
             and description not in  ('Urethral discharge',
             'Discharge of firework',
             'Legal intervention involving firearm discharge')
 
              ) as c 
        where e.Icd10Code = c.code) as f
    where d.id = f.id and AgeType = 1 
    group by Age
    ) as g
     where g.Age = v.Age
     -- End of SQL
")

allVehicleGun <- dbGetQuery(db, query)

# -- Just Look at Totals
data <- select(allVehicleGun, Vehicle_Total,Gun_Total,Age) %>% 
          gather(Group,Deaths,-Age) 

g <- ggplot(dat = data, 
       aes(x=Age, y=Deaths)) + 
      geom_line(aes(colour=Group, group=Group)) + 
      geom_point(aes(colour=Group, shape=Group, group=Group), size=1)+
  ggtitle("Gun vs. Vehicle Deaths\nby Age")

Graph of Guns vs. Vehicle

The graph below is interesting. Note the 2nd jump in deaths, after age 50.

# Show plot
g

Race

Let’s further subdivide this by race. And this is where it starts to get interesting.

# Let's see where the jump is coming from.

data <- select(allVehicleGun, Vehicle_White,Vehicle_Black,
               Gun_White,Gun_Black,Age) %>% 
               gather(Group,Deaths,-Age) 

ggplot(dat = data, 
       aes(x=Age, y=Deaths)) + 
      geom_line(aes(color=Group, group=Group)) + 
      geom_point(aes(color=Group, shape=Group, group=Group), size=1)+
  ggtitle("Gun vs. Vehicle Deaths\nby Age and Race")

Close Look at the Numbers

Let’s take a close look at the numbers. It might help to see this in table form.

# Look at the numbers
datatable(allVehicleGun, class = 'compact')

db <- dbConnect(dbDriver("SQLite"), "../input/database.sqlite")

query <-paste("

select *

from (

select Icd10Code,count(*) count from 

( -- Put the whole previous query block in here

 select distinct d.id
   from DeathRecords d,
     (select distinct e.DeathRecordId as id from 
     EntityAxisConditions e,
     (

     -- Every Firearm discharge, except Legal intervention
    select Code,Description from Icd10Code
     where description like '%discharge%' 
     and description not in  ('Urethral discharge','Discharge of firework',
     'Legal intervention involving firearm discharge')
 
   ) as c 
  where e.Icd10Code = c.code) as f
  where d.id = f.id and AgeType = 1 

  -- End of big query block
) as s

,DeathRecords d
where s.id=d.id
group by Icd10Code order by count desc


) as a,
Icd10Code b where
a.Icd10Code = b.code limit 10

")

vData <- dbGetQuery(db, query)

Top Icd10Codes

See the table below for an explaination of the top ICD10codes. Please note the top 2 codes, and the count (total number of deaths) for each entry.

The top code X74, list ‘Intentional self-harm..’, which we’ll assume is suicide.

# This might explain why the results seem odd.
# Note the category 'Intentional self-harm by other and unspecified firearm discharge'
kable(vData)

Icd10Code	count	Code	Description
X74	12921	X74	Intentional self-harm by other and unspecified firearm discharge
X95	9733	X95	Assault by other and unspecified firearm discharge
X72	5389	X72	Intentional self-harm by handgun discharge
X73	3034	X73	Intentional self-harm by rifle, shotgun and larger firearm discharge
X93	786	X93	Assault by handgun discharge
X94	456	X94	Assault by rifle, shotgun and larger firearm discharge
W34	423	W34	Discharge from other and unspecified firearms
Y24	208	Y24	Other and unspecified firearm discharge, undetermined intent
W32	96	W32	Handgun discharge
W33	64	W33	Rifle, shotgun and larger firearm discharge

Explaination:

X74 – “Intentional self-harm by other and unspecified firearm discharge” is skewing the results. You can see in the graph below W_X74 (Race White) compared to B_X74 (Race Black) the differences.

db <- dbConnect(dbDriver("SQLite"), "../input/database.sqlite")

query <-paste("


select Age,count(*) Total ,sum(Race == 1) as White, 
  sum(Race == 2) as Black, sum(Race >=3 or   Race == 0) All_Other,
  sum(Race == 1 and Icd10Code == 'X74')  W_X74,
  sum(Race == 2 and Icd10Code == 'X74')  B_X74,

  sum(Race == 1 and Icd10Code == 'X95')  W_X95,
  sum(Race == 2 and Icd10Code == 'X95')  B_X95,

  sum(Race == 1 and Icd10Code == 'X72')  W_X72,
  sum(Race == 2 and Icd10Code == 'X72')  B_X72,

  sum(Race == 1 and Icd10Code == 'X73')  W_X73,
  sum(Race == 2 and Icd10Code == 'X73')  B_X73,

  sum(Race == 1 and Icd10Code == 'X93')  W_X93,
  sum(Race == 2 and Icd10Code == 'X93')  B_X93,

  sum(Race == 1 and Icd10Code == 'X94')  W_X94,
  sum(Race == 2 and Icd10Code == 'X94')  B_X94





 from DeathRecords d,
   (select distinct e.DeathRecordId as id from 
   EntityAxisConditions e,
   (

   select Code,Description from Icd10Code
   where description like '%discharge%' 
   and description not in  ('Urethral discharge','Discharge of firework',
   'Legal intervention involving firearm discharge')
 
   
 
   ) as c 
  where e.Icd10Code = c.code) as f
  where d.id = f.id and AgeType = 1 
 group by Age;

")

v2Data <- dbGetQuery(db, query)

data <- select(v2Data, W_X74,B_X74,
               Age) %>% 
  gather(Group,Total,-Age) 

g <- ggplot(dat = data, 
       aes(x=Age, y=Total)) + 
      geom_line(aes(color=Group, group=Group)) + 
      geom_point(aes(color=Group, shape=Group, group=Group), size=1)+
  ggtitle("X74 - Intentional self-harm by other\n and unspecified firearm discharge\nby Age")

Graph of X74

Here’s the actual graph of X74. You can see the impact.

# Display graph
g

Listing the Table

# Here's more detail
kable(v2Data)

Age	Total	White	Black	All_Other	W_X74	B_X74	W_X95	B_X95	W_X72	B_X72	W_X73	B_X73	W_X93	B_X93	W_X94	B_X94
1	8	2	5	1	0	0	1	3	0	0	0	0	0	0	0	0
2	19	11	8	0	0	0	6	6	0	0	0	0	1	0	1	0
3	22	7	14	1	0	0	3	8	0	0	0	0	1	0	0	0
4	22	14	8	0	0	0	10	4	0	0	0	0	0	0	1	0
5	17	9	8	0	0	0	5	5	0	0	0	0	1	2	1	0
6	12	8	4	0	0	0	3	3	0	0	0	0	3	0	0	0
7	15	8	5	2	0	0	4	4	0	0	0	0	1	0	1	1
8	10	7	3	0	0	0	4	2	0	0	0	0	1	0	0	0
9	21	15	4	2	0	0	8	4	0	0	0	0	1	0	0	0
10	16	10	6	0	1	0	4	4	0	0	0	0	2	1	2	1
11	28	19	8	1	5	0	8	6	4	1	1	0	0	0	0	0
12	42	36	6	0	14	3	8	3	3	0	5	0	1	0	1	0
13	89	67	17	5	30	1	12	12	14	2	7	0	1	0	1	0
14	131	99	29	3	41	3	15	23	19	1	14	1	3	1	3	0
15	195	130	60	5	48	4	22	52	17	1	25	0	7	1	3	1
16	290	167	118	5	56	3	46	100	32	2	23	1	0	7	2	2
17	383	195	181	7	71	5	52	148	24	3	33	0	5	11	4	5
18	557	291	247	19	89	11	89	211	40	6	41	2	15	4	5	4
19	645	314	308	23	87	10	108	263	32	3	51	3	8	17	9	4
20	709	336	355	18	96	16	124	307	41	2	49	3	8	15	5	4
21	789	379	385	25	142	29	111	304	46	13	41	1	13	25	6	6
22	865	458	391	16	167	37	126	312	75	11	51	3	16	16	5	2
23	808	426	357	25	150	22	118	295	76	5	44	2	16	20	3	6
24	834	434	373	27	165	35	113	308	74	12	49	0	13	9	5	6
25	754	387	344	23	147	28	102	287	67	5	35	4	13	14	11	3
26	750	438	292	20	159	31	128	237	74	6	43	2	14	12	7	1
27	644	356	268	20	129	22	83	218	76	8	46	0	15	9	3	4
28	626	361	248	17	133	23	96	203	71	6	34	0	10	9	6	4
29	605	337	251	17	136	22	84	206	56	0	30	1	10	12	8	2
30	581	352	209	20	139	19	87	166	66	5	34	1	11	11	10	6
31	605	379	204	22	163	23	89	157	59	5	43	3	9	9	9	5
32	581	351	210	20	115	17	96	165	77	4	43	1	5	12	7	6
33	533	343	182	8	134	19	89	141	62	2	35	1	7	8	7	5
34	553	363	172	18	140	19	99	134	56	4	42	1	8	10	7	2
35	544	356	173	15	150	23	83	129	66	3	32	2	5	7	10	5
36	516	346	155	15	151	19	72	118	57	5	35	3	12	6	6	3
37	502	340	146	16	146	24	71	101	55	0	48	1	8	8	4	6
38	453	306	140	7	140	17	60	109	48	7	37	0	10	5	4	1
39	424	298	114	12	130	9	56	88	62	5	32	2	5	8	3	1
40	438	320	101	17	136	11	87	75	53	5	28	1	5	5	4	1
41	500	374	105	21	171	18	58	67	55	4	54	1	13	8	8	2
42	471	369	91	11	174	11	70	72	60	3	49	1	8	1	2	2
43	455	344	97	14	168	13	63	69	48	7	46	1	8	5	5	0
44	497	392	91	14	197	16	51	65	70	1	42	1	11	5	6	2
45	469	386	64	19	185	7	56	48	73	4	43	4	10	0	7	0
46	455	384	61	10	185	7	43	46	86	3	47	1	9	3	5	1
47	486	395	76	15	184	10	50	52	90	5	46	2	6	4	10	0
48	511	427	74	10	215	10	61	56	87	2	48	2	3	0	3	1
49	564	481	75	8	225	14	64	53	97	5	64	0	9	3	9	0
50	519	434	71	14	236	15	46	43	85	4	43	0	6	4	5	2
51	579	507	57	15	245	12	54	35	110	3	73	0	9	1	6	3
52	560	498	52	10	252	4	57	36	82	4	85	1	3	3	4	1
53	539	473	56	10	248	15	39	34	109	3	50	1	4	2	6	0
54	552	506	39	7	269	15	47	21	107	1	66	0	2	1	5	0
55	509	454	44	11	232	14	39	24	106	1	57	0	3	1	4	1
56	561	508	48	5	285	12	36	31	106	1	66	1	2	1	5	2
57	500	459	35	6	248	4	38	23	93	5	61	0	3	2	4	0
58	508	456	44	8	240	17	28	21	110	3	58	1	4	0	4	1
59	466	432	28	6	227	5	25	17	105	2	62	0	4	1	3	1
60	471	436	23	12	235	8	28	12	108	1	50	1	3	0	4	1
61	439	409	26	4	216	11	26	10	106	2	44	0	2	1	2	2
62	390	363	23	4	196	8	20	12	84	3	43	0	4	0	5	0
63	334	314	14	6	171	4	17	7	76	2	40	0	1	0	2	0
64	385	360	21	4	210	5	20	11	81	1	38	1	4	1	0	1
65	327	308	14	5	185	4	16	3	63	1	29	0	1	1	3	2
66	351	327	20	4	172	9	26	6	77	0	34	0	1	0	1	1
67	361	336	22	3	190	7	12	11	86	1	39	1	3	1	4	1
68	290	270	18	2	143	4	15	10	68	1	29	1	2	0	4	0
69	292	280	10	2	177	2	10	6	64	0	19	1	0	0	2	1
70	325	307	16	2	189	11	4	2	68	1	34	0	1	0	3	1
71	324	310	9	5	166	6	14	1	83	0	36	1	2	1	1	0
72	277	256	14	7	159	6	8	4	59	1	19	0	2	0	0	0
73	259	247	9	3	134	1	15	4	65	0	23	2	2	2	1	0
74	239	227	10	2	124	7	9	1	59	1	25	1	2	0	2	0
75	233	227	6	0	144	4	10	0	48	1	19	0	3	0	1	0
76	182	174	6	2	110	4	7	2	37	0	13	0	0	0	2	0
77	198	190	8	0	116	6	7	2	47	0	12	0	0	0	1	0
78	203	190	10	3	107	3	9	2	49	2	17	2	2	0	1	0
79	204	195	5	4	124	3	4	1	43	0	21	0	0	1	0	0
80	185	177	6	2	96	6	9	0	41	0	25	0	0	0	1	0
81	203	195	7	1	102	2	8	2	54	0	27	1	0	0	0	1
82	171	166	4	1	93	1	7	0	48	1	15	0	0	0	0	0
83	178	171	5	2	89	3	4	0	50	1	27	1	0	0	0	0
84	163	155	6	2	89	2	7	1	34	2	20	0	0	1	2	0
85	145	140	3	2	76	3	3	0	35	0	20	0	4	0	0	0
86	154	150	4	0	92	0	3	1	37	0	15	2	1	0	1	0
87	110	106	3	1	64	2	2	1	24	0	15	0	0	0	0	0
88	121	119	1	1	63	0	2	0	39	0	14	1	0	0	1	0
89	87	85	2	0	47	1	1	1	27	0	8	0	0	0	0	0
90	79	77	2	0	49	0	4	1	16	0	6	1	0	0	0	0
91	58	58	0	0	34	0	1	0	15	0	8	0	0	0	0	0
92	51	51	0	0	31	0	1	0	13	0	4	0	0	0	0	0
93	39	36	2	1	18	0	1	1	12	1	5	0	0	0	0	0
94	23	22	1	0	13	0	0	0	8	1	0	0	0	0	0	0
95	16	16	0	0	7	0	0	0	8	0	1	0	0	0	0	0
96	21	20	1	0	9	1	1	0	7	0	1	0	1	0	0	0
97	11	11	0	0	5	0	1	0	4	0	1	0	0	0	0	0
98	6	6	0	0	4	0	0	0	2	0	0	0	0	0	0	0
99	3	3	0	0	2	0	0	0	0	0	1	0	0	0	0	0
101	2	1	1	0	1	1	0	0	0	0	0	0	0	0	0	0
102	1	1	0	0	0	0	0	0	0	0	1	0	0	0	0	0