carsaccidentproject.Rmd

Ahmed Mahmoud Hanafy
========================================================


```{r echo=FALSE, message=FALSE, warning=FALSE, packages}
# Load all of the packages that you end up using in your analysis in this code
# chunk.

# Notice that the parameter "echo" was set to FALSE for this code chunk. This
# prevents the code from displaying in the knitted HTML output. You should set
# echo=FALSE for all code chunks in your file, unless it makes sense for your
# report to show the code that generated a particular plot.

# The other parameters for "message" and "warning" should also be set to FALSE
# for other code chunks once you have verified that each plot comes out as you
# want it to. This will clean up the flow of your report.

library(ggplot2)
```

```{r echo=FALSE, Load_the_Data}
# Load the Data
df<-read.csv('C:\\Users\\MasterO\\carsaccidents\\nassCDS.csv')
#the data is found in that link 
#https://vincentarelbundock.github.io/Rdatasets/csv/DAAG/nassCDS.csv
#this is a Documentation taht could de found in the coming link
#https://vincentarelbundock.github.io/Rdatasets/doc/DAAG/nassCDS.html
#nassCDS	R Documentation
#Airbag and other influences on accident fatalities
#Description
#US data, for 1997-2002, from police-reported car crashes in which there is a 
#harmful event (people or property), and from which at least one vehicle was 
#towed. Data are restricted to front-seat occupants, include only a subset of 
#the variables recorded, and are restricted in other ways also.

#Usage
#nassCDS
#Format
#A data frame with 26217 observations on the following 15 variables.

#dvcat
#ordered factor with levels (estimated impact speeds):
#      1-9km/h, 10-24, 25-39, 40-54, 55+

#weight
#Observation weights, albeit of uncertain accuracy, designed to account for 
#varying sampling probabilities.

#dead
#factor with levels alive dead

#airbag
#a factor with levels none airbag

#seatbelt
#a factor with levels none belted

#frontal
#a numeric vector; 0 = non-frontal, 1=frontal impact

#sex
#a factor with levels f m

#ageOFocc
#age of occupant in years

#yearacc
#year of accident

#yearVeh
#Year of model of vehicle; a numeric vector

#abcat
#Did one or more (driver or passenger) airbag(s) deploy? This factor has levels 
#deploy nodeploy unavail

#occRole
#a factor with levels driver pass

#deploy
#a numeric vector: 0 if an airbag was unavailable or did not deploy; 1 if one or
#more bags deployed.

#injSeverity
#a numeric vector; 0:none, 1:possible injury, 2:no incapacity, 3:incapacity,
#                  4:killed; 5:unknown, 6:prior death

#caseid
#character, created by pasting together the populations sampling unit, the 
#case number, and the vehicle number. Within each year, use this to uniquely 
#identify the vehicle.

#Details
#Data collection used a multi-stage probabilistic sampling scheme. The
#observation weight, called national inflation factor (national) in the data 
#from NASS, is the inverse of an estimate of the selection probability. These 
#data include a subset of the variables from the NASS dataset. Variables that 
#are coded here as factors are coded as numeric values in that dataset.

#Source
#http://www.stat.colostate.edu/~meyer/airbags.htm\ ftp://ftp.nhtsa.dot.gov/nass/

#See also\ http://www.maths.anu.edu.au/~johnm/datasets/airbags

#References
#Meyer, M.C. and Finney, T. (2005): Who wants airbags?. Chance 18:3-16.

#Farmer, C.H. 2006. Another look at Meyer and Finney's ‘Who wants airbags?’
#. Chance 19:15-22.

#Meyer, M.C. 2006. Commentary on "Another look at Meyer and Finney's 
#‘Who wants airbags?’. Chance 19:23-24.

#For analyses based on the alternative FARS (Fatal Accident Recording System) 
#data, and associated commentary, see:

#Cummings, P; McKnight, B, 2010. Accounting for vehicle, crash, and occupant 
#characteristics in traffic crash studies. Injury Prevention 16: 363-366. 
#[The relatively definitive analyses in this paper use a matched cohort design,

#Olson, CM; Cummings, P, Rivara, FP, 2006. Association of first- and 
#second-generation air bags with front occupant death in car crashes: a matched 
#cohort study. Am J Epidemiol 164:161-169. [The relatively definitive analyses 
#in this paper use a matched cohort design, using data taken from the FARS 
#(Fatal Accident Recording System) database.]

#Braver, ER; Shardell, M; Teoh, ER, 2010. How have changes in air bag designs 
#affected frontal crash mortality? Ann Epidemiol 20:499-510.

#The web page http://www-fars.nhtsa.dot.gov/Main/index.aspx has a menu-based 
#interface into the FARS (Fatality Analysis Recording System) data. The FARS 
#database aims to include every accident in which there was at least one fatality.

#Examples
#data(nassCDS)
#xtabs(weight ~ dead + airbag, data=nassCDS)
#xtabs(weight ~ dead + airbag + seatbelt + dvcat, data=nassCDS)
#tab <- xtabs(weight ~ dead + abcat, data=nassCDS,
#            subset=dvcat=="25-39"&frontal==0)[, c(3,1,2)]
#round(tab[2, ]/apply(tab,2,sum)*100,2)
```

