design section complete

jhelvy · Jun 12, 2023 · 1080973 · 1080973
1 parent 96765a6
commit 1080973
Show file tree

Hide file tree

Showing 8 changed files with 218 additions and 41 deletions.
diff --git a/parts/designing-surveys/designing-surveys.pdf b/parts/designing-surveys/designing-surveys.pdf
diff --git a/parts/designing-surveys/designing-surveys.zip b/parts/designing-surveys/designing-surveys.zip
diff --git a/parts/designing-surveys/figs/unnamed-chunk-24-1.png b/parts/designing-surveys/figs/unnamed-chunk-24-1.png
diff --git a/parts/designing-surveys/figs/unnamed-chunk-26-1.png b/parts/designing-surveys/figs/unnamed-chunk-26-1.png
diff --git a/parts/designing-surveys/index.Rmd b/parts/designing-surveys/index.Rmd
@@ -698,6 +698,21 @@ background-size: contain
 
 ---
 
+class: inverse 
+
+# Your turn
+
+- Download the practice zip file for this section.
+- Open the `designing-surveys.Rproj` file to open RStudio.
+- In RStudio, open the `practice.R` file.
+- Experiment with different design options, then examine the power:
+    - What if you modify the quesitons per respondent?
+    - What if you use a labeled design? 
+    - What if you include a "no choice" option?
+    - What if you use a Bayesian D-efficient design?
+
+---
+
 class: inverse
 
 <br>

diff --git a/parts/designing-surveys/index.html b/parts/designing-surveys/index.html
@@ -284,12 +284,12 @@
 
 ```
 #&gt;   profileID respID qID altID obsID price       type freshness
-#&gt; 1         1      1   1     1     1   1.0       Fuji      Poor
-#&gt; 2        61      1   1     2     1   3.0 Honeycrisp Excellent
-#&gt; 3        41      1   1     3     1   3.5 Honeycrisp   Average
-#&gt; 4        44      1   2     1     2   1.5       Fuji Excellent
-#&gt; 5        42      1   2     2     2   4.0 Honeycrisp   Average
-#&gt; 6         9      1   2     3     2   1.5       Gala      Poor
+#&gt; 1        38      1   1     1     1   2.0 Honeycrisp   Average
+#&gt; 2        39      1   1     2     1   2.5 Honeycrisp   Average
+#&gt; 3        20      1   1     3     1   3.5 Honeycrisp      Poor
+#&gt; 4         3      1   2     1     2   2.0       Fuji      Poor
+#&gt; 5        60      1   2     2     2   2.5 Honeycrisp Excellent
+#&gt; 6        13      1   2     3     2   3.5       Gala      Poor
 ```
 
 ---
@@ -316,12 +316,12 @@
 
 ```
 #&gt;   profileID respID qID altID obsID price type_Fuji type_Gala type_Honeycrisp freshness_Poor freshness_Average freshness_Excellent no_choice
-#&gt; 1        61      1   1     1     1   3.0         0         0               1              0                 0                   1         0
-#&gt; 2         7      1   1     2     1   4.0         1         0               0              1                 0                   0         0
-#&gt; 3        11      1   1     3     1   2.5         0         1               0              1                 0                   0         0
+#&gt; 1         7      1   1     1     1   4.0         1         0               0              1                 0                   0         0
+#&gt; 2        46      1   1     2     1   2.5         1         0               0              0                 0                   1         0
+#&gt; 3        23      1   1     3     1   1.5         1         0               0              0                 1                   0         0
 #&gt; 4         0      1   1     4     1   0.0         0         0               0              0                 0                   0         1
-#&gt; 5        30      1   2     1     2   1.5         0         1               0              0                 1                   0         0
-#&gt; 6        12      1   2     2     2   3.0         0         1               0              1                 0                   0         0
+#&gt; 5        19      1   2     1     2   3.0         0         0               1              1                 0                   0         0
+#&gt; 6        34      1   2     2     2   3.5         0         1               0              0                 1                   0         0
 ```
 
 ---
@@ -350,11 +350,11 @@
 
 ```
 #&gt;   profileID respID qID altID obsID price       type freshness
-#&gt; 1        45      1   1     1     1   2.0       Fuji Excellent
-#&gt; 2        13      1   1     2     1   3.5       Gala      Poor
-#&gt; 3        60      1   1     3     1   2.5 Honeycrisp Excellent
-#&gt; 4        23      1   2     1     2   1.5       Fuji   Average
-#&gt; 5        11      1   2     2     2   2.5       Gala      Poor
+#&gt; 1        47      1   1     1     1   3.0       Fuji Excellent
+#&gt; 2        56      1   1     2     1   4.0       Gala Excellent
+#&gt; 3        40      1   1     3     1   3.0 Honeycrisp   Average
+#&gt; 4        45      1   2     1     2   2.0       Fuji Excellent
+#&gt; 5        51      1   2     2     2   1.5       Gala Excellent
 #&gt; 6        38      1   2     3     2   2.0 Honeycrisp   Average
 ```
 
