In mdsteiner/ShinyPsych: An easy way to program psychology experiments using Shiny

About

This tutorial shows you how to implement an n Armed Bandit task (where n can range from two to six) in a shiny app using the ShinyPsych package.

In this tutorial, we will show you a three Armed Bandit task implementation. Where necessary, we will add notes on how to change the setting to get a version with another number of arms. Piece by piece we will go through the whole app code, with comments and explanations between the pieces. To see the app working, click here.

If you have any questions about the package, just email us at [e-mail] or [e-mail]. Ok let's get started with the app...

The Bandit App

We subdivided the script in eight sections:

• Section 0: Load Libraries
• Section A: Assign External Values
• Section B: Define Overall Layout
• Section C: Define Reactive Values
• Section D: Page Layouts
• Section F: Event (e.g. Button) Actions
  • Section F1: Page Navigation Button
  • Section F2: Event Control
• Section G: Save Data
• Section H: Create App

Most of the time we will show the code for a whole section and then explain everything. Sometimes we will subdivide it a little further to avoid to large blocks to maintain some readability.

Section 0: Load Libraries

library(shiny)
library(shinyjs)
library(ShinyPsych)

This bandit app only relies on these three libraries (and their dependencies). The shiny library is the basis to create working shiny apps. It can be used to create html pages and dynamic interfaces, e.g. to display dynamic plots etc. shinyjs is a usefull tool to bring some javascript logic in the page, e.g. to control whether a button is disabled, i.e. nothing happens if you click it, and then to enable it, once e.g. a necessary input has been given. And ShinyPsych about which you'll learn more now...

Section A: Assign External Values

# Dropbox directory to save data
outputDir <- "msteiner/ShinyPsych/Bandit"

# Vector with page ids used to later access objects
idsVec <- c("Instructions", "Demographics", "Goodbye")

# create page lists for the instructions and the last page
instructions.list <- createPageList(fileName = "Instructions_Bandit",
                                    globId = "Instructions")
demographics.list <- createPageList(fileName = "Demographics")
goodbye.list <- createPageList(fileName = "Goodbye")

# prepare a list with game parameters
banditDistList <- list("nTrials" = c(5, rep(10, 3)),  # trials for practice trial and game trials
                       "distributionType" = matrix(   # draw values from different distributions
                         rep(c("unif", "normal", "exgauss"), 5),
                         ncol = 3, byrow = TRUE),
                       "mean" = matrix(c(NA, 6, NA, rep(c(NA, 4, NA), 3)), # arguments for
                                       ncol = 3, byrow = TRUE),            # normal dist
                       "sd" = matrix(c(NA, 2, NA, rep(c(NA, 3, NA), 3)), # arguments for
                                     ncol = 3, byrow = TRUE),            # normal dist
                       "min" = matrix(c(-1, NA, NA, rep(c(-3, NA, NA), 3)), # arguments for
                                      ncol = 3, byrow = TRUE),              # uniform dist
                       "max" = matrix(c(5, NA, NA, rep(c(6, NA, NA), 3)), # arguments for
                                     ncol = 3, byrow = TRUE),             # uniform dist
                       "mu" = matrix(c(NA, NA, 3, rep(c(NA, NA, 4.5), 3)), # arguments for
                                         ncol = 3, byrow = TRUE),          # exgauss dist
                       "sigma" = matrix(c(NA, NA, 4, rep(c(NA, NA, 5), 3)), # arguments for
                                         ncol = 3, byrow = TRUE),           # exgauss dist
                       "tau" = matrix(c(NA, NA, 0, rep(c(NA, NA, 2), 3)), # arguments for
                                      ncol = 3, byrow = TRUE),            # exgauss dist
                       "positive" = matrix(c(NA, NA, FALSE, rep(c(NA, NA, FALSE), 3)), 
                                      ncol = 3, byrow = TRUE)) # arguments for exgauss dist

# create the outcome lists for the bandit, rounded to 1 digit after the comma
banditContainer <- createBanditList(nArms = 3, roundDigits = 1,
                                    distList = banditDistList,
                                    differentDists = TRUE)

