---
title: "Explore and Compare Further"
output: rmarkdown::html_vignette
description: >
  Advanced choice-level analyses using **projoint**: direct trade-offs, level collapsing,
  and subgroup comparisons (MMs). Designed to complement the main "Analyze and Visualize Important QOIs" vignette.
vignette: >
  %\VignetteIndexEntry{Explore and Compare Further}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
library(projoint)
library(dplyr)
library(ggplot2)
library(patchwork)
```

## 🌟 Explore and Compare Further

Choice-level analysis opens the door to many **new research questions** that traditional profile-level analysis often overlooks. Below, we demonstrate how to estimate **deeper quantities** and **compare subgroups** effectively.

Depending on your objectives, you may want to reorganize the data in a `projoint_data` object. The helper function below is internal to the package, but you can call it explicitly in your script.”
```{r}
projoint_data <- function(labels, data) {
  structure(
    list(labels = labels, data = data),
    class = "projoint_data"
  )
}
```

---

## 📦 Setup

We use the already wrangled and cleaned data `out1_arranged`.

```{r}
data("out1_arranged")
out1_arranged$labels
```

---

## ⚖️ Explore: Compare Trade-offs Directly

<details><summary><b>Example: Low Housing Costs vs. Low Crime Rates</b></summary>

**Goal.** Compare choices between two *joint* profiles:

- **Low housing cost** but **high violent‑crime rate**, versus
- **High housing cost** but **low violent‑crime rate**.

```{r, message=FALSE, warning=FALSE}
# 1) Data: keep only the two joint profiles of interest
data("out1_arranged")
d1 <- out1_arranged$data
d2 <- d1 |> 
  mutate(y1 = case_when(
    # Low housing cost, high crime
    att1 == "att1:level1" & att6 == "att6:level2" ~ 1,
    TRUE ~ 0
  ),
  y0 = case_when(
    # High housing cost, low crime
    att1 == "att1:level3" & att6 == "att6:level1" ~ 1,
    TRUE ~ 0
  )) |> 
  filter(y1 == 1 | y0 == 1)

# 2) Labels: rename only the two att1 levels to reflect the joint trade-offs
labels1 <- out1_arranged$labels
labels2 <- labels1 |> 
  mutate(level = case_when(level_id == "att1:level1" ~ "Housing Cost (Low)\nCrime Rate(High)", 
                           level_id == "att1:level3" ~ "Housing Cost (High)\nCrime Rate(Low)", 
                           TRUE ~ level_id))
```


**(Optional) Sanity checks**
```{r}
d1 |> count(att1, att6)
d2 |> count(att1, att6) # only the two joint profiles remain
labels1 |> filter(attribute_id == "att1")
labels2 |> filter(attribute_id == "att1" & level_id %in% c("att1:level1", "att1:level3"))
```

**Recreate a `projoint_data` object, set the QOI, and plot.**
```{r, fig.width = 6, fig.height = 3}
# 3) Build a new projoint_data object
pj_data_wrangled <- projoint_data("labels" = labels2, 
                                  "data" = d2)

# 4) Quantity of interest: Low vs High housing cost under the specified crime conditions (choice-level MM)
qoi <- set_qoi(
  .att_choose = "att1", 
  .lev_choose = "level1", # Low housing cost (with high crime in this subset)
  .att_notchoose = "att1", 
  .lev_notchoose = "level3" # High housing cost (with low crime in this subset)
)

# 5) Estimate and plot (horizontal layout)
out <- projoint(pj_data_wrangled, qoi)
plot(out)
```

</details>

---

## 🧩 Explore: Compare Multiple Levels Simultaneously

<details><summary><b>Example: Urban vs. Suburban Preferences</b></summary>

**Goal.** Collapse `att7` into two buckets—City (levels 1–2) vs. Suburban (levels 5–6)—then re‑estimate and plot.

```{r, message=FALSE, warning=FALSE}
# 1) Data: collapse levels for att7
d1 <- out1_arranged$data
d2 <- d1 |>
  mutate(
    att7 = case_when(
      att7 %in% c("att7:level1", "att7:level2") ~ "att7:level7",  # City
      att7 %in% c("att7:level5", "att7:level6") ~ "att7:level8",  # Suburban
      TRUE ~ att7
    )
  )

# 2) Labels: create matching level IDs and readable names
labels1 <- out1_arranged$labels
labels2 <- labels1 |>
  mutate(
    level_id = case_when(
      level_id %in% c("att7:level1", "att7:level2") ~ "att7:level7",
      level_id %in% c("att7:level5", "att7:level6") ~ "att7:level8",
      TRUE ~ level_id
    ),
    level = case_when(
      level_id == "att7:level7" ~ "City",
      level_id == "att7:level8" ~ "Suburban",
      TRUE ~ level
    )
  ) |>
  distinct()
```


**(Optional) Sanity checks**
```{r}
d1 |> count(att7)
d2 |> count(att7)
labels1 |> filter(attribute_id == "att7")
labels2 |> filter(attribute_id == "att7")
```

**Recreate a `projoint_data` object, set the QOI, and plot.**
```{r, fig.width = 6, fig.height = 3}
# 3) Build a new projoint_data object
pj_data_wrangled <- projoint_data("labels" = labels2, 
                                  "data" = d2)

# 4) Quantity of interest: City vs. Suburban (choice-level MM)
qoi <- set_qoi(
  .structure     = "choice_level",
  .att_choose    = "att7",
  .lev_choose    = "level7",  # City
  .att_notchoose = "att7",
  .lev_notchoose = "level8"   # Suburban
)

# 5) Estimate and plot (horizontal layout)
out <- projoint(pj_data_wrangled, qoi)
plot(out)
```

</details>

---

## 📊 Compare: Subgroup Differences

<details><summary><b>Choice-Level Subgroup Comparison: Party Differences</b></summary>

```{r, fig.width = 6, fig.height = 3}
data("exampleData1")

outcomes <- c(paste0("choice", 1:8), "choice1_repeated_flipped")

df_D <- exampleData1 |> filter(party_1 == "Democrat") |> reshape_projoint(outcomes)
df_R <- exampleData1 |> filter(party_1 == "Republican") |> reshape_projoint(outcomes)
df_0 <- exampleData1 |> filter(party_1 %in% c("Something else", "Independent")) |> reshape_projoint(outcomes)

qoi <- set_qoi(
  .structure = "choice_level",
  .estimand = "mm",
  .att_choose = "att2",
  .lev_choose = "level3",
  .att_notchoose = "att2",
  .lev_notchoose = "level1"
)

out_D <- projoint(df_D, qoi)
out_R <- projoint(df_R, qoi)
out_0 <- projoint(df_0, qoi)

out_merged <- bind_rows(
  out_D$estimates |> mutate(party = "Democrat"),
  out_R$estimates |> mutate(party = "Republican"),
  out_0$estimates |> mutate(party = "Independent")
) |> filter(estimand == "mm_corrected")

# Plot

ggplot(out_merged, aes(y = party, x = estimate)) +
  geom_vline(xintercept = 0.5, linetype = "dashed", color = "gray") +
  geom_pointrange(aes(xmin = conf.low, xmax = conf.high)) +
  geom_text(aes(label = format(round(estimate, 2), nsmall = 2)), vjust = -1) +
  labs(y = NULL, x = "Choice-level Marginal Mean",
       title = "Preference for Democratic-majority areas") +
  theme_classic()
```

</details>

---

🏠 **Home:** [Home](https://yhoriuchi.github.io/projoint/index.html)
