Introduction

This document is a final project for the subject “Advanced Visualisation in R” offered by the Faculty of Economic Sciences at the University of Warsaw.

In the project we wanted to explore some characteristics of the super-rich by using interesting plots and graphics.

Questions

What we wanted to know? * How old are billionaires? * Are there any differences between males and females? * What is a spatial distribution of billionaires? * What are the main industries their wealth come from? * Are there any relationships between the number of billionaires and other variables? * How unequal are super-rich? * How often billionaires are self-made?

Data source

The data we used was collected by Forbes (2023). It was later compiled and shared on Kaggle under the link https://www.kaggle.com/datasets/nelgiriyewithana/billionaires-statistics-dataset. It contains information about 2397 individuals whoose approximate net worth is at least 1 billion US$. The selected information include their age, gender, country of origin, being self-made or not and more.

Packages and libraries

library(janitor) # for very handy cleaning data
library(dplyr) # for pipeline, widening data and other operations
library(tidyr) # for easier handling data and less messy code
library(stringr) # for operations on strings
library(lubridate) # for dealing with time-data
library(ggplot2) # plotting
library(ggthemes) # for nicer themes
library(hrbrthemes) # for other nice themes
library(sf) # for spatial analysis (maps)
library(rnaturalearth) # for ne_countries data
library(ggrepel) # extra geoms (e.g. for labels)
library(viridis) # colourful charts
library(ggridges) # density plots
library(countrycode) # for accessing countrycode in ISO format
library(gglorenz) # for inequality curve

Reading the data and preparation

data = read.csv("Billionaires Statistics Dataset.csv")

summary(data)
##       rank        finalWorth       category          personName       
##  Min.   :   1   Min.   :  1000   Length:2640        Length:2640       
##  1st Qu.: 659   1st Qu.:  1500   Class :character   Class :character  
##  Median :1312   Median :  2300   Mode  :character   Mode  :character  
##  Mean   :1289   Mean   :  4624                                        
##  3rd Qu.:1905   3rd Qu.:  4200                                        
##  Max.   :2540   Max.   :211000                                        
##                                                                       
##       age           country              city              source         
##  Min.   : 18.00   Length:2640        Length:2640        Length:2640       
##  1st Qu.: 56.00   Class :character   Class :character   Class :character  
##  Median : 65.00   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 65.14                                                           
##  3rd Qu.: 75.00                                                           
##  Max.   :101.00                                                           
##  NA's   :65                                                               
##   industries        countryOfCitizenship organization        selfMade      
##  Length:2640        Length:2640          Length:2640        Mode :logical  
##  Class :character   Class :character     Class :character   FALSE:828      
##  Mode  :character   Mode  :character     Mode  :character   TRUE :1812     
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##     status             gender           birthDate           lastName        
##  Length:2640        Length:2640        Length:2640        Length:2640       
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##   firstName            title               date              state          
##  Length:2640        Length:2640        Length:2640        Length:2640       
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##  residenceStateRegion   birthYear      birthMonth       birthDay   
##  Length:2640          Min.   :1921   Min.   : 1.00   Min.   : 1.0  
##  Class :character     1st Qu.:1948   1st Qu.: 2.00   1st Qu.: 1.0  
##  Mode  :character     Median :1957   Median : 6.00   Median :11.0  
##                       Mean   :1957   Mean   : 5.74   Mean   :12.1  
##                       3rd Qu.:1966   3rd Qu.: 9.00   3rd Qu.:21.0  
##                       Max.   :2004   Max.   :12.00   Max.   :31.0  
##                       NA's   :76     NA's   :76      NA's   :76    
##   cpi_country     cpi_change_country gdp_country       
##  Min.   : 99.55   Min.   :-1.900     Length:2640       
##  1st Qu.:117.24   1st Qu.: 1.700     Class :character  
##  Median :117.24   Median : 2.900     Mode  :character  
##  Mean   :127.76   Mean   : 4.364                       
##  3rd Qu.:125.08   3rd Qu.: 7.500                       
##  Max.   :288.57   Max.   :53.500                       
##  NA's   :184      NA's   :184                          
##  gross_tertiary_education_enrollment gross_primary_education_enrollment_country
##  Min.   :  4.00                      Min.   : 84.7                             
##  1st Qu.: 50.60                      1st Qu.:100.2                             
##  Median : 65.60                      Median :101.8                             
##  Mean   : 67.23                      Mean   :102.9                             
##  3rd Qu.: 88.20                      3rd Qu.:102.6                             
##  Max.   :136.60                      Max.   :142.1                             
##  NA's   :182                         NA's   :181                               
##  life_expectancy_country tax_revenue_country_country total_tax_rate_country
##  Min.   :54.30           Min.   : 0.10               Min.   :  9.90        
##  1st Qu.:77.00           1st Qu.: 9.60               1st Qu.: 36.60        
##  Median :78.50           Median : 9.60               Median : 41.20        
##  Mean   :78.12           Mean   :12.55               Mean   : 43.96        
##  3rd Qu.:80.90           3rd Qu.:12.80               3rd Qu.: 59.10        
##  Max.   :84.20           Max.   :37.20               Max.   :106.30        
##  NA's   :182             NA's   :183                 NA's   :182           
##  population_country  latitude_country longitude_country
##  Min.   :3.802e+04   Min.   :-40.90   Min.   :-106.35  
##  1st Qu.:6.683e+07   1st Qu.: 35.86   1st Qu.: -95.71  
##  Median :3.282e+08   Median : 37.09   Median :  10.45  
##  Mean   :5.102e+08   Mean   : 34.90   Mean   :  12.58  
##  3rd Qu.:1.366e+09   3rd Qu.: 40.46   3rd Qu.: 104.20  
##  Max.   :1.398e+09   Max.   : 61.92   Max.   : 174.89  
##  NA's   :164         NA's   :164      NA's   :164