@@ -401,11 +401,11 @@
 
 ```
 #&gt;   respID qID altID obsID price       type freshness
-#&gt; 1      1   1     1     1   2.0       Fuji Excellent
-#&gt; 2      1   1     2     1   3.5       Gala      Poor
-#&gt; 3      1   1     3     1   2.5 Honeycrisp Excellent
-#&gt; 4      1   2     1     2   1.5       Fuji   Average
-#&gt; 5      1   2     2     2   2.5       Gala      Poor
+#&gt; 1      1   1     1     1   3.0       Fuji Excellent
+#&gt; 2      1   1     2     1   4.0       Gala Excellent
+#&gt; 3      1   1     3     1   3.0 Honeycrisp   Average
+#&gt; 4      1   2     1     2   2.0       Fuji Excellent
+#&gt; 5      1   2     2     2   1.5       Gala Excellent
 #&gt; 6      1   2     3     2   2.0 Honeycrisp   Average
 ```
 
@@ -529,12 +529,12 @@
 
 ```
 #&gt;   profileID respID qID altID obsID price       type freshness choice
-#&gt; 1        45      1   1     1     1   2.0       Fuji Excellent      1
-#&gt; 2        13      1   1     2     1   3.5       Gala      Poor      0
-#&gt; 3        60      1   1     3     1   2.5 Honeycrisp Excellent      0
-#&gt; 4        23      1   2     1     2   1.5       Fuji   Average      0
-#&gt; 5        11      1   2     2     2   2.5       Gala      Poor      1
-#&gt; 6        38      1   2     3     2   2.0 Honeycrisp   Average      0
+#&gt; 1        47      1   1     1     1   3.0       Fuji Excellent      0
+#&gt; 2        56      1   1     2     1   4.0       Gala Excellent      1
+#&gt; 3        40      1   1     3     1   3.0 Honeycrisp   Average      0
+#&gt; 4        45      1   2     1     2   2.0       Fuji Excellent      0
+#&gt; 5        51      1   2     2     2   1.5       Gala Excellent      0
+#&gt; 6        38      1   2     3     2   2.0 Honeycrisp   Average      1
 ```
 
 ---
@@ -685,13 +685,13 @@
 ```
 
 ```
-#&gt;   sampleSize               coef          est         se
-#&gt; 1         30              price  0.003092675 0.09016038
-#&gt; 2         30           typeGala -0.240473504 0.18989874
-#&gt; 3         30     typeHoneycrisp  0.060170597 0.17735710
-#&gt; 4         30   freshnessAverage  0.253766258 0.22468413
-#&gt; 5         30 freshnessExcellent -0.110946044 0.22337299
-#&gt; 6         60              price  0.031519941 0.06396166
+#&gt;   sampleSize               coef        est         se
+#&gt; 1         30              price -0.1289689 0.09703613
+#&gt; 2         30           typeGala  0.3097395 0.19622827
+#&gt; 3         30     typeHoneycrisp  0.4039833 0.19185208
+#&gt; 4         30   freshnessAverage -0.4936206 0.22915332
+#&gt; 5         30 freshnessExcellent -0.2773703 0.21284363
+#&gt; 6         60              price -0.0811527 0.06713569
 ```
 
 ]
@@ -705,12 +705,12 @@
 
 ```
 #&gt;    sampleSize               coef         est         se
