---
title: "Case study: percentile distributions using the General Social Survey"
author: "Jorge Cimentada"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Case study: percentile differences using the General Social Survey}
  %\VignetteEngine{knitr::rmarkdown}
  usepackage[UTF-8]{inputenc}
---

Reardon (2011) introduced a very interesting concept in which he calculates percentile differences from ordered categorical variables. He explains his procedure very much in detail in the appendix of the book chapter but no formal implementation has been yet available on the web. With this package I introduce a function that applies the procedure, following a step-by-step Stata script that Sean Reardon kindly sent me.

In this vignette I show you how to use the function and match the results to the Stata code provided by Reardon himself.

We'll be using a real world data set, the General Social Survey, that surveys American citizens on attitudes, behaviors and attributes. For this example we'll need the packages below.

```{r, message = FALSE, warning = FALSE}
library(dplyr)
library(ggplot2)
library(carData)
```

Let's prepare the data.

```{r, message = FALSE, warning = FALSE}
set.seed(213141)
data("GSSvocab")

gss <- 
  as_tibble(GSSvocab) %>% 
  filter(year == '1978') %>% 
  mutate(weight = sample(1:3, size = nrow(.), replace = TRUE, prob = c(0.1, 0.5, 0.4))) %>% 
  select(ageGroup, vocab, weight)


gss
```

This is the minimum dataset that the function will accept. This means that it needs to have at least one categorical variable (`ageGroup`) and a continuous variable (`vocab`) (the vector of weights is optional). The first variable is the typical age variable but asked in age brackets rather than in a continuous fashion. The second one measures the number of words out of 10 correct on a vocabulary test.

The package is called `perccalc`, short for percentile calculator and we can install and load it with this code:

```{r, eval = FALSE}
devtools::install_github("cimentadaj/perccalc")
library(perccalc)
```

```{r, echo = F, message = F, warning = F}
library(perccalc)
```

The package only has two functions called `perc_diff` and `perc_dist`. They're very easy to use, we just specify the data, the name of the categorical and continuous variable and the percentile difference we want. 

Let's put it to use!

```{r, error = TRUE}
perc_diff(gss, ageGroup, vocab, percentiles = c(90, 10))
```

I generated that error on purpose to raise a very important requirement of the function: the categorical variable needs to be an ordered factor. This is very important because otherwise we could be calculating percentile differences from categorical variables which have no apparent order such as married, single and widowed.

We can turn the previous into an ordered factor with the code below.

```{r}
gss <-
  gss %>%
  mutate(ageGroup = factor(ageGroup, ordered = TRUE))
```

Now it'll work.

```{r}
perc_diff(gss, ageGroup, vocab, percentiles = c(90, 10))
```

We can play around with other percentiles

```{r}
perc_diff(gss, ageGroup, vocab, percentiles = c(50, 10))
```

And we can add a vector of weights

```{r}
perc_diff(gss, ageGroup, vocab, weight)
```

Now, how are we sure that these estimates are as accurate as the Reardon (2011) implementation? We can compare the Stata output using this data set.

```{r, eval = FALSE}
# Saving the dataset to a path
gss %>%
  write_dta(path = "C:\\Users\\cimentadaj\\Downloads\\gss_data.dta", version = 13)
```

Running the code below using the `gss_data.dta`..

```{r, eval = FALSE}
*--------
use "/Users/cimentadaj/Downloads/gss_data.dta", clear

drop if missing(ageGroup)
drop if missing(vocab)

tab ageGroup, gen(inc)
*--------

/*-----------------------
	Making a data set that has 
	one observation per age group category
	and has mean and se(mean) in each category
	and percent of population in the category
------------------------*/

tempname memhold
tempfile results
postfile `memhold' agegroup mean se_mean per using `results'

forv i = 1/5 {
	sum inc`i' [aw=weight]
	loc per`i' = r(mean)
									
	qui sum vocab if inc`i'==1 
							
	if `r(N)'>0 {
		qui regress vocab if inc`i'==1 [aw=weight]
		post `memhold' (`i') (_b[_cons]) (_se[_cons]) (`per`i'')
							
	}				
}
postclose `memhold'	

/*-----------------------
	Making age group categories
	into percentiles
------------------------*/


	use `results', clear

	sort agegroup
	gen cathi = sum(per)
	gen catlo = cathi[_n-1]
	replace catlo = 0 if agegroup==1
	gen catmid = (catlo+cathi)/2
	
	/*-----------------------
		Calculate age group 
		vocabulary gaps
	------------------------*/

	sort agegroup
	
	g x1 = catmid
	g x2 = catmid^2 + ((cathi-catlo)^2)/12
	g x3 = catmid^3 + ((cathi-catlo)^2)/4

	g cimnhi = mean + 1.96*se_mean
	g cimnlo = mean - 1.96*se_mean

	reg mean x1 x2 x3 [aw=1/se_mean^2] 

	twoway (rcap cimnhi cimnlo catmid) (scatter mean catmid) ///
		(function y = _b[_cons] + _b[x1]*x + _b[x2]*x^2 + _b[x3]*x^3, ran(0 1))	
	
	loc hi_p = 90
	loc lo_p = 10

	loc d1 = [`hi_p' - `lo_p']/100
	loc d2 = [(`hi_p')^2 - (`lo_p')^2]/(100^2)
	loc d3 = [(`hi_p')^3 - (`lo_p')^3]/(100^3)

	lincom `d1'*x1 + `d2'*x2 + `d3'*x3
	loc diff`hi_p'`lo_p' = r(estimate)
	loc se`hi_p'`lo_p' = r(se)
	
	di "`hi_p'-`lo_p' gap:     `diff`hi_p'`lo_p''"
	di "se(`hi_p'-`lo_p' gap): `se`hi_p'`lo_p''"
```

I get that the 90/10 difference is `0.1760` with a standard error of `0.377`. Does it sound familiar?

```{r}
perc_diff(gss, ageGroup, vocab, weight)
```

Finally, there's `perc_dist` that shares a lot of similarity with `perc_diff`. It calculates the estimate for every percentile. You can use this to perform your own analysis. For example,

```{r}
perc_dist(gss, ageGroup, vocab) %>%
  head()
```

We can also add the optional set of weights and graph it in a more convenient way.

```{r, fig.align = 'center', fig.width = 6, fig.height = 5}
gss %>%
  perc_dist(ageGroup, vocab, weight) %>%
  mutate(ci_low = estimate - 1.96 * std.error,
         ci_hi = estimate + 1.96 * std.error) %>%
  ggplot(aes(percentile, estimate)) +
  geom_point() +
  geom_errorbar(aes(ymin = ci_low, ymax = ci_hi))
```

Please note that for calculating the difference between two percentiles it is more accurate to use the `perc_diff` function. The `perc_diff` function calculates the difference through a linear combination of coefficients.

For example:

```{r}
perc_dist(gss, ageGroup, vocab, weight) %>%
  filter(percentile %in% c(90, 10)) %>%
  summarize(diff = diff(estimate),
            se_diff = diff(std.error))
```

compared to

```{r}
perc_diff(gss, ageGroup, vocab, weight, percentiles = c(90, 10))
```

Note how the coefficients are the same but the standard error is different.

I hope this was a convincing example, I know this will be useful for me. All the intellectual ideas come from Sean Reardon, as well as the Stata code. The R implementation is my own work.

- Reardon, Sean F. "The widening academic achievement gap between the rich and the poor: New evidence and possible explanations." Whither opportunity (2011): 91-116.