```{r echo=FALSE, message=FALSE, warning=FALSE, some_modifications}
# i would like to add a dummy variable of death to make it easy getting death 
#rate by categories
df$death <- as.numeric(df$dead ==  'dead')
#adding a factor for injuries
df$injdegree <- cut(df$injSeverity,breaks = c(-1,0,1,2,3,4,5,6),
                    labels = c('none','possible injury','no incapacity',
                               'incapacity','killed','unknown','prior death'))
#adding a factor for direction of impact
df$direction <-  cut(df$frontal,breaks = c(-1,0,1),
                     labels = c('non-frontal', 'frontal impact'))
#adding a dummy variable for seatbelt
df$belted <- as.numeric(df$seatbelt == 'belted')

```

# introduction about the data:
the data is about Airbag and other influences on car accident fatalities and 
injuries like weather the impact was frontal or not the seatbelt was belted or 
not and the speed of the impact among others 

# operations performed on the data 
- creating a dummy variable for death making it easy to get rate of death
- adding factor variable for direction of impact easier to deal with than
 frontal int variable in the data
- adding factor variable for injury degree easier to deal with than injseverity
 int variable in the data
- adding a dummy variable for seatbelt

# Univariate Plots Section


## estimated impact speeds distribution

```{r echo=FALSE, message=FALSE, warning=FALSE, Univariate_Plots}
#ploting a histogram for spead
ggplot(data = df , aes(dvcat))+
  geom_histogram(stat = 'count')
```
```{r echo=FALSE, message=FALSE, warning=FALSE}
#speed summary
summary(df$dvcat)
```

sound strange the most accidents occurred in the range 10-24 and the faster
above it the less accidents

## gender count 

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a bar chart for sex
ggplot(data = df , aes(sex))+
  geom_histogram(stat = 'count')
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#sex summary
summary(df$sex)
```

sound that males have more accidents than females

## age distribution

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a histogram for age
ggplot(data = df , aes(ageOFocc))+
  geom_histogram(binwidth = 1)+
  scale_x_continuous(breaks = seq(16,97,2))+
  theme(axis.text.x = element_text(angle = 45))
```

sound that the older the less accidents with the peak between 16 and 24 

## year of car model

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a histogram for year of car model
ggplot(data = df , aes(yearVeh))+
  geom_histogram(binwidth = 1)+
  scale_x_continuous(breaks = seq(1950,2005,5))
```

as the data is for years between 1997 and 2002 it is normal to see more models
near that period not very old 

## injury degree count

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a bar chart for injuries count except for nulls and prior death
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                         "incapacity","killed")) ,
       aes(injdegree))+
  geom_histogram(stat = 'count')
```
```{r echo=FALSE, message=FALSE, warning=FALSE}
#injdegree summary
summary(df$injdegree)
```

incapacity injury is the mood after it come none injury then possible injury 
then no incapacity injuries and the least is killed


# Univariate Analysis

### the structure of the dataset

- the data consists of 20 variables and 26217 observations

### the distributions of some variables

- the most accidents occurred in the range 10-24 and the fasterabove it the less 
- males have more accidents than females
- the older the less accidents with the peak between 16 and 24
- the data is for years between 1997 and 2002 it is normal to see more models
 near that period not very old
