Programming simple economic experiments in shiny

[This article was first published on Rficionado » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

In this post, I want to present a flexible way to implement small surveys or economic experiments in shiny. If you have some background in experimental economics, you may have noticed that the most widely used software to implement economic experiments is zTree. To be honest I never touched zTree so I can say little about it, but my impression was that capabilities are actually fairly limited. On the other hand, what are the alternatives? Well, let us assume pen&paper is not a viable alternative. A more modern approach is to code the experiment as a small webpage, i.e. use languages such as HTML, JavaScript, Ruby or Python (or a mix of them). The resulting app is then deployed to a server and can be called in a standard webbrowser. Unfortunately that requires that you are proficient in at least one of these languages and that you have an idea about how to set up a server to get this running, including how to handle users, sessions, create a database on the server to save the responses etc. etc. In case you are familiar with these things, I guess that’s the way to go, because it’s tremendously more flexible. Moreover, once you have an experiment running online, it’s available everywhere. No messy zTree installation on PCs in the lab. All you need is that computers in the lab are connected to the internet (a very mild requirement I’d say).

When I wanted to run my first experiments, I was not familiar with any of the mentioned programming languages and learning them was a bit steep for me (both in terms of time and effort). Fortunately, I had a good friend to help me out here with some production grade code – no way I could have come up with that. So without being a web programmer, what else can you do? Enter: Dean Attali, who blogged about how to mimick a Google Doc in shiny.

Dean's little doc

I think Dean wrote a great post (again someone who seems to be a great teacher) and made a tremendous effort to describe in detail how to build this little app from scratch. His solution also shows his shinyjs package in action, a package that I will make extensive use of here, too.

Taking Dean’s code from his GitHub repo makes it straightforward to customize and expand his doc to a small multi-page survey, where users are prompted to provide answers to several questions and their responses are saved in a ‘database’. He has a follow-up post, where he discusses different possibilities to store these responses not only locally, but also how to push them to a remote server, e.g. Amazon’s S3 or your Dropbox. Using remote storage, e.g. on S3, you can also grant your co-authors immediate access to the data (see here).

Economic Experiments in shiny?

On a second thought, many, if not most, experiments that economist run are just like these little surveys. Consider the following structure:

  1. Login page, where participants that were recruited to the lab type in their credentials.
  2. A single or a set of pages with instructions about the experiment that is to follow.
  3. Pages with the main experiment, e.g. a series of pages where the participants have to provide answers to incentivized questions.
  4. Logout page, where participants often receive feedback on their responses and their final payoff.

This structure suffices for many of the experiments that I have seen. In what follows, I will demonstrate how with the help of Dean’s code one can implement this in shiny. That being said, you may well ask for more and find that the above structure is too rudimentary for what you have in mind. Think of what you will see next as a proof of concept, but by no means an exhausive example. In fact, I believe much more fancy things are possible than what I will show below, e.g. to have users interact etc.

Prerequisites

I assume you work from RStudio. We will need the same prerequisites as listed by Dean:

  • Packages: shiny, shinyjs,digest and dplyr installed from CRAN.
  • In case you want to replicate Dean’s or my example you will need install package DT to render the table using the jQuery plug-in DataTables. Apparently, you won’t have to install DT from GitHub anymore, since it was moved to CRAN as well. If you do not plan to include a data table like here, you will not need DT.

A simple experiment

I will split up the shiny app into three files: helpers.R, server.R and ui.R. In case you are not familiar with the latter two and the basic structure of shiny apps, I recommend you read through this introduction first. The file helpers.R will be sourced in one of the two other files and load some workhorse functions and parameters – it makes things more tidy.

Handling login, instructions & final page

Without any reference to the actual experiment that we will implement, we can begin to code the login page, which may serve as a blueprint independent of what comes thereafter. Let’s begin with the ui.R, i.e. the user interface that participants in the lab will see. Following the basic structure, this will be a login page. Start with a skeletal UI and consider the following basic page:

shinyUI(fluidPage(
useShinyjs(),
div(
id = "login_page",
titlePanel("Welcome to the experiment!"),
br(),
sidebarLayout(

sidebarPanel(
h2("Login"),
p("Welcome to today's experiment. Please use the user name provided on the instructions to login into the experiment."),
hidden(
div(
id = "login_error",
span("Your user name is invalid. Please check for typos and try again.", style = "color:red")
)
)
),

mainPanel(
textInput("user", "User", "123"),
textInput("password", "Password", ""),
actionButton("login", "Login", class = "btn-primary")
)
)
)
)
)

Let’s walk through the code together. First, I load shinyjs by writing useShinyjs to be able to call functions from that package. Next I use the HTML tag div() to create a division, like the div tag in HTML. By giving the division an id (here: id=login_page), I can later reference it and thereby change its properties using functions from shinyjs. Shiny will keep a list of all named items (divs, buttons, widgets and so on) and allows you to call them by their name to affect them. Everything inside div(...) is a plain shiny page that consists of a titlePanel and a sidebarLayout that you should be familiar with. I have put some basic login instructions in the sidebarPanel part of the page and a little further down you see that in the mainPanel there are three widgets: a textInput for username and for a password and an actionButton which is there for the user to confirm her credentials.

Enter: shinyjs

I haven’t talked about the part of the sidebarPanel that is wrapped in the hidden() command. This is our first encounter of a basic JS function provided by shinyjs. If you consult the help file ?hidden, it says:

Create a Shiny tag that is invisible when the Shiny app starts. The tag can be made visible later with shinyjs::toggle or shinyjs::show.

Thus, everything inside hidden will be invisible to the participants when the screen is loaded. I have put an error message inside hidden, which will be uncovered in case the credentials are invalid. The help file for hidden already mentions that anything hidden can be uncovered using the command show. Likewise, once shown, items can (again) be hidden using hide.

How and under which conditions login_error is uncovered is handled in the server.R script below. Details aside for now, the principle is as follows: the app waits for the user to press the button login. Once pressed the server checks the credentials. This check returns a boolean (true or false) and in case it is FALSE the div with id login_error will be uncovered.

This is also the general principle how I will build a multi-page app. For every “page” in your app, include a div in the ui.R and hide all but the initial screen using hidden. Then define certain “events” in the server.R script, e.g. the user clicking on a button that says “Continue to next page”. Let the server observe whether this event took place and if the answer is yes, hide the current page, and uncover the next. For example, if login credentials are correct what happens? I will hide the div login_page and uncover another div, called instructions say, that is not yet included above, but which prints the instructions on the screen. E.g

shinyUI(fluidPage(
useShinyjs(),
div(
id = "login_page",
titlePanel("Welcome to the experiment!"),
br(),
sidebarLayout(

sidebarPanel(
h2("Login"),
p("Welcome to today's experiment. Please use the user name provided on the instructions to login into the experiment."),
hidden(
div(
id = "login_error",
span("Your user name is invalid. Please check for typos and try again.", style = "color:red")
)
)
),

mainPanel(
textInput("user", "User", ""),
textInput("password", "Password", ""),
actionButton("login", "Login", class = "btn-primary")
)
)
),

hidden(
div( id = "instructions",
h3("Here we post instructions for subjects..."),
p("In this experiment you will have to guess the in wich direction
a coin that is tossed repeatedly is biased. You will observe whether
the coin landed heads or tails over several tosses.... Bla bla"),
actionButton("confirm", label = "Ok, I got it...")
)
),

hidden(
div(
id = "end",
titlePanel("Thank you!"),
br(),
p("End of experiment.")
)
)
)
)

These are not a very carefully formatted divs that I included, but they get the idea across. The instructions will be hidden at the outset and only uncovered once the user submitted valid username and password. At the same time, the login_page will be hidden. Otherwise the app will throw the error message. Same for the instructions. Once the user presses the button labelled confirm, the app hides instructions and uncovers the end div. This gives the user the impression to walk through multiple pages, where in fact it is just a single page with multiple overlays that are covered and uncovered. Bingo!

Once we understood the general “hidden-hide-show” principle, we can now go on and include further pages by adding further hidden divs in the ui.R. Before we do that, let us peek into the server.R to see how the basic three-page structure we have until now is implemented server-wise.

shinyServer(function(input, output, session) {

# When the Login button is clicked, check whether user name is in list
observeEvent(input$login, {

# Disable the login, user cannot click it until it is enabled again
disable("login")

# Check whether user name is correct Very simple here: a hard-coded password
user_ok

# If credentials are valid push user into experiment
if (user_ok) {
hide("login_page")
show("instructions")

} else {
# If credentials are invalid throw error and prompt user to try again
reset("login_page")
show("login_error")
enable("login")
}

})

observeEvent(input$confirm, {
hide("instructions")
show("end")
})
})

The first handler that appears in the server script is observeEvent. Again, consulting the respective help file ?observeEvent we get to know what this is for

Respond to “event-like” reactive inputs, values, and expressions.

This function is used to constantly observe the value of a certain variable. For example, let us consider an actionButton, e.g. the login button:

Creates an action button or link whose value is initially zero, and increments by one each time it is pressed.

When the app is started, it initializes the action button and adds an item to the input list, i.e. for the login button it creates something like

input$login ```

This value is constantly monitored by the server-side function `observeEvent`. Once its value changes, e.g. from zero to one, the code that appears inside the curly brackets will be executed.

In the given case this is a series of `shinyjs` commands together with an if-else check for whether the credentials are valid. You might wonder where is the variable `session_password` that I compare the entered password to. I put that into the `helpers.R` file where I park all utilities, such as specific functions that I will have to call or other hard-coded variables.

For now `helpers.R`, which resides in the same directory as the other two files, is simply
```r
# Password to login for this session
session_password <- "foo"

Of course, I have to source this file at the beginning of the server.R.

If the password is correct, user_ok evaluates to TRUE and the login page will be hidden, whereas the instructions will be shown. If user_ok evaluates to FALSE, the instructions remain hidden and the login page remains visible. However, all text inputs will be reset (they will be empty again), the error message will be shown and the login button enabled again.

This is how a basic login page can be handled. And the “hidden-hide-show” principle is one of the key learning outcome of this post.

The main part

For the main part we have to add quite a bit of functionality usually, because this is were the actual experiment starts and the app has to react in maybe multiple ways to the responses by the user. It would also be common to have to store responses over multiple rounds of the same experiment.

I will show some basic functionality here by implementing a very simple (not to say boring) little experiment. The user has to guess in which direction a coin that is flipped is biased. The user observes the tosses in chunks, first one then three, then five and so on. After each new chunk, the user has to indicate which side she thinks is the one being more likely. And this will be done over several rounds. Sounds very boring – and it is, but it’s a simple example that already features a lot of different things to do.

I will also add some functionality to the final page, by showing a table of the decisions submitted by the user together with a short information text about what is the payoff from the experiment.

Let us begin with the complete ui.R

library(shinyjs)

source('helpers.R')
shinyUI(fluidPage(
useShinyjs(),
div(
id = "login_page",
titlePanel("Welcome to the experiment!"),
br(),
sidebarLayout(

sidebarPanel(
h2("Login"),
p("Welcome to today's experiment. Please use the user name provided on the instructions to login into the experiment."),
hidden(
div(
id = "login_error",
span("Your user name is invalid. Please check for typos and try again.", style = "color:red")
)
)
),

mainPanel(
textInput("user", "User", ""),
textInput("password", "Password", ""),
actionButton("login", "Login", class = "btn-primary")
)
)
),

hidden(
div( id = "instructions",
h3("Here we post instructions for subjects..."),
p("In this experiment you will have to guess the in wich direction
a coin that is tossed repeatedly is biased. You will observe whether
the coin landed heads or tails over several tosses.... Bla bla"),
actionButton("confirm", label = "Ok, I got it... let's start")
)
),

hidden(
div(
id = "form",
titlePanel("Main experimental screen"),

sidebarLayout(

sidebarPanel(
p("Indicate whether you think the coin that was tossed is more likely to land heads or tails based on the throws shown to you on the right."),
radioButtons("guess",
label = h3("Your based on the tosses so far"),
choices = list("Heads" = "Heads", "Tails" = "Tails"),
selected = NULL),
actionButton("submit", "Submit", class = "btn-primary")
),

mainPanel(
h4(textOutput("round_info")),
dataTableOutput(outputId="table")
)
)
)
),

hidden(
div(
id = "end",
titlePanel("Thank you!"),

sidebarLayout(

sidebarPanel(
p("You have reached the end of the experiment. Thank you for your participation."),
h4("Your payoff details:"),
textOutput("round")
),

mainPanel(
h4("Overview over your choices"),
dataTableOutput(outputId="results")
)
)
)
)
)
)

This is roughly the same as before, but with a new div for the main experimental screen. I again opted for the simple sidebarLayout with the user inputs being a simple radio button (I’d love to initialize it with state NULL so that nothing is selected, but this is not possible – setting it to NULL is like setting it to be first option) and a submit button. The mainPanel consists of a table that is the list of of Heads-Tails for that round. It comes in form of a DataTable, hence the DT package.

Note: You are free to do much more fancy things than a table. R is great for plotting and you can leverage its capabilities here by providing graphs that react to user input and much more.

The final page has pretty much the same structure now.

Handling data storage and multiple rounds

Let’s think about how we want the user to experience this ui.R. First the login and instructions as before. Then she is pushed into the first round of the main part. There she observes the split screen with radio button on the left, table on the right. We now wait for her to guess the bias, i.e. select and press submit. Now we want to show further tosses of the coin for the first round, i.e. update the table, but also not forget to save the previous response. To save user responses I bite the code by Dean Attali, so you might want to look at his article for further explanation. All I should mention here is that you will have to create a folder inside the the folder you saved helpers.R, ui.R and server.R that is called responses. This will be directory where user responses will be saved. In case you want to store data not locally, but on a remote server you will have to change that – but Dean has a separate article on this. After the user has played through all rounds, we want to push her out of the main experiment part and route her to the final page that says good-bye and gives users the possibility to review their choices.

That’s quite a bit to handle by server.R – let’s jump right into my final solution:

library(shiny)
require(digest)
require(dplyr)

source("helpers.R")

shinyServer(function(input, output, session) {

########################################################## PART I: LOGIN ################################

# When the Login button is clicked, check whether user name is in list
observeEvent(input$login, {

# User-experience stuff
shinyjs::disable("login")

# Check whether user name is correct Fix me: test against a session-specific
# password here, not username
user_ok

# If credentials are valid push user into experiment
if (user_ok) {
shinyjs::hide("login_page")
shinyjs::show("instructions")

# Save username to write into data file
output$username input$user
}
} else {
# If credentials are invalid throw error and prompt user to try again
shinyjs::reset("login_page")
shinyjs::show("login_error")
shinyjs::enable("login")
}

})

########################################################## PART II: INSTRUCTIONS ########################

observeEvent(input$confirm, {
hide("instructions")
show("form")
})

########################################################## PART III: MAIN EXPERIMENT ####################

## Initialize reactive values round is an iterator that counts how often
## 'submit' as been clicked.
values # df will carry the responses submitted by the user
values$df

########################################################## PART IIIa: MAIN HANDLER #######################

## This is the main experiment handler Observe the submit button, if
## clicked... FIRE
observeEvent(input$submit, {

# Increment the round by one
isolate({
values$round })

# Call function formData() (see below) to record submitted response
newLine

# Write newLine into data frame df
isolate({
values$df n_guesses){

# Draw a round from all rounds with equal probability Note: the username
# must be numeric here, because it serves as a seed for the RNG. See comment
# below.
isolate(values$payroll

# Based on the drawn round determine the payoff. People get a Euro for
# having guessed correctly.
output$round paste0("The computer selected round ", values$payroll,
". Because you guessed ",ifelse(values$df[values$payroll, 3]==true_state[values$payroll], "correctly ", "incorrectly "),
"we will add ", ifelse(values$df[values$payroll, 3]==true_state[values$payroll], prize, 0),
" Euro to your show-up fee. Your total payoff will therefore equals ",
ifelse(values$df[values$payroll, 3]==true_state[values$payroll], prize, 0) + show_up, " Euro.")
})
isolate(values$df[, 5]

# The function saveData() writes the df to disk. This can be a remote
# server!
saveData(values$df)

# Say good-bye
hide(id = "form")
show(id = "end")
}
})

## Utilities & functions

# I take formData from Dean with minor changes. When it is called, it
# creates a vector of data. This will be a row added to values$df - one for
# each round. Gather all the form inputs (and add timestamp)
formData data data data data
})

# The coin flips shown on the right. Note I have added a small delay with
# progress bar, just to give users a more natural look-and-feel, since
# throwing coins usually takes time. I have disabled all of the features of
# DT below, because they distract users
output$table 1 && values$round <= n_guesses){
withProgress(message = 'Flipping the coin.',
detail = 'Please wait...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(0.02)
}
})
}
idx.row idx.col data.frame(Wurf = seq(1, idx.row), Seite= flips[1:idx.row, idx.col])
},
options = list(paging = FALSE,
searching = FALSE,
ordering = FALSE
)
)