We want to unify the names of columns. To do so, we use janitor package

data <- clean_names(data)
#Let's see the new names
names(data)
##  [1] "rank"                                      
##  [2] "final_worth"                               
##  [3] "category"                                  
##  [4] "person_name"                               
##  [5] "age"                                       
##  [6] "country"                                   
##  [7] "city"                                      
##  [8] "source"                                    
##  [9] "industries"                                
## [10] "country_of_citizenship"                    
## [11] "organization"                              
## [12] "self_made"                                 
## [13] "status"                                    
## [14] "gender"                                    
## [15] "birth_date"                                
## [16] "last_name"                                 
## [17] "first_name"                                
## [18] "title"                                     
## [19] "date"                                      
## [20] "state"                                     
## [21] "residence_state_region"                    
## [22] "birth_year"                                
## [23] "birth_month"                               
## [24] "birth_day"                                 
## [25] "cpi_country"                               
## [26] "cpi_change_country"                        
## [27] "gdp_country"                               
## [28] "gross_tertiary_education_enrollment"       
## [29] "gross_primary_education_enrollment_country"
## [30] "life_expectancy_country"                   
## [31] "tax_revenue_country_country"               
## [32] "total_tax_rate_country"                    
## [33] "population_country"                        
## [34] "latitude_country"                          
## [35] "longitude_country"

We remove rows with blank cells or NA’s

data<- subset(data, complete.cases(data))

The birthdate and date column can be converted into date type with lubridate package

data$date <- parse_date_time(data$date, orders = "%m/%d%y %H:%M") %>% 
  round_date(unit = "day")
data$birth_date <- parse_date_time(data$birth_date, orders = "%m/%d%y %H:%M") %>% 
  round_date(unit = "day")

Let’s hunt down duplicate colums

colnames(data[duplicated(as.list(data))])
## [1] "industries"
# Well, there is one duplicate. Let's remove it
data <- select(data, -industries)

In gdp_country there is a ‘$’ sign. I will remove it and write numerical values in millions. (To make it comparable with ‘final_worth’ colums)

data$gdp_country <- str_remove(data$gdp_country,pattern="\\$") %>%
  str_remove_all(pattern=",") %>%
  str_trim() %>% # trim whitespaces
  as.numeric() %>%
  '/'(1000000) %>%
  round(digits = 0)

Adding new columns

Based on the existing columns we see the opportunity to extract more information from them. We will check who shares their wealth with the family and who owns the assets on their own.

Family

data$family_wealth <- grepl("& family", data$person_name) # new variable if the wealth is shared with the family
data$person_name <- sub(" & family", "", data$person_name) # removing the suffix from name

Continent

iso_codes <- countrycode(data$country, origin = "country.name", destination = "iso3c")
continents <- countrycode(iso_codes, origin = "iso3c", destination = "continent")
data$continent <- continents