-#&gt; 45        270 freshnessExcellent -0.16091892 0.07531163
-#&gt; 46        300              price -0.06196600 0.02871551
-#&gt; 47        300           typeGala  0.09127943 0.05911533
-#&gt; 48        300     typeHoneycrisp  0.16258872 0.05841456
-#&gt; 49        300   freshnessAverage  0.20443009 0.06990719
-#&gt; 50        300 freshnessExcellent -0.16052514 0.07132286
+#&gt; 45        270 freshnessExcellent -0.31731638 0.07674039
+#&gt; 46        300              price -0.08985462 0.02913155
+#&gt; 47        300           typeGala  0.15681599 0.05935676
+#&gt; 48        300     typeHoneycrisp  0.19697765 0.05883549
+#&gt; 49        300   freshnessAverage -0.05403604 0.06891741
+#&gt; 50        300 freshnessExcellent -0.31296763 0.07264400
 ```
 
 ]
@@ -783,6 +783,21 @@
 
 ---
 
+class: inverse 
+
+# Your turn
+
+- Download the practice zip file for this section.
+- Open the `designing-surveys.Rproj` file to open RStudio.
+- In RStudio, open the `practice.R` file.
+- Experiment with different design options, then examine the power:
+    - What if you modify the quesitons per respondent?
+    - What if you use a labeled design? 
+    - What if you include a "no choice" option?
+    - What if you use a Bayesian D-efficient design?
+
+---
+
 class: inverse
 
 &lt;br&gt;

diff --git a/parts/designing-surveys/practice.R b/parts/designing-surveys/practice.R
@@ -0,0 +1,146 @@
+# Make conjoint survey designs using the cbcTools package
+
+# Install packages
+# install.packages("cbcTools")
+
+# Load libraries
+library(cbcTools)
+
+# A simple conjoint experiment about apples
+
+# Generate all possible profiles  ----
+
+profiles <- cbc_profiles(
+    price     = c(1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5),
+    type      = c("Fuji", "Gala", "Honeycrisp"),
+    freshness = c('Poor', 'Average', 'Excellent')
+)
+
+# Make a design ----
+
+# Make a randomized survey design
+
+design_rand <- cbc_design(
+    profiles = profiles,
+    n_resp   = 1000, # Number of respondents
+    n_alts   = 3,   # Number of alternatives per question
+    n_q      = 6    # Number of questions per respondent
+)
+
+# Make a randomized survey design with a "no choice" option
+
+design_rand_nochoice <- cbc_design(
+    profiles  = profiles,
+    n_resp    = 1000, # Number of respondents
+    n_alts    = 3,   # Number of alternatives per question
+    n_q       = 6,   # Number of questions per respondent
+    no_choice = TRUE
+)
+
+# Make a randomized labeled survey design with each "type" appearing in
+# each choice question
+
+design_rand_labeled <- cbc_design(
+    profiles  = profiles,
+    n_resp    = 1000, # Number of respondents
+    n_alts    = 3,   # Number of alternatives per question
+    n_q       = 6,   # Number of questions per respondent
+    label     = "type"
+)
+
+# Make a Bayesian D-efficient design with a prior model specified
+
+design_deff <- cbc_design(
+    profiles  = profiles,
+    n_resp    = 1000, # Number of respondents
+    n_alts    = 3,  # Number of alternatives per question
+    n_q       = 6,  # Number of questions per respondent
+    n_start   = 1,
+    priors = list(
+        price     = -0.1,
+        type      = c(0.1, 0.2),
+        freshness = c(0.1, 0.2)
+    )
+)
+
+# Inspect designs ----
+
+# Inspect balance 
+
+cbc_balance(design_rand)
+cbc_balance(design_rand_nochoice)
+cbc_balance(design_rand_labeled)
+cbc_balance(design_deff)
+
+# Inspect overlap
+
+cbc_overlap(design_rand)
+cbc_overlap(design_rand_nochoice)
+cbc_overlap(design_rand_labeled)
+cbc_overlap(design_deff)
+
+# Simulate choices ----
+
+design <- design_deff
+
+# Random choices 
+
+data <- cbc_choices(
+    design = design,
+    obsID  = "obsID"
+)
+
+# Choices according to a prior
+
+data <- cbc_choices(
+    design = design,
+    obsID = "obsID",
+    priors = list(
+        price     = -0.1,
+        type      = c(0.1, 0.2),
+        freshness = c(0.1, 0.2)
+    )
+)
+
+# Choices according to a prior with an interaction term
+
+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)
+    )
+)
+
+# Choices according to a prior with a random normal term
+
+data <- cbc_choices(
+    design = design,
+    obsID = "obsID",
+    priors = list(
+        price = -0.1,
+        type = randN(mean = c(0.1, 0.2), sd = c(1, 2)),
+        freshness = c(0.1, 0.2)
+    )
+)
+
+# Power analysis ----
+
+power <- cbc_power(
+    data    = data,
+    pars    = c("price", "type", "freshness"),
+    outcome = "choice",
+    obsID   = "obsID",
+    nbreaks = 10,
+    n_q     = 6
+)
+
+head(power)
+tail(power)
+
+# Visualize results
+
+plot(power)
diff --git a/parts/render.R b/parts/render.R
@@ -12,6 +12,7 @@ tools::compactPDF(paste0(lesson, ".pdf"), gs_quality = 'ebook')
 zip::zip(
     zipfile = paste0(lesson, ".zip"),
     files = c(
-        'demoSurvey.Rmd',
+        # 'demoSurvey.Rmd',
+        'practice.R',
         paste0(lesson, ".Rproj"))
 )