Modified IPEDS completion data script for Anthropology PhDs

blk_completion_2011-2017.Rmd

---
title: "IPEDS Completion Data - Black Students in Anthropology - 2011-2017"
author: "Pris Nasrat - based off work by Clara Bicalho"
date: "6/13/2020"
output: pdf_document
---

Source: [IPEDS](https://nces.ed.gov/ipeds/).
More details on data base [here](https://surveys.nces.ed.gov/ipeds/VisInstructions.aspx?survey=10&id=30080&show=all).
Original analysis by Clara Bicalho [here](https://github.com/clarabicalho/Diversity_PS).


```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
library(tidyverse)
library(xtable)
library(dplyr)
```

```{r import, message=FALSE, warning=FALSE}
files <- paste0("data/C", 2011:2018, "_A.csv")
dat <- do.call(plyr::rbind.fill, lapply(files, read_csv))

ps <- dat %>% 
  filter(
    # Poli Sci
    #        CIPCODE %in% c("45.1099", "45.1001", "45.1002", "45.1003", "45.1004") &  
    # Anthro
    CIPCODE %in% c("45.0201", "45.0202", "45.0203", "45.0204", "45.0299") & 
      UNITID %in% c(144050, 166027, 110635, 104179, 243744, 190150, 110662,
                    215062, 130794, 228778, 187985, 193900, 236948,
                    110705)) %>%
  mutate(University = case_when(UNITID == 144050 ~ "U Chicago",
         UNITID == 166027 ~ "Harvard",
         UNITID == 170976 ~ "UMich",
         UNITID == 110635 ~ "UC Berkeley",
         UNITID == 104179 ~ "Arizona",
         UNITID == 243744 ~ "Stanford",
         UNITID == 190150 ~ "Columbia",
         UNITID == 110662 ~ "UCLA",
         UNITID == 215062 ~ "Pennsylvania",
         UNITID == 130794 ~ "Yale",
         UNITID == 228778 ~ "UT Austin",
         UNITID == 187985 ~ "New Mexico",
         UNITID == 193900 ~ "NYU",
         UNITID == 236948 ~ "Washington",
         UNITID == 110705 ~ "UCSB"))
```

```{r summary}
tab <- ps %>% group_by(University) %>% 
  summarize(Total = sum(CBKAAT[AWLEVEL == 17], na.rm=TRUE),
            Pct = sum(CBKAAT[AWLEVEL == 17], na.rm=TRUE)/
              sum(CTOTALT[AWLEVEL == 17], na.rm=TRUE))
```

```{r, include=FALSE}
# Undegrads
# ps %>% group_by(University) %>% 
#   summarize(Total = sum(CBKAAT[AWLEVEL == "05"], na.rm=TRUE),
#             Pct = sum(CBKAAT[AWLEVEL == "05"], na.rm=TRUE)/
#               sum(CTOTALT[AWLEVEL == "05"], na.rm=TRUE))

# ps %>% select(CBKAAT, UNITID)
# table(ps$AWLEVEL)
```

\centering
\clearpage

```{r export, echo=FALSE, results="asis"}
exp_tab <- capture.output(print(
  xtable(tab, caption = "Black Students Who Completed an Anthropology PhD Program, Top 15 Programs (2011-2017)"), 
  caption.placement = "top", include.rownames = FALSE, comment = FALSE,
  header = FALSE))

cat(exp_tab, sep = "\n")
```

Note: Data used in Table 1 above does not include race/ethnicity of non-resident aliens. These are therefore excluded from the Black counts, though these students are included in the denominator in the percentage column. Top 15 programs according to 

Kawa, Nicholas C., José A. Clavijo Michelangeli, Jessica L. Clark, Daniel Ginsberg, and Christopher McCarty. "The social network of US academic anthropology and its inequalities." *American Anthropologist* 121, no. 1 (2019): 14-29. [doi/10.1111/aman.13158](https://doi.org/10.1111/aman.13158)