Countries from North America and South America are treated as “Americas”. We divide them.

north_american_countries <- c("United States", "Mexico", "Canada", "Guatemala", "Haiti", "Dominican Republic", "Cuba")
data$continent[data$country %in% north_american_countries] <- "North America"
data$continent[data$continent == "Americas"] <- "South America"

Plots

Summary of final worth in each category

Total worth within each category

summary_categories <- data %>%
  group_by(category) %>%
  summarise(total_final_worth = sum(final_worth))

summary_categories$category=str_wrap(summary_categories$category, width = 10)


ggplot(summary_categories, aes(x = reorder(category, total_final_worth), y = total_final_worth)) +
  geom_bar(stat = "identity", fill = "darkblue", width = 0.5) +
  geom_text(aes(label = paste0(round((total_final_worth/sum(total_final_worth))*100, 2), "%")), 
            vjust = 0.2, hjust = -0.2, size = 3) +
  labs(title = "Total Final Worth by Category", 
       x = "Category", 
       y = "Total Final Worth (bn $)") +
  coord_flip() +
  theme_gdocs() +
  theme(axis.text.y = element_text(size = 7),  
        plot.title = element_text(size = 20, hjust = 0.5))

Categories by gender

categories_wealth <- data %>%
  group_by(category) %>%
  summarize(categories_count = n(),
            males_count = sum(gender == "M"),
            females_count = sum(gender == "F")) %>%
  arrange(desc(categories_count))

new_dataframe <- categories_wealth %>%
  pivot_longer(cols = c(males_count, females_count), names_to = "gender", values_to = "count") %>%
  mutate(gender = ifelse(gender == "males_count", "male", "female"))

ggplot(data = new_dataframe, aes(x = reorder(factor(category), -count), y = count, fill = factor(gender))) +
  geom_bar(na.rm = TRUE, position = "stack", width = 0.5, stat = "identity") +
  ggtitle('Categories by Gender') +
  xlab('Category') +
  ylab('Count') +
  labs(fill = 'Gender') +
  theme_gdocs() +
  scale_fill_manual(values = c('pink', 'lightblue')) +
  geom_text(aes(label = count), position = position_stack(vjust = 0.5), size = 2.5) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(size = 20, hjust = 0.5))

Age histogram

ggplot(data=data, aes(x = age)) + 
  geom_histogram(aes(color = gender, fill=gender), alpha=0.5, position="stack")+
  geom_vline(aes(xintercept=mean(age, na.rm = T), color="65.14"), 
             linetype="dashed", size=1)+
  scale_color_manual(name = "Mean =", values = c("65.14" = "red"))+
  scale_fill_discrete(name = "Gender")+
  scale_x_continuous(breaks = c(20,30,40,50,60,70,80,90,100))+
  labs(title = 'Number of Billionaires by Age',
       x = 'Age' , y = 'Number of Billionaires')  +
  theme_gdocs()
## 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.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Gender pie chart

Find the gender and their respective percentage values

gender_percentages <- data.frame(prop.table(table(data$gender)) * 100) %>% rename(gender = Var1)

Plotting the pie chart

ggplot(gender_percentages, aes(x = "", y = Freq, fill = gender)) +
  geom_col(color = "black", alpha=0.5) +
  geom_label(aes(label = sprintf("%0.1f%%",Freq)), 
             color='white',
             size=10,
             position = position_stack(vjust = 0.5),
             show.legend = FALSE) +
  guides(fill="none")+
  coord_polar(theta = "y") + 
  theme_void()

Age groups

Explore the wealth differences across different age groups by dividing them into bins of 10

age_bin_data <- data %>%
  mutate(age_bin = cut(age, breaks = c(18,30,40,50,60,70,80,90,101))) %>%
  group_by(age_bin) %>%
  summarize(avg_wealth = mean(final_worth, na.rm = TRUE),
            count_family_share = sum(family_wealth==TRUE)) %>%
  na.omit()

Create a histogram

ggplot(age_bin_data, aes(x = age_bin, y = avg_wealth/1000, label = round(avg_wealth/1000,2))) +
  geom_bar(stat = "identity", fill = "lightgreen", color = "black") +
  geom_text(size=4,vjust=2.5,color= "black") +
  labs(title = "Average Wealth by Age Group",x = "Age Group",y = "Average Wealth (Billions)") +
  theme(axis.text.x = element_text(hjust = 0.5))+
  theme_gdocs()

