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.
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")
# 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"
# 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>
# 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.
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%.
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")
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.