index.qmd

---
title: "Assignment 4"
subtitle: "Link to Data Source https://usa.ipums.org/usa/"
author: "Benjamin Reese and Sarah Hayes"
format: html
self-contained: true
---

```{r, warning=FALSE, message=FALSE}
library(readr)
acs <- read_csv("usa_00003.csv")
library(tidyverse)
```

## Figure One
Figure one examines the income distribution by racial category. As the figure shows, all racial groups have a higher distribution of incomes closer to the poverty line. However, American Indians (Indigenous) have a larger amount of people closer to the poverty line, whereas for Asian Americans, they have the highest distribution of incomes. 
```{r, warning = FALSE, message = FALSE}
acs %>%
  filter(INCTOT < 200000 & INCTOT !=0 ) %>%
  mutate(Race = case_when(
    RACE == 1 ~ "White",
    RACE == 2 ~ "Black",
    RACE == 3 ~ "American Indian",
    RACE == 4 | RACE == 5 | RACE == 6 ~ "Asian or P I",
    RACE > 6 ~ "Other"
    )) %>%
  ggplot(aes(Race, INCTOT)) +
  geom_violin(col="blue", fill="light blue") +
  theme_minimal() +
  labs(x=NULL, y="Income",
          title = "The Distribution of Income Is Largely Consistent Between Races",
          subtitle = "Income by Race for Americans",
          caption = "Data Source: IPUMS 2019 ACS")
```


## Figure Two

Continuing with Figure Two, poverty line is broken down by racial and sex categories. Similar to figure one, there is a relative equal distribution between genders of each racial groups. Poverty between men and women remain similar between one another for each racial group. Similar to figure one, average poverty for Asian Americans is lower for both men and women amongst the racial groups, while Indigenous Americans and Black American are closer to the poverty line compared to the other groups.

```{r, warning=FALSE, message=FALSE}

acs %>%
  filter(POVERTY > 0) %>%
  mutate(Race = case_when( ## creating new race variable
    RACE == 1 ~ "White",
    RACE == 2 ~ "Black",
    RACE == 3 ~ "American Indian",
    RACE == 4 | RACE == 5 | RACE == 6 ~ "Asian or P I",
    RACE > 6 ~ "Other"
  )) %>%
  mutate(Sex = case_when( ## creating new sex variable
    SEX == 1 ~ "Male",
    SEX == 2 ~ "Female",
  )) %>%
  ggplot(aes(Race, POVERTY, fill=Sex)) +
  geom_boxplot() + 
  theme_minimal() +
  labs(y="Income as Percent of Poverty Level", x=NULL,
       title = "Wages as Percent of Poverty Level Shows Variation in Income by Race",
       subtitle = "Asian or P I Have Average Incomes Far Above Poverty Level",
       caption = "Data Source: IPUMS 2019 ACS")
```

## Figure Three 

Breaking down income levels by college attainment for each gender also revealed patterns in wages. Having a college degree aid in a higher income attainment for both genders, however this is exceptionally true for men with degrees, who earns the most out of each category. Those with less than a a high school degree, for both genders, earn the least out of each education category. Surprisingly, those with a high school degree only make slightly less than those with some college.

```{r, message=FALSE, warning=FALSE}
options(scipen = 99999)

library(srvyr)
```


```{r, message=FALSE, warning=FALSE}
## Adding Weights
acs_svy <- acs %>%
  as_survey_design(weights = PERWT)

## Barplot Seperated By Sex Including Survey Weights
acs_svy %>%
  filter(INCTOT > 100000 & INCTOT != 9999999) %>%
  mutate(ed = case_when( ## creating new educ variable
    EDUC <= 5 ~ "Less Than HS",
    EDUC == 6 ~ "High School",
    EDUC == 7 | EDUC == 8 | EDUC == 9 ~ "Some College",
    EDUC >= 10 ~ "College+"
  )) %>%
  mutate(Sex = case_when( ## creating new sex variable
    SEX == 1 ~ "Male",
    SEX == 2 ~ "Female",
  )) %>%
  group_by(ed, Sex) %>%
  summarize(n = unweighted(n())) %>%
  ggplot(aes(x=ed, y=n, fill=Sex)) +
  geom_bar(position="dodge", stat="identity") +
  theme_minimal() +
  labs(y="Number of Respondents", x=NULL,
       title = "College Degree Holders Makeup Most High Earners",
       subtitle = "Most Americans with $100,000+ Incomes Have College Degree",
       caption = "Data Source: IPUMS 2019 ACS")
```

## Figure Four

Figure four examines the likelihood someone receives additional income passed their earned labor wages. Racial differences appear when examining the income above wages. Most notably, all racial groups, except White Americans, appear to stop earning significantly more income once they reach more extra income. Asian Americans have a slightly less steep drop in those who are earning more income, but these results are still comparable to the other racial minorities groups. 

```{r, warning=FALSE, message=FALSE}
library(ggjoy)
```


```{r, warning=FALSE, message=FALSE}
acs %>%
  filter(INCTOT < 100000 & INCWAGE < 999997) %>%
  mutate(Race = case_when( ## creating new race variable
    RACE == 1 ~ "White",
    RACE == 2 ~ "Black",
    RACE == 3 ~ "American Indian",
    RACE == 4 | RACE == 5 | RACE == 6 ~ "Asian or P I",
    RACE > 6 ~ "Other"
  )) %>%
  mutate(income_above_wages = INCTOT-INCWAGE) %>%
  filter(income_above_wages != 0) %>%
  ggplot(aes(x=income_above_wages, y=Race, fill=Race)) +
  geom_joy(scale=2) + 
  scale_x_log10() +
  theme_minimal() +
  labs(x="log(Income Above Wages)", y=NULL,
       title = "Whites More Likely To Receive Income Beyond Their Wages",
       subtitle = "Income Beyond Wages Differs By Identity Group",
       caption = "Data Source: IPUMS 2019 ACS")


```