Family wealth plot

Create a histogram

ggplot(age_bin_data, aes(x = age_bin, y = count_family_share, label = count_family_share)) +
  geom_bar(stat = "identity", fill = "lightgreen", color = "black", alpha = 0.8) +
  geom_text(size=4,vjust=-0.4,color= "black") +
  labs(title = "Number of Family Share by Age Group",
       x = "Age Group",
       y = "Number of Family Share") +
  theme(axis.text.x = element_text(hjust = 0.5))+
  theme_gdocs()

World map

world <- ne_countries(scale = "small", returnclass = "sf")

billionaires_ppl <- data %>% 
  group_by(country) %>% 
  summarize(billionaires_count = n())

billionaires_ppl <- billionaires_ppl[-1,]

New column to match with ‘world’ object

billionaires_ppl$name <- billionaires_ppl$country
billionaires_ppl[billionaires_ppl$name=="Czech Republic", 3] = "Czechia"
billionaires_ppl[billionaires_ppl$name=="Eswatini (Swaziland)", 3] = "eSwatini"
billionaires_ppl[billionaires_ppl$name=="United States", 3] = "United States of America"

world <- left_join(world, billionaires_ppl, by= join_by(name))

Creating a world map

ggplot(data = world) +
  coord_sf(expand = FALSE) +
  geom_sf(aes(fill =  billionaires_count)) +
  scale_fill_gradient(low = 'azure',  #lightgreen
                      high = 'blue4', #darkorange
                      breaks = seq(0, 750, by=100),
                      labels = paste(seq(0, 750, by=100), 'people'),
                      guide = guide_colorbar(barwidth = 2, barheight = 12,),
                      name = "Number of Billionaires",
                      #colours = c("#f7ffe6", "#d9ffb3", "#b1ff80", "#8fe65c", "#64cc39", "#47ab2f", "#2f8f24", "#1f7519"),
                      space = "Lab",
                      na.value = "white",
                      aesthetics = "fill")+
  theme(legend.position = 'right')+
  theme_gdocs()+
  labs(title="Where do Billionaires Come From?")
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.

Map for checking billionaires’ age

Preparation

average_age_by_country <- data %>%
  group_by(country) %>%
  summarise(average_age = mean(age, na.rm = TRUE))

average_age_by_country  <- average_age_by_country [-1,]

average_age_by_country$name <- average_age_by_country$country
average_age_by_country[average_age_by_country$name=="Czech Republic", 3] = "Czechia"
average_age_by_country[average_age_by_country$name=="Eswatini (Swaziland)", 3] = "eSwatini"
average_age_by_country[average_age_by_country$name=="United States", 3] = "United States of America"

world_2 <- left_join(world, average_age_by_country, by= join_by(name))

And the map

ggplot(data = world_2) +
  coord_sf(expand = FALSE) +
  geom_sf(aes(fill =  average_age)) +
  scale_fill_gradient(low = 'azure',
                      high = 'blue4',
                      breaks = seq(0, 90, by=5),
                      labels = paste(seq(0, 90, by=5), 'years'),
                      guide = guide_colorbar(barwidth = 2, barheight = 12,),
                      name = "Age of billionaires",
                      #colours = c("#f7ffe6", "#d9ffb3", "#b1ff80", "#8fe65c", "#64cc39", "#47ab2f", "#2f8f24", "#1f7519"),
                      space = "Lab",
                      na.value = "white",
                      aesthetics = "fill")+
  theme(legend.position = 'right')+
  theme_gdocs()+
  labs(title="What is the Average Age of Billionaires?")
## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.

## `summarise()` has grouped output by 'name'. You can override using the
## `.groups` argument.

10 countries with the highest number of billionaires

top_countries <- billionaires_ppl %>%
  top_n(10,billionaires_count)

Wrapping the text for better display on a plot

top_countries$name=str_wrap(top_countries$name, width = 10)

And the plot

ggplot(top_countries, aes(x = reorder(name, desc(billionaires_count)), y = billionaires_count, label=billionaires_count)) +
  geom_bar(stat = "identity", fill = "lightgreen", alpha=0.8) +
  labs(title = "Countries with Most Billionaires", 
       x = "Country", 
       y = "Number of Billionaires") +
  geom_text(size=4,vjust=0.6,color= "black") +
  theme_gdocs()