We first define outputDir, which contains the path we use in the dropbox to later save the data. If you use dropbox you can also define such an opject or later directly give the string as an argument.
Next we define idsVec, which includes the names of three lists that create pages (such as displaying text or having survey questions on it), that we will use. You do not need to use these exact names, but whatever you call it here, has to match what you call it at different other places later.
The createPageList() function that is thrice called afterwards loads in .txt files, that are called fileName.txt, i.e. if fileName = "Goodbye", R will then search for a file named Goodbye.txt in the current directory, if it is no default list (in this case it is a default list). So if you have not stored your file in the app directory but, e.g. in the www folder of your app, make sure to also enter the path, e.g. fileName = "www/Goodbye". There are some default files, such as the three loaded in here. If you do not use a default list, make sure to set the defaulttxt argument of createPageList() to FALSE. Note that for the bandit instructions list we had to add the argument globId = "Instructions" because the default is just the fileName, but this way it is easier to change tasks and so on. More on how to create these pages, see here.
The banditDistList specified next, contains all the information needed to sample from the outcome distributions. It must at least contain an nTrials and a distributionType object, as well as objects necessary for the distributions. nTrials indicates how many trials there are in each game. Here it is set to "nTrials" = c(5, rep(10, 3)), which means that the first game (the practice game) will have 5 trials, and the other three will each consist of 10 trials. Here distribitionType is "distributionType" = matrix(rep(c("unif", "normal", "exgauss"), 5), ncol = 3, byrow = TRUE), indicating that in each game the three options will be distributed as $Opt1 \sim uniform(min, max)$, $Opt2 \sim\mathcal{N}(\mu, \sigma)$ and $Opt3 \sim exgauss(\mu, \sigma, \tau)$. The other arguments match the arguments of the functions for the three distribution types: runif(), rnorm() and exgauss() (exgauss is from the retimes package). Let us shortly explain the logic behind these arguments: Due to how the function is set up, every argument passed to one of the distribution functions must be a matrix with the dimensions ncol equal to the number of bandit arms and nrow equal to the number of games (i.e. length(nTrials)). If, as in this example, you use different distribution types, only the column matching the distributionType must contain numbers, i.e. if we look at distributionType, we can see that "normal" is the distribution for the second option. Therefore only the second column of the matrix specifying the distribution parameters for rnorm() must contain numbers. The rest we simply fill with NAs. If you don't want to use different distribution types but, e.g., use a normal distribution for all options, just set "distributionType" = "normal", this will also be slightly more efficient, because fewer checks need to be executed. But you still have to enter a matrix with the paramers...
The last function called is createBanditList(), which takes the afore created banditDistList as argument. Note the differentDists = TRUE. If you only have one distribution type, just set this to FALSE (or drop it, FALSE is the default). The nArms argument, yes you've guessed correctly (well hopefully), indicates the bandit's number of arms/ options. roundDigits set's the number of digits after the comma you want the outcomes to be drawn (is passed to R's round() function). createBanditList() returns a list containing, among other things, the outcomes sampled from the specified distributions.
Now all the lists are prepared and we go on to start defining the actual app.

Section B: Define Overall Layout

ui <- fixedPage(

  # App title
  title = "ShinyBandit",

  # To receive the page layouts
  uiOutput("MainAction"),

  # For Shinyjs functions
  useShinyjs(),

  # include appropriate css and js scripts
  includeScriptFiles(fileList = "bandit", nArms = 3) 

)

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

  output$MainAction <- renderUI( {
    PageLayouts()

  })

# The server function continues, which is why the curly brackets are not closed

