---
title: "3. Methods"
author: "Yuki Atsusaka and Seo-young Silvia Kim"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{3. Methods}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---


```{r setup, message = FALSE, warning = FALSE}
library(rankingQ)
data(identity)

library(dplyr)
library(ggplot2)
library(tidyr)
```

## Estimating the Proportion of Random Responses

In the `identity` dataset, given `anc_correct_identity`, the raw
proportion of those who have correctly or incorrectly answered the
anchor question is as follows:

```{r}
round(prop.table(table(identity$anc_correct_identity)) * 100, digits = 1)
```
The 69.7% seen here, however, is likely an upwardly biased estimate of
the percentage of non-random responses, because we must account for
respondents accidentally answering the question correctly. For an
unbiased estimate of random responses, we use `unbiased_correct_prop`.

```{r}
identity$random_identity <- case_when(
  identity$anc_correct_identity == 1 ~ 0,
  TRUE ~ 1
)

unbiased_correct_prop(
  sum(identity$random_identity == 0) / sum(!is.na(identity$random_identity)),
  J = 4
)
```
The revised estimate of non-random responses is 68.4%. That is to say,
roughly 31.6% of the respondents are randomly responding.

## Direct Bias Correction via `imprr_direct`

`rankingQ` has two primary functions to perform bias correction. First,
`imprr_direct` **impr**oves **r**anking data by applying **direct** bias
correction to several classes of quantities of interest.

To apply the bias correction, we specify our dataset (`data`), the
number of items (`J`), the columns holding the marginal ranks for the
target ranking question (`main_q`), and the indicator for answering
the anchor ranking question correctly (`anc_correct`). When survey
weights are available, they can be included by specifying `weight` in
the function.

```{r}
## party, religion, gender, and race hold the marginal rank of each item

# Perform bias correction
out_direct <- imprr_direct(
  data = identity,
  ## Not strictly necessary: when `main_q` lists the ranking columns,
  ## J is inferred from their number
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity",
  # setting to 10 only for our vignette
  n_bootstrap = 10
)
```


By default, `imprr_direct` assumes that the target population is a set
of non-random respondents. When researchers wish to study the entire
population as a target group, additional arguments must be specified,
including `population` and `assumption`. For example, the uniform
preference assumption can be specified as follows:


```{r}
# Bias correction for the entire population with the uniform assumption

out_direct_uniform <- imprr_direct(
  data = identity,
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity",
  population = "all",
  assumption = "uniform",
  n_bootstrap = 10
)
```

Similarly, the contaminated sampling assumption can be specified as follows:

```{r}
# Bias correction for the entire population with contaminated sampling

out_direct_contaminated <- imprr_direct(
  data = identity,
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity",
  population = "all",
  assumption = "contaminated",
  n_bootstrap = 10
)
```


### Results: Estimated Proportion of Random Responses

The first output of `imprr_direct` is the estimated proportion of random
responses. The vector `est_p_random` returns the estimated proportion
along with the lower and upper ends of its corresponding 95% confidence
interval.

```{r}
# Estimated proportion of random responses with a 95% CI
out_direct$est_p_random
```

### Results: Estimated Quantities of Interest

The other output is the bias-corrected estimates of four classes of
ranking-based quantities, including

1.  average ranks
2.  pairwise ranking probabilities
3.  top-k ranking probabilities
4.  marginal ranking probabilities

The output tibble `qoi` stores the estimated quantities and their
corresponding 95% CIs.

```{r}
# View the results based on the quantity of interest
out_direct$results %>%
  filter(qoi == "average rank")

# View the results based on the item
out_direct$results %>%
  filter(item == "party")
```

For example, one can visualize the result for average ranks as follows:

```{r}
# Plot the result
out_direct$results %>%
  mutate(
    item = factor(
      item,
      levels = c("party", "religion", "gender", "race")
    )
  ) %>%
  plot_avg_ranking()
```

## Weighting-Based Bias Correction via `imprr_weights`

The alternative method for bias correction is based on the idea of
inverse-probability weighting (IPW). `imprr_weights` **impr**oves
**r**anking data by computing bias correction **weights**, which can be
used to correct for the bias in the IPW framework. The same arguments
previously used can be used as follows:

Because `imprr_weights` enumerates the full permutation space, its
computational cost grows quickly with `J!`. In practice, this method is
best suited to small or moderate ranking questions; for larger `J`,
`imprr_direct` or `imprr_direct_rcpp` will usually be much more practical.

```{r}
# Perform bias correction
out_weights <- imprr_weights(
  data = identity,
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity"
)
```


By default, `imprr_weights` assumes that the target population is a set
of non-random respondents. When researchers wish to study the entire
population as a target group, additional arguments must be specified,
including `population` and `assumption`. For example, the uniform
preference assumption can be specified as follows:

```{r}
# Perform bias correction with the uniform preference assumption
out_weights_uniform <- imprr_weights(
  data = identity,
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity",
  population = "all",
  assumption = "uniform"
)
```

Similarly, the contaminated sampling assumption can be specified as follows:

```{r}
# Perform bias correction with the uniform preference assumption
out_weights_contaminated <- imprr_weights(
  data = identity,
  J = 4,
  main_q = c("party", "religion", "gender", "race"),
  anc_correct = "anc_correct_identity",
  population = "all",
  assumption = "contaminated"
)
```


### Results: Estimated Weights

The output of `imprr_weights` contains the set of weights for all
possible ranking profiles with `J` items. For example, when `J = 4`,
the set has `{1234, 1243, ..., 4321}` and each profile now has an
estimated weight.

```{r}
# View the estimated weights
out_weights$rankings %>%
  select(ranking, weights)
```

### Results: Estimated PMF with Bias Corrected Data

`imprr_weights` also returns the estimated probability mass function of
all ranking profiles before and after bias correction.

```{r}
# View the estimated corrected PMF
out_weights$rankings %>%
  select(ranking, prop_obs, prop_bc)
```

## Estimated Weights with Original Data

```{r}
identity_w <- out_weights$results
head(identity_w)
# save(identity_w, file = "data/identity_w.rda")
```