---
title: "Simulating Choices"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Simulating Choices}
  %\VignetteEngine{knitr::rmarkdown}
  \usepackage[utf8]{inputenc}
  \usepackage{xcolor}
  \usepackage{bbding}
bibliography: "`r here::here('vignettes', 'library.bib')`"
---

```{r setup, include=FALSE, message=FALSE, warning=FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  warning = FALSE,
  message = FALSE,
  fig.retina = 3,
  comment = "#>"
)

set.seed(123)
```

Choice simulation converts experimental designs into realistic choice data by predicting how respondents would answer choice questions. This is essential for testing designs, conducting power analyses, and validating experimental assumptions before data collection. This article shows how to use `cbc_choices()` to simulate choice patterns.

Before starting, let's define some basic profiles and a basic random design to work with:

```{r}
library(cbcTools)

profiles <- cbc_profiles(
  price = c(1, 1.5, 2, 2.5, 3),
  type = c('Fuji', 'Gala', 'Honeycrisp'),
  freshness = c('Poor', 'Average', 'Excellent')
)

design <- cbc_design(
  profiles = profiles,
  method = "random",
  n_alts = 2,
  n_q = 6,
  n_resp = 100
)

design
```

# Choice Simulation Approaches

`cbc_choices()` supports two simulation approaches:

1. **Random simulation**: Each alternative has equal probability of being chosen
2. **Utility-based simulation**: Choice probabilities based on multinomial logit model with specified priors

## Random Choices

Without priors, choices are simulated randomly with equal probabilities:

```{r}
# Random choice simulation (default)
choices_random <- cbc_choices(design)

head(choices_random)

# Check choice distribution
table(choices_random$choice, choices_random$altID)
```

Random simulation is useful for:

- Quick testing of design structure
- Conservative power analysis (worst-case scenario)
- Baseline comparisons

## Utility-Based Choices

With priors, choices follow realistic utility-based patterns:

```{r}
# Create priors for utility-based simulation
priors <- cbc_priors(
  profiles = profiles,
  price = -0.25, # Negative preference for higher prices
  type = c(0.5, 1), # Gala and Honeycrisp preferred over Fuji
  freshness = c(0.6, 1.2) # Average and Excellent preferred over Poor
)

# Utility-based choice simulation
choices_utility <- cbc_choices(design, priors = priors)

head(choices_utility)
```

## Choice Data Format

The simulated choice data includes all design columns plus a `choice` column:

```{r}
head(choices_utility)
```

# Advanced Simulation Options

## Designs with No-Choice

For designs with no-choice options, specify no-choice priors:

```{r}
# Create design with no-choice option
design_nochoice <- cbc_design(
  profiles = profiles,
  n_alts = 2,
  n_q = 6,
  n_resp = 100,
  no_choice = TRUE,
  method = "random"
)

# Create priors including no-choice utility
priors_nochoice <- cbc_priors(
  profiles = profiles,
  price = -0.25,
  type = c(0.5, 1.0),
  freshness = c(0.6, 1.2),
  no_choice = -0.5 # Negative = no-choice less attractive
)

# Simulate choices
choices_nochoice <- cbc_choices(
  design_nochoice,
  priors = priors_nochoice
)

# Examine no-choice rates
nochoice_rate <- mean(choices_nochoice$choice[choices_nochoice$no_choice == 1])
cat("No-choice selection rate:", round(nochoice_rate * 100, 1), "%\n")
```

## Random Parameters (Mixed Logit)

Simulate heterogeneous preferences using random parameters:

```{r}
# Create priors with random parameters
priors_random <- cbc_priors(
  profiles = profiles,
  price = rand_spec(dist = "n", mean = -0.1, sd = 0.05),
  type = rand_spec(dist = "n", mean = c(0.1, 0.2), sd = c(0.05, 0.1)),
  freshness = c(0.1, 0.2), # Keep some parameters fixed
  n_draws = 100
)

# Simulate choices with preference heterogeneity
choices_mixed <- cbc_choices(design, priors = priors_random)
```

## Interaction Effects

Include interaction effects in choice simulation:

