library(readxl)
## Warning: package 'readxl' was built under R version 4.3.3
data <- read_excel("anlysis.xlsx")
View(data)
###### Data Manipulation
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
names(data)
## [1] "country" "variable" "percentile" "year"
## [5] "value" "age" "population unit"
str(data) # A lot of information
## tibble [273 × 7] (S3: tbl_df/tbl/data.frame)
## $ country : chr [1:273] "Germany" "Germany" "Germany" "Germany" ...
## $ variable : chr [1:273] "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" ...
## $ percentile : chr [1:273] "p0p10" "p0p10" "p0p10" "p0p10" ...
## $ year : num [1:273] 2010 2011 2012 2013 2014 ...
## $ value : num [1:273] 0.0031 0.0031 0.0031 0.0029 0.0029 0.0029 0.003 0.003 0.003 0.0027 ...
## $ age : chr [1:273] "adults" "adults" "adults" "adults" ...
## $ population unit: chr [1:273] "equal-splint" "equal-splint" "equal-splint" "equal-splint" ...
#
#
select(data, country, variable, year,percentile)
## # A tibble: 273 × 4
## country variable year percentile
## <chr> <chr> <dbl> <chr>
## 1 Germany share /pre-tax national income/adults/equal-splint 2010 p0p10
## 2 Germany share /pre-tax national income/adults/equal-splint 2011 p0p10
## 3 Germany share /pre-tax national income/adults/equal-splint 2012 p0p10
## 4 Germany share /pre-tax national income/adults/equal-splint 2013 p0p10
## 5 Germany share /pre-tax national income/adults/equal-splint 2014 p0p10
## 6 Germany share /pre-tax national income/adults/equal-splint 2015 p0p10
## 7 Germany share /pre-tax national income/adults/equal-splint 2016 p0p10
## 8 Germany share /pre-tax national income/adults/equal-splint 2017 p0p10
## 9 Germany share /pre-tax national income/adults/equal-splint 2018 p0p10
## 10 Germany share /pre-tax national income/adults/equal-splint 2019 p0p10
## # ℹ 263 more rows
#
#
dplyr::select(data, country, variable, year, percentile)
## # A tibble: 273 × 4
## country variable year percentile
## <chr> <chr> <dbl> <chr>
## 1 Germany share /pre-tax national income/adults/equal-splint 2010 p0p10
## 2 Germany share /pre-tax national income/adults/equal-splint 2011 p0p10
## 3 Germany share /pre-tax national income/adults/equal-splint 2012 p0p10
## 4 Germany share /pre-tax national income/adults/equal-splint 2013 p0p10
## 5 Germany share /pre-tax national income/adults/equal-splint 2014 p0p10
## 6 Germany share /pre-tax national income/adults/equal-splint 2015 p0p10
## 7 Germany share /pre-tax national income/adults/equal-splint 2016 p0p10
## 8 Germany share /pre-tax national income/adults/equal-splint 2017 p0p10
## 9 Germany share /pre-tax national income/adults/equal-splint 2018 p0p10
## 10 Germany share /pre-tax national income/adults/equal-splint 2019 p0p10
## # ℹ 263 more rows
#### filtering rows according to a given condition
#
filter(data, country == "Germany")
## # A tibble: 143 × 7
## country variable percentile year value age `population unit`
## <chr> <chr> <chr> <dbl> <dbl> <chr> <chr>
## 1 Germany share /pre-tax natio… p0p10 2010 0.0031 adul… equal-splint
## 2 Germany share /pre-tax natio… p0p10 2011 0.0031 adul… equal-splint
## 3 Germany share /pre-tax natio… p0p10 2012 0.0031 adul… equal-splint
## 4 Germany share /pre-tax natio… p0p10 2013 0.0029 adul… equal-splint
## 5 Germany share /pre-tax natio… p0p10 2014 0.0029 adul… equal-splint
## 6 Germany share /pre-tax natio… p0p10 2015 0.0029 adul… equal-splint
## 7 Germany share /pre-tax natio… p0p10 2016 0.003 adul… equal-splint
## 8 Germany share /pre-tax natio… p0p10 2017 0.003 adul… equal-splint
## 9 Germany share /pre-tax natio… p0p10 2018 0.003 adul… equal-splint
## 10 Germany share /pre-tax natio… p0p10 2019 0.0027 adul… equal-splint
## # ℹ 133 more rows
filter(data, country == "United Kingdom")
## # A tibble: 130 × 7
## country variable percentile year value age `population unit`
## <chr> <chr> <chr> <dbl> <dbl> <chr> <chr>
## 1 United Kingdom share /pre-ta… p0p10 2010 0.0032 adul… equal-splint
## 2 United Kingdom share /pre-ta… p0p10 2011 0.0032 adul… equal-splint
## 3 United Kingdom share /pre-ta… p0p10 2012 0.003 adul… equal-splint
## 4 United Kingdom share /pre-ta… p0p10 2013 0.003 adul… equal-splint
## 5 United Kingdom share /pre-ta… p0p10 2014 0.0032 adul… equal-splint
## 6 United Kingdom share /pre-ta… p0p10 2015 0.0033 adul… equal-splint
## 7 United Kingdom share /pre-ta… p0p10 2016 0.0034 adul… equal-splint
## 8 United Kingdom share /pre-ta… p0p10 2017 0.0035 adul… equal-splint
## 9 United Kingdom share /pre-ta… p0p10 2018 0.0034 adul… equal-splint
## 10 United Kingdom share /pre-ta… p0p10 2019 0.003 adul… equal-splint
## # ℹ 120 more rows
# summarising the variables
#
# A data frame results
#
# Sample mean of Height
#
summarise(data, ave = mean(value)) # mean is a measure of location
## # A tibble: 1 × 1
## ave
## <dbl>
## 1 0.101
summarise(data, ave = mean(year))
## # A tibble: 1 × 1
## ave
## <dbl>
## 1 2016
as.data.frame(summarise(data, ave = mean(value)))
## ave
## 1 0.101263
###### Standard Deviation of the dataset
summarise(data, sd = sd(year)) # standard deviation is a measure of spread
## # A tibble: 1 × 1
## sd
## <dbl>
## 1 3.75
summarise(data, sd = sd(value))
## # A tibble: 1 × 1
## sd
## <dbl>
## 1 0.0964
##### counting the number of values
#
count(data, value)
## # A tibble: 231 × 2
## value n
## <dbl> <int>
## 1 0.0027 1
## 2 0.0029 4
## 3 0.003 7
## 4 0.0031 3
## 5 0.0032 4
## 6 0.0033 4
## 7 0.0034 2
## 8 0.0035 1
## 9 0.0217 1
## 10 0.0228 1
## # ℹ 221 more rows
#
#### summarising *grouped by* other variables
#
# Group by country
data_by_variable <- group_by(data, variable)
#
# The sample mean and the sample standard deviation for each level of sex
#
summarise(data_by_variable, ave = mean(value), sd = sd(year))
## # A tibble: 1 × 3
## variable ave sd
## <chr> <dbl> <dbl>
## 1 share /pre-tax national income/adults/equal-splint 0.101 3.75
#
#
data %>% group_by(variable) %>% summarise(ave = mean(value), sd = sd(year))
## # A tibble: 1 × 3
## variable ave sd
## <chr> <dbl> <dbl>
## 1 share /pre-tax national income/adults/equal-splint 0.101 3.75
#
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.3.3
## Warning: package 'ggplot2' was built under R version 4.3.3
## Warning: package 'tibble' was built under R version 4.3.3
## Warning: package 'tidyr' was built under R version 4.3.3
## Warning: package 'readr' was built under R version 4.3.3
## Warning: package 'purrr' was built under R version 4.3.3
## Warning: package 'stringr' was built under R version 4.3.3
## Warning: package 'forcats' was built under R version 4.3.3
## Warning: package 'lubridate' was built under R version 4.3.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ ggplot2 3.5.1 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(dplyr)
str(data)
## tibble [273 × 7] (S3: tbl_df/tbl/data.frame)
## $ country : chr [1:273] "Germany" "Germany" "Germany" "Germany" ...
## $ variable : chr [1:273] "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" "share /pre-tax national income/adults/equal-splint" ...
## $ percentile : chr [1:273] "p0p10" "p0p10" "p0p10" "p0p10" ...
## $ year : num [1:273] 2010 2011 2012 2013 2014 ...
## $ value : num [1:273] 0.0031 0.0031 0.0031 0.0029 0.0029 0.0029 0.003 0.003 0.003 0.0027 ...
## $ age : chr [1:273] "adults" "adults" "adults" "adults" ...
## $ population unit: chr [1:273] "equal-splint" "equal-splint" "equal-splint" "equal-splint" ...
data <- arrange(data, percentile, year, value)
library(ggplot2)
ggplot(data, aes(x = year, y = percentile)) + # This sets up the plot
geom_point() # This "geometry" plots points
#
# Add a * main title * and * label the axes *
#
ggplot(data, aes(x = year, y = percentile)) +
geom_point() +
labs(title = "A plot of percentile versus years",
x = "years", # Label for the x aesthetic
y = "percentile") # Label for the y aesthetic
#### Adding a subtitle, and a caption, which provides information about the data source
#
ggplot(data, aes(x = year, y = percentile)) +
geom_point() +
labs(title = "A plot of percentile versus years",
x = "year", y = "percentile")
#
# Add a * smooth curve *
#
ggplot(data, aes(x = year, y = percentile)) +
geom_point() +
labs(title = "A plot of percentile versus years", subtitle = "Virtualizing how percentile changes over the years", caption = "Percentile versus years",
x = "year", y = "percentile") +
geom_smooth(span = 1)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
##### adding a straight line
#
ggplot(data, aes(x = year, y = percentile)) +
geom_point() +
labs(title = "A plot of percentile versus years", subtitle = "Virtualizing how percentile changes over the years", caption = "Percentile versus years",
x = "year", y = "percentile") +
geom_smooth(method = "lm")
## `geom_smooth()` using formula = 'y ~ x'
#############################################################################
#####Distribution of values over different years
ggplot(data, aes(x = year, y = value)) +
geom_line() +
labs(title = "Distribution of 'value' Across Different Years",
x = "Year",
y = "Value")
##### This plot shows how the 'value' variable changes over different years.
#### the line plot helps in identifying trends, peaks, and troughs over time
####This plot is highly relevant to our analysis because it reveals temporal trends in income distribution,
#### which can indicate economic cycles, policy impacts, or other significant events.
#### Plot of Average 'value' by Country
average_value_by_country <- data %>%
group_by(country) %>%
summarise(avg_value = mean(value, na.rm = TRUE))
# Define a color palette
color_palette <- c("Germany" = "red", "United Kigdom" = "green") # Example colors
# Plot average 'value' by country with color differentiation
ggplot(average_value_by_country, aes(x = reorder(country, avg_value), y = avg_value, fill = country)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = color_palette) +
labs(title = "Average 'value' by Country",
x = "Country",
y = "Average Value") +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
########This bar plot shows the average 'value' for each country, with distinct colors representing different countries.
## In this case, "Germany" is represented by a red color and "United Kingdom " by a green color.
### The plot helps in visually comparing the average income distribution across these countries.
### This visualization helps to highlight country-wise disparities or similarities in income distribution.
### Using distinct colors for each country improves clarity and helps in quickly identifying which country has higher or lower average values.
### This can be particularly useful in cross-country economic comparisons and understanding the impact of different economic policies.
###### Trend of 'value' Over Time for Each Country
ggplot(data, aes(x = year, y = value, color = country)) +
geom_line() +
labs(title = "Trend of 'value' Over Time for Each Country",
x = "Year",
y = "Value")
## This plot shows how the 'value' variable changes over time for each country.
## Using different colors for each country allows for a clear comparison of trends between countries.
### The plot offers a detailed view of how income distribution evolve over time within each country,
#### allowing for a comparative temporal analysis.
####Distribution of 'value' by 'percentile' and 'age'
ggplot(data, aes(x = percentile, y = value, fill = age)) +
geom_boxplot() +
labs(title = "Distribution of 'value' by 'percentile' and 'age'",
x = "Percentile",
y = "Value")
###################################################
######## Visualizaing the data using line plot
ggplot(data, aes(x = year, y = value, color = country)) +
geom_line() +
labs(
title = "Top 10% Income Share Over Time",
x = "Year",
y = "Income Share",
color = "Country"
) +
scale_color_manual(values = c("United Kingdom" = "blue", "Germany" = "orange")) +
theme_minimal()
### A blue line represents the top 10% income share over time for the United Kingdom.
## An orange line represents the same metric for Germany.
### The plot allows for easy comparison of the trends in the top 10% income share between the Germany and United Kingdom over time.
####Creating a box plot for United Kingdom and Germany arranged side by side
##### Checking for missing values in relevant columns
sum(is.na(data$year))
## [1] 0
sum(is.na(data$value))
## [1] 0
sum(is.na(data$country))
## [1] 0
ggplot(data, aes(x = country, y = value, fill = country)) +
geom_boxplot() +
scale_fill_manual(values = c("United Kingdom" = "blue", "Germany" = "orange")) +
labs(
title = "Distribution of Income Share for Top 10% by Country",
x = "Country",
y = "Income Share"
) +
theme_minimal()
##### This code produced a box plot that clearly shows the distribution of income share for the top 10% in both the United Kingdom and Germany,
### with each country represented by a distinct colour
#######Scatter Plot
ggplot(data, aes(x = `value`, y = `percentile`)) +
geom_point() +
geom_smooth(method = "lm", col = "red") +
labs(title = "Scatter Plot of United Kingdom versus Germany Top 10% Income Share",
x = "United Kingdom Income Share",
y = "Germany Income Share")
## `geom_smooth()` using formula = 'y ~ x'
### The scatter plot allows us to observe the relationship between the top 10% income share in the United Kingdom and Germany.
####### The red line is a linear regression line fitted to the data points, indicating the trend and relationship between the two variables.
### The slope of the line shows the direction and strength of the relationship:
# If the line slopes upwards, it indicates a positive correlation (as the United Kingdom income share increases, the Germany income share also increases).
# But if the line slopes downwards, it indicates a negative correlation (as the United Kingdom income share increases, the Germany income share decreases).
# The steepness of the slope indicates the strength of the relationship.
# Finally, The scatter plot and regression line provide insights into the nature of the relationship between the two variables.
### For example, a positive correlation might suggest similar economic factors influencing income distribution in both countries,
### whereas a lack of correlation might suggest differing economic policies or conditions.
### The linear regression line helps in quantifying this relationship and making predictions about one variable based on the other.
# Load required packages
library(ggplot2)
library(reshape2)
## Warning: package 'reshape2' was built under R version 4.3.3
##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smiths
library(gridExtra)
## Warning: package 'gridExtra' was built under R version 4.3.3
##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine
# Reshape the data for easier plotting with ggplot2
data_melted <- melt(data, id.vars = "year",
measure.vars = c("value", "percentile"),
variable.name = "country",
value.name = "Income_Share")
plot_uk <- ggplot(subset(data, country == "United Kingdom"), aes(x = value, y = percentile)) +
geom_point() +
geom_smooth(method = "lm", col = "red") +
labs(
title = "United Kingdom Top 10% Income Share",
x = "Income Share",
y = "Percentile"
) +
theme_minimal()
# Plot for Germany
plot_germany <- ggplot(subset(data, country == "Germany"), aes(x = value, y = percentile)) +
geom_point() +
geom_smooth(method = "lm", col = "red") +
labs(
title = "Germany Top 10% Income Share",
x = "Income Share",
y = "Percentile"
) +
theme_minimal()
# Arrange the plots side by side
grid.arrange(plot_uk, plot_germany, ncol = 2)
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
####### Lorenz Curve for Germany
library(ggplot2)
library(ineq)
# Filter the dataset to include only the relevant data points for Germany
germany_data <- data %>% filter(country == "Germany")
# Group by percentile and year, then aggregate the values
germany_data_agg <- germany_data %>%
group_by(percentile, year) %>%
summarize(value = mean(value, na.rm = TRUE), .groups = 'drop')
# Extract unique percentiles and sort them
percentiles <- sort(unique(germany_data_agg$percentile))
# Prepare data for Lorenz curve: cumulative income shares
cumulative_income_share <- germany_data_agg %>%
arrange(percentile, year) %>%
group_by(year) %>%
mutate(cumsum_value = cumsum(value)) %>%
ungroup() %>%
group_by(percentile) %>%
summarize(avg_cumsum_value = mean(cumsum_value), .groups = 'drop') %>%
arrange(percentile)
# Add a starting point (0,0) for the Lorenz curve
lorenz_curve <- c(0, cumulative_income_share$avg_cumsum_value)
# Calculate the x-axis points for the Lorenz curve (cumulative population share)
cumulative_population_share <- seq(0, 1, length.out = length(lorenz_curve))
# Create a data frame for plotting
lorenz_data <- data.frame(
cumulative_population_share = cumulative_population_share,
cumulative_income_share = lorenz_curve
)
# Plot the Lorenz curve
ggplot(lorenz_data, aes(x = cumulative_population_share, y = cumulative_income_share)) +
geom_line(color = "blue", size = 1) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "gray") +
labs(
title = "Lorenz Curve for Germany",
x = "Cumulative Population Share",
y = "Cumulative Income Share"
) +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Calculate Theil index for the most recent year
most_recent_year <- max(germany_data_agg$year)
recent_year_data <- germany_data_agg %>% filter(year == most_recent_year) %>% pull(value)
# Theil index calculation
theil_index <- function(income_shares) {
mean_income_share <- mean(income_shares)
theil_sum <- sum(income_shares * log(income_shares / mean_income_share))
theil_index_value <- theil_sum / length(income_shares)
return(theil_index_value)
}
theil_index_value <- theil_index(recent_year_data)
print(theil_index_value)
## [1] 0.03214114
# Load necessary libraries
library(readxl)
library(ggplot2)
library(dplyr)
library(ineq)
# Filter the dataset to include only the relevant data points for the United Kingdom
uk_data <- data %>% filter(country == "United Kingdom")
# Group by percentile and year, then aggregate the values
uk_data_agg <- uk_data %>%
group_by(percentile, year) %>%
summarize(value = mean(value, na.rm = TRUE), .groups = 'drop')
# Extract unique percentiles and sort them
percentiles <- sort(unique(uk_data_agg$percentile))
# Prepare data for Lorenz curve: cumulative income shares
cumulative_income_share <- uk_data_agg %>%
arrange(percentile, year) %>%
group_by(year) %>%
mutate(cumsum_value = cumsum(value)) %>%
ungroup() %>%
group_by(percentile) %>%
summarize(avg_cumsum_value = mean(cumsum_value), .groups = 'drop') %>%
arrange(percentile)
# Add a starting point (0,0) for the Lorenz curve
lorenz_curve <- c(0, cumulative_income_share$avg_cumsum_value)
# Calculate the x-axis points for the Lorenz curve (cumulative population share)
cumulative_population_share <- seq(0, 1, length.out = length(lorenz_curve))
# Create a data frame for plotting
lorenz_data <- data.frame(
cumulative_population_share = cumulative_population_share,
cumulative_income_share = lorenz_curve
)
# Plot the Lorenz curve
ggplot(lorenz_data, aes(x = cumulative_population_share, y = cumulative_income_share)) +
geom_line(color = "blue", size = 1) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "gray") +
labs(
title = "Lorenz Curve for United Kingdom",
x = "Cumulative Population Share",
y = "Cumulative Income Share"
) +
theme_minimal()
# Calculate Theil index for the most recent year
most_recent_year <- max(uk_data_agg$year)
recent_year_data <- uk_data_agg %>% filter(year == most_recent_year) %>% pull(value)
# Theil index calculation
theil_index <- function(income_shares) {
mean_income_share <- mean(income_shares)
theil_sum <- sum(income_shares * log(income_shares / mean_income_share))
theil_index_value <- theil_sum / length(income_shares)
return(theil_index_value)
}
theil_index_value <- theil_index(recent_year_data)
print(theil_index_value)
## [1] 0.03486818
########## The provided plot shows the Lorenz curve for Germany, representing the cumulative distribution of income among the population.
# Line of Equality (45-degree line):
### This dashed line represents perfect equality, where each percentage of the population earns an equal percentage of the total income.
### For example, 10% of the population would earn 10% of the income, 50% would earn 50%, and so on.
###Lorenz Curve (yellow line):
##The yellow Lorenz curve shows the actual cumulative income distribution. The further this curve is from the line of equality, the higher the income inequality.
# Key Observations:
# Initial Portion (Left side of the curve): The curve starts close to the origin (0,0), indicating that the lowest percentiles of the population hold a very small share of the total income.
# For example, the bottom 20% of the population might hold less than 10% of the total income.
# Middle Portion: As we move along the x-axis (increasing population percentiles), the curve remains below the line of equality, showing that cumulative income shares increase but not as quickly as the population percentiles.
# Final Portion (Right side of the curve): The curve rises more sharply towards the end, indicating that the top percentiles of the population hold a significantly larger share of the total income. For example, the top 20% might hold more than 50% of the total income.
###Interpretation of Inequality:
# Income Distribution: The Lorenz curve’s bowing away from the line of equality suggests that income is not evenly distributed.
# A significant portion of the income is concentrated among the higher percentiles.
# Measure of Inequality: The area between the Lorenz curve and the line of equality represents the degree of inequality. The larger this area, the greater the inequality. In this plot, the curve’s noticeable bowing indicates a moderate level of income inequality in Germany.
#
#Comparative Analysis:
# The visual representation suggests that Germany has a significant, though not extreme, level of income inequality.
# The curve is not extremely far from the line of equality, implying that Germany's income distribution, while unequal, is not among the most unequal globally.
###The Lorenz curve for Germany demonstrates that there is a moderate level of income inequality.
# The lower percentiles of the population hold a relatively small share of total income, while the higher percentiles hold a disproportionately large share.
#####################################################
#### Lorenz Curve for United Kingdom
#
library(ggplot2)
library(dplyr)
library(ineq)
# Filter the dataset to include only the relevant data points for the United Kingdom
uk_data <- data %>% filter(country == "United Kingdom")
# Group by percentile and year, then aggregate the values
uk_data_agg <- uk_data %>%
group_by(percentile, year) %>%
summarize(value = mean(value, na.rm = TRUE), .groups = 'drop')
# Extract unique percentiles and sort them
percentiles <- sort(unique(uk_data_agg$percentile))
# Prepare data for Lorenz curve: cumulative income shares
cumulative_income_share <- uk_data_agg %>%
arrange(percentile, year) %>%
group_by(year) %>%
mutate(cumsum_value = cumsum(value)) %>%
ungroup() %>%
group_by(percentile) %>%
summarize(avg_cumsum_value = mean(cumsum_value), .groups = 'drop') %>%
arrange(percentile)
# Add a starting point (0,0) for the Lorenz curve
lorenz_curve <- c(0, cumulative_income_share$avg_cumsum_value)
# Calculate the x-axis points for the Lorenz curve (cumulative population share)
cumulative_population_share <- seq(0, 1, length.out = length(lorenz_curve))
# Create a data frame for plotting
lorenz_data <- data.frame(
cumulative_population_share = cumulative_population_share,
cumulative_income_share = lorenz_curve
)
# Plot the Lorenz curve
ggplot(lorenz_data, aes(x = cumulative_population_share, y = cumulative_income_share)) +
geom_line(color = "blue", size = 1) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "gray") +
labs(
title = "Lorenz Curve for United Kingdom",
x = "Cumulative Population Share",
y = "Cumulative Income Share"
) +
theme_minimal()
# Calculate Theil index for the most recent year
most_recent_year <- max(uk_data_agg$year)
recent_year_data <- uk_data_agg %>% filter(year == most_recent_year) %>% pull(value)
# Theil index calculation
theil_index <- function(income_shares) {
mean_income_share <- mean(income_shares)
theil_sum <- sum(income_shares * log(income_shares / mean_income_share))
theil_index_value <- theil_sum / length(income_shares)
return(theil_index_value)
}
theil_index_value <- theil_index(recent_year_data)
print(theil_index_value)
## [1] 0.03486818