---
# General Settings
format: html
echo: false
warning: false

# Theme Settings
theme: default
barposition: top
footer-left: "Made with [surveydown](https://surveydown.org)"
footer-right: '[<i class="bi bi-github"></i> Source Code](https://github.com/surveydown-dev/templates)'

# Survey Settings
use-cookies: true
auto-scroll: false
rate-survey: false
system-language: en
highlight-unanswered: true
highlight-color: blue
capture-metadata: true
all-questions-required: false
required-questions:
  - consent_age
  - consent_understand
  - screenout
---

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

::: {.sd_page id=welcome}

# Template - Choice-based-conjoint Survey

::: {.callout-note}

There are two versions of the conjoint survey: "button" and "table". This is the "**button**" version.

In this version, the conjoint options are shown in buttons.

:::

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

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

:::

::: {.sd_page id=consent}

# 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()
```

:::

::: {.sd_page id=favorite_fruit}

# 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()
```

:::

::: {.sd_page id=screening}

# 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()
```

:::

::: {.sd_page id=educational}

# 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()
```

:::

::: {.sd_page id=cbc_practice_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()
```

:::

::: {.sd_page id=cbc_intro}

# Conjoint Question Intro

Great work!

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

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

:::

::: {.sd_page id=cbc_q1_page}

# Conjoint Question 1

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

:::

::: {.sd_page id=cbc_q2_page}

# Conjoint Question 2

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

:::

::: {.sd_page id=cbc_q3_page}

# Conjoint Question 3

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

:::

::: {.sd_page id=cbc_q4_page}

# Conjoint Question 4

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

:::

::: {.sd_page id=cbc_q5_page}

# Conjoint Question 5

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

:::

::: {.sd_page id=cbc_q6_page}

# Conjoint Question 6

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

:::

::: {.sd_page id=apple_knowledge}

# 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()
```

:::

::: {.sd_page id=demographics}

# 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()
```

:::

:::

::: {.sd_page id=end_normal}

# 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()
```

:::

::: {.sd_page id=end_consent}

# End Page

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

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

:::

::: {.sd_page id=end_screenout}

# End Page

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

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

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

:::