# This renders the table of choices made by a participant that is shown
# to them on the final screen
output$results out Guess = rep(seq(1, guesses_per_round), times = n_rounds),
choice = values$df[,3],
actual = rep(true_state, each = guesses_per_round)
)
colnames(out) out
},
options = list(paging = FALSE,
searching = FALSE,
ordering = FALSE
)
)

# Tell user where she is
output$round_info paste0("Round ", ceiling(values$round/guesses_per_round), " of ", n_rounds)
})

})

Phew, there are lots of new things. Let me go from top to bottom. First, I initialize an object called values and this is a reactive object. Again the help file has a concise description of what are its capabilities:

This function returns an object for storing reactive values. It is similar to a list, but with special capabilities for reactive programming. When you read a value from it, the calling reactive expression takes a reactive dependency on that value, and when you write to it, it notifies any reactive functions that depend on that value. (…)

The reactive variable values$round serves as a counter or iterator that I use to keep track of the round the user is currently in. Most experiments will have participants play multiple rounds of the same task and this variable is there to record in which round users currently are.

Next comes the main handler. The main handler observed the value of input$submit. If the user clicks it, the stuff in curly brackets is executed. Inside the curly brackets, we first increase values$round by one. Because this is a reactive value, it will broadcast its new value to all functions that depend on it. If you scroll down to the output$table you will note than e.g. the data table on the right depends on values$round and hence will get updated, once values$round changes.

