# import data
billionaire_gdp_indus_usa <- read.csv("../data/billionaire_gdp_indus_usa.csv")
billionaire_gdp <- read.csv("../data/billionaire_gdp.csv")
gdp <- read.csv("../data/gdp.csv")Global Billionaires’ Wealth Trends Analysis
We conduct some exploratory analysis from two main aspects:
Billionaire Economic Trends:
GDP Trends: Analysis of changes in GDPs of 5 countries home to global billionaires, highlighting growth rates and economic development stages.
Sectoral Wealth Growth: Examination of the wealth growth within industries dominated by billionaires, noting the rise of new economic powerhouses.
Millionaire Residency Wealth Analysis: Tracking the net worth trends in Millionaire Residency with the highest concentration of billionaires, identifying urban patterns of wealth accumulation.
Billionaire Wealth Distribution
Global Net Worth Trends: Observation of the global net worth changes of billionaires, highlighting significant fluctuations due to global economic conditions.
Region Wealth Comparison: Analysis of the combined net worth of billionaires in the top five regions, reflecting the economic health and wealth generation in these nations.
Gender Wealth Gap: Examination of the distribution and total net worth of billionaires by gender, underscoring the persistent gender gap in billionaire wealth.
Self-Made Billionaires: Tracking the rise of self-made billionaires over the years, indicating the evolving landscape of entrepreneurial success and self-made wealth.
It explores the dynamics of economies, industries, and residences in terms of GDP and wealth concentration.
countries <- c("USA", "CHN", "RUS", "JPN", "DEU")
gdp_selected <-
gdp[gdp$code %in% countries & gdp$year >= 2010 & gdp$year <= 2022, ]
# draw GDP plot
gdp_con =
ggplot(data = gdp_selected, aes(x = year, y = gdp, color = code)) +
theme_minimal() +
geom_line(size = 1.2) +
labs(title = "GDP change from 2010 to 2022", x = "Year", y = "GDP(trillions)", color = "Region Code") +
scale_x_continuous(breaks = 2010:2022)+
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(gdp_con)The graph demonstrates the varying economic trajectories of these five countries(USA, CHN, RUS, JPN, DEU) over a 12-year period, with China showing the most remarkable growth rate, the USA maintaining a strong and steadily increasing GDP, while Japan shows relatively little change.
bil_industry =
billionaire_gdp |>
mutate(industries = replace(industries, industries == "Billionaire", NA))|>
drop_na(industries) |>
group_by(year, industries) |>
summarize(n = n()) |>
ggplot(aes(x = year, y = n, fill = industries))+
theme_minimal()+
geom_bar(position="stack", stat="identity")+
labs(title = "Number of billionaires in different industries from 2010 to 2023",
x = "Year", y = "Number of billionaires", fill = "Industries")+
scale_x_continuous(breaks = 2010:2023)+
theme(plot.title = element_text(hjust = 0.6),
text = element_text(family = "Helvetica"))
ggplotly(bil_industry)The global chart shows a clear upward trend in the number of billionaires across various industries, with significant growth in sectors such as Technology and Finance & Investments.
indus_gdp =
billionaire_gdp_indus_usa |>
drop_na(industry_gdp) |>
group_by(year, industries) |>
summarize(n = n()) |>
ggplot(aes(x = year, y = n, fill = industries)) +
theme_minimal() +
geom_bar(position="stack", stat="identity") +
labs(title = "Number of billionaires in different industries in the USA from 2017 to 2022",
x = "Year", y = "Number of billionaires", fill = "Industries") +
scale_x_continuous(breaks = 2017:2022)+
theme(plot.title = element_text(hjust = 0.6),
text = element_text(family = "Helvetica"))
ggplotly(indus_gdp)The USA-specific chart also displays an increase in the number of billionaires, particularly in Technology and Finance & Investments, while those engaged in health care increased significantly after 2020 due to the global epidemic.
data_filtered <- billionaire_gdp_indus_usa %>%
filter(year >= 2017 & year <= 2022) %>%
na.omit()
gdp_industry_usa <- data_filtered |>
select(year, industries, industry_gdp) |>
unique() |>
ggplot(aes(x = year, y = industry_gdp, color = industries)) +
geom_line(size = 1.2) +
theme_minimal() +
labs(title = "Industry GDP by year from 2017 to 2022 in the USA",
x = "Year", y = "Industry GDP(trillions)", color = "Industries")+
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(gdp_industry_usa)The chart illustrates the GDP changes of various industries in the USA from 2017 to 2022. It highlights that the Real Estate sector experienced the most significant growth, while the Media and Entertainment industry saw the least. There was a noticeable downturn in 2020 attributed to the COVID-19 pandemic, affecting billionaires across all sectors.
data_filtered <- billionaire_gdp |>
filter(year >= 2010 & year <= 2023,
country_of_citizenship == "United States")
net_worth_by_city_year <- data_filtered |>
select(year, city_of_residence, net_worth) |>
unique() |>
drop_na(city_of_residence)
# top5 total_net_worth
top_cities_by_year <- net_worth_by_city_year %>%
group_by(year) %>%
slice_max(order_by = net_worth, n = 5) %>%
ungroup()
nw_residence =
ggplot(top_cities_by_year, aes(x = year, y = net_worth, color = city_of_residence)) +
geom_line(size = 1.2) +
labs(title = "Net Worth Evolution in Top 5 Cities by Millionaire Residency (2010-2023)",
x = "Year", y = "Net worth(billions)",
color = "City of residence") +
scale_x_continuous(breaks = 2010:2023)+
theme(legend.position = "right") +
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(nw_residence)Note: In this analysis, 11 cities are considered, with annual changes in rankings due to variations in net worth. Net worth serves as the 5 sorting criterion and the decline noted in 2023 is likely a result of incomplete data.
The data indicates that while cities like Medina and Omaha remain consistent high performers, there’s a dynamic shift with other cities like Austin and Seattle showing rapid growth, indicating a possible diversification in the geographical distribution of wealth.
This category focuses on the distribution of wealth among different groups, genders, and the rise of self-made billionaires.
bil_all =
billionaire_gdp |>
group_by(year) |>
summarize(total_net_worth = sum(net_worth)) |>
ggplot(aes(x = year, y = total_net_worth, color = "#440154")) +
geom_line(size = 1.2) +
labs(title = "Total net worth of billionaire from 2010 to 2023",
x = "Year", y = "Total net worth (billions)")+
scale_x_continuous(breaks = 2010:2023)+
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none",
text = element_text(family = "Helvetica"))
ggplotly(bil_all)The line graph shows the changes in a billionaire’s net worth from 2010 to 2023, generally increasing but with significant drops in 2016 and 2020. These drops were probably caused by market problems and the financial effects of the COVID-19 pandemic. After the decrease in 2020, there was a sharp increase, reaching the highest point in 2021.
data_filtered <- billionaire_gdp %>%
filter(year >= 2010 & year <= 2023)
# group by region_code net worth over time
total_net_worth_by_region <- data_filtered %>%
group_by(region_code) %>%
summarise(total_net_worth = sum(net_worth, na.rm = TRUE))
# net worth top 5 regions
top_regions <- total_net_worth_by_region %>%
top_n(5, total_net_worth) %>%
pull(region_code)
top_regions_data <- data_filtered %>%
filter(region_code %in% top_regions)
total_net_worth_by_year_region <- top_regions_data %>%
group_by(year, region_code) %>%
summarise(total_net_worth = sum(net_worth, na.rm = TRUE))
# plot
tnw_citizen =
ggplot(total_net_worth_by_year_region, aes(x = year, y = total_net_worth, color = region_code)) +
geom_line(size = 1.2) +
theme_minimal() +
labs(title = "Total net worth of billionaires by top 5 regions from 2010 to 2023",
x = "Year", y = "Total net worth (billions)",
color = "Region code")+
scale_x_continuous(breaks = 2010:2023)+
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(tnw_citizen)The chart comparing billionaires’ net worth from 2010 to 2023 in five key regions shows the USA’s significant growth, particularly after 2015. China demonstrates rapid, albeit fluctuating, wealth accumulation. Germany exhibits consistent growth, while India’s rise mirrors its economic development. Hong Kong, however, saw growth followed by a decline after 2019. This data reflects diverse economic trends and the influence of regional and global factors on wealth.
# scale it to 1 to analyze the proportions
bil_gender_prop <-
billionaire_gdp|>
drop_na(gender) |>
group_by(year, gender) |>
summarize(n = n()) |>
group_by(year) |>
mutate(total = sum(n),
prop = n/ total)
bil_gender =
bil_gender_prop |>
ggplot(aes(x = year, y = prop, fill = gender))+
geom_bar(position="stack", stat="identity") +
labs(title = "Proportion of billionaires by gender from 2010 to 2023",
x = "Year", y = "Proportion", fill = "Gender")+
scale_x_continuous(breaks = 2010:2023)+
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(bil_gender)The bar chart illustrates the proportion of male and female billionaires from 2010 to 2023, indicating a consistent predominance of males in each year, with females representing a very small fraction of the total. This disparity in representation may reflect long-standing gender imbalances in wealth accumulation and opportunities for economic advancement.
billionaires_filtered <- billionaire_gdp %>%
filter(year >= 2010 & year <= 2023) %>% na.omit()
total_net_worth_by_year_gender <- billionaires_filtered %>%
group_by(year, gender) %>%
summarise(total_net_worth = sum(net_worth, na.rm = TRUE))
tnw_gender =
ggplot(total_net_worth_by_year_gender, aes(x = year, y = total_net_worth, color = gender)) +
geom_line(size = 1.2) +
theme_minimal() +
labs(title = "Total net worth by gender from 2010 to 2023",
x = "Year", y = "Total net worth (billions)", color = "Gender")+
scale_x_continuous(breaks = 2010:2023)+
theme(plot.title = element_text(hjust = 0.5),
text = element_text(family = "Helvetica"))
ggplotly(tnw_gender)The second line graph shows the net worth by gender from 2010 to 2023. The net worth of male billionaires is significantly higher than that of females throughout the period, with a particularly steep increase for males after 2015. The consistent gap and the sharp rise in male net worth could be due to a combination of factors, including the compounding effect of existing wealth, gender disparities in key industries, and potentially more males being active in high-growth sectors such as technology and finance.
# scale it to 1 to analyze the proportions
bil_selfmade_prop <-
billionaire_gdp|>
filter(year > 2010) |>
drop_na(self_made) |>
group_by(year, self_made) |>
summarize(n = n()) |>
group_by(year) |>
mutate(total = sum(n),
prop = n/ total)
bil_selfmade =
bil_selfmade_prop |>
ggplot(aes(x = year, y = prop, fill = self_made)) +
geom_bar(position="stack", stat="identity") +
labs(title = "Proportion of self-made status count from 2011 to 2023",
x = "Year", y = "Proportion", fill = "Self-made")+
theme(plot.title = element_text(hjust = 0.5))+
scale_x_continuous(breaks = 2011:2023)
ggplotly(bil_selfmade)Note: Remove data for the year 2010 due to errors
The bar chart depicting the proportion of self-made billionaires from 2011 to 2023 demonstrates a consistent majority of individuals who have amassed their wealth independently, without inheritance or existing family wealth.