For this project I picked a dataset about billionaires. I wanted to see if there were any common factors that many of the worlds richest share. The data has 2,614 rows. Each row is one billionaire on one of three lists, from 1996, 2001, and 2014, so the same person can show up more than once. The file is a compiled version of the Forbes billionaire lists put together by researchers at the Peterson Institute for International Economics, and I downloaded it from CORGIS datasets.
The file has 22 columns, but I only use seven of them. name is the billionaire’s name (categorical variable). year is the year of the list, and it only takes the values 1996, 2001, and 2014, so it is basically categorical. worth is net worth in billions of US dollars, which is a continuous quantitative variable and my main outcome. age is the billionaire’s age in years (quantitative), and founded is the year the person’s company was founded (quantitative). region is the part of the world the person is a citizen of, such as North America, Europe, or East Asia (categorical). Last, wealth_type tells how the money was made, with five groups: inherited, founder non-finance, self-made finance, executive, and privatized and resources (categorical).
Cleaning was a big part of this project, because the missing values in this file are not stored as blanks. Missing ages are stored as 0, missing founding years are stored as 0, and some rows dont have any information. I also left out the GDP column, since it is 0 for almost every billionaire on the 2014 list. I used select() to keep and rename my seven columns, and filter() to remove the rows with these fake or missing values, which left 2,210 billionaires.
Libraries
# tidyverse has read_csv, dplyr, and ggplot2 in itlibrary(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.2.1 ✔ readr 2.2.0
✔ forcats 1.0.1 ✔ stringr 1.6.0
✔ ggplot2 4.0.3 ✔ tibble 3.3.1
✔ lubridate 1.9.5 ✔ tidyr 1.3.2
✔ purrr 1.2.2
── 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(ggplot2)# highcharter is for the interactive graphlibrary(highcharter)
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
Highcharts (www.highcharts.com) is a Highsoft software product which is
not free for commercial and Governmental use
Loading the Data
# load the csv filebillionaires <-readr::read_csv("billionaires.csv")
Rows: 2614 Columns: 22
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (13): name, company.name, company.relationship, company.sector, company....
dbl (6): rank, year, company.founded, demographics.age, location.gdp, wealt...
lgl (3): wealth.how.from emerging, wealth.how.was founder, wealth.how.was p...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Min. 1st Qu. Median Mean 3rd Qu. Max.
-42.00 47.00 59.00 53.34 70.00 98.00
#year the company was foundedsummary(billionaires$company.founded)
Min. 1st Qu. Median Mean 3rd Qu. Max.
0 1936 1963 1925 1985 2012
#net worth in billionssummary(billionaires$`wealth.worth in billions`)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.000 1.400 2.000 3.532 3.500 76.000
Exploring visualizations
#I want to see how these two variables look togetherggplot(billionaires,aes(x=demographics.age, y =`wealth.worth in billions`))+geom_point(size=2, alpha =0.5)+labs(x="Age", y ="Net Worth (billions of US dollars)",title ="Age and Net Worth of Billionaires")
This first plot showed me two things. A column of points sits at age 0, which are the missing ages, so those rows have to go. Also, most billionaires are packed near the bottom of the plot with only a few huge fortunes above them, which made me decide to compare how people got rich (wealth type) and to use a log scale for net worth in my final graph.
Cleaning the Data
#select the 7 coumns I need and give them shorter names#then filter out the rws that have fake zeros or missing valuesbillionaires_clean<-billionaires |>select(name,year,worth=`wealth.worth in billions`,age =demographics.age,founded =company.founded,region= location.region,wealth_type= wealth.type) |>filter(age >0, founded>1000, region!="0",!is.na(wealth_type))# check how many rows are leftnrow(billionaires_clean)
[1] 2210
# check that the cleaning workedsummary(billionaires_clean$age)
Min. 1st Qu. Median Mean 3rd Qu. Max.
12.00 53.00 62.00 62.59 72.00 98.00
summary(billionaires_clean$founded)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1610 1942 1968 1958 1987 2012
I chose three quantitative variables to predict a billionaire’s net worth (worth). age is in the model because older people have had more years to build or inherit wealth. founded is in the model because a company that has been around longer may be bigger and more stable. year is in the model because the three lists are from very different times, and fortunes in dollars tend to be larger in later years, so I wanted to control for that.
#multiple linear regression: worth predicted by age, founded, and yearmodel<-lm(worth~age+founded+year,data=billionaires_clean)#show the coefficients, p-values, and adjusted R squaredsummary(model)
Call:
lm(formula = worth ~ age + founded + year, data = billionaires_clean)
Residuals:
Min 1Q Median 3Q Max
-4.115 -2.256 -1.477 -0.053 72.230
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -1.038e+02 3.428e+01 -3.027 0.00249 **
age 2.996e-02 9.063e-03 3.306 0.00096 ***
founded -3.569e-03 2.984e-03 -1.196 0.23182
year 5.604e-02 1.761e-02 3.181 0.00149 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 5.398 on 2206 degrees of freedom
Multiple R-squared: 0.01191, Adjusted R-squared: 0.01056
F-statistic: 8.861 on 3 and 2206 DF, p-value: 7.749e-06
Analysis: The p-values for age (about 0.001) and year (about 0.0015) are below 0.05, so both are statistically significant. Holding the other variables the same, each extra year of age goes with about 0.03 billion dollars (30 million) more net worth, and each later list year goes with about 0.056 billion dollars (56 million) more. The p-value for founded is about 0.23, which is not significant, so I can’t say the founding year of the company matters once age and list year are in the model. The adjusted R-squared is only about 0.011, so the model explains roughly 1% of the differences in net worth. The model is weak. Net worth depends on much more than these three numbers, and a few very large fortunes pull everything around.
Visualization 1: Age and Net Worth by How the Money Was Made
# scatter plot of age and net worth, colored by wealth type#log scale on the y axis because a few fortunes are hugeggplot(billionaires_clean, aes(x = age, y = worth, color = wealth_type))+geom_point(size =2, alpha =0.5) +geom_smooth(method = lm, se =FALSE,linewidth=0.3)+scale_y_log10() +scale_color_manual(values =c("blue", "red", "darkgreen", "orange", "purple")) +labs(x="Age of Billionaire (years)",y="Net Worth (billions of US dollars, log scale)",title="Age and Net Worth of Billionaires by How They Made Their Money, 1996-2014",caption ="Source: billionaires.csv (Forbes billionaire lists for 1996, 2001, and 2014)",color="How the Wealth Was Made") +theme_minimal()
`geom_smooth()` using formula = 'y ~ x'
Visualization 2: Company Founding Year and Net Worth by Region (Interactive)
# interactive scatter plot using highcharter# each region gets its own color, and you can hover over a pointhighchart() |>hc_add_series(data = billionaires_clean, type="scatter", hcaes(x= founded,y =worth,group = region)) |>hc_colors(c("blue", "red", "darkgreen", "orange", "purple", "brown", "gray")) |>hc_xAxis(title =list(text="Year the Company Was Founded")) |>hc_yAxis(title=list(text="Net Worth (billions of US dollars)")) |>hc_title(text ="Year a Billionaire's Company Was Founded and Net Worth, by Region") |>hc_caption(text ="Source: billionaires.csv (Forbes billionaire lists for 1996, 2001, and 2014)")
What the Visualizations Show
The first graph compares age and net worth for the five ways of making money. The dashed trend lines are almost flat, so age does not tell us much about how rich someone is, which matches the very low adjusted R-squared in my regression. The surprise for me was how similar the groups are. I expected inherited and self-made fortunes to look very different, but the points for every group overlap heavily. Most billionaires sit around 1 to 3 billion dollars, and the median for inherited fortunes (about 2.4 billion) was actually a little higher than for the other types. The few giants at the top, like Bill Gates at 76 billion in 2014, are mostly founders and people in privatized and resources industries, but they are rare.
The second graph, the interactive one, shows when each billionaire’s company was founded and how much they are worth, with a color for each region. North America and Europe have the most points, and East Asia has a big cluster of companies founded after 1970. Hovering over the points helped me find individual outliers that I could not read in a static graph. Many of the older companies (before 1900) belong to inherited fortunes, which makes sense, but there were not many of them.
There are a few things I wished I could have shown. I wanted to use the GDP of each person’s country, but it is 0 for nearly the whole 2014 list, so I had to leave it out. I also wanted to animate the points across the three list years with gganimate, but with only three years the animation would just jump around. Finally, I wanted both graphs to use a log scale and to be interactive, but I kept the highcharter graph as simple as I could.
Challenges I Faced While Coding
The hardest part was the data itself. Zeros were being used instead of missing values, and I only noticed it after my first plot had a strange column of points at age 0. The column names were also long, with dots and spaces (like wealth.worth in billions), so I needed backticks around some of them until I renamed them inside select(). Another challenge was that the net worth values are very skewed, so a normal scale made most points bunch up at the bottom. Using scale_y_log10() fixed that. Last, the highcharter code took a few tries because I had to get the group variable inside hcaes() before each region would get its own color.
Conclusion
In this project I used the billionaires dataset to ask whether age, company age, and the year of the list explain how much money a billionaire has. After cleaning out the fake zeros and missing values, I had 2,210 billionaires. My regression showed that age and list year are significant predictors of net worth, but the adjusted R-squared of about 0.011 means they explain only around 1% of the differences. My two graphs backed this up: age barely changes net worth, and fortunes of every type and region are spread across the same range, with only a few very large exceptions. Overall, being a billionaire is hard to predict from simple facts about a person, and the biggest fortunes are rare outliers.
