Guiding question: Between 2000 and 2021, which countries and regions made the most progress in reducing deaths before the age of 70 from Chronic Disease?

Data Source: I am using the World Bank data on “Mortality from CVD, cancer, diabetes or CRD between exact ages 30 and 70 (%)”. It shows the percentage of a 30 year old dying before the age of 70 from heart disease, cancer, diabetes, or chronic lung disease. The lower the percentage, the better the chance.

Load required libraries and import data

library(readr)
library(dplyr)
library(ggplot2)

# Import the data, but skip the first four rows
wb_data <- read_csv("mortality.csv", skip = 4)

# Import the meta data file, will use this file to filter out groups and countries
meta_data <- read_csv("mortality_metadata.csv")

View the data

# Find the number of rows and columns
dim(wb_data)
## [1] 265  71
# Find the column names
colnames(wb_data)
##  [1] "Country Name"   "Country Code"   "Indicator Name" "Indicator Code"
##  [5] "1960"           "1961"           "1962"           "1963"          
##  [9] "1964"           "1965"           "1966"           "1967"          
## [13] "1968"           "1969"           "1970"           "1971"          
## [17] "1972"           "1973"           "1974"           "1975"          
## [21] "1976"           "1977"           "1978"           "1979"          
## [25] "1980"           "1981"           "1982"           "1983"          
## [29] "1984"           "1985"           "1986"           "1987"          
## [33] "1988"           "1989"           "1990"           "1991"          
## [37] "1992"           "1993"           "1994"           "1995"          
## [41] "1996"           "1997"           "1998"           "1999"          
## [45] "2000"           "2001"           "2002"           "2003"          
## [49] "2004"           "2005"           "2006"           "2007"          
## [53] "2008"           "2009"           "2010"           "2011"          
## [57] "2012"           "2013"           "2014"           "2015"          
## [61] "2016"           "2017"           "2018"           "2019"          
## [65] "2020"           "2021"           "2022"           "2023"          
## [69] "2024"           "2025"           "...71"

Clean the data

# Using the meta data file, pull out the list of actual countries
countries <- subset(meta_data, !is.na(Region))

# Using the subset above only keep the countries only for mortality data set
wb_data <- subset(wb_data, `Country Code` %in% countries$`Country Code`)

# Only keep relevant columns 
wb_data <- subset(wb_data, select = c(`Country Name`, `Country Code`, `2000`:`2021`))

# Using the region information from meta data file, add the country's region
wb_data <- left_join(wb_data, subset(countries, select = c(`Country Code`, Region)), by = "Country Code")

wb_data
## # A tibble: 217 × 25
##    `Country Name`       `Country Code` `2000` `2001` `2002` `2003` `2004` `2005`
##    <chr>                <chr>           <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 Aruba                ABW              NA     NA     NA     NA     NA     NA  
##  2 Afghanistan          AFG              43.2   43.5   43.1   42.5   42.3   41.9
##  3 Angola               AGO              30.5   29.7   29.4   29.3   29     27.8
##  4 Albania              ALB              18     15     15.8   16.6   16.1   19.4
##  5 Andorra              AND              NA     NA     NA     NA     NA     NA  
##  6 United Arab Emirates ARE              11.6   11.2   11.5   10.7   10.4    9.8
##  7 Argentina            ARG              20     19.7   19.8   19.5   18.8   18.3
##  8 Armenia              ARM              27.5   27.3   27.3   27.1   26.8   26.5
##  9 American Samoa       ASM              NA     NA     NA     NA     NA     NA  
## 10 Antigua and Barbuda  ATG              19     18.2   19     18.5   18.2   17.3
## # ℹ 207 more rows
## # ℹ 17 more variables: `2006` <dbl>, `2007` <dbl>, `2008` <dbl>, `2009` <dbl>,
## #   `2010` <dbl>, `2011` <dbl>, `2012` <dbl>, `2013` <dbl>, `2014` <dbl>,
## #   `2015` <dbl>, `2016` <dbl>, `2017` <dbl>, `2018` <dbl>, `2019` <dbl>,
## #   `2020` <dbl>, `2021` <dbl>, Region <chr>

Insight #1: Not all countries improved, but improvements were led by the Maldives, Uzbekistan, Kazakhstan, Rwanda, and Azerbaijan