The first part assigned to ui, is the usual shiny ui part (if that's news for you, we recommend on reading up on shiny apps first). The title will be displayed in the tab bar. useShinyjs() is needed to allow shinyjs functions to be used. includeScriptFiles() will include some css and javascript scripts we've written for the tasks. If you plan to include several tasks in one app, just give a vector with the task names to fileList. You also need to specify the number of arms the bandit has, since different scripts are used depending on the number of arms. If not otherwise specified with globalScript = FALSE, a css script will be loaded that specifies some parameters such as the font size. If you have additional own css or js files to include, you can do this with shiny's includeCSS() and includeScript() functions. Note that all of our javascript scripts have two versions: a commented version that you can look at in the package directory to see what it's doing, and a compiled version (indicated through the Comp.js at the end of the filename), that was compiled by using Google's closure compiler to make it less readable. This is done to make it a bit harder to check or change the variables in the console.
Please note the session in the server definition. You must have for the javascript communicatoin to work.

Section C: Define Reactive Values

  # CurrentValues controls page setting such as which page to display
  CurrentValues <- createCtrlList(firstPage = "instructions", # id of the first page
                                  globIds = idsVec,           # ids of pages for createPage
                                  complCode = TRUE,           # create a completion code
                                  complName = "EP-Bandit",    # first element of completion code
                                  task = "bandit")            # the task(s) used in the app

  # GameData controls task settings and is used to store the task data
  GameData <- createTaskCtrlList(task = "bandit")

These two functions set up the lists of reactive values (again, if that's not a familiar term you should consider to read about shiny apps first) needed to control settings and store values. createCtrlList() is used to set up the general control list that navigates you through the experiment by containing the current page value and things like that. The firstPage argument indicates, yes, the id of the first page. This will be the first thing you see when you run the app. The globIds are the list ids defined earlier in section A as idsVec. complCode and complName control whether a completion code of the form "complName-XXX-XXX-XXX", where XXX is a random number between 100 and 999, should be generated. task takes a vector of names, indicating which tasks are used. This app only contains a bandit task, so we set this to "bandit".
createTaskCtrlList creates a task specific list of reactive values. This will be used to store data in. Note that if you have several tasks in one app, you must call this function several times, because only a list for one task will be created. If you give it a vector this will not work. This is because some tasks have objects with the same name.

Section D: Page Layouts

  PageLayouts <- reactive({

    # insert created completion code that it can later be displayed
    goodbye.list <- changePageVariable(pageList = goodbye.list, variable = "text",
                                       oldLabel = "completion.code",
                                       newLabel = CurrentValues$completion.code)

    # display instructions page
    if (CurrentValues$page == "instructions") {

      return(
        # create html logic of instructions page
        createPage(pageList = instructions.list,
                   pageNumber = CurrentValues$Instructions.num,
                   globId = "Instructions", ctrlVals = CurrentValues)
      )}

    # display task page
    if (CurrentValues$page == "game") {

      return(
        # create html logic of task page and handle client side communications
        multiArmedBanditPage(ctrlVals = CurrentValues, nArms = 3, distList = banditDistList,
                             session = session, container = banditContainer, roundDigits = 1,
                             nTrials = banditDistList$nTrials[CurrentValues$banditGame],
                             nGames = length(banditDistList$nTrials) - 1, withPracticeGame = TRUE)
      )}


  if (CurrentValues$page == "postPractice"){
    return(
        list(
          tags$br(), tags$br(), tags$br(),
          h2("Finished with Practice Game", class = "firstRow"),
          p(paste("You finished the practice game with",
                  GameData$points.cum[length(GameData$points.cum)],
                  "points.")),
          p("On the next pages, you'll start playing the first of 3 real games!"),
          p("Here are a few additional notes and reminders about the game:"),
          tags$ul(
            tags$li("You will play 3 games in total."),
            tags$li("The boxes are the same in each game. However, the",
                    strong("locations of the boxes will be randomly determined"), 
                    "at the start of each game. The boxes might be in the same location, or different locations, in each game."),
            tags$li("The point values in the boxes",
                    strong("do not change over time."),
                    " Each time you choose and option, the point value you see is always returned to the box.")
          ),
          p(strong("On the next page the first real game will start. Click to continue when you are ready.")),
          tags$br(),
          actionButton(inputId = "gt_game", 
                       label = "Start Game 1") 
        )
    )
  }

  # 4) END OF GAME PAGE
  if (CurrentValues$page == "endGame") {
    return(
      list(
        tags$br(), tags$br(),tags$br(),
        p(paste("You ended Game", CurrentValues$game - 2, "with",
                GameData$points.cum[length(GameData$points.cum)], "points.")),
        p("Click the button below to start the next game."),
        p("Remember that all games have the same boxes, however, the positions of the boxes will be randomly determined when the game starts."),
        tags$br(),
        actionButton(inputId = "gt_games",
                     label = paste0("Start Game ", CurrentValues$banditGame - 1))))
  }

  if (CurrentValues$page == "lastEndGame") {

    return(
      list(
        tags$br(), tags$br(),tags$br(),
        h3("You finished all games!", class = "firstRow"),
        p(paste("You earned", GameData$points.cum[length(GameData$points.cum)],
                "points in the game.")),
        p("You have now finished playing all 3 games. The points you have earned across all 3 games have been recorded."),
        p("You have earned", sum(GameData$outcome),
          "points over all games."),
        p("On the next page we ask you a couple of questions."),
        tags$br(),
        actionButton(inputId = "gt_demographics",
                     label = "Continue")))
  }

  if (CurrentValues$page == "demographics"){

    return(
      createPage(pageList = demographics.list, pageNumber = CurrentValues$Demographics.num,
                 globId = "Demographics", ctrlVals = CurrentValues)
    )}


# P5) Goodbye
  if (CurrentValues$page == "goodbye") {

    return(
      createPage(pageList = goodbye.list, pageNumber = CurrentValues$Goodbye.num,
                 globId = "Goodbye", ctrlVals = CurrentValues, continueButton = FALSE)
    )}

  })

PageLayouts is a reactive expression in which the page layouts are defined. First the goodbye.list is updated with the completion code. It has a placeholder in the list for the completion code that is inserted with changePageVariable(). The pages are then created using the createPage() function by giving it the in section A created page lists, the reactive control values created in section C and the global id, i.e. the respective id from idsVec. The pageNumber argument controls which page of the current list is to be displayed. You can see that all pages based on a previously created page list are set up in the same form with createPage().
The task page is then set up by multiArmedBanditPage() which can be called to create any number of armed bandits with two to six armes. The only thing you'd need to change there, in order to get an, e.g., 4 armed bandit was to change the nArms argument to 4 (of course assuming that you previously created the correct banditDistList in section A). The roundDigits argument here indicates the number of digits to round the displayed total point value to, not the individual outcomes (these were defined earlier in Section A). Note that in we use nGames = length(banditDistList$nTrials) - 1 and not nGames = length(banditDistList$nTrials). This is because we include a practice trial, and the number of games will be part of a title displayed on the topleft of the game (e.g. "Game 1 of 3") we don't want the practice game to count to the total number of games. multiArmedBanditPage() will first send the outcomes of a particular game to javascript and then set up the html code to display the page.
The three pages with the ids postPractice, endGame and lastEndGame are formatted in the way you would create your pages if you don't use the createPage() function to create your page from a previously specified .txt file. We use this format here because you currently cannot insert computed variables in, e.g., a paragraph specified in a page list. With changePageVariable() you could only change the whole paragraph, but not a single part of it.

Section F: Event (e.g. Button) Actions

This section is again subdivided in two subsections, one of which is controlling the navigation through the app (F1) and the other is controlling some events, such as enabling the continue buttons (F2).

Section F1: Page Navigation Button

observeEvent(input[["Instructions_next"]],{
  nextPage(pageId = "instructions", ctrlVals = CurrentValues, nextPageId = "game",
          pageList = instructions.list, globId = "Instructions")
})

observeEvent(input[["continueBandit"]], {
  nextBanditPage(ctrlVals = CurrentValues, distList = banditDistList,
                 gameData = GameData, withPracticeGame = TRUE)
})

observeEvent(input[["gt_game"]], {
  CurrentValues$page <- "game"
})

observeEvent(input[["gt_games"]], {
  CurrentValues$page <- "game"
  })
observeEvent(input[["gt_demographics"]], {
  CurrentValues$page <- "demographics"
})

These little blocks each observe a button named the same as the strings in the double brackets (e.g. "continueBandit") and will, once they receive input from the tracked button, call the function indicated in the curly brackets. The nextPage()function handles the flow through pages created with createPage() from an existing page list. Each time the button is clicked, it will increase the pagenumber of that page id by 1, until the maximum number of pages in that list is reached (for "Instructions" this maximum is 2) and will then go to the page indicated at nextPageId.
The nextBanditPage() function will, after a game is finished, go to either the afterPracticeGame page after the practice game (default here is "postPractice"), afterGamePage page after one of the middle games (default here is "endGame") or to afterLastGamePage when the last game is finished (default here is "lastEndGame").
Another way to go to another page is as in the last three observeEvent() blocks, by simply using CurrentValues$page <- newPage, where newPage is a page id.

Section F2: Event Control

# game control
observeEvent(input[["gameNr"]], {
  appendBanditValues(ctrlVals = CurrentValues, distList = banditDistList,
                     input = input, gameData = GameData)
})

# Make sure answers are selected
observeEvent(reactiveValuesToList(input),{

  onInputEnable(pageId = "instructions", ctrlVals = CurrentValues,
                pageList = instructions.list, globId = "Instructions",
                inputList = input, charNum = 4)

  onInputEnable(pageId = "demographics", ctrlVals = CurrentValues,
                pageList = demographics.list, globId = "Demographics",
                inputList = input)

})

The two blocks in this section have the same structure as the ones for navigation control in section F1. The difference lies in the functions called when observe event gets some input. appendBanditValues() is used to append the game parameters, such as option selected, response time etc. to the task control list generated in Section C. The game parameters are sent from javascript to R after each game. This way server - client communication is minimized. When all the necessary values are appended, the continue button is enabled. Note that it does not necessarily have to be gameNr that is observed, it could be any of the objects returned by javascript, such as trial, outcome etc. but gameNr is a good choice because it will change after each game, which is necessary for observeEvent() to react. If you have the same input returned as before, e.g. let's assume you sample the outcome 4 and this would be returned, then if again 4 was sampled and returned, observeEvent() would not react, because the value didn't change. Since the game parameters are only sent after each game it is safe to use gameNr here.
onInputEnable() checks for prespecified conditions to be met, an if TRUE, enables the continue button. This function is designed for use with a page list. The conditions are specified in the page list. Usually these conditions are that an input mustn't be NULL because in many input fields, if nothing has been given as input yet, it just yields NULL. However you may also include a minimum character check such as in onInputEnable() called for the Instructions page list. On the first page of the Instructions list, you have to enter an id. The check will only be ok if, in this case at least 4 (because of charNum = 4) characters are given as input. Only then will the button be enabled. Note that the observed input object is in this case reactiveValuesToList(input), which basically means that every input object is observed. That's why onInputEnable() first does a check if you're currently on the correct page (e.g. instructions in the first call), before it does anything else. This might not be very efficient but it saves you from having to give every input variable to check to observeEvent() and is therefore particularly usefull if you have a larger number of checks, e.g. in a questionnaire with many items on the same page.

Section G: Save Data

observeEvent(input[["Demographics_next"]], {(

# Create progress message   
withProgress(message = "Saving data...", value = 0, {

  incProgress(.25)

  # Create a list to save data
  data.list <- list(  "id" = input$Instructions_workerid, # participant id
                      "trial" = GameData$trial, # trial numbers in a game
                      "time" = GameData$time, # response times
                      "selection" = GameData$selection, # stated preference (option chosen)
                      "outcomes" = GameData$outcome, # outcome sampled
                      "points.cum" = GameData$points.cum, # summed points up to a trial
                      "game" = GameData$game, # gambe order as presented
                      "completion.code" = CurrentValues$completion.code,
                      "option.order" = banditContainer$option.order, # order of display (horizontal)
                      "age" = input$Demographics_age, # stated age
                      "sex" = input$Demographics_sex) # stated sex

  # save Data
      if (!is.null(input$Instructions_mail) &&
          nchar(input$Instructions_mail) > 4){
        saveData(data.list, location = "mail", outputDir = outputDir,
                 partId = data.list$id, suffix = "_g",
                 mailSender = "[e-mail]",
                 mailReceiver = input$Instructions_mail,
                 mailBody = "Your data sent by the ShinyPsych app demo.",
                 mailSubject = paste("ShinyPsych data for id", data.list$id))
      } else {
        saveData(data.list, location = "dropbox", outputDir = outputDir,
                 partId = data.list$id, suffix = "_g")
      }

  CurrentValues$page <- "goodbye"

  })

)})

}

The last observeEvent() block again tracks a continue button. Note that each page created with createPage() with the continueButton argument set to TRUE (default) has a continue button with the id globId_next, which is why here Demographics_next is observed. What this block then does is before it sets the current page variable to in this case goodbye, it prepares a data list containing all the data we want to be saved and then saving it by calling saveData(). Note that data list must either contain variables of length one, or of the same lengths, because in saveData() will call as.data.frame(data.list). So if you have differing lengths it will throw an error. saveData() in this case writes the data to dropbox, which is why we need to give it the output directory for dropbox which we specified in Section A. The saved file will be of the form paste0(partid, Sys.time(), digest::digest(data.list), suffix, ".csv") to ensure no file will overwrite another one. Note that in order to save a file to dropbox you need to give your access tokens for dropbox to the function. You have to put them in an .rds file and give the name (if you have it in the www folder with the path so www/droptoken.rds) to the function. Default is droptoken = "droptoken.rds" which is also what my access token file is called, thus I didn't have to specify this here. You can, however, also save your files locally when you run the app on a local computer. Just use location = "local" and then specify where you want to have you file in outputDir. Note that the creation of the data list and the save data function are wrapped in withProgress() to which also incProgress() belongs. It displays a little panel indicating the progress to the user.

In this app we provide the possibility to send the data to an email address. The user is asked for an email address in the beginning to which the data will then be sent to. If you want to use this feature in your app, please indicate your own addresses in mailSender and mailReceiver, it can be the same address in both fields. Note that this functionality may not work with some mail servers, depending on their filters. So please make sure to test this feature before using it in a study.

Section H: Create App

# Create app!
shinyApp(ui = ui, server = server)

mdsteiner/ShinyPsych documentation built on Feb. 12, 2022, 2:09 p.m.