layout: true <!-- this adds the link footer to all slides, depends on my-footer class in css--> <div class="footer-small"> <span> https://github.com/jhelvy/2022-sawtooth-conf </span> </div> --- name: title-slide class: inverse, middle background-image: url(images/blue.jpg) # The `cbcTools` Package <a href='https://jhelvy.github.io/cbcTools/'><img src='images/logo.png' align="right" height="300"/></a> ## Tools for Designing and Testing<br>Choice-Based Conjoint Surveys in
### by John Paul Helveston Sawtooth Software Conference May 06, 2022 --- class: center ### Designing a Choice-Based Conjoint Survey is Hard -- <center> <img src="images/tradeoffs1.png" width=90%> </center> --- class: center ### Designing a Choice-Based Conjoint Survey is Hard <center> <img src="images/tradeoffs2.png" width=90%> </center> --- class: center ### Designing a Choice-Based Conjoint Survey is Hard <center> <img src="images/tradeoffs3.png" width=90%> </center> --- # .center[A simple conjoint experiment about _cars_] Attribute | Levels ----------|---------- Brand | GM, BMW, Ferrari Price | $20k, $40k, $100k .center[**Design: .red[9] choice sets, .blue[3] alternatives each**] -- .leftcol[ ``` Attribute counts: brand: GM BMW Ferrari 10 11 6 price: 20k 40k 100k 9 9 9 ``` ] -- .rightcol[ ``` Pairwise attribute counts: brand & price: 20k 40k 100k GM 3 0 7 BMW 4 5 2 Ferrari 2 4 0 ``` ] --- # .center[A simple conjoint experiment about _cars_] Attribute | Levels ----------|---------- Brand | GM, BMW, Ferrari Price | $20k, $40k, $100k .center[**Design: .red[90] choice sets, .blue[3] alternatives each**] -- .leftcol[ ``` Attribute counts: brand: GM BMW Ferrari 92 80 98 price: 20k 40k 100k 91 84 95 ``` ] -- .rightcol[ ``` Pairwise attribute counts: brand & price: 20k 40k 100k GM 31 31 30 BMW 25 25 30 Ferrari 35 28 35 ``` ] --- # .center[Bayesian D-efficient designs] ### .center[Maximize information on "Main Effects" according to priors] Attribute | Levels | Prior ----------|-------------------|---------- Brand | GM, BMW, Ferrari | 0, 1, 2 Price | $20k, $40k, $100k | 0, -1, -4 -- .leftcol[ ``` Attribute counts: brand: GM BMW Ferrari 93 90 86 price: 20k 40k 100k 97 93 78 ``` ] -- .rightcol[ ``` Pairwise attribute counts: brand & price: 20k 40k 100k GM 52 41 0 BMW 30 30 30 Ferrari 15 22 49 ``` ] --- # .center[Bayesian D-efficient designs] ### .center[Attempts to maximize information on .red[Main Effects]] -- <center> <img src="images/design_compare.png" width=100%> </center> --- ### .center[...but .red[interaction effects] are confounded in D-efficient designs] -- <center> <img src="images/design_compare_int.png" width=120%> </center> --- # .center[But what about other factors?] <br> - What if I add one more choice question to each respondent? -- - What if I increase the number of alternatives per choice question? -- - What if I use a labeled design (aka "alternative-specific design")? -- - What if there are interaction effects? --- class: middle, center, inverse # The `cbcTools` Package <center> <img src="images/logo.png" width=30%> </center> --- background-image: url("images/process.png") --- background-image: url("images/process_labels.png") --- class: center, middle background-image: url("images/process_labels.png") .border[ <center> <img src="images/cbc_screenshot.png" width=80%> </center> ] --- background-image: url("images/process_levels.png") --- # .center[Define the attributes and levels] <br> ```r levels <- list( price = c(1.00, 1.50, 2.00, 2.50, 3.00, 3.50, 4.00), # $ per pound type = c("Fuji", "Gala", "Honeycrisp"), freshness = c("Excellent", "Average", "Poor") ) ``` -- ```r levels ``` ``` #> $price #> [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 #> #> $type #> [1] "Fuji" "Gala" "Honeycrisp" #> #> $freshness #> [1] "Excellent" "Average" "Poor" ``` --- background-image: url("images/process_profiles.png") --- # .center[Generate all possible profiles] <br> ```r profiles <- cbc_profiles(levels) ``` -- .leftcol[ ```r head(profiles) ``` ``` #> profileID price type freshness #> 1 1 1.0 Fuji Excellent #> 2 2 1.5 Fuji Excellent #> 3 3 2.0 Fuji Excellent #> 4 4 2.5 Fuji Excellent #> 5 5 3.0 Fuji Excellent #> 6 6 3.5 Fuji Excellent ``` ] .rightcol[ ```r tail(profiles) ``` ``` #> profileID price type freshness #> 58 58 1.5 Honeycrisp Poor #> 59 59 2.0 Honeycrisp Poor #> 60 60 2.5 Honeycrisp Poor #> 61 61 3.0 Honeycrisp Poor #> 62 62 3.5 Honeycrisp Poor #> 63 63 4.0 Honeycrisp Poor ``` ] --- # .center[Attribute-specific levels] <br> ```r levels <- list( price = c(1.00, 1.50, 2.00, 2.50, 3.00, 3.50, 4.00), freshness = c("Excellent", "Average", "Poor"), type = list( "Fuji" = list( price = c(2.00, 2.50, 3.00) ), "Gala" = list( price = c(1.00, 1.50, 2.00) ), "Honeycrisp" = list( price = c(2.50, 3.00, 3.50, 4.00), freshness = c("Excellent", "Average") ) ) ) ``` --- # .center[Generate restricted set of profiles] <br> ```r profiles <- cbc_profiles(levels) ``` -- .leftcol[ ```r head(profiles) ``` ``` #> profileID price freshness type #> 1 1 2.0 Excellent Fuji #> 2 2 2.5 Excellent Fuji #> 3 3 3.0 Excellent Fuji #> 4 4 2.0 Average Fuji #> 5 5 2.5 Average Fuji #> 6 6 3.0 Average Fuji ``` ] .rightcol[ ```r tail(profiles) ``` ``` #> profileID price freshness type #> 21 21 3.5 Excellent Honeycrisp #> 22 22 4.0 Excellent Honeycrisp #> 23 23 2.5 Average Honeycrisp #> 24 24 3.0 Average Honeycrisp #> 25 25 3.5 Average Honeycrisp #> 26 26 4.0 Average Honeycrisp ``` ] --- background-image: url("images/process_design.png") --- # .center[Generate a survey design] ```r design <- cbc_design( profiles = profiles, n_resp = 300, # Number of respondents n_alts = 3, # Number of alternatives per question n_q = 6 # Number of questions per respondent ) ``` -- ```r head(design) ``` ``` #> respID qID altID obsID profileID price type freshness #> 1 1 1 1 1 60 2.5 Honeycrisp Poor #> 2 1 1 2 1 39 2.5 Honeycrisp Average #> 3 1 1 3 1 37 1.5 Honeycrisp Average #> 4 1 2 1 2 58 1.5 Honeycrisp Poor #> 5 1 2 2 2 3 2.0 Fuji Excellent #> 6 1 2 3 2 38 2.0 Honeycrisp Average ``` --- # .center[Include a "no choice" option] ```r design <- cbc_design( profiles = profiles, n_resp = 300, # Number of respondents n_alts = 3, # Number of alternatives per question n_q = 6, # Number of questions per respondent * no_choice = TRUE ) ``` -- ```r head(design) ``` ``` #> respID qID altID obsID profileID price type_Fuji type_Gala type_Honeycrisp freshness_Excellent freshness_Average freshness_Poor no_choice #> 1 1 1 1 1 3 2.0 1 0 0 1 0 0 0 #> 2 1 1 2 1 38 2.0 0 0 1 0 1 0 0 #> 3 1 1 3 1 19 3.0 0 0 1 1 0 0 0 #> 4 1 1 4 1 0 0.0 0 0 0 0 0 0 1 #> 5 1 2 1 2 30 1.5 0 1 0 0 1 0 0 #> 6 1 2 2 2 53 2.5 0 1 0 0 0 1 0 ``` --- ## .center[Make a labeled design] .center[.font100[(aka "alternative-specific design")]] ```r design <- cbc_design( profiles = profiles, n_resp = 300, # Number of respondents n_alts = 3, # Number of alternatives per question n_q = 6, # Number of questions per respondent * label = "type" ) ``` -- ```r head(design) ``` ``` #> respID qID altID obsID profileID price type freshness #> 1 1 1 1 1 3 2.0 Fuji Excellent #> 2 1 1 2 1 53 2.5 Gala Poor #> 3 1 1 3 1 38 2.0 Honeycrisp Average #> 4 1 2 1 2 3 2.0 Fuji Excellent #> 5 1 2 2 2 50 1.0 Gala Poor #> 6 1 2 3 2 42 4.0 Honeycrisp Average ``` --- # .center[Make a Bayesian D-efficient design] ### .center[(coming soon!)] ```r design <- cbc_design( profiles = profiles, n_resp = 300, # Number of respondents n_alts = 3, # Number of alternatives per question n_q = 6, # Number of questions per respondent * priors = list( * price = -0.1, * type = c(0.1, 0.2), * freshness = c(0.1, -0.2) * ) ) ``` --- # .center[Make a Bayesian D-efficient design] ### .center[(coming soon!)] <br> ## - Check out the [`idefix`](https://www.jstatsoft.org/article/view/v096i03) package -- ## - Import a design: .blue[Sawtooth]
--- background-image: url("images/process_inspect.png") --- # .center[Check design **balance**] ```r cbc_balance(design) ``` -- .leftcol[ ``` Attribute counts: price: 1 1.5 2 2.5 3 3.5 4 825 797 743 743 767 779 746 type: Fuji Gala Honeycrisp 1842 1769 1789 freshness: Excellent Average Poor 1813 1775 1812 ``` ] -- .rightcol[ ``` Pairwise attribute counts: price & type: Fuji Gala Honeycrisp 1 304 252 269 1.5 274 251 272 2 257 254 232 2.5 240 254 249 3 249 263 255 3.5 257 250 272 4 261 245 240 ``` ] --- # .center[Check design **overlap**] ```r cbc_overlap(design) ``` -- .leftcol[ ``` Counts of attribute overlap: (# of questions with N unique levels) price: 1 2 3 31 630 1139 type: 1 2 3 156 1248 396 freshness: 1 2 3 175 1189 436 ``` ] --- background-image: url("images/process_choices.png") --- # .center[Simulate random choices] ```r data <- cbc_choices( design = design, obsID = "obsID" ) ``` -- ```r head(data) ``` ``` #> respID qID altID obsID profileID price type freshness choice #> 1 1 1 1 1 3 2.0 Fuji Excellent 0 #> 2 1 1 2 1 53 2.5 Gala Poor 0 #> 3 1 1 3 1 38 2.0 Honeycrisp Average 1 #> 4 1 2 1 2 3 2.0 Fuji Excellent 1 #> 5 1 2 2 2 50 1.0 Gala Poor 0 #> 6 1 2 3 2 42 4.0 Honeycrisp Average 0 ``` --- # .center[Simulate choices according to a prior] .leftcol[ ```r data <- cbc_choices( design = design, obsID = "obsID", * priors = list( * price = -0.1, * type = c(0.1, 0.2), * freshness = c(0.1, -0.2) * ) ) ``` ] .rightcol[ Attribute | Level | Utility ----------|----------- **Price** | Continuous | -0.1 **Type** | Fuji | 0 | Gala | 0.1 | Honeycrisp | 0.2 **Freshness** | Average | 0 | Excellent | 0.1 | Poor | -0.2 ] --- # .center[Simulate choices according to a prior] .leftcol[ ```r data <- cbc_choices( design = design, obsID = "obsID", priors = list( price = -0.1, * type = randN( * mu = c(0.1, 0.2), * sigma = c(0.5, 1) * ), freshness = c(0.1, -0.2) ) ) ``` ] .rightcol[ Attribute | Level | Utility ----------|----------- **Price** | Continuous | -0.1 **Type** | Fuji | 0 | Gala | N(0.1, 0.5) | Honeycrisp | N(0.2, 1) **Freshness** | Average | 0 | Excellent | 0.1 | Poor | -0.2 ] --- # .center[Simulate choices according to a prior] .leftcol[ ```r data <- cbc_choices( design = design, obsID = "obsID", priors = list( price = -0.1, type = c(0.1, 0.2), freshness = c(0.1, -0.2), * "price*type" = c(0.1, 0.5) ) ) ``` ] .rightcol[ Attribute | Level | Utility ----------|----------- **Price** | Continuous | -0.1 **Type** | Fuji | 0 | Gala | 0.1 | Honeycrisp | 0.2 **Freshness** | Average | 0 | Excellent | 0.1 | Poor | -0.2 **Price x Type** | Fuji | 0 | Gala | 0.1 | Honeycrisp | 0.5 ] --- background-image: url("images/process_power.png") --- # .center[Conduct a power analysis] ```r power <- cbc_power( nbreaks = 10, n_q = 6, data = data, obsID = "obsID", outcome = "choice", pars = c("price", "type", "freshness") ) ``` -- .leftcol[ ```r head(power) ``` ``` #> sampleSize coef est se #> 1 30 price -0.18558034 0.09627804 #> 2 30 typeGala -0.11287630 0.18806682 #> 3 30 typeHoneycrisp -0.00373311 0.18247312 #> 4 30 freshnessAverage -0.23740384 0.21995530 #> 5 30 freshnessPoor -0.58571733 0.23470664 #> 6 60 price -0.13680799 0.06768533 ``` ] .rightcol[ ```r tail(power) ``` ``` #> sampleSize coef est se #> 45 270 freshnessPoor -0.18341634 0.07544056 #> 46 300 price -0.11054677 0.02899401 #> 47 300 typeGala 0.09544003 0.05943437 #> 48 300 typeHoneycrisp 0.18369313 0.05829540 #> 49 300 freshnessAverage 0.13523452 0.07015579 #> 50 300 freshnessPoor -0.19427738 0.07161628 ``` ] --- # .center[Conduct a power analysis] ```r plot(power) ``` <img src="figs/unnamed-chunk-30-1.png" width="576" /> --- # .center[Conduct a power analysis] .leftcol[ ```r power_int <- cbc_power( nbreaks = 10, n_q = 6, data = data, pars = c( "price", "type", "freshness", * "price*type" ), outcome = "choice", obsID = "obsID" ) ``` ] .rightcol[ ```r plot(power_int) ``` <img src="figs/unnamed-chunk-32-1.png" width="576" /> ] --- background-image: url("images/process_labels.png") <center> <img src="images/logo.png" width=20%> </center> --- background-image: url("images/sawtooth-cbcTools.png") --- background-color: #fff background-image: url("images/cbcTools-sawtooth.png") background-position: center background-size: contain --- class: inverse background-image: url(images/blue.jpg) <br> # .center[.font150[Thanks!]] ### `cbcTools` documentation: https://jhelvy.github.io/cbcTools/ ### Slides: https://jhelvy.github.io/2022-sawtooth-conf .footer-large[ .right[ @johnhelveston
<br> @jhelvy
<br> @jhelvy
<br> jhelvy.com
<br> jph@gwu.edu
]] --- class: center, middle, inverse # Extra slides