# top 5 countries
top5 <- head(wb_data[order(-(wb_data$`2000` - wb_data$`2021`)), ], 5)
print(paste("The five countries that made the most progress are:", paste(top5$`Country Name`, collapse = ", ")))
## [1] "The five countries that made the most progress are: Maldives, Uzbekistan, Kazakhstan, Rwanda, Azerbaijan"
# 5 countries that improved the least
bottom5 <- head(wb_data[order(wb_data$`2000` - wb_data$`2021`), ], 5)
print(paste("The five countries that made the least progress are:", paste(bottom5$`Country Name`, collapse = ", ")))
## [1] "The five countries that made the least progress are: Lesotho, Philippines, Zimbabwe, Solomon Islands, Mozambique"
# Add a column to show whether each country improved from 2000 to 2021
wb_data$direction <- ifelse(wb_data$`2000` - wb_data$`2021` > 0, "Improved", "Did not improve")

wb_data %>%
  filter(!is.na(direction)) %>%
  count(direction)
## # A tibble: 2 × 2
##   direction           n
##   <chr>           <int>
## 1 Did not improve    23
## 2 Improved          162

Out of the 185 countries with data, 162 countries reduced the risk of a 30-year-old dying before the age of 70 from a chronic disease between 2000 and 2021. The Maldives, Uzbekistan, Kazakhstan, Rwanda, and Azerbaijan made the most progress. However, 23 countries did not improve, and the risk increased the most in Lesotho, the Philippines, Zimbabwe, Solomon Islands, and Mozambique. 32 countries have no data.

Insight #2: Europe & Central Asia made the most progress

region_summary <- wb_data %>%
  group_by(Region) %>%
  summarize(countries = sum(!is.na(`2021`)),
            avg_2000 = mean(`2000`, na.rm = TRUE),
            avg_2021 = mean(`2021`, na.rm = TRUE),
            avg_decrease = mean(`2000` - `2021`, na.rm = TRUE)) %>%
  arrange(desc(avg_decrease))

region_summary
## # A tibble: 7 × 5
##   Region                     countries avg_2000 avg_2021 avg_decrease
##   <chr>                          <int>    <dbl>    <dbl>        <dbl>
## 1 Europe & Central Asia             48     23.2     15.6         7.61
## 2 South Asia                         6     23.6     16.6         6.97
## 3 Middle East & North Africa        23     23.6     17.0         6.59
## 4 North America                      2     16.1     11.7         4.4 
## 5 East Asia & Pacific               26     26.9     23.6         3.32
## 6 Sub-Saharan Africa                48     25.9     22.9         3.04
## 7 Latin America & Caribbean         32     19.2     16.2         2.92

The data shows that Europe & Central Asia made the most progress, by decreasing the average risk by 7.6 percentage points from 2000 to 2021. Latin America & Caribbean made the least progress, with only 2.9 percentage points. East Asia & Pacific still has the highest average risk, at 23.6%.

Visualising the insight with ggplot2

I wanted to try plotting a dot chart to visualise where each region started in 2000 and where it ended in 2021. The length of the line shows the decrease in risk, and it also shows that East Asia & Pacific still has the highest risk even after improving.

ggplot(region_summary) +
  geom_segment(aes(x = avg_2000, xend = avg_2021,
                   y = reorder(Region, avg_decrease), yend = reorder(Region, avg_decrease)),
               color = "gray") +
  geom_point(aes(x = avg_2000, y = reorder(Region, avg_decrease)), color = "#CD1076", size = 4) +
  geom_point(aes(x = avg_2021, y = reorder(Region, avg_decrease)), color = "#9ACD32", size = 4) +
  labs(title = "Average Risk of Dying Before 70 by Region, 2000 (pink) vs. 2021 (green)",
       x = "Risk of dying before 70 (%)",
       y = "Region")

Conclusion:

Between 2000 and 2021, the five countries that made the most progress in reducing the risk of a 30-year-old dying before the age of 70 from chronic disease were the Maldives, Uzbekistan, Kazakhstan, Rwanda, and Azerbaijan. Most countries also improved over this period of time, 162 of the 185 countries. However, 23 countries did not improve, and the risk increased the most in Lesotho, the Philippines, Zimbabwe, Solomon Islands, and Mozambique. Europe & Central Asia made the most progress, decreasing the average risk by 7.6 percentage points, while Latin America & Caribbean made the least progress, with only 2.9 percentage points.