Visualizing Wealth Distribution in America (1990-2023)

Area Chart

Motivation

Recreate VISUAL CAPITALIST chart:Visualizing Wealth Distribution in America (1990-2023)

Data Processing

# Clear R environment: 
rm(list = ls())

# Setwd
setwd("D:/0 - My documents/TOOLS/R/Visual Capitalist/Wealth Distribution in America/wealth distribution")

# Pacman: Load necessary packages
library(pacman)
pacman::p_load(
  rio,
  tidyverse,
  skimr,
  summarytools,
  showtext,
  ggdark)

library(rio)
wealth <- import("D:/0 - My documents/TOOLS/R/Visual Capitalist/Wealth Distribution in America/dfa-networth-levels.csv")

# Data description
summary(wealth)
skim(wealth)
freq(wealth$Category)

wealth <- wealth %>% 
  select("Date", "Category", "Net worth")

wealth_wide <- wealth %>% 
  pivot_wider(
    names_from = "Category",
    values_from = "Net worth"
  )

wealth_wide <- wealth_wide %>% 
  mutate(F50t90 = Bottom50 + Next40) %>% 
  mutate(F90t99 = F50t90 + Next9) %>% 
  mutate(Remain = F90t99 + RemainingTop1) %>% 
  mutate(Top01 = Remain + TopPt1)

summary(wealth_wide)

Visualization

# Visualization

library(extrafont)

font_import(pattern = "Philosopher")

loadfonts()

# List available font families
windowsFonts()


y_lables <- c("$0", "$50T","$100T")


# Area chart
ggplot(wealth_wide) +
  geom_area(aes(x = seq_along(Date), y = Top01), fill = "#96B6C5", color = NA)+
  geom_line(aes(x = seq_along(Date), y = Remain), color = "grey40", linetype = "dotted")+
  geom_area(aes(x = seq_along(Date), y = F90t99), fill = "#FCE09B", color = NA)+
  geom_area(aes(x = seq_along(Date), y = F50t90), fill = "#C08261", color = NA)+
  geom_area(aes(x = seq_along(Date), y = Bottom50), fill = "#9A3B3B", color = NA)+
  # Set theme
  dark_theme_minimal()+
  # Adjust background
  theme(axis.ticks = element_blank()) + 
  theme(axis.title = element_blank()) +
  theme(panel.grid.major.x = element_blank())+
  theme(panel.grid.major.y = element_line(color = "grey40", linewidth = 0.2))+
  # Scale x,y
  scale_y_continuous(breaks = seq(0, 1.0e+08, 5.0e+07),
                     limits = c(0, 1.5e+08), 
                     expand = c(0, 0), 
                     labels = y_lables)+
  scale_x_continuous(breaks = c(3,43,83,123),
                     labels = c("1990","2000","2010","2020"),
                     expand = c(0, 0),
                     limits = c(0, 160))+
  labs(title = "Distribution of\nHousehold Wealth", 
       subtitle = "IN THE U.S. BY INCOME GROUP", 
       caption = c("Source: The Federal Reserve"))+
  theme(plot.title = element_text(size = 20, color = "white",family = "#9Slide03 Philosopher"))+
  theme(plot.subtitle = element_text(size = 10, color = "grey60", family = "#9Slide03 Philosopher"))+
  theme(plot.caption = element_text(size = 8, color = "grey60"))+
  theme(axis.text = element_text(size = 8, color = "white"))+
  theme(plot.title.position = "plot")+
  # Adjust plot margin
  theme(plot.margin = unit(c(0.3, 0.3, 0.2, 0.3), "cm"))+
  # Note Bottom 50%
  geom_segment(x = 87, y = 7.0e+06,
               xend = 87, yend = 1.1e+06,
               color = "black",
               arrow = arrow(length = unit(0.2, "cm")),
               linewidth = 0.1)+
  geom_text(label = "The share of wealth owned\nby the bottom of 50% hit its\nlow point of 0.4% in 2011",
            colour = "black",
            x = 87,
            y = 13.0e+06, 
            size = 2) +
  # Note peak
  geom_text(label = "The share of wealth\nowned by the top 0.1%\nis currently at its peak",
            colour = "white",
            x = 90,
            y = 1.1e+08,
            size = 2.5)+
  # Label
  geom_label(aes(x = 150, y = 8.0e+06,
                 label = "Bottom\n50%"),
             stat = "unique",
             size = 2.5, fill = "#9A3B3B", color = "black", family = "#9Slide03 Philosopher")+
  geom_label(aes(x = 150, y = 30.0e+06,
                 label = "50-90%"),
             stat = "unique",
             size = 2.5, fill = "#C08261", color = "black", family = "#9Slide03 Philosopher")+
  geom_label(aes(x = 150, y = 70.0e+06,
                 label = "90-99%"),
             stat = "unique",
             size = 2.5, fill = "#FCE09B", color = "black", family = "#9Slide03 Philosopher")+
  geom_label(aes(x = 150, y = 1.1e+08,
                 label = "Top 1%"),
             stat = "unique",
             size = 2.5, fill = "#96B6C5", color = "black", family = "#9Slide03 Philosopher")+
  geom_segment(x = 139, y = 122564928,
               xend = 139, yend = 142417129,
               color = "white",
               linewidth = 0.1)+
  geom_label(aes(x = 150, y = 1.35e+08,
                 label = "Top 0.1%"),
             stat = "unique",
             size = 2.5, fill = "grey90", color = "black", family = "#9Slide03 Philosopher")

# Save chart
  
ggsave("wealth.png", width = 4.7, height = 5.8,dpi = 300,units = c("in"))