- incapacity injury is the mood after it come none injury then possible injury 
 then no incapacity injuries and the least is killed

### to do next

looking at those factors and airbag and there effect on injuries and death
 

# Bivariate Plots Section


## death rate by speed

```{r echo=FALSE, message=FALSE, warning=FALSE, Bivariate_Plots}
#ploting speed by death rate by taking death mean as the default
ggplot(data = df ,aes(dvcat,death))+
  geom_bar(stat = 'summary')
```

sound that the higher the speed the higher the death rate

## injury by speed

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a scatter of speed by injuries except for nulls and prior death 
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                        "incapacity","killed")) ,
       aes(dvcat,injdegree))+
  geom_point(position = 'jitter',alpha = .1)
```

sound that the higher the speed the worse the injury

## death rate by airbag catigory

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting airbag catigory by death rate by taking death mean as the default
ggplot(data = df ,aes(abcat,death))+
  geom_bar(stat = 'summary')
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting airbag by death rate by taking death mean as the default
ggplot(data = df ,aes(airbag,death))+
  geom_bar(stat = 'summary')
```
```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting whether airbag was deployed or not by death rate by taking death mean
#as the default
ggplot(data = df ,aes(deploy,death))+
  geom_bar(stat = 'summary')
```

sound that airbags are doing there job as death rate is lower with airbags

## death rate by seatbelt

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting seatbelt by death rate by taking death mean as the default
ggplot(data = df ,aes(seatbelt,death))+
  geom_bar(stat = 'summary')+
  scale_y_continuous(breaks = seq(0,.1,.01))
```

sound that seatbelts are doing there job better than airbags as death rate is
lower with belted seatbelts

## gender by death rate and seatbelt using

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting sex by death rate by taking death mean as the default
ggplot(data = df ,aes(sex,death))+
  geom_bar(stat = 'summary')
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#finding the rate of death for each sex
by(df$death,df$sex,mean)
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting sex by the rate of belting seat belt
ggplot(data = df ,aes(sex,belted))+
  geom_bar(stat = 'summary')
```

males have higher death rate and males use seatbelt less

## death rate by age

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting age by death rate by taking death mean as the default
ggplot(data = df ,aes(ageOFocc,death))+
  geom_bar(stat = 'summary')
```

looks like the higher the age the higher death rate

## death rate by model year

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting year of model of the car by death rate by taking death mean as the 
#default
ggplot(data = df ,aes(yearVeh,death))+
  geom_bar(stat = 'summary')
```

death rate for modern car are less than old ones in general

## drivers compared to passenger death rate and seatbelt using

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting whether driver or passenger by death rate by taking death mean as the 
#default
ggplot(data = df ,aes(occRole,death))+
  geom_bar(stat = 'summary')
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting whether driver or passenger by seatbelt belting rate 
ggplot(data = df ,aes(occRole,belted))+
  geom_bar(stat = 'summary')
```

death rate for passenger is higher than drivers and they use seatbelt less too

## direction of impact by death rate

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting direction of impact by death rate by taking death mean as the default
ggplot(data = df ,aes(direction,death))+
  geom_bar(stat = 'summary')
```

frontal impact has less death rate

## injury by airbag

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a scatter plot for airbag by injuries except nulls and prior death
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                        "incapacity","killed")) ,
       aes(airbag,injdegree))+
  geom_point(position = 'jitter',alpha = .1)
```

not very clear

# Bivariate Analysis

- the higher the speed the higher the death rate
- the higher the speed the worse the injury
- airbags are doing there job
- seatbelts are doing there job better than airbags
- males have higher death rate and males use seatbelt less
- the higher the age the higher death rate
- death rate for modern car are less than old ones in general
- death rate for passenger is higher than drivers and they use seatbelt less too
- frontal impact has less death rate than non-frontal ones


# Multivariate Plots Section


## death rate by airbag catigory faceted by speed

```{r echo=FALSE, message=FALSE, warning=FALSE, Multivariate_Plots}
#a bar plot for airbag by death rate faceted by speed
ggplot(data = df ,aes(airbag,death))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat,nrow = 1)
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#a bar plot for deploy by death rate faceted by speed
ggplot(data = df ,aes(deploy,death))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat,nrow = 1)
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#a bar plot for airbag category by death rate faceted by speed
ggplot(data = df ,aes(abcat,death))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat,nrow = 1)+
  theme(axis.text.x = element_text(angle = 45))
  
