Global_Suicide_Trends_And_Analysis.Rmd

---
title: "Global Suicide Analysis"
author: " By Siddharth Sudhakar"
date: "May 6, 2020"
output:
  html_document:
    code_folding: hide
    css: style1.css
    highlight: monochrome
    theme: cosmo
    toc: yes
    toc_depth: 4
    toc_float: no
  pdf_document:
    toc: yes
    toc_depth: '4'
---
# <b>Introduction</b>
The main dataset for our project is a combined from several datasets made by *United Nations Development Program*, *World Bank*, *Kaggle*, and *World Health Organization*. The dataset can be found [here](https://www.kaggle.com/russellyates88/suicide-rates-overview-1985-to-2016).The dataset has records from 1985 to 2016. However, since there is very few data in 2016, we will only keep the range from 1985 to 2015.The dataset has **27820 observations** and **10 features**. Features we are interested in include : <br>
  Features <br>
  Country <br>
  Year : from 1985 to 2015 <br>
  Sex <br>
  Age : Age groups including “5-14”, “15-24”, “25-34”, “35-54”, “55-74”, and “75+”. <br>
  Suicides_no : Number of suicides <br>
  Population <br>
  GDP_per_capita:ratio between the country's GDP and its population <br>
  Continent <br>
Apart from those, we will create another variable called **suicides_per_100k** which is obtained by dividing **Suicides_no** by **population**


```{r global_options, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE)
```

```{r echo = FALSE}
library(tidyverse)
library(countrycode)
library(gridExtra)
library(forcats)
library(extrafont)
library(corrplot)
library(rworldmap)
library(msm)
library(broom)
library(RColorBrewer)


df <- read_csv("master.csv")
df <- df %>%
#select(-c("HDI for year","suicides/100k pop")) %>%
rename(country_year = "country-year",
       gdp_for_year = "gdp_for_year ($)",
       gdp_per_capita = "gdp_per_capita ($)"
       ) %>%
as.data.frame()
  
df <- df%>%
  filter(year != 2016) %>%
  select(-country_year)

df$age <- gsub(" years", "", df$age)
df$sex <- ifelse(df$sex == "male","Male","Female")

# Adding continent to data:
df$continent <- countrycode(sourcevar = df[, "country"],
                              origin = "country.name",
                              destination = "continent")

# Making age ordinal
df$age <- factor(df$age, 
                   ordered = T, 
                   levels = c("5-14",
                              "15-24", 
                              "25-34", 
                              "35-54", 
                              "55-74", 
                              "75+"))


  theme_func <- function() {
  theme_minimal() +
  theme(
    text = element_text(family = "serif", color = "gray25"),
    plot.subtitle = element_text(size = 12,hjust = 0.5,color = "gray45"),
    plot.caption = element_text(color = "gray30"),
    plot.background = element_rect(fill = "gray95"),
    plot.margin = unit(c(5, 10, 5, 10), units = "mm"),
    plot.title = element_text(hjust = 0.5),
    strip.text = element_text(color = "white")
  )
}
```

# <b>Exploratory Data Analysis</b>
## <b>Country</b>
There are on average, **74.4** countries in the dataset across each year. Graph below shows the distribution of countries from **1995** to **2015**, Although the number of countries before 1995 is quite less,after that the amount of countries for each year is stable around **80**.


```{r fig.align = "center", echo = FALSE}
df %>%
  group_by(year,country) %>%
  summarise(countries = unique(country))%>%
  summarise(count = n()) %>%
  ggplot(aes(x = year,y = count)) +
  geom_bar(stat = "identity")+
  geom_text(aes(label=count),vjust = -0.3) +
  theme_func()+
      theme( 
        panel.grid = element_blank()
) +
      scale_x_continuous(breaks = seq(1985, 2015, 2)) +
      labs(
    x = "year",
    y = "count",
    subtitle = "1985-2015",
    title = "Distribution of number of countries over the years in the database ",
    caption = "Data source: Kaggle"
  ) 
  

```

## <b>Global Trend of Suicides Per 100K</b>
We plot the estimated total suicides per 100k population across all countries throughout the time. As we can see,the number of suicides reaches its peak in the year **1995** with **243544** cases.But in recent years, the estimated suicides are **decreasing**.


```{r fig.align = "center" ,echo = FALSE}
global_average <- (sum(as.numeric(df$suicides_no)) / sum(as.numeric(df$population)))*100000 


df %>%
  group_by(year) %>%
  summarise(total_pop = sum(population),
            total_suicides = sum(suicides_no),
            suicides_per_100k = (total_suicides/total_pop) * 100000)%>%

  ggplot(aes(x = year, y = suicides_per_100k)) +
  geom_line(size = 1) +
  geom_point(size = 2) +
  geom_hline(yintercept = global_average,linetype = 2) +
  scale_x_continuous(breaks = seq(1985, 2015, 2))  +
  theme_func() +
  theme(
    panel.grid = element_blank()
  ) + 

      labs(
    y = "Suicides per 100k",
    x = "Year",
    title = "Worldwide Suicides by year",
    subtitle = "1985-2015",
    caption = "Data source: kaggle"
      )

```


## <b>Global Trend of Suicides over time, by Sex</b>
Globally, the rate of suicide has been **~3.5 times** higher for men.And this trend has remained constant since mid 90s.The male and female suicide rates peaked in the year 1995.

```{r fig.height = 6, fig.align = "center", echo = FALSE}



sex_plot <- df %>%
  group_by(sex) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
ggplot(aes(x = sex, y = suicide_per_100k, fill = sex)) + 
  geom_col() + 
  labs(title = "Global suicides by Sex",
       x = "Sex", 
       y = "Suicides per 100k",
       color = "Sex") +theme_func() +
  theme(plot.title = element_text(hjust = 0.5)) 

 sex_time_plot <- df %>%
  group_by(year, sex) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  ggplot(aes(x = year, y = suicide_per_100k, col = factor(sex))) + 
  facet_grid(sex ~ ., scales ="free_y") + 
  geom_line() + 
  geom_point() +

  labs(title = "Trends Over Time, by Sex",
       subtitle = "1985-2015",
       x = "Year", 
       y = "Suicides per 100k", 
       color = "Sex",caption = "Data source: kaggle") +theme_func() 

grid.arrange(sex_plot,sex_time_plot,ncol = 2) 
```

## <b>Suicides by Continent,Age and Sex</b>
The ratio between male and female have *remained constant* in all Continents, Age groups and sex.It is also found that the likelihood of suicide rates **increases** with age. This trend is also true across all continents and sex. 

```{r fig.height = 8, fig.align = "center", echo = FALSE}
continent_sex_plot <-  df %>%
  group_by(continent,sex) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  arrange(suicide_per_100k) %>%

 ggplot(aes(x = reorder(continent,suicide_per_100k), y = suicide_per_100k, fill = sex)) + 
  geom_bar(position = "dodge",alpha = 0.6,stat = 'Identity') + 
       geom_hline(yintercept = global_average,linetype = 2)+
    scale_y_continuous(limits = c(0, 50,10)) +
    labs(
    x = "Continent",
    y = "Suicides per 100k",
    col = "Sex",
    title = "Suicides by Continent and Age",
    subtitle = "1985-2015"
      )+  
theme_func() +
    theme(plot.title = element_text(hjust = 0.5)) 

age_sex_plot <-  df %>%
  group_by(age,sex) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  arrange(suicide_per_100k) %>%

 ggplot(aes(x = reorder(age,suicide_per_100k), y = suicide_per_100k, fill = sex)) + 
  geom_bar(position = "dodge",alpha = 0.6,stat = 'Identity') + 
       geom_hline(yintercept = global_average,linetype = 2)+
    scale_y_continuous(limits = c(0, 50,10)) +
    labs(
    x = "Age",
    y = "Suicides per 100k",
    col = "Sex",
    title = "Suicides by Sex and Age",
    subtitle = "1985-2015",
    caption = "Data source: kaggle"
      )+  
  theme_func()+
  theme(plot.title = element_text(hjust = 0.5)) 

grid.arrange(continent_sex_plot,age_sex_plot,nrow=2)
```

In the Continent of Oceania there is higher number of suicides in people aged between **15-24 and 25-34**.wheras in other Continents the suicide rates are more between age groups of **55-74 and 75+**.

```{r fig.align = "center", echo = FALSE}

 df %>%
  group_by(age,continent) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  arrange(suicide_per_100k) %>%

 ggplot(aes(x = reorder(continent,suicide_per_100k), y = suicide_per_100k, fill = age)) +   geom_hline(yintercept = global_average,linetype = 2)+
  geom_bar(stat = 'Identity',position = "dodge") + 
    labs(
    x = "Continents",
    y = "Suicides per 100k",
    fill = "Age",
    title = "Suicides by Continent and Age",
    subtitle = "1985-2015",
    caption = "Data source: kaggle"
      )+  
theme_func() +
  theme(
    panel.grid = element_blank()
  )


```

## <b>Global Trend of Suicides over time, by Continent and Age</b>
As can be seen from the plots below,the rate of suicides is *decreasing in Asia and Europe* but *decreasing in America and Oceania*.Since 1995, suicide rate is *relatively constant in the African continent*.

After the year 1995 which saw the highest number of cases,the suicide rates have been steadily decreasing across all age groups with an exception of age group between 5-14 where the rate is nearly constant.

```{r fig.height = 7, fig.align = "center", echo = FALSE}
continent_time <- df %>%
  group_by(year, continent) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) 

continent_time_plot <- ggplot(continent_time, aes(x = year, y = suicide_per_100k, col = factor(continent))) + 
  facet_grid(continent ~ ., scales = "free_y") + 
  geom_line() + 
  geom_point() + 
    theme(
    text = element_text(family = "serif", color = "gray25"),
    plot.subtitle = element_text(size = 12),
    plot.caption = element_text(color = "gray30"),
    plot.background = element_rect(fill = "gray95"),
    plot.margin = unit(c(5, 10, 5, 10), units = "mm"),
   legend.position = "none") +
  labs(title = "Trends Over Time, by Continent", 
       x = "Year", 
       y = "Suicides per 100k", 
       color = "Continent") +
  scale_x_continuous(breaks = seq(1985, 2015, 5), minor_breaks = F) 

age_time <- df %>%
  group_by(year, age) %>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  ggplot(aes(x = year, y = suicide_per_100k, col = age)) + 
  facet_grid(age ~ ., scales = "free_y") + 
  geom_line() + 
  geom_point() + 
  theme(
    text = element_text(family = "serif", color = "gray25"),
    plot.subtitle = element_text(size = 12),
    plot.caption = element_text(color = "gray30"),
    plot.background = element_rect(fill = "gray95"),
    plot.margin = unit(c(5, 10, 5, 10), units = "mm"),
    legend.position = "none") +
  labs(title = "Trends Over Time, by Age", 
       x = "Year", 
       y = "Suicides per 100k", 
       color = "age") +
    scale_x_continuous(breaks = seq(1985, 2015, 5), minor_breaks = F)

grid.arrange(continent_time_plot,age_time,ncol=2)
```

## <b>Countries with most suicides across the years</b>
*Lithuania's* number has been the highest with around **41 suicides per 100k** population,followed by *Russian Federation and Sri Lanka*.There is a large over representation of European countries with high suicide rates.

```{r fig.height = 8, fig.align = "center", echo = FALSE}
country <- df %>%
  group_by(country,continent) %>%
  summarize(n = n(),suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000) %>%
  arrange(desc(suicide_per_100k)) %>%
  head(40)

ggplot(country, aes(x = suicide_per_100k, y = reorder(country,suicide_per_100k), fill = continent))  + 
  geom_bar(stat = "identity")+
  geom_vline(xintercept = global_average, linetype = 2, color = "grey35", size = 1) +
theme_func()+
      labs(
    x = "Working hours per week",
    y = "Country",
    fill = "Age",
    title = "Top 40 Countries by Suicides",
    caption = "Data source: kaggle"
      )  


```

## <b>Change in the Rate of Suicide Across Continents </b>
Here we are interested in finding the change in suicide rates in the year 1995 and 2014.The reason for selecting these two years is to have large representation of countries across continents.We also ignore few countries that have almost no change in the suicide rates between the year 1995 and 2014.

```{r echo = FALSE }
t <- df%>%
  group_by(country,year,continent) %>%
  filter(year == "2014") %>%
       summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000)

u <- df%>%
  group_by(country,year,continent) %>%
  filter(year == "1995")%>%
  summarize(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000)

countries <- t$country
u <- u %>%
  filter(country %in% countries )

countries1 <- u$country
t <- t %>%
  filter(country %in% countries1 )


m <- rbind(u, t)


m <- as.data.frame(m)
m <- m %>%
  arrange(desc(country))

```

### <b>Europe</b>
It is observed that there is a huge **decrease** in the suicide rates in most of the  European countries compared to countries of other continents.**Portugal**, **United Kingdom** and **Malta** are the few countries with increase in Suicide rates in Europe.**Estonia** is the country with considerable decrease by almost **125%**,followed by **Russian Federation and Latvia** with **121%** and **113%** respectively.

```{r fig.height = 10, fig.align = "center", echo = FALSE,fig.width=15}
#library(extrafont)
#font_import()
#loadfonts(device = "win")


 m %>%filter(continent %in% c("Europe")) %>%
 filter(!(country %in% c("Netherlands","Japan","Thailand","Kuwait","Iceland","Ireland","Poland","Spain","Romania","Greece"))) %>%
  ggplot() +
  geom_path(aes(x =suicide_per_100k,y = reorder(country,suicide_per_100k)),arrow = arrow(length = unit(1.5, "mm"), type = "closed")) +

      geom_text(
          aes(x = suicide_per_100k,
              y = country,
              label = round(suicide_per_100k, 1),
              hjust = ifelse(year == "2015", 20,0 ),
              vjust = 1,
            ),
          # Change the appearance of the text
          size = 4,
          )   +
  #    scale_x_continuous(breaks = seq(0, 30, 5), minor_breaks = F) +
    labs(
    x = "Suicides per 100k",
    y = "Country",
    subtitle = "in the year 1995 and 2014",
    title = "Change in the rate of suicides in European countries"
  #  caption = "Data source: ILO, 2017"
  ) +theme_func() +theme(
    panel.grid = element_blank(),
    text = element_text(size=20)
  )

```

### <b>Asia and Africa</b>
**Republic of Korea,Japan,Georgia and Qatar** are the countries with an *increase* in suicide rates.**Republic of Korea** particularly catches the eye with *highest increase* among all the countries,as suicide rate has increased by **147%**.

```{r fig.align = "center", echo = FALSE}
#library(extrafont)
#font_import()
#loadfonts(device = "win")


 m %>%filter(continent %in% c("Asia","Africa")) %>%
  filter(!(country %in% c("Uzbekistan","Kuwait"))) %>%
  ggplot() +
  geom_path(aes(x =suicide_per_100k,y = reorder(country,suicide_per_100k)),arrow = arrow(length = unit(1.5, "mm"), type = "closed")) +

      geom_text(
          aes(x = suicide_per_100k,
              y = country,
              label = round(suicide_per_100k, 1),
              hjust = ifelse(year == "2015", 20,0 ),
              vjust = 1,
            ),
          # Change the appearance of the text
          size = 3,
          )   +
      scale_x_continuous(breaks = seq(0, 30, 5), minor_breaks = F) +
    labs(
    x = "Suicides per 100k",
    y = "Country",
    subtitle = "in the year 1995 and 2014",
    title = "Change in the rate of suicides in Asian and African countries",
    caption = "Data source: Kaggle"
  ) +theme_func() +theme(
    panel.grid = element_blank()
  )

```

### <b>Americas</b>
 Americas is a peculiar case with more than *two thirds* of the countries have an *increase* in the suicide rates,which is not the trend followed by countries of other continents.**Suriname** has the highest increase with **82.2%** and **Cuba** has the **steepest decrease of 64.4%**.
 
```{r fig.align = "center", echo = FALSE}
 m %>%filter(continent %in% c("Americas")) %>%
  filter(!(country %in% c("Belize","Costa Rica","Antigua and Barbuda","Saint Lucia","Ecuador" ))) %>%
  ggplot() +
  geom_path(aes(x =suicide_per_100k,y = reorder(country,suicide_per_100k)),arrow = arrow(length = unit(1.5, "mm"), type = "closed")) +

      geom_text(
          aes(x = suicide_per_100k,
              y = country,
              label = round(suicide_per_100k, 1),
              hjust = ifelse(year == "2015", 20,0 ),
              vjust = 1.2,
            ),
          # Change the appearance of the text
          size = 3,
          color = "gray25"
          )   +
    labs(
    x = "Suicides per 100k",
    y = "Country",
    subtitle = "in the year 1995 and 2014",
    title = "Change in the rate of suicides in American countries",
    caption = "Data source: kaggle"
  ) +theme_func() +theme(
    panel.grid = element_blank()
  )
```

## <b>Correlation betweem Suicide Rate and Country's GDP</b>
As observed from the graph below, There is weak *positive linear relationship* between suicide rates and Country's GDP.That is richer countries are associated to higher rates of suicide.

```{r fig.align = "center", echo = FALSE, message = FALSE, warning = FALSE}
country_mean_gdp <- df %>%
  group_by(country,continent) %>%
  mutate(suicide_per_100k = (sum(as.numeric(suicides_no)) / sum(as.numeric(population))) * 100000, 
            gdp_per_capita = mean(gdp_per_capita))

ggplot(country_mean_gdp, aes(x = gdp_per_capita, y = suicide_per_100k)) + 
  geom_point(alpha = 0.4) + 
    geom_smooth(method = "lm",se = TRUE,na.rm = FALSE)+
  labs(title = "Correlation between GDP (per capita) and Suicides per 100k", 
       x = "GDP (per capita)", 
       y = "Suicides per 100k", 
       col = "Continent") +
    theme_func()
```

## <b>Suicides and GDP (per capita) by Continent</b>
 The points to do top left and bottom right are exceptional cases(outliers), but heavily influence the regression line, hence will be removed.

```{r fig.align = "center", echo = FALSE, message = FALSE, warning = FALSE}
## https://www.kaggle.com/lmorgan95/r-suicide-rates-in-depth-stats-insights
model1 <- lm(suicide_per_100k ~ gdp_per_capita, data = country_mean_gdp)

gdp_suicide_no_outliers <- model1 %>%
  augment() %>%
  arrange(desc(.cooksd)) %>%
  filter(.cooksd < 4/nrow(.)) %>% # removes 5/93 countries
  inner_join(country_mean_gdp, by = c("suicide_per_100k", "gdp_per_capita")) %>%
  select(country, continent, gdp_per_capita, suicide_per_100k)

model2 <- lm(suicide_per_100k ~ gdp_per_capita, data = gdp_suicide_no_outliers)

summary(model2)


ggplot(gdp_suicide_no_outliers, aes(x = gdp_per_capita, y = suicide_per_100k, col = continent)) + 
  geom_point() + 
  geom_smooth(method = "lm", aes(group = 1)) + 

  labs(title = "Correlation between GDP (per capita) and Suicides", 
       x = "GDP (per capita)", 
       y = "Suicides per 100k", 
       col = "Continent") +theme_func()
```

Now we can see the clear positive linear relation between GDP and Suicide rates.