```{r}
# Create priors with interactions
priors_interactions <- cbc_priors(
  profiles = profiles,
  price = -0.1,
  type = c("Fuji" = 0.5, "Gala" = 1),
  freshness = c("Average" = 0.6, "Excellent" = 1.2),
  interactions = list(
    # Price sensitivity varies by apple type
    int_spec(
      between = c("price", "type"),
      with_level = "Fuji",
      value = 0.5
    ),
    int_spec(
      between = c("price", "type"),
      with_level = "Gala",
      value = 0.2
    )
  )
)

# Simulate choices with interaction effects
choices_interactions <- cbc_choices(
  design,
  priors = priors_interactions
)
```

# Validating Choice Patterns

## Overall Choice Frequencies

Based on the priors used, we expect:

- **Lower prices preferred** (negative price coefficient)
- **Honeycrisp > Gala > Fuji** (type coefficients: 0.2 > 0.1 > 0)
- **Excellent > Average > Poor** (freshness coefficients: 0.2 > 0.1 > 0)

Examine aggregate choice patterns to validate simulation:

```{r}
# Decode the choice data first to get categorical variables
choices_decoded <- cbc_decode(choices_utility)

# Aggregate attribute choices across all respondents
choices <- choices_decoded

# Price choices
price_choices <- aggregate(choice ~ price, data = choices, sum)
price_choices$prop <- price_choices$choice / sum(price_choices$choice)
print(price_choices)

# Type choices
type_choices <- aggregate(choice ~ type, data = choices, sum)
type_choices$prop <- type_choices$choice / sum(type_choices$choice)
print(type_choices)

# Freshness choices
freshness_choices <- aggregate(choice ~ freshness, data = choices, sum)
freshness_choices$prop <- freshness_choices$choice /
  sum(freshness_choices$choice)
print(freshness_choices)
```

## Respondent Heterogeneity

For random parameter models, examine variation across respondents:

```{r}
# Create dataset with only chosen alternatives
chosen_alts <- choices_mixed[choices_mixed$choice == 1, ]

# Mean attribute levels chosen by each respondent
resp_means <- aggregate(
  cbind(
    price,
    typeGala,
    typeHoneycrisp,
    freshnessAverage,
    freshnessExcellent
  ) ~
    respID,
  data = chosen_alts,
  mean
)

# Look at variation across respondents
cat("Price variation across respondents:\n")
cat("Mean:", round(mean(resp_means$price), 2), "\n")
cat("SD:", round(sd(resp_means$price), 2), "\n")

cat("\nHoneycrisp choice rate variation:\n")
cat("Mean:", round(mean(resp_means$typeHoneycrisp), 2), "\n")
cat("SD:", round(sd(resp_means$typeHoneycrisp), 2), "\n")
```

# Design Consistency

## Using Consistent Priors

For D-optimal designs created with priors, use the same priors for choice simulation:

```{r}
# Create D-optimal design with priors
design_optimal <- cbc_design(
  profiles = profiles,
  n_alts = 2,
  n_q = 6,
  n_resp = 100,
  priors = priors,
  method = "stochastic"
)

# Use SAME priors for choice simulation
choices_consistent <- cbc_choices(
  design_optimal,
  priors = priors
)
```

## Prior Consistency Warnings

cbcTools warns when different priors are used:

```{r}
# Create different priors
different_priors <- cbc_priors(
  profiles = profiles,
  price = -0.2, # Different from design optimization
  type = c(0.2, 0.4),
  freshness = c(0.2, 0.4)
)

# This will generate a warning about inconsistent priors
choices_inconsistent <- cbc_choices(
  design_optimal,
  priors = different_priors
)
```

# Best Practices

## Prior Specification

- **Use realistic priors**: Base on literature, pilot studies, or expert judgment
- **Match design priors**: Use same priors for design optimization and choice simulation  
- **Test multiple scenarios**: Simulate under optimistic and conservative assumptions
- **Include heterogeneity**: Use random parameters when appropriate

## Validation Steps

1. **Check choice counts**: Verify one choice per question
2. **Examine patterns**: Ensure choices align with prior expectations
3. **Test extremes**: Simulate with very strong/weak preferences
4. **Compare methods**: Test different simulation approaches

# Next Steps

After simulating choices:

1. **Conduct power analysis** using `cbc_power()` to determine sample size requirements
2. **Compare designs** by simulating choices for different design methods
3. **Validate assumptions** by checking if simulated patterns match expectations
4. **Refine priors** based on simulation results before data collection

For details on power analysis, see the [Power Analysis](power.Rmd) vignette.