```

there is a problem with airbags at low spead and the death rate is higher

## airbag by count faceted by injury

```{r echo=FALSE, message=FALSE, warning=FALSE}
#a histogram for airbag faceted by injdegree
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                         "incapacity","killed")) ,
       aes(airbag))+
  geom_histogram(stat = 'count')+
  facet_wrap(.~injdegree,nrow = 1)
```

very interesting more injuries happen with airbags than without them but death
is more with out them

## injury by speed faceted by airbag

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a scatter of speed by injuries except for nulls and prior death 
#facetted by airbag category
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                        "incapacity","killed")) ,
       aes(dvcat,injdegree))+
  geom_point(position = 'jitter',alpha = .1)+
  facet_wrap(.~abcat)
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
#ploting a scatter of speed by injuries except for nulls and prior death colored
#by airbag category
ggplot(data =subset(df,injdegree %in%c("none","possible injury","no incapacity",
                                        "incapacity","killed")) ,
       aes(dvcat,injdegree))+
  geom_point(position = 'jitter',alpha = .1,aes(color = abcat))
```

it seems that airbags are working in general

## death rate by seatbelt faceted by speed

```{r echo=FALSE, message=FALSE, warning=FALSE}
#a bar plot for seatbelt by death rate faceted by speed
ggplot(data = df ,aes(seatbelt,death))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat ,nrow = 1)
```

it seems that seatbelts are doing well across all speeds

# Multivariate Analysis

- there is a problem with airbags at low spead and the death rate is higher
- it seems that airbags are working in general
- it seems that seatbelts are doing well across all speeds
- the effect of seatbelt on fatality rate looks larger than airbags in general
- very interesting more injuries happen with airbags than without them but death
 is more with out them
 
------

# Final Plots and Summary

### Plot One

```{r echo=FALSE, message=FALSE, warning=FALSE, Plot_One}
# a histogram for speed
ggplot(data = df , aes(dvcat))+
  geom_histogram(stat = 'count',color = 'blue', fill = 'dodgerblue4')+
  ggtitle('estimated impact speeds count')+
  xlab('estimated impact speed')+
  scale_y_continuous(breaks = seq(0,13000,1000))
```

### Description One

sound strange the most accidents occurred in the range 10-24 and the faster
above it the less accidents 

### Plot Two

```{r echo=FALSE, message=FALSE, warning=FALSE, Plot_Two}
#a bar plot for airbag by death rate faceted by speed
ggplot(data = df ,aes(airbag,death ,fill = airbag))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat,nrow = 1)+
  ggtitle('death rate by airbag faceted by speed')+
  ylab('death rate')+
  scale_y_continuous(breaks = seq(0,.3,.02))
```

### Description Two

- it seems that death rate is lower in presence of airbags except for low speed
 impact which sound strange
- it is clear that although more accidents occure at low speed the death rate
 for high speed is higher
 
### Plot Three

```{r echo=FALSE, message=FALSE, warning=FALSE, Plot_Three}
#a bar plot for seatbelt by death rate faceted by speed
ggplot(data = df ,aes(seatbelt,death , color = seatbelt , fill = seatbelt))+
  geom_bar(stat = 'summary')+
  facet_wrap(.~dvcat ,nrow = 1)+
  ggtitle('death rate by seatbelt faceted by speed')+
  ylab('death rate')+
  scale_y_continuous(breaks = seq(0,.35,.02))
```

### Description Three

it seems that death rate is well lower when seatbelts are belted

------

# Reflection

- the data set was good easy to work with
- there is not enough quantitative variables to work with
- death rate at low speed was strange as it was higher in presence of airbag
 and that need more investigation
- more work could be done on injuries and its degrees may be by extracting 
 dummy from it and see its rates related to other factors
- making dummy variables made it easy to compare rates
- the shortage in quantitative variable make it hard to make scatterblot
- because the is alot of catigorical variable the bar blot is the best to use