Categories of wealth

categories_wealth <- data %>%
  group_by(category) %>%
  summarize(categories_count = n()) %>%
  arrange(desc(categories_count))

head(categories_wealth)
## # A tibble: 6 × 2
##   category              categories_count
##   <chr>                            <int>
## 1 Finance & Investments              340
## 2 Technology                         293
## 3 Manufacturing                      287
## 4 Fashion & Retail                   244
## 5 Food & Beverage                    189
## 6 Healthcare                         188

We will sum small categories into one bigger one “Others”

top_categories <- categories_wealth %>%
  filter(categories_count>=100) %>%
  rbind(c("Others", 
          sum(categories_wealth[which(categories_wealth$categories_count<100),2])))

Changing to numeric for plotting

top_categories$categories_count <- as.numeric(top_categories$categories_count)

Scatterplot gdp vs. number of billionaires

  • total_tax_rate
billionaires_ppl$gdp <- 0
billionaires_ppl$population <- 0
billionaires_ppl$total_tax_rate_country <- 0

The loop here takes some time

for (i in 1:nrow(billionaires_ppl)) {
  for (j in 1:nrow(data)) {
    if (billionaires_ppl[i, "name"] == data[j, "name"]) {
      billionaires_ppl[i, "gdp"] = data[j, "gdp_country"]
      billionaires_ppl[i, "population"] = data[j, "population_country"]
      billionaires_ppl[i, "total_tax_rate_country"] = data[j, "total_tax_rate_country"]
      billionaires_ppl[i, "gross_tertiary_education_enrollment"] = data[j, "gross_tertiary_education_enrollment"]
      billionaires_ppl[i, "tax_revenue_country_country"] = data[j, "tax_revenue_country_country"]
      
      break
    }
  }
}

Log transformations

billionaires_ppl$log_pop <- log(billionaires_ppl$population)
billionaires_ppl$log_gdp <- log(billionaires_ppl$gdp)

Let’s see whether there is a relationship between GDP and the number of billionaires

ggplot(billionaires_ppl, aes(x = gdp, y = billionaires_count)) +
  geom_point(aes(size = total_tax_rate_country, color = population)) +
  labs(title = 'GDP vs. Number of Billionaires', color = 'Population',
       x = 'GDP' , y = 'Number of Billionaires', size = 'Total Tax Rate')  + 
  scale_x_continuous(breaks=c(1000000,5000000,10000000,15000000,20000000, 25000000),
                     labels = c("1 bln $", "5 bln $", "10 bln $", "15 bln $", "20 bln $", "25 bln $"))+
  geom_smooth(method='lm', formula= y~x)+
  geom_text_repel(aes(label = name))+
  theme_gdocs()
## Warning: ggrepel: 59 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

Maybe tax revenue has an impact too?

ggplot(billionaires_ppl, aes(x = tax_revenue_country_country, y = log(billionaires_count))) +
  geom_point(aes(size = total_tax_rate_country, color = population)) +
  labs(title = 'Tax Revenue vs. Number of Billionaires', color = 'Population',
       x = 'Tax Revenue' , y = 'Number of Billionaires (log)', size = 'Total Tax Rate')  + 
  scale_x_continuous(breaks=c(1,25,50,75,100),
                     labels = c("1", "25", "50", "75", "100"))+
  geom_smooth(method='loess', formula= y~x)+
  theme_gdocs()

There are some outliers. We will delete them and rerun the code

billionaires_ppl_new <- billionaires_ppl %>% 
  filter(tax_revenue_country_country>5) %>%
  filter(tax_revenue_country_country<26)

And plot again

ggplot(billionaires_ppl_new, aes(x = tax_revenue_country_country, y = log(billionaires_count))) +
  geom_point(color = "darkgreen", size= 3) +
  labs(title = 'Tax Revenue vs. Number of Billionaires',
       x = 'Tax Revenue' , y = 'Number of Billionaires (log)',
       caption = "*Outliers excluded")  + 
  scale_x_continuous(breaks=c(1,5,15,25,35),
                     labels = c("1", "5", "15", "25", "35"))+
  geom_smooth(method='loess', formula= y~x, fill="lightgreen")+
  theme_gdocs()

