survey.qmd

---
format: html
echo: false
warning: false
---

```{r}
library(surveydown)
```

::: {#welcome .sd-page}

# Demo survey of choice-based-conjoint questions

::: {.callout-note}

This is a demo survey showcasing the functionality of <a href="https://surveydown.org" target="_blank">surveydown</a>. It doesn't collect any data.

The GitHub repo of this demo can be accessed <a href="https://github.com/surveydown-dev/demo-choice-based-conjoint" target="_blank">here</a>.

:::

This is a demo of choice-based-conjoint survey. For this survey, we will ask you about your preferences for different types of apples.

```{r}
sd_next()
```

:::

::: {#consent .sd-page}

# Consent

This survey is being conducted by students at The George Washing University. We will not be collecting any identifying data, such as your name or address. The whole survey will take approximately 10 to 15 minutes to complete. Your participation is voluntary and you may stop the survey at any time.

If you would like to participate, please answer the following questions:

```{r}
sd_question(
  type  = 'mc',
  id    = 'consent_age',
  label = "I am age 18 or older",
  option = c(
    'Yes' = 'yes',
    'No'  = 'no'
  )
)

sd_question(
  type  = 'mc',
  id    = 'consent_understand',
  label = "I have read and understand the above information",
  option = c(
    'Yes' = 'yes',
    'No'  = 'no'
  )
)

sd_next()
```

:::

::: {#favorite_fruit .sd-page}

# Favorite Fruit

```{r}
sd_question(
  type  = 'mc',
  id    = 'like_fruit',
  label = "Do you like fruit?",
  option = c(
    'Yes!'    = 'yes',
    'Kind of' = 'kind_of',
    'No :('   = 'no'
  )
)

sd_question(
  type  = 'text',
  id    = 'fav_fruit',
  label = "What is your favorite fruit?"
)

sd_next()
```

:::

::: {#screening .sd-page}

# Screening Questions

For this example, I'm using the response here to screen out respondents - I'm only interested in people who choose **"Red"**, so if you choose "Blue" you'll be screened out.

Usually you would not tell respondents ahead of time how they will be screened - I'm just putting an explanation here since this whole survey is for demonstration purposes

```{r}
sd_question(
  type  = 'mc',
  id    = 'screenout',
  label = "Before we go on, please select which color you prefer between these two:",
  option = c(
    'Blue' = 'blue',
    'Red'  = 'red'
  )
)

sd_next()
```

:::

::: {#educational .sd-page}

# Educational Page

Great work! 

Now that you've shared a bit about yourself, we'd like you to consider a shopping scenario in which you can choose some apples to purchase from a set of apples with different attributes.

Let's learn about these attributes.

## Price

Price refers to the full price you will pay (including taxes) for the apples

## Freshness

The freshness of the apple will be presented as one of three different categories:

- **Excellent**: No bruising or marks. 
- **Average**: One or two light bruises. 
- **Poor**: Multiple bruises and marks.

## Type

We will show five different types of apples:

<div style="width: 500px;">

Fuji | Gala | Honeycrisp | Pink Lady | Red Delicious
-----|------|------------|-----------|--------------
<img src="images/fuji.jpg" width=100> | <img src="images/gala.jpg" width=100> | <img src="images/honeycrisp.jpg" width=100> | <img src="images/pinkLady.jpg" width=100> | <img src="images/redDelicious.jpg" width=100>

</div>

```{r}
sd_next()
```

:::

::: {#cbc_practice .sd-page}

# Choice-based Conjoint (cbc) Practice

We'll now begin the choice tasks. On the next few pages we will show you three options of apples and we'll ask you to choose the one you most prefer.

```{r}
# Define the option vector

apple_buttons_option <- c("option_1", "option_2", "option_3")

# Change the names of each element to display markdown-formatted
# text and an embedded image using html

names(apple_buttons_option)[1] <- "
  **Option 1**<br>
  <img src='images/fuji.jpg' width=100><br>
  **Type**: Fuji<br>
  **Price**: $ 2 / lb<br>
  **Freshness**: Average
"
names(apple_buttons_option)[2] <- "
  **Option 2**<br>
  <img src='images/pinkLady.jpg' width=100><br>
  **Type**: Pink Lady<br>
  **Price**: $ 1.5 / lb<br>
  **Freshness**: Excellent
"
names(apple_buttons_option)[3] <- "
  **Option 3**<br>
  <img src='images/honeycrisp.jpg' width=100><br>
  **Type**: Honeycrisp<br>
  **Price**: $ 2 / lb<br>
  **Freshness**: Poor
"

sd_question(
  type   = 'mc_buttons',
  id     = 'cbc_practice',
  label  = "For example, if these were the only apples available, which would you choose?",
  option = apple_buttons_option
)

sd_next()
```

:::

::: {#cbc_intro .sd-page}

# Conjoint Question Intro

Great work!

We will now show you 6 sets of choice questions starting on the next page.

```{r}
sd_next()
```

:::

::: {#cbc_q1 .sd-page}

# Conjoint Question 1

```{r}
sd_output("cbc_q1", type = "question")
sd_next()
```

:::

::: {#cbc_q2 .sd-page}

# Conjoint Question 2

```{r}
sd_output("cbc_q2", type = "question")
sd_next()
```

:::

::: {#cbc_q3 .sd-page}

# Conjoint Question 3

```{r}
sd_output("cbc_q3", type = "question")
sd_next()
```

:::

::: {#cbc_q4 .sd-page}

# Conjoint Question 4

```{r}
sd_output("cbc_q4", type = "question")
sd_next()
```

:::

::: {#cbc_q5 .sd-page}

# Conjoint Question 5

```{r}
sd_output("cbc_q5", type = "question")
sd_next()
```

:::

::: {#cbc_q6 .sd-page}

# Conjoint Question 6

```{r}
sd_output("cbc_q6", type = "question")
sd_next()
```

:::

::: {#apple_knowledge .sd-page}

# Apple Knowledge

Thank you for your feedback! The next section will ask some basic questions about apples. 

Please answer to the best of your knowledge.

```{r}
label <- 'Please select the type of this apple:

  <img src="images/fuji.jpg" width=100>'

sd_question(
  type  = 'select',
  id    = 'apple_knowledge_1',
  label = label,
  option = c(
    'Fuji'          = 'fuji',
    'Gala'          = 'gala',
    'Honeycrisp'    = 'honeycrisp',
    'Pink Lady'     = 'pink_lady',
    'Red Delicious' = 'red_delicious'
  ),
  width = "500px"
)

label <- 'Please select the type of this apple:

<img src="images/gala.jpg" width=100>'

sd_question(
  type  = 'select',
  id    = 'apple_knowledge_2',
  label = label,
  option = c(
    'Fuji'          = 'fuji',
    'Gala'          = 'gala',
    'Honeycrisp'    = 'honeycrisp',
    'Pink Lady'     = 'pink_lady',
    'Red Delicious' = 'red_delicious'
  ),
  width = "500px"
)

sd_next()
```

:::

::: {#demographics .sd-page}

# Demographics Page

## Nice job!

We're almost done! We'd just like to ask just a few more questions about you which we will only use for analyzing our survey data.

::: {style="width:500px; margin: 0 auto;"}

```{r}
# Construct the list of years

years <- as.character(2003:1920)
names(years) <- years
years <- c("Prefer not to say" = "prefer_not_say", years)

sd_question(
  type   = 'select',
  id     = 'year_of_birth',
  label  = "(1) In what year were you born?",
  option = years
)

genders <- c(
  "Male"                     = "male",
  "Female"                   = "female", 
  "Non-binary"               = "non_binary", 
  "Trans male/trans man"     = "trans_male",
  "Trans female/trans woman" = "trans_female",
  "Prefer not to say"        = "prefer_not_to_say"
)

sd_question(
  type   = 'select',
  id     = 'gender',
  label  = "(2) What is your current gender identity?",
  option = genders
)

races <- c(
  "White (Not of Hispanic or Latino origin)"  = "white",
  "African American or Black"                 = "black",
  "Asian"                                     = "asian",
  "Hispanic or Latino"                        = "hispanic",
  "American Indian or Alaska Native"          = "native_american",
  "Native Hawaiian or Other Pacific Islander" = "pacific_islander",
  "Prefer not to say"                         = "prefer_not_to_say"
)

sd_question(
  type   = 'select',
  id     = 'race',
  label  = "(3) I identify my race as (select all that apply):",
  option = races
)

educations <- c(
  "Less than high school" = "less_than_high_school",
  "High school"           = "high_school",
  "Some college"          = "some_college",
  "Associate's degree"    = "associate_degree",
  "Bachelor's degree"     = "bachelor_degree",
  "Master's degree"       = "master_degree",
  "Doctoral degree"       = "doctoral_degree",
  "Prefer not to say"     = "prefer_not_to_say"
)

sd_question(
  type   = 'select',
  id     = 'education',
  label  = "(4) What is the highest degree or level of school you have completed? If currently enrolled, please use the highest degree received.",
  option = educations
)

incomes <- c(
  "Less than $10,000"    = "less_than_10k",
  "$10,000 to $14,999"   = "10k_to_14k",
  "$15,000 to $19,999"   = "15k_to_19k",
  "$20,000 to $24,999"   = "20k_to_24k",
  "$25,000 to $29,999"   = "25k_to_29k",
  "$30,000 to $34,999"   = "30k_to_34k",
  "$35,000 to $39,999"   = "35k_to_39k",
  "$40,000 to $49,999"   = "40k_to_49k",
  "$50,000 to $74,999"   = "50k_to_74k",
  "$75,000 to $99,999"   = "75k_to_99k",
  "$100,000 to $149,999" = "100k_to_149k",
  "$150,000 to $199,999" = "150k_to_199k",
  "$200,000 or more"     = "200k_or_more",
  "Prefer not to say"    = "prefer_not_to_say"
)

sd_question(
  type   = 'select',
  id     = 'income',
  label  = "(5) What is your annual household income (from all sources) before taxes and other deductions from pay?",
  option = incomes
)

sd_question(
  type  = "textarea",
  id    = "feedback",
  label = 
  "Please let us know if you have any other thoughts or feedback on this survey.
  
  Your feedback will help us make future improvements :)"
)

sd_next()
```

:::

:::

::: {#end_normal .sd-page}

# End Page

The survey is finished. Thank you for your feedback!

Your completion code is: **`r sd_output('completion_code', type = 'value')`**

You may close the window now.

```{r}
sd_close()
```

:::

::: {#end_consent .sd-page}

# End Page

The survey is now finished. You may close the window.

```{r}
sd_close()
```

:::

::: {#end_screenout .sd-page}

# End Page

Sorry, we wanted you to select the **red** button.

The survey is now finished. You may close the window.

```{r}
sd_close()
```

:::