Reactive Labels and options depending on previous answers

[StefanMunnes]

Description

Right now, I'm testing your wonderful project for our use cases. One thing we use quite often, is the conditional display of questions labels or answers. For example, when the respondent is interested in dating men, I would like to change the text of the following question slightly to change just one or two words (e.g. "What do you like about {men}?").
I know, I could create different questions, but this seems too confusing to me. I know I can use sd_output() to display the value of a previous question, but how can I access this value to write a conditional statement for the label (e.g. if (id_value) == 1 "men" else "women")? I also tried to use the value in the app.R server function (e.g. input$id == 1), but receive the error "outside of reactive consumer". I checked your documentation and tried different approaches.
For know, I can't get it solved by my own and need your help and suggestions.
All the best,
Stefan

[jhelvy]

Idea 1

Put the question in the markdown and leave the actual question label blank. This works okay, but it's less ideal as the question label is outside of the question box. It looks like this:

Here's how you could make this:

SURVEY:

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

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

::: {#page1 .sd-page}

```{r}
sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

sd_next()
```

:::

::: {#page_id .sd-page}

What do you like about dating `r sd_output('date_type', type = 'value')`?

```{r}
sd_question(
  type   = "textarea",
  id     = "likes",
  label  = ""
)

sd_next()
```

:::


::: {#end .sd-page}

This is the end of the survey

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

:::

APP:

library(surveydown)

db <- sd_database(ignore = TRUE)

server <- function(input, output, session) {
  sd_server(db = db)
}

shiny::shinyApp(ui = sd_ui(), server = server)

[jhelvy]

Idea 2

Define two separate questions in your server() function and then use the show_if feature to display only one of the questions depending on the answer to the first question. This will render the way you might want, something like this:

Here's how you could make this:

SURVEY:

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

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

::: {#page1 .sd-page}

```{r}
sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

sd_next()
```

:::

::: {#page_id .sd-page}

```{r}
sd_output('likes_men', type = 'question')
sd_output('likes_women', type = 'question')

sd_next()
```

:::

::: {#end .sd-page}

This is the end of the survey

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

:::

APP:

library(surveydown)

db <- sd_database(ignore = TRUE)

server <- function(input, output, session) {

  sd_question(
    type   = "textarea",
    id     = "likes_men",
    label  = "What do you like about dating men?"
  )

  sd_question(
    type   = "textarea",
    id     = "likes_women",
    label  = "What do you like about dating women?"
  )

  sd_show_if(
    input$date_type == "men" ~ "likes_men",
    input$date_type == "women" ~ "likes_women"
  )

  sd_server(db = db)
}

shiny::shinyApp(ui = sd_ui(), server = server)

[jhelvy]

Idea 3

(IMO the simplest / best solution)

Use sd_output() when defining the label of the second question. For example, on one page you might have a question like this:

sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

Then on the next page you could insert the response to the first question in the label of the follow-on question like this:

sd_question(
  type   = "textarea",
  id     = "likes",
  label  = glue::glue("What do you like about dating {sd_output('date_type', type = 'value')}?")
)

Here's a full example:

SURVEY:

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

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

::: {#page1 .sd-page}

```{r}
sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

sd_next()
```

:::

::: {#page_id .sd-page}

```{r}
sd_question(
  type   = "textarea",
  id     = "likes",
  label  = glue::glue("What do you like about dating {sd_output('date_type', type = 'value')}?")
)

sd_next()
```

:::

::: {#end .sd-page}

This is the end of the survey

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

:::

APP:

library(surveydown)

db <- sd_database(ignore = TRUE)

server <- function(input, output, session) {
  sd_server(db = db)
}

shiny::shinyApp(ui = sd_ui(), server = server)

[jhelvy]

Okay I left 3 ideas here on how to do this. The simplest one by far is idea 3, but I'm keeping all of these just in case there are others who may find these approaches helpful.

• Idea 1: Embed the value from the first question in the markdown, not the question label.
• Idea 2: Make multiple questions then use the show_if feature to show the appropriate question according to the response to the first question.
• Idea 3: Simply embed the value from the first question in the next question label using sd_output()

[StefanMunnes]

I really appreciate the effort you guys spend in this project. So, thanks for the quick and extensive response. I also think this could be helpful for others. Nevertheless, I still miss an additional solution where I can access and use the value for further conditional selections. Let me provide a more profound but fictional example:

SURVEY:

sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

lab_date_type <- date_type$value # fictional way of accessing the given answer
lab_pref_type <- if (lab_date_type == "men") "masculanity" else "feminity"

sd_question(
  type   = "mc",
  id     = "date_preference",
  label  = glue::glue{"Since you are interesseted in {lab_date_type}, do you like {lab_pref_type}""),
  option = c(
     glue::glue("Yes, I like {lab_pref_type}") = "date_pref_yes",
     glue::glue("No, I don't like {lab_pref_type}") = "date_pref_no"
  )
)

I hope this makes my needs a little bit more clear. I'm looking for a way to use a respondent's answer for further question and answer modeling, and I can't just prolong with the "simple" answer. Could also be the case, if it's a condition on multiple possible answers (e.g. male & diverse vs. female).
Since the sd_output can reactively output the value in the markdown and code cell, is it possible to work with the value instead of presenting it?

[jhelvy]

Okay I see what you're trying to do. The sd_output() function can only be used to display something that is "rendered" inside the server, and in the background when we use sd_output() with type = "value", we're calling a pre-rendered value (we render every value from every question automatically to allow users to be able to display them).

In this case, you're trying to use the response value itself to do something with it, like create some other object based on the value chosen. In this case, you would have to run this logic in the server() function and then store the resulting value that you want to display in the survey.

This works for the question label, but we don't have this supported yet for the question options. That's something we could probably add though. Here's an example:

SURVEY:

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

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

::: {#page1 .sd-page}

```{r}
sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women"  = "women"
  )
)

sd_next()
```

:::

::: {#page2 .sd-page}

```{r}
# Create local objects to display 
date_type <- sd_output('date_type', type = 'value')
pref_type <- textOutput('lab_pref_type', inline = TRUE)

sd_question(
  type   = "mc",
  id     = "date_preference",
  label  = glue::glue("Since you are interested in {date_type}, do you like {pref_type}"),
  option = c(
    "Yes" = "yes", 
    "No" = "no"
  )
)

sd_next()
```

:::

::: {#end .sd-page}

This is the end of the survey

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

:::

APP:

library(surveydown)
db <- sd_database()

server <- function(input, output, session) {

  observe({
    result <- "feminity"
    type <- input$date_type
    if (length(type) > 0) {
      if (type == "men") { result <- "masculanity" }
    }
    output$lab_pref_type <- renderText(result)
  })

  sd_server(db = db)
}

shiny::shinyApp(ui = sd_ui(), server = server)

Notice there's a good bit of shiny machinery here needed to make this work, namely this bit:

  observe({
    result <- "feminity"
    type <- input$date_type
    if (length(type) > 0) {
      if (type == "men") { result <- "masculanity" }
    }
    output$lab_pref_type <- renderText(result)
  })

Here what we're doing is setting up an observer to "watch" the date_type input / question. We set a default value ("feminity"), and if the user chooses "men" it changes to "masculanity". Then I'm just using typical shiny code to store this value in the output as lab_pref_type. Up in the survey, I embed this value into the question label by making the object pref_type <- textOutput('lab_pref_type', inline = TRUE), using a regular shiny textOutput() function.

It's a good bit of work, but this is one way to make this happen. If you try to do the same thing for the options label, it won't render properly, at least not yet. I'll look into whether it's possible to modify the option label with a reactive value just like we did with the label.

[StefanMunnes]

Looks promising, even if I hoped for a less complicated way to do this. But I can't run this example, it always crashes with the error message:

Warnung: Error in quarto::quarto_render: ✖ Error running quarto cli.
Caused by error:
! System command 'quarto.exe' failed
  52: <Anonymous>
  51: signalCondition
  50: signal_abort
  49: rlang::abort
  48: cli::cli_abort
  47: value[[3L]]
  46: tryCatchOne
  45: tryCatchList
  44: tryCatch
  43: quarto_run
  42: quarto::quarto_render
  41: get_html_content
  40: run_config
  39: sd_server
  38: server [C:\Users\munnes\Nextcloud\...\test/app.R#15]
   1: shiny::runApp
Error in quarto::quarto_render(survey_file) : 
  ✖ Error running quarto cli.
Caused by error:
! System command 'quarto.exe' failed

I first tried it with my own survey and tried in the end your example, but no way for me to solve this by my own.

[jhelvy]

Okay sorry for that - the error is because I forgot to include library(shiny) in the survey.qmd file 🤦 .

Anyway, I did find a full solution for this. It's a bit more complicated, but the main idea is that if you're trying to change the question values (either the label or options or both) based on anything reactive (e.g., answers to a previous question), then you should define the whole question inside your server() function and use sd_output() with type = "question" in the survey.qmd file. Here's an example below.

SURVEY:

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

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

::: {#page1 .sd-page}

```{r}
sd_question(
  type   = "mc",
  id     = "date_type",
  label  = "Do you date men or women?",
  option = c(
    "Men" = "men",
    "Women" = "women"
  )
)

sd_next()
```

:::

::: {#page2 .sd-page}

```{r}
sd_output('date_preference', type = 'question')

sd_next()
```

:::

::: {#end .sd-page}

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

:::

APP:

library(surveydown)

server <- function(input, output, session) {

  # Create reactives to generate the labels and question options
  pref_type <- reactive({
    if (length(input$date_type) > 0) {
      if (input$date_type == "men") { return("masculinity") }
    }
    return("feminity") # Default type
  })

  pref_label <- reactive({
    glue::glue(
      "Since you are interested in {input$date_type}, do you like {pref_type()}?"
    )
  })

  pref_options <- reactive({
    options <- c('yes', 'no')
    names(options)[1] <- glue::glue("Yes, I like {pref_type()}")
    names(options)[2] <- glue::glue("No, I like {pref_type()}")
    return(options)
  })

  # Need to wrap the question in an observer so that the values update dynamically
  observe({
    sd_question(
      type   = "mc",
      id     = "date_preference",
      label  = pref_label(),
      option = pref_options()
    )
  })

  sd_server()
}

shiny::shinyApp(ui = sd_ui(), server = server)

There's a lot going on in there, but here's a quick explanation. First, in the survey.qmd file, I just have the one line to insert the reactive question: sd_output('date_preference', type = 'question'). This is just telling surveydown where to put the question.

In the app.R file, I created reactive expressions for pref_label() and pref_options(). These are like functions, but they won't evaluate until something changes that they depend on. For example, inside pref_label() I have input$date_type, so whenever the chosen answer for this question changes, the whole pref_label() expression will get re-evaluated. So down in the sd_question() function, I have the label defined as label = pref_label(), meaning the label will also update.

So this is a specific example, but hopefully the general pattern is clear. I might actually update the docs on the reactivity page with an example like this.

[jhelvy]

Btw, here's another way to define the server function in the app.R file:

server <- function(input, output, session) {

  observe({
    date_type <- input$date_type

    # Define the pref_type based on date_type
    pref_type <- "feminity" # Default type
    if (length(date_type) > 0) {
      if (date_type == "men") { pref_type <- "masculinity" }
    }

    # Make the question label and options
    pref_label <-glue::glue(
      "Since you are interested in {date_type}, do you like {pref_type}?"
    )
    pref_options <- c('yes', 'no')
    names(pref_options)[1] <- glue::glue("Yes, I like {pref_type}")
    names(pref_options)[2] <- glue::glue("No, I like {pref_type}")

    # Make the question
    sd_question(
      type   = "mc",
      id     = "date_preference",
      label  = pref_label,
      option = pref_options
    )
  })

  sd_server()
}

This approach is a little simpler. We just have one big observer that updates whenever the answer to the date_type question changes. It creates all the pieces we need (label and question options) then creates the question. The survey.qmd file is the same.

[jhelvy]

I added a similar (but slightly simpler) example to the documentation page on reactivity. Hopefully that will be helpful for anyone else trying something like this.