More data transformations

data <- data %>%
  mutate(self_made = as.integer(self_made))

data <- data %>%
  mutate(family_wealth = as.integer(family_wealth))

data <- data %>%
  mutate(self_made = as.integer(self_made))

Logit models

Hypothesis: the higher the age the lower the probability fo being self-made

ggplot(data = data, aes(x = age, y = self_made)) +
  geom_point() +
  geom_smooth(method = 'glm', method.args = list(family = binomial(link = 'logit')),
              formula = y ~ x) +
  theme_gdocs() +
  labs(title = "Probability of Being Self-Made vs. Age",
       x = "Age",  # Label for x-axis
       y = "Self-made") +  # Label for y-axis
  theme(
    text = element_text(size = 20),  
    plot.title = element_text(hjust = 0.5) 
  )

Maybe tendencies depend on the continent? We will drop Africa and Australia because they may include some unconventional observations

data_filtered <- data %>% 
  filter(!continent %in% c("Africa", "Oceania"))

ggplot(data = data_filtered, aes(x = age, y = self_made, color = continent)) +
  geom_point() +
  geom_smooth(
    method = 'glm',
    method.args = list(family = binomial(link = 'logit')),
    formula = y ~ x,
    se = TRUE
  )  +theme_gdocs()+
  labs(title = "Probability of Being Self-Made vs. Age",
       x = "Age",  # Label for x-axis
       y = "Self-made") +  # Label for y-axis
  theme(
    text = element_text(size = 20),  
    plot.title = element_text(hjust = 0.5) 
  )

Rigid plots

We start with removing outliers for better visibility

filtered_data <- data %>%
  arrange(final_worth) %>%
  slice(1:(0.9 * nrow(.)))

Plotting the distribution of final_worth by gender

ggplot(filtered_data, aes(x = final_worth, y = gender, fill = ..x..)) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis(name = "Final Worth", option = "D") +
  theme_minimal() +
  theme(plot.title = element_text(size = 20, hjust = 0.5)) +
  labs(title = "Density Plots of Billionaires Worth by Gender and Self-Made Status",
       x = "Final Worth (mln $)",
       y = "Gender") +
  facet_grid(self_made ~ ., scales = "free_y", space = "free_y", 
             labeller = labeller(self_made = c("1" = "Self-Made", "0" = "Non-Self-Made")))+
  geom_rect(data = subset(filtered_data, self_made == 0),
            aes(xmin = quantile(final_worth[self_made == 0], 0.90),
                xmax = max(final_worth[self_made == 0]),
                ymin = -Inf,
                ymax = 4),
            fill = NA, color = "red", size = 1)+
  theme_gdocs()
## Warning: The dot-dot notation (`..x..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(x)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Picking joint bandwidth of 520
## Picking joint bandwidth of 424

Lorenz curves

data %>%
  ggplot(aes(final_worth)) +
  stat_lorenz(desc = TRUE) +
  coord_fixed() +
  geom_abline(linetype = 'dashed') +
  theme_minimal() +
  hrbrthemes::scale_x_percent() +
  hrbrthemes::scale_y_percent() +
  hrbrthemes::theme_ipsum_rc() +
  labs(x = "Cumulative Percentage of the Billionaires",
       y = "Cumulative Percentage of Total Net Worth") +
  theme_gdocs() +
  theme(plot.title = element_text(hjust = 0.5)) + 
  ggtitle("Inequality Among Billionaires")

Selecting 3 categories with lowest and highest inequality level

data_filtered <- data %>%
  filter(category %in% c("Telecom", "Real Estate", "Automotive", "Construction & Engineering",  "Service", "Technology"))

data_filtered  %>%
  ggplot(aes(final_worth, fill = category, color = category)) +
  stat_lorenz(desc = TRUE) +
  coord_fixed() +
  geom_abline(linetype = 'dashed') +
  theme_minimal() +
  hrbrthemes::scale_x_percent() +
  hrbrthemes::scale_y_percent() +
  hrbrthemes::theme_ipsum_rc() +
  labs(x = "Cumulative Percentage of the Billionaires",
       y = "Cumulative Percentage of Total Net Worth") +
  theme_gdocs() +
  theme(plot.title = element_text(hjust = 0.5)) + 
  ggtitle("Inequality Among Billionaires by Category")