This project uses R to explore the relationship between population and CO2 emissions with two publicly available datasets from Kaggle: the World Population Dataset, which contains country-level population figures from 1970 to 2019 together with area, population density, growth rate and share of the world population; and the CO2 Emissions Around the World dataset, which records annual CO2 emissions per country up to 2022.
The objectives of this project are to:
The findings give insight into whether population size alone explains differences in CO2 emissions between countries, or whether other factors play a larger role.
library(readr) # reading CSV files (read_csv)
library(dplyr) # data manipulation: filter, select, mutate, summarise, joins
library(tidyr) # reshaping data: pivot_longer, pivot_wider
library(ggplot2) # plotting
library(janitor) # clean_names() for tidy column names
library(ggcorrplot) # correlation heatmaps
world_population <-readr::read_csv("D:\\Document\\BIG-DATA\\R\\MID_TERM\\assets\\world_population.csv", show_col_types = FALSE) |>
clean_names() # changes every name into simple snake_case
# Reka twerekane rows zitabaye loaded, zifite ibibazo
problems(world_population)
## # A tibble: 0 × 5
## # ℹ 5 variables: row <int>, col <int>, expected <chr>, actual <chr>, file <chr>
CO2_emission <- readr::read_csv("D:\\Document\\BIG-DATA\\R\\MID_TERM\\assets\\CO2_emission.csv", show_col_types = FALSE) |>
clean_names() # changes every name into simple snake_case
# Reka twerekane rows zitabaye loaded, zifite ibibazo
problems(CO2_emission)
## # A tibble: 0 × 5
## # ℹ 5 variables: row <int>, col <int>, expected <chr>, actual <chr>, file <chr>
# Show variables cg columns za world_population
names(world_population)
## [1] "rank" "cca3"
## [3] "country_territory" "capital"
## [5] "continent" "x2022_population"
## [7] "x2020_population" "x2015_population"
## [9] "x2010_population" "x2000_population"
## [11] "x1990_population" "x1980_population"
## [13] "x1970_population" "area_km2"
## [15] "density_per_km2" "growth_rate"
## [17] "world_population_percentage"
# List top 5 records za world_population
top_5_world_population <- head(world_population,n=5)
knitr::kable(top_5_world_population,
caption = "Explore Top 5 world population")
| rank | cca3 | country_territory | capital | continent | x2022_population | x2020_population | x2015_population | x2010_population | x2000_population | x1990_population | x1980_population | x1970_population | area_km2 | density_per_km2 | growth_rate | world_population_percentage |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 36 | AFG | Afghanistan | Kabul | Asia | 41128771 | 38972230 | 33753499 | 28189672 | 19542982 | 10694796 | 12486631 | 10752971 | 652230 | 63.0587 | 1.0257 | 0.52 |
| 138 | ALB | Albania | Tirana | Europe | 2842321 | 2866849 | 2882481 | 2913399 | 3182021 | 3295066 | 2941651 | 2324731 | 28748 | 98.8702 | 0.9957 | 0.04 |
| 34 | DZA | Algeria | Algiers | Africa | 44903225 | 43451666 | 39543154 | 35856344 | 30774621 | 25518074 | 18739378 | 13795915 | 2381741 | 18.8531 | 1.0164 | 0.56 |
| 213 | ASM | American Samoa | Pago Pago | Oceania | 44273 | 46189 | 51368 | 54849 | 58230 | 47818 | 32886 | 27075 | 199 | 222.4774 | 0.9831 | 0.00 |
| 203 | AND | Andorra | Andorra la Vella | Europe | 79824 | 77700 | 71746 | 71519 | 66097 | 53569 | 35611 | 19860 | 468 | 170.5641 | 1.0100 | 0.00 |
# List bottom 10 records za world_population
bottom_10_world_population <- tail(world_population,n=10)
knitr::kable(bottom_10_world_population,
caption = "Explore Bottom 10 world population")
| rank | cca3 | country_territory | capital | continent | x2022_population | x2020_population | x2015_population | x2010_population | x2000_population | x1990_population | x1980_population | x1970_population | area_km2 | density_per_km2 | growth_rate | world_population_percentage |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 43 | UZB | Uzbekistan | Tashkent | Asia | 34627652 | 33526656 | 30949417 | 28614227 | 24925554 | 20579100 | 15947129 | 12011361 | 447400 | 77.3975 | 1.0160 | 0.43 |
| 181 | VUT | Vanuatu | Port-Vila | Oceania | 326740 | 311685 | 276438 | 245453 | 192074 | 150882 | 118156 | 87019 | 12189 | 26.8061 | 1.0238 | 0.00 |
| 234 | VAT | Vatican City | Vatican City | Europe | 510 | 520 | 564 | 596 | 651 | 700 | 733 | 752 | 1 | 510.0000 | 0.9980 | 0.00 |
| 51 | VEN | Venezuela | Caracas | South America | 28301696 | 28490453 | 30529716 | 28715022 | 24427729 | 19750579 | 15210443 | 11355475 | 916445 | 30.8820 | 1.0036 | 0.35 |
| 16 | VNM | Vietnam | Hanoi | Asia | 98186856 | 96648685 | 92191398 | 87411012 | 79001142 | 66912613 | 52968270 | 41928849 | 331212 | 296.4472 | 1.0074 | 1.23 |
| 226 | WLF | Wallis and Futuna | Mata-Utu | Oceania | 11572 | 11655 | 12182 | 13142 | 14723 | 13454 | 11315 | 9377 | 142 | 81.4930 | 0.9953 | 0.00 |
| 172 | ESH | Western Sahara | El Aaiún | Africa | 575986 | 556048 | 491824 | 413296 | 270375 | 178529 | 116775 | 76371 | 266000 | 2.1654 | 1.0184 | 0.01 |
| 46 | YEM | Yemen | Sanaa | Asia | 33696614 | 32284046 | 28516545 | 24743946 | 18628700 | 13375121 | 9204938 | 6843607 | 527968 | 63.8232 | 1.0217 | 0.42 |
| 63 | ZMB | Zambia | Lusaka | Africa | 20017675 | 18927715 | 16248230 | 13792086 | 9891136 | 7686401 | 5720438 | 4281671 | 752612 | 26.5976 | 1.0280 | 0.25 |
| 74 | ZWE | Zimbabwe | Harare | Africa | 16320537 | 15669666 | 14154937 | 12839771 | 11834676 | 10113893 | 7049926 | 5202918 | 390757 | 41.7665 | 1.0204 | 0.20 |
str(world_population)
## spc_tbl_ [234 × 17] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ rank : num [1:234] 36 138 34 213 203 42 224 201 33 140 ...
## $ cca3 : chr [1:234] "AFG" "ALB" "DZA" "ASM" ...
## $ country_territory : chr [1:234] "Afghanistan" "Albania" "Algeria" "American Samoa" ...
## $ capital : chr [1:234] "Kabul" "Tirana" "Algiers" "Pago Pago" ...
## $ continent : chr [1:234] "Asia" "Europe" "Africa" "Oceania" ...
## $ x2022_population : num [1:234] 41128771 2842321 44903225 44273 79824 ...
## $ x2020_population : num [1:234] 38972230 2866849 43451666 46189 77700 ...
## $ x2015_population : num [1:234] 33753499 2882481 39543154 51368 71746 ...
## $ x2010_population : num [1:234] 28189672 2913399 35856344 54849 71519 ...
## $ x2000_population : num [1:234] 19542982 3182021 30774621 58230 66097 ...
## $ x1990_population : num [1:234] 10694796 3295066 25518074 47818 53569 ...
## $ x1980_population : num [1:234] 12486631 2941651 18739378 32886 35611 ...
## $ x1970_population : num [1:234] 10752971 2324731 13795915 27075 19860 ...
## $ area_km2 : num [1:234] 652230 28748 2381741 199 468 ...
## $ density_per_km2 : num [1:234] 63.1 98.9 18.9 222.5 170.6 ...
## $ growth_rate : num [1:234] 1.026 0.996 1.016 0.983 1.01 ...
## $ world_population_percentage: num [1:234] 0.52 0.04 0.56 0 0 0.45 0 0 0.57 0.03 ...
## - attr(*, "spec")=
## .. cols(
## .. Rank = col_double(),
## .. CCA3 = col_character(),
## .. `Country/Territory` = col_character(),
## .. Capital = col_character(),
## .. Continent = col_character(),
## .. `2022 Population` = col_double(),
## .. `2020 Population` = col_double(),
## .. `2015 Population` = col_double(),
## .. `2010 Population` = col_double(),
## .. `2000 Population` = col_double(),
## .. `1990 Population` = col_double(),
## .. `1980 Population` = col_double(),
## .. `1970 Population` = col_double(),
## .. `Area (km²)` = col_double(),
## .. `Density (per km²)` = col_double(),
## .. `Growth Rate` = col_double(),
## .. `World Population Percentage` = col_double()
## .. )
## - attr(*, "problems")=<pointer: 0x000001d9037e32e0>
# twerekane rows, columns za world_population
dim(world_population)
## [1] 234 17
# shape before removing duplicates
dim(world_population)
## [1] 234 17
# find duplicated rows in world_population
duplicated_count <- sum(duplicated(world_population))
print(duplicated_count)
## [1] 0
# Keep only unique
world_population_clean <- unique(world_population)
# check the number of rows after cleaning
nrow(world_population_clean)
## [1] 234
missing_count <- colSums(is.na(world_population_clean)) # missing values per column
print(missing_count)
## rank cca3
## 0 0
## country_territory capital
## 0 0
## continent x2022_population
## 0 0
## x2020_population x2015_population
## 0 0
## x2010_population x2000_population
## 0 0
## x1990_population x1980_population
## 0 0
## x1970_population area_km2
## 0 0
## density_per_km2 growth_rate
## 0 0
## world_population_percentage
## 0
# missing percentages
missing_percentage <- colMeans(is.na(world_population_clean)) * 100
print(missing_percentage)
## rank cca3
## 0 0
## country_territory capital
## 0 0
## continent x2022_population
## 0 0
## x2020_population x2015_population
## 0 0
## x2010_population x2000_population
## 0 0
## x1990_population x1980_population
## 0 0
## x1970_population area_km2
## 0 0
## density_per_km2 growth_rate
## 0 0
## world_population_percentage
## 0
missing_summary <- data.frame(
Column = names(world_population_clean),
Missing_Values = missing_count,
Missing_Percentage = round(missing_percentage, 2)
)
print(missing_summary)
## Column Missing_Values
## rank rank 0
## cca3 cca3 0
## country_territory country_territory 0
## capital capital 0
## continent continent 0
## x2022_population x2022_population 0
## x2020_population x2020_population 0
## x2015_population x2015_population 0
## x2010_population x2010_population 0
## x2000_population x2000_population 0
## x1990_population x1990_population 0
## x1980_population x1980_population 0
## x1970_population x1970_population 0
## area_km2 area_km2 0
## density_per_km2 density_per_km2 0
## growth_rate growth_rate 0
## world_population_percentage world_population_percentage 0
## Missing_Percentage
## rank 0
## cca3 0
## country_territory 0
## capital 0
## continent 0
## x2022_population 0
## x2020_population 0
## x2015_population 0
## x2010_population 0
## x2000_population 0
## x1990_population 0
## x1980_population 0
## x1970_population 0
## area_km2 0
## density_per_km2 0
## growth_rate 0
## world_population_percentage 0
numeric_data <- select(
world_population,
where(is.numeric),
-rank,
-growth_rate
)
ggplot(
pivot_longer(
numeric_data,
everything(),
names_to = "variable",
values_to = "value"
),
aes(x = "", y = value)
) +
geom_boxplot(fill = "darkseagreen") +
scale_y_log10() +
facet_wrap(~ variable, scales = "free") +
labs(
title = "Box Plots on Log10 Scale",
x = NULL,
y = "Value (Log10)"
)
## Handling Missing Values
numeric_columns <- names(
select(world_population, where(is.numeric), -rank)
)
# Replace missing values in numeric columns with their median
for (column in numeric_columns) {
# Extract column values
col_value <- world_population[[column]]
# Calculate median, ignoring missing values
median_value <- median(
col_value,
na.rm = TRUE
)
# print(median_value)
# Skip columns where median is NA
if (is.na(median_value)) {
next
}
# Identify missing positions
na_col <- is.na(col_value)
#Replace missing values with median
col_value[na_col] <- median_value
# Update the original data frame
world_population[[column]] <- col_value
}
# Check missing values again
colSums(is.na(world_population))
## rank cca3
## 0 0
## country_territory capital
## 0 0
## continent x2022_population
## 0 0
## x2020_population x2015_population
## 0 0
## x2010_population x2000_population
## 0 0
## x1990_population x1980_population
## 0 0
## x1970_population area_km2
## 0 0
## density_per_km2 growth_rate
## 0 0
## world_population_percentage
## 0
After handling missing values, all 17 variables contain 0 missing values, confirming that the dataset is complete and ready for analysis
# Keep only quantitative variables (drop rank: it is just a position number)
quant_vars <- select(world_population, where(is.numeric), -rank)
# Reshape from wide to long so ggplot can draw one box per variable
quant_long <- pivot_longer(quant_vars,
cols = everything(),
names_to = "variable",
values_to = "value")
ggplot(quant_long, aes(x = "", y = value)) +
geom_boxplot(fill = "steelblue", outlier.colour = "red") +
facet_wrap(~ variable, scales = "free") +
labs(title = "Box plots of quantitative variables",
x = NULL, y = "Value")
### Counting the outliers and finding out who they are
count_outliers <- function(x) {
q1 <- quantile(x, 0.25, na.rm = TRUE)
q3 <- quantile(x, 0.75, na.rm = TRUE)
iqr <- q3 - q1
sum(x < q1 - 1.5 * iqr | x > q3 + 1.5 * iqr, na.rm = TRUE)
}
sapply(quant_vars, count_outliers)
## x2022_population x2020_population
## 25 26
## x2015_population x2010_population
## 27 26
## x2000_population x1990_population
## 29 31
## x1980_population x1970_population
## 32 29
## area_km2 density_per_km2
## 28 22
## growth_rate world_population_percentage
## 3 25
# Which countries are the outliers? Example: 2022 population
sorted_pop <- arrange(world_population, desc(x2022_population))
get_x2022_population <-select(sorted_pop, country_territory, x2022_population)
knitr::kable(head(get_x2022_population, 10),
col.names = c("Country", "Population 2022"),
caption = "Which countries are the outliers? Example: 2022 population")
| Country | Population 2022 |
|---|---|
| China | 1425887337 |
| India | 1417173173 |
| United States | 338289857 |
| Indonesia | 275501339 |
| Pakistan | 235824862 |
| Nigeria | 218541212 |
| Brazil | 215313498 |
| Bangladesh | 171186372 |
| Russia | 144713314 |
| Mexico | 127504125 |
# Keep the outliers, but plot on a log10 scale so the distribution is readable
quant_vars_log <- select(quant_vars, -growth_rate)
quant_long_log <- pivot_longer(quant_vars_log,
cols = everything(),
names_to = "variable",
values_to = "value")
ggplot(quant_long_log, aes(x = "", y = value)) +
geom_boxplot(fill = "darkseagreen") +
scale_y_log10() +
facet_wrap(~ variable, scales = "free") +
labs(title = "Box plots on log10 scale (outliers kept)",
x = NULL, y = "Value (log10 scale)")
Insights:
China (1.426 billion) and India (1.417 billion) are far ahead of everyone else and almost equal to each other, only about 9 million apart. These two are the most extreme outliers.
The United States is third, with 338 million. That’s less than a quarter of China or India, so there’s a huge gap between 2nd and 3rd place.
From 4th place down, the numbers fall gradually: Indonesia 276M -> Mexico 128M.
The original box plots showed many high outliers in population, area and density, belonging to large countries such as China and India. On a log10 scale most of these outliers disappear, which shows the data is strongly right-skewed rather than wrong, so all observations were kept.
The projection uses the exponential growth model:
\[N_t = P e^{rt}\]
where \(P\) is the 2022 population, \(r\) is the annual growth rate, and \(t = 2030 - 2022 = 8\) years.
# Check how growth_rate is stored
summary(world_population$growth_rate)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.912 1.002 1.008 1.010 1.017 1.069
t <- 2030 - 2022 # time period = 8 years
# Growth Rate is stored as a multiplier (e.g. 1.0068 = +0.68% per year),
# so subtract 1 to get the rate r
world_population$r <- world_population$growth_rate - 1
# Apply N_t = P * e^(r * t)
world_population$x2030_population <- round(
world_population$x2022_population * exp(world_population$r * t)
)
# Top 10 countries by projected 2030 population
top10_2030 <- head(select(arrange(world_population, desc(x2030_population)),
country_territory, x2022_population, growth_rate, x2030_population), 10)
# Format the numbers for display only
top10_2030$x2022_population <- format(top10_2030$x2022_population, big.mark = ",")
top10_2030$x2030_population <- format(top10_2030$x2030_population, big.mark = ",")
knitr::kable(top10_2030,
col.names = c("Country", "Population 2022", "Growth Rate", "Projected Population 2030"),
caption = "Top 10 countries by projected 2030 population")
| Country | Population 2022 | Growth Rate | Projected Population 2030 |
|---|---|---|---|
| India | 1,417,173,173 | 1.0068 | 1,496,402,904 |
| China | 1,425,887,337 | 1.0000 | 1,425,887,337 |
| United States | 338,289,857 | 1.0038 | 348,731,782 |
| Indonesia | 275,501,339 | 1.0064 | 289,974,355 |
| Pakistan | 235,824,862 | 1.0191 | 274,757,645 |
| Nigeria | 218,541,212 | 1.0241 | 265,011,868 |
| Brazil | 215,313,498 | 1.0046 | 223,384,633 |
| Bangladesh | 171,186,372 | 1.0108 | 186,634,630 |
| Ethiopia | 123,379,924 | 1.0257 | 151,542,848 |
| Russia | 144,713,314 | 0.9973 | 141,621,023 |
# World totals: 2022 vs projected 2030
world_totals <- data.frame(
pop_2022 = format(sum(world_population$x2022_population), big.mark = ","),
pop_2030 = format(sum(world_population$x2030_population), big.mark = ",")
)
knitr::kable(world_totals,
col.names = c("Population 2022", "Projected Population 2030"),
caption = "World totals: 2022 vs projected 2030")
| Population 2022 | Projected Population 2030 |
|---|---|
| 7,973,413,042 | 8,569,157,744 |
A new variable, x2030_population, was created using the exponential growth model with t = 8 years. The growth rate was first converted from a multiplier to a rate (r = growth rate − 1). The world population is projected to grow from X billion in 2022 to Y billion in 2030, with [country] expected to be the most populous country.
top10 <- head(arrange(world_population, desc(x2022_population)), 10)
top10$x2022_population2 <- format(top10$x2022_population, big.mark = ",")
knitr::kable(
select(top10, country_territory, cca3, x2022_population2)
,
col.names = c("Country", "cca3","Population 2022"),
caption = "Based on 2022 population, Extract the top 10")
| Country | cca3 | Population 2022 |
|---|---|---|
| China | CHN | 1,425,887,337 |
| India | IND | 1,417,173,173 |
| United States | USA | 338,289,857 |
| Indonesia | IDN | 275,501,339 |
| Pakistan | PAK | 235,824,862 |
| Nigeria | NGA | 218,541,212 |
| Brazil | BRA | 215,313,498 |
| Bangladesh | BGD | 171,186,372 |
| Russia | RUS | 144,713,314 |
| Mexico | MEX | 127,504,125 |
ggplot(top10, aes(x = reorder(country_territory, x2022_population),
y = x2022_population / 1e6)) +
geom_col(fill = "steelblue") +
geom_text(aes(label = round(x2022_population / 1e6)), hjust = -0.1, size = 3.5) +
coord_flip() +
labs(title = "Top 10 most populous countries in 2022",
x = "Country", y = "Population (millions)") +
expand_limits(y = 1600)
# Keep the country name and the population columns from 1990 to 2022
top10_trend <- select(top10, country_territory,
x1990_population, x2000_population, x2010_population,
x2015_population, x2020_population, x2022_population)
# Wide -> long: one row per country per year
top10_long <- pivot_longer(top10_trend,
cols = -country_territory,
names_to = "year",
values_to = "population")
# "x1990_population" -> 1990
top10_long$year <- as.numeric(substr(top10_long$year, 2, 5))
ggplot(top10_long, aes(x = year, y = population / 1e6, colour = country_territory)) +
geom_line(linewidth = 1) +
geom_point(size = 2) +
labs(title = "Population trend of the 10 most populous countries, 1990–2022",
x = "Year", y = "Population (millions)", colour = "Country")
names(CO2_emission) # check the column names first
## [1] "country_name" "country_code" "region" "indicator_name"
## [5] "x1990" "x1991" "x1992" "x1993"
## [9] "x1994" "x1995" "x1996" "x1997"
## [13] "x1998" "x1999" "x2000" "x2001"
## [17] "x2002" "x2003" "x2004" "x2005"
## [21] "x2006" "x2007" "x2008" "x2009"
## [25] "x2010" "x2011" "x2012" "x2013"
## [29] "x2014" "x2015" "x2016" "x2017"
## [33] "x2018" "x2019_34" "x2019_35"
unique(CO2_emission$indicator_name) # check the unit of the values
## [1] "CO2 emissions (metric tons per capita)"
cols_2019 <- grep("^x2019", names(CO2_emission), value = TRUE)
cols_2019 # "x2019_34" "x2019_35"
## [1] "x2019_34" "x2019_35"
identical(CO2_emission[[cols_2019[1]]], CO2_emission[[cols_2019[2]]])
## [1] TRUE
CO2_emission <- CO2_emission[, names(CO2_emission) != cols_2019[2]]
names(CO2_emission)[names(CO2_emission) == cols_2019[1]] <- "x2019"
tail(names(CO2_emission), 3) # "x2017" "x2018" "x2019"
## [1] "x2017" "x2018" "x2019"
dim(CO2_emission) # 215 34
## [1] 215 34
# Match on the 3-letter country code (works even when names differ, e.g. Russia)
co2_top10 <- CO2_emission[CO2_emission$country_code %in% top10$cca3, ]
# Keep the country name and the year columns from 1990 to 2019
year_cols <- paste0("x", 1990:2019)
co2_top10 <- co2_top10[, c("country_name", year_cols)]
# Wide -> long
co2_top10_long <- pivot_longer(co2_top10,
cols = -country_name,
names_to = "year",
values_to = "co2")
# "x1990" -> 1990
co2_top10_long$year <- as.numeric(substr(co2_top10_long$year, 2, 5))
# Check: should be 10
length(unique(co2_top10_long$country_name))
## [1] 10
ggplot(co2_top10_long, aes(x = year, y = co2, colour = country_name)) +
geom_line(linewidth = 1) +
labs(title = "CO2 emission trend of the 10 most populous countries, 1990–2019",
x = "Year", y = "CO2 emissions (metric tons per capita)", colour = "Country")
The United States and Russia have the highest CO2 emissions per person throughout 1990–2019, although US emissions fell from about 20 to about 15 tonnes after the mid-2000s.
China’s emissions per person rose about fourfold, from about 2 to 7.6 tonnes, mainly after 2002, while the other most populous countries, such as India, Pakistan, Nigeria and Bangladesh, stayed below about 4 tonnes.
This shows that having a large population does not mean high emissions per person.
# Keep the four variables
pop_vars <- select(world_population, area_km2, density_per_km2,
growth_rate, world_population_percentage)
# Pearson correlation (linear relationship)
cor_pearson <- cor(pop_vars, method = "pearson")
round(cor_pearson, 2)
## area_km2 density_per_km2 growth_rate
## area_km2 1.00 -0.06 -0.01
## density_per_km2 -0.06 1.00 -0.07
## growth_rate -0.01 -0.07 1.00
## world_population_percentage 0.45 -0.03 -0.02
## world_population_percentage
## area_km2 0.45
## density_per_km2 -0.03
## growth_rate -0.02
## world_population_percentage 1.00
# Spearman correlation (rank-based, robust to outliers and skew)
cor_spearman <- cor(pop_vars, method = "spearman")
round(cor_spearman, 2)
## area_km2 density_per_km2 growth_rate
## area_km2 1.00 -0.58 0.36
## density_per_km2 -0.58 1.00 -0.22
## growth_rate 0.36 -0.22 1.00
## world_population_percentage 0.84 -0.15 0.28
## world_population_percentage
## area_km2 0.84
## density_per_km2 -0.15
## growth_rate 0.28
## world_population_percentage 1.00
ggcorrplot(cor_pearson,
lab = TRUE, # print the values in each cell
type = "lower", # show only the lower triangle (no repeats)
colors = c("firebrick", "white", "steelblue"),
title = "Correlation heatmap of population variables (Pearson)")
# Extract 2022 population and 2019 CO2 emissions
pop_2022 <- select(world_population, country_territory, continent, x2022_population)
co2_2019 <- select(CO2_emission, country_name, x2019)
# Country names in the CO2 data that do not match the population data
setdiff(co2_2019$country_name, pop_2022$country_territory)
## [1] "Bahamas, The" "Brunei Darussalam"
## [3] "Cote d'Ivoire" "Congo, Dem. Rep."
## [5] "Congo, Rep." "Cabo Verde"
## [7] "Egypt, Arab Rep." "Micronesia, Fed. Sts."
## [9] "Gambia, The" "Hong Kong SAR, China"
## [11] "Iran, Islamic Rep." "Kyrgyz Republic"
## [13] "St. Kitts and Nevis" "Korea, Rep."
## [15] "Lao PDR" "St. Lucia"
## [17] "Macao SAR, China" "St. Martin (French part)"
## [19] "Korea, Dem. People's Rep." "West Bank and Gaza"
## [21] "Russian Federation" "Slovak Republic"
## [23] "Sint Maarten (Dutch part)" "Syrian Arab Republic"
## [25] "Turkiye" "St. Vincent and the Grenadines"
## [27] "Venezuela, RB" "Virgin Islands (U.S.)"
## [29] "Yemen, Rep."
# Rename CO2 country names to match the population dataset
name_fix <- c(
"Russian Federation" = "Russia",
"Congo, Dem. Rep." = "DR Congo",
"Congo, Rep." = "Republic of the Congo",
"Egypt, Arab Rep." = "Egypt",
"Iran, Islamic Rep." = "Iran",
"Korea, Rep." = "South Korea",
"Korea, Dem. People's Rep." = "North Korea",
"Turkiye" = "Turkey",
"Venezuela, RB" = "Venezuela",
"Yemen, Rep." = "Yemen",
"Syrian Arab Republic" = "Syria",
"Lao PDR" = "Laos",
"Kyrgyz Republic" = "Kyrgyzstan",
"Slovak Republic" = "Slovakia",
"Bahamas, The" = "Bahamas",
"Gambia, The" = "Gambia",
"Brunei Darussalam" = "Brunei",
"Micronesia, Fed. Sts." = "Micronesia",
"Cote d'Ivoire" = "Ivory Coast",
"Cabo Verde" = "Cape Verde",
"St. Kitts and Nevis" = "Saint Kitts and Nevis",
"St. Lucia" = "Saint Lucia",
"St. Vincent and the Grenadines" = "Saint Vincent and the Grenadines",
"Hong Kong SAR, China" = "Hong Kong",
"Macao SAR, China" = "Macau",
"West Bank and Gaza" = "Palestine"
)
to_fix <- co2_2019$country_name %in% names(name_fix)
co2_2019$country_name[to_fix] <- unname(name_fix[co2_2019$country_name[to_fix]])
# Names still unmatched after the fix
setdiff(co2_2019$country_name, pop_2022$country_territory)
## [1] "St. Martin (French part)" "Sint Maarten (Dutch part)"
## [3] "Virgin Islands (U.S.)"
merged <- inner_join(pop_2022, co2_2019, by = c("country_territory" = "country_name"))
merged <- merged[!is.na(merged$x2019), ]
dim(merged)
## [1] 191 4
merged$x2022_population2 <- format(merged$x2022_population, big.mark = ",")
knitr::kable(
select(head(merged), country_territory, continent, x2022_population2, x2019),
col.names = c("Country","continent", "Population 2022", "CO2 emissions 2019"),
caption = "Population and CO2 Emissions")
| Country | continent | Population 2022 | CO2 emissions 2019 |
|---|---|---|---|
| Afghanistan | Asia | 41,128,771 | 0.1598244 |
| Albania | Europe | 2,842,321 | 1.6922483 |
| Algeria | Africa | 44,903,225 | 3.9776505 |
| Andorra | Europe | 79,824 | 6.4812174 |
| Angola | Africa | 35,588,987 | 0.7921371 |
| Antigua and Barbuda | North America | 93,763 | 5.3544765 |
ggplot(merged, aes(x = x2022_population, y = x2019)) +
geom_point(aes(colour = continent), size = 2.5, alpha = 0.7) +
geom_smooth(method = "lm", colour = "black", se = TRUE) +
scale_x_log10(labels = scales::comma) +
labs(title = "2022 population vs 2019 CO2 emissions per capita",
x = "Population 2022 (log10 scale)",
y = "CO2 emissions 2019 (metric tons per capita)",
colour = "Continent")
# Pearson: linear relationship
cor.test(merged$x2022_population, merged$x2019, method = "pearson")
##
## Pearson's product-moment correlation
##
## data: merged$x2022_population and merged$x2019
## t = 0.19882, df = 189, p-value = 0.8426
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1277814 0.1561191
## sample estimates:
## cor
## 0.01446026
# Spearman: rank-based, robust to outliers and skew
cor.test(merged$x2022_population, merged$x2019, method = "spearman", exact = FALSE)
##
## Spearman's rank correlation rho
##
## data: merged$x2022_population and merged$x2019
## S = 1289342, p-value = 0.1288
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.1102766
model <- lm(x2019 ~ log10(x2022_population), data = merged)
summary(model)
##
## Call:
## lm(formula = x2019 ~ log10(x2022_population), data = merged)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.083 -3.216 -1.492 1.462 28.263
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.7780 2.4914 2.319 0.0215 *
## log10(x2022_population) -0.2437 0.3616 -0.674 0.5013
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.721 on 189 degrees of freedom
## Multiple R-squared: 0.002396, Adjusted R-squared: -0.002882
## F-statistic: 0.454 on 1 and 189 DF, p-value: 0.5013
# Sum 2019 CO2 emissions (metric tons per capita) by continent
continent_co2 <- summarise(group_by(merged, continent),
total_co2 = sum(x2019, na.rm = TRUE),
n_countries = n())
# Rank from highest to lowest
continent_co2 <- arrange(continent_co2, desc(total_co2))
continent_co2$rank <- 1:nrow(continent_co2)
knitr::kable(continent_co2,
col.names = c("Continent", "Total CO2 2019 (metric tons per capita)",
"Number of countries", "Rank"),
digits = 2,
caption = "Total 2019 CO2 emissions by continent")
| Continent | Total CO2 2019 (metric tons per capita) | Number of countries | Rank |
|---|---|---|---|
| Asia | 290.55 | 46 | 1 |
| Europe | 246.67 | 42 | 2 |
| North America | 96.90 | 23 | 3 |
| Africa | 63.73 | 54 | 4 |
| Oceania | 54.78 | 14 | 5 |
| South America | 33.36 | 12 | 6 |
ggplot(continent_co2, aes(x = reorder(continent, total_co2), y = total_co2)) +
geom_col(fill = "darkorange") +
geom_text(aes(label = round(total_co2, 1)), hjust = -0.1, size = 4) +
coord_flip() +
expand_limits(y = max(continent_co2$total_co2) * 1.15) +
labs(title = "Total 2019 CO2 emissions by continent",
x = "Continent",
y = "Total CO2 emissions (metric tons per capita)")
This project analysed the relationship between population and CO2 emissions using the World Population and CO2 Emissions Around the World datasets in R.
The population data contained no missing values; the outliers detected were genuine countries such as China and India, so all observations were kept.
Using the exponential growth model, the world population is projected to grow from about 7.97 billion in 2022 to about 8.57 billion in 2030.
Among the ten most populous countries, the United States and Russia have the highest CO2 emissions per capita, while China’s emissions per capita rose sharply after 2002.
The correlation and regression analyses showed [a weak / no significant] relationship between population size and CO2 emissions per capita, so population alone does not explain how much each person emits; income, industrialization and energy sources are likely more important.