Back to the main handler. Next the code creates an object called newLine which is row in our later data matrix. We write it to values$df. Next we check whether the previous round was the final round. This is the case if the iterator values$round exceeds the hard-coded number of rounds given by n_guesses. If the final round was reached, we do four things:

  1. Draw one round randomly and compare the actual bias of the coin to the guess by the user.
  2. Prepare a text message for the final screen which takes into account whether the user was lucky and will receive a bonus for having guessed correctly.

  3. Save all received responses to disk.

  4. Say good-bye by loading the final screen.

The astute reader will miss numerous functions that I call inside server.R, but that are nowhere defined. I follow Dean Attali’s style here and defer them to the helpers file:

# which fields get saved
fieldsAll

responsesDir

# Password
session_password <- "foo"

### Generate data here
###
###
###
set.seed(1906)
n_rounds n_flips probs prize show_up probas true_state for(i in 1:n_rounds){
if(true_state[i]=="Heads"){
probas[i,] } else {
probas[i,] }
}

flips replace = TRUE,
prob = probas[x, ])
)
flips

cascade tmp dim(tmp) tmp[lower.tri(tmp)] tmp[tmp==1] <- "Heads"
tmp[tmp!="Heads"] <- "Tails" if(thin > 1){
tmp }
return(tmp)
}

tmp flips

n_guesses guesses_per_round

# add an asterisk to an input label
labelMandatory tagList(
label,
span("*", class = "mandatory_star")
)
}

# CSS to use in the app
appCSS <- ".mandatory_star { color: red; }
.shiny-input-container { margin-top: 25px; }
.shiny-progress .progress-text {
font-size: 18px;
top: 50% !important;
left: 50% !important;
margin-top: -100px !important;
margin-left: -250px !important;
}"

# Helper functions
humanTime

saveData fileName humanTime(),
digest::digest(data))

write.csv(x = data, file = file.path(responsesDir, fileName),
row.names = FALSE, quote = TRUE)
}

payoffRound set.seed(user)
out return(out)
}

epochTime as.integer(Sys.time())
}

The helper file begins with defining the user inputs that will be saved along with a timestamp etc.

Another thing that I handle is generating the data. All coin flips are not drawn live during the experiment, but before the first screen is loaded. Because I set a static seed, all users will see the same sequence of flips.

Finally, several workhorse functions are defined. You may find a less thoroughly commented version of the code on GitHub

Further notes & extensions

An idea that I like to borrow from Joern Hees is the possibility to use the username (or part of it) as a seed for the random numbers that will be drawn during the experiment. Depending on your analysis and the design of the experiment this can be very useful. For example, if you have two groups, one treatment and one control group, and you want to show exactly one subjects in the control and one in the treatment exactly the same stimuli, you can do this by conditioning all random numbers on their username. For example, take users A-01 and B-01. If we denote groups by A and B, then it’s easy to extract the two-digit number using a regular expression and take it as a seed for a random number generator.

The type of experiments that can be implemented in this way is still fairly limited. For example, I have not tried to program an experiment where different users interact, e.g. to run experiments that inspect how behavior changes within a group, or how certain types of communication affect outcomes.
But given there are examples of chat rooms being implemented using shiny, I see a chance this can be done.

Conclusion

Even though the length of the post and my messy code can look daunting and give the impression that this is not much easier than becoming a web programmer, it certainly is. Shiny handles a lot of server structure and initialization of databases, sessions and much more beneath the hood. The simple experiment I implemented above is more of a proof of concept and you may wish to expand it in many ways. I certainly have shown only a very narrow set of things that are possible within shiny.

Thus, in case you just got started running experiments and want to have more flexibility than zTree and not to hassle about the gory details, shiny might be an alternative for you.


Filed under: Behavioral Economics, R, Shiny Tagged: Experiments, R, RStudio, shiny, shinyjs

To leave a comment for the author, please follow the link and comment on their blog: Rficionado » R.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)