Data Cleaning

The below code helps make sense of the data. Some “NA” data was formatted as “.”, so we apply a transformation to make “.” into NA, so they can easily be removed. We also convert some variables to numeric, as when imported into R they come in as character variables.

leadingCauses$Deaths[leadingCauses$Deaths=="."] <- NA
leadingCauses$`Death Rate`[leadingCauses$`Death Rate`=="."] <- NA
leadingCauses$`Age Adjusted Death Rate`[leadingCauses$`Age Adjusted Death Rate`=="."] <- NA
leadingCauses <- na.omit(leadingCauses)


leadingCauses$Deaths <- as.numeric(leadingCauses$Deaths)
leadingCauses$`Death Rate` <- as.numeric(leadingCauses$`Death Rate`)
leadingCauses$`Age Adjusted Death Rate` <- as.numeric(leadingCauses$`Age Adjusted Death Rate`)

Summary Statistics

The below summary and describe show some summary statistics, such as mean/median/range for variables in the dataset.

summary(leadingCauses)

##       Year      Leading Cause          Sex            Race Ethnicity    
##  Min.   :2007   Length:708         Length:708         Length:708        
##  1st Qu.:2008   Class :character   Class :character   Class :character  
##  Median :2010   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :2010                                                           
##  3rd Qu.:2012                                                           
##  Max.   :2014                                                           
##      Deaths         Death Rate     Age Adjusted Death Rate
##  Min.   :  13.0   Min.   :  2.40   Min.   :  2.50         
##  1st Qu.: 107.0   1st Qu.: 11.60   1st Qu.: 12.15         
##  Median : 209.5   Median : 18.35   Median : 20.35         
##  Mean   : 591.5   Mean   : 53.44   Mean   : 53.46         
##  3rd Qu.: 501.2   3rd Qu.: 64.62   3rd Qu.: 77.55         
##  Max.   :7050.0   Max.   :491.40   Max.   :350.70

describe(leadingCauses)

##                         vars   n    mean     sd  median trimmed    mad
## Year                       1 708 2010.48   2.30 2010.00 2010.48   2.97
## Leading Cause*             2 708     NaN     NA      NA     NaN     NA
## Sex*                       3 708     NaN     NA      NA     NaN     NA
## Race Ethnicity*            4 708     NaN     NA      NA     NaN     NA
## Deaths                     5 708  591.47 981.18  209.50  356.16 199.41
## Death Rate                 6 708   53.44  76.52   18.35   35.60  15.05
## Age Adjusted Death Rate    7 708   53.46  69.10   20.35   39.14  17.57
##                            min    max  range skew kurtosis    se
## Year                    2007.0 2014.0    7.0 0.01    -1.25  0.09
## Leading Cause*             Inf   -Inf   -Inf   NA       NA    NA
## Sex*                       Inf   -Inf   -Inf   NA       NA    NA
## Race Ethnicity*            Inf   -Inf   -Inf   NA       NA    NA
## Deaths                    13.0 7050.0 7037.0 3.15    11.71 36.88
## Death Rate                 2.4  491.4  489.0 2.48     6.84  2.88
## Age Adjusted Death Rate    2.5  350.7  348.2 1.81     2.68  2.60

The data show that the # of individuals per ethnicity seems evenly distributed - there are about the same amount per group in the data.

leadingCauses %>%
  group_by(leadingCauses$`Race Ethnicity`) %>%
  summarize(n=n())

## # A tibble: 4 x 2
##   `leadingCauses$\`Race Ethnicity\``     n
##   <chr>                              <int>
## 1 Asian and Pacific Islander           177
## 2 Black Non-Hispanic                   178
## 3 Hispanic                             177
## 4 White Non-Hispanic                   176

The data also has an even number of males and females.

leadingCauses %>%
  group_by(leadingCauses$Sex) %>%
  summarize(n=n())

## # A tibble: 2 x 2
##   `leadingCauses$Sex`     n
##   <chr>               <int>
## 1 F                     354
## 2 M                     354

Visual Analysis

The following interactive bargraph shows the count of deaths by year.

p1 <- ggplot(data = leadingCauses, aes(leadingCauses$Year, leadingCauses$Deaths)) + 
  stat_summary(fun.y = sum,
               geom = "bar", aes(fill = Year))

ggplotly(p1)

The following graph shows the number of deaths broken down by Ethnicity.

p2 <- ggplot(data = leadingCauses, aes(leadingCauses$`Race Ethnicity`, leadingCauses$Deaths)) + 
  stat_summary(fun.y = sum,
               geom = "bar", aes(fill = `Race Ethnicity`)) +
  theme(legend.position="none")

ggplotly(p2)

According to the graph, white non-Hispanic have the most reported deaths; followed by black non-Hispanic.

The following graph shows the leading causes by number of deaths.

p3 <- ggplot(data = leadingCauses, aes(leadingCauses$`Leading Cause`, leadingCauses$Deaths)) + 
  stat_summary(fun.y = sum,
               geom = "bar", aes(fill = `Leading Cause`)) +
  theme(legend.position="none") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())

ggplotly(p3)

The data seems to show that the leading cause of death is those related to the heart.

nums <- unlist(lapply(leadingCauses, is.numeric)) 
nums1 <- leadingCauses[ , nums]
cor(nums1)

##                                 Year       Deaths   Death Rate
## Year                     1.000000000 -0.001807682 -0.003462548
## Deaths                  -0.001807682  1.000000000  0.972060559
## Death Rate              -0.003462548  0.972060559  1.000000000
## Age Adjusted Death Rate -0.028267102  0.826825203  0.919520032
##                         Age Adjusted Death Rate
## Year                                 -0.0282671
## Deaths                                0.8268252
## Death Rate                            0.9195200
## Age Adjusted Death Rate               1.0000000

ANOVA Models

In order to test if there’s a significant difference between the death rate of different ethnicities, we’re going to use an ANOVA test (since there are more than 2 variables we would like to test for.)

\[H_0: \mu_{white} = \mu_{black} = \mu_{asian} = \mu_{hispanic}\]

\[H_a: \mu_{white} \neq \mu_{black} \neq \mu_{asian} \neq \mu_{hispanic} \]

model <- lm(leadingCauses$`Death Rate` ~ leadingCauses$`Race Ethnicity`, leadingCauses)
anova(model)

## Analysis of Variance Table
## 
## Response: leadingCauses$`Death Rate`
##                                 Df  Sum Sq Mean Sq F value    Pr(>F)    
## leadingCauses$`Race Ethnicity`   3  375826  125275  23.428 1.835e-14 ***
## Residuals                      704 3764387    5347                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Since the p-value from our model is less than 0.05, we reject the \(H_0\) and accept the \(H_a\), that there is significant evidence that there is a difference in death rate between different ethnicity.

model <- lm(leadingCauses$`Death Rate` ~ leadingCauses$Sex, leadingCauses)
anova(model)

## Analysis of Variance Table
## 
## Response: leadingCauses$`Death Rate`
##                    Df  Sum Sq Mean Sq F value Pr(>F)
## leadingCauses$Sex   1    2940  2939.8  0.5017  0.479
## Residuals         706 4137273  5860.2

Since the p-value from our model is higher than 0.05, we fail to reject the \(H_0\), that there is not enough significant evidence that there is a difference in death rate between different sexes.