A pre-computation survey landing page (or other UI speed improvements)

[soerendamsbo]

Description

I like surveydown a lot and I'm working towards trying it at scale for research asap. The main obstacle is performance, specifically waiting time for users. I've set up short test surveys (with embedded experiments) deployed to Posit Connect Cloud with Supabase as the backend. In an attempt to improve performance, I am trying out the Basic plan on PCC ($19/mo) and the Pro plan on Supabase ($25/mo). However, it is still slow for (test) users.

In particular, I notice that saving data to the Postgres DB with sd_store_value() is slow (often >1 sec per call). In my simple test survey, I am running sd_store_value() 10 times, which results in >10 seconds load time – and I would need to store more than 10 values for production.

The best thing would be if there were ways to speed up interactions with the DB. But one possible simple improvement of the user experience would be implementing a static landing/welcome page and have all the Shiny app code, including sd_store_value() calls, run in the background. This page could include a welcome message, consent, etc. that respondents need time to read anyway.

I'm also very interested in hearing other people's experience with performance, infrastructure (Supabase etc.), and tips for improving waiting time.

Thanks a lot for your work on the surveydown project!

[jhelvy]

Hi! Thanks for using surveydown. Performance is definitely a challenge, and it's something we can try to keep working on. I am curious though why you are having issues specifically with sd_store_value() as it shouldn't require much run time. Is there a demo survey you could share to let us see how you've set it up?

We have it on our roadmap to make storing different things optional, as right now we record all the time stamps of each page and question, which doubles the number of columns in the database. Turning off some of those options (when we enable that) should also help.

[soerendamsbo]

Thanks a lot for taking this issue up so quickly. It's great that you're making it optional to store things like time stamps! I am also curious about whether other users have the same experience with slow sd_store_value() calls. It's a bit hard for me to reliably share an actual online demo survey atm, but as a first step I'm attaching the app.R file of my demo along with a screenshot of the survey loading screen – with a progress bar that I've implemented to partially mitigate the problem with slow (ostensibly unresponsive) startup.

Storage of values initiates after the page loads and a progress bar appears, which increments when another value has been stored (~10 in total). That's how I know that the bottleneck is these sd_store_value() calls, which take ~1 second each.

Some of the values, I'm storing, are relatively long strings, i.e., text vignettes of ~10-50 words (in Danish), that are randomly presented to the survey respondents. An example would be "Kommunen skal gøre mere for at få ejere af tomme, forfaldne bygninger til at renovere eller sælge dem". But it still shouldn't take that long to store a bit of raw text, I would assume. As far as I understand, anything that is variably presented in the survey must go through the app.R -> sd_store_value() -> DB -> sd_output() pipeline, right? If long strings are in fact the issue, it would be extremely helpful if there were some way of circumventing this pipeline (i.e., go straight from app.R to output, storing only a numeric indicator of what the outputted value is).

Survey loading screenshot

App. R

# Install required packages:
# install.packages("pak")
# pak::pak("surveydown-dev/surveydown") # Development version from GitHub

# Load packages
library(shiny)
library(surveydown)
library(dplyr)

# Database setup --------------------------------------------------------------

# Setup Postgresql database connection
# sd_db_config()

# Connect
db <- sd_db_connect(ignore = FALSE)

# UI setup --------------------------------------------------------------------

ui <- sd_ui()

# Server setup ----------------------------------------------------------------

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

  # Load   and   sample   from   data
  policy <- read.csv(
    "randomization_persuasion.csv"
  ) |>
    dplyr::sample_n(1)

  story <- read.csv("randomization_severity.csv") |>
    dplyr::filter(stringr::str_detect(text, "\"")) |>
    dplyr::sample_n(1)

  # Conditions: list experiment
  list_condition <- c('treatment', 'kontrol') |>
    sample(size = 1, replace = FALSE)

  # Store values
  # use input$time_start to trigger storage when the survey starts
  # use input$welcome_next to trigger storage when the user selects "next" on the first page

  observeEvent(input$time_start != "", {
    Sys.sleep(.5)
    withProgress(message = "Tak for at du vil deltage! Vent venligst, mens vi forbereder dit spørgeskema. Det er klar om få sekunder...", expr = {
      nsteps <- 10
      completion_code <- sd_get_url_pars("completion_code")
      sd_store_value(completion_code, id = "completion_code")
      incProgress(1 / nsteps) # step 1
      sd_store_value(story$text, id = "stor_text")
      incProgress(1 / nsteps) # step 2
      sd_store_value(story$politician, id = "stor_politician")
      incProgress(1 / nsteps) # step 3
      sd_store_value(story$permutation_id, id = "stor_permutation_id")
      incProgress(1 / nsteps) # step 4
      sd_store_value(policy$permutation_id, id = "pers_permutation_id")
      incProgress(1 / nsteps) # step 5
      sd_store_value(policy$condition, id = "pers_condition")
      incProgress(1 / nsteps) # step 6
      sd_store_value(policy$question, id = "pers_question")
      incProgress(1 / nsteps) # step 7
      sd_store_value(policy$pro, id = "pers_pro")
      incProgress(1 / nsteps) # step 8
      sd_store_value(policy$con, id = "pers_con")
      incProgress(1 / nsteps) # step 9
      sd_store_value(list_condition, id = "list_condition")
      incProgress(1 / nsteps) # step 10
    })
  })

  # Define any conditional skip logic here (skip to page if a condition is true)
  sd_skip_if()

  # Define any conditional display logic here (show a question if a condition is true)
  # OBS! This has to be outside the observeEvent call
  sd_show_if(
    list_condition == "treatment" ~ "list-treatment",
    list_condition == "kontrol" ~ "list-kontrol",
    policy$condition == "null" ~ "persuasion-null",
    policy$condition == "pro" ~ "persuasion-pro",
    policy$condition == "con" ~ "persuasion-con",
    policy$condition == "procon" ~ "persuasion-procon"
  )

  # Run surveydown server and define database
  sd_server(db = db)
}

# Launch the app
shiny::shinyApp(ui = ui, server = server)

[jhelvy]

Ah, okay so a few things. First, I see Sys.sleep(.5) inside your observeEvent call. That is forcing a half second pause to all computation, so you're losing time there. That might be there just for printing out the progress, but you should be able to remove it. Second, you shouldn't need the observeEvent call anyway. If you call sd_store_value() directly at the top of your server function it should run right away anyway.

Finally, you could speed things up by pre-defining the randomization and storing it inside a csv file (see here). That way you could read in the pre-randomized set of values as a csv (which you can do at the top of your app.R file outside of the server function) and just record the single user id with sd_store_value(). If you had, for example, a design data frame with an id column and then columns for all other values you need, then you'd only have something like this:

# Randomly choose a row id
random_id <- sample(design$id, 1)

# Store the chosen id in the survey data
sd_store_value(random_id)

Then all other values could be loaded from the design data frame by slicing it by random_id. No need to save all those values in the database because you can just join all that on later after collecting your data.

[soerendamsbo]

Thanks for your suggestions! Regarding your final suggestion, I have read all your excellent documentation, including on randomization, but it did not seem to match what I need. I'm randomizing information that's provided on the page before asking a (simple) question (see screenshot and page-specific code from survey.qmd below). What you seem to be suggesting is randomizing information in the question. With lengthy (randomized) multidimensional information, including it in the actual question label becomes bulky, I'm fearing. But it might still be a solution given that the question label supports markdown etc., and I haven't really tried it out, to be honest, so I will! Are there any ways of doing a similar thing with information in the page rather than question (defining individual randomized page versions rather than question versions in the app.R file) – or do you see a way of adding support for such a feature?

--- persuasion-con

## Din holdning til konkret politik

> **`r sd_output("pers_question", type = "value")`**

| | Argumenter imod (uenig) |  
|-----------------------|-------------------------|
| | `r sd_output("pers_con", type = "value")` | 

```{r}
sd_question("policy")
```

[soerendamsbo]

Update: I successfully inserted all randomized information directly into the question label with markdown/html syntax and it works like a charm. This greatly reduces the need for storing values to the DB, as you suggested, which means that loading time is mechanically slashed by several seconds. So it goes a long way towards solving my problem, which is exciting!

Within the server() call in app.R, I've added:

# fmt: skip
      policy_lab <- glue::glue("__{policy$question}__ 


| {policy$pro_lab} | {policy$con_lab} |  
|------------------|------------------|
|   {policy$pro}   |   {policy$con}   | 

  
  Hvad er din egen holdning?
    
  ")

      sd_question(
        id = "policy",
        type = "mc",
        label = policy_lab,
        options = c("Helt enig", "Delvist enig", "Delvist uenig", "Helt uenig")
      )

and replaced the page in survey.qmd with:

--- persuasion

## Din holdning til konkret politik

```{r}
sd_output(id = "policy", type = "question")
```

yielding:

Long term I think it would still be useful to provide a way of doing the same thing in a way that is separate from questions. For instance, when I provide randomized information with three follow-up questions on the same page (a common case for me), it is a bit awkward that the information has to go into first question rather than being presented independently. I guess a very simple and easy solution could be to implement an 'information' or 'empty' or 'null' question type, which works like any other question type but has no options (null).

[jhelvy]

Wow that worked! I wasn't sure if it would, but Quarto + shiny is a pretty flexible framework :)

It is a bit tedious though. Another idea is you could render the random text inside the app and store it in the output, like:

output$policy_pro <- shiny::renderText(policy$pro)

Then in your survey.qmd you could use shiny::textOutput("policy_pro") in your markdown table. I think that should be able to work so that this is all separate from the question itself.

[soerendamsbo]

This seems to work too, at least in the sense of printing the text. It does not appear to render html/markdown correctly out of the box, though. But it's something to experiment with if/when embedding in question label fall short. Perhaps it's worth adding information about this in the documentation and/or (re)consider the option-free "empty" question type? Either way, thanks a million, John!

[jhelvy]

Yeah I might put a little example of something like this in the docs. The general idea of pre-randomizing things is there, but it takes some careful planning to make sure it's set up properly.