Motivation

R Shiny apps are a way so share bits of data analyses or interactive plots or whatever else you want all coded up in the language we know and love: R.

I wanted to give then a shot for student assignment in the course I was TAing, at the time.

There are many choices for hosting Shiny apps:

1. Shinyapp.io (free or pay options)

2. GitHub or Gist (free, but need to launch locally)

3. Custom server with the Shiny server (GitHub code) and deployment from your home server/Amazon EC2/Digital Oceansee here/whatever you want.

For my purposes, I needed to deploy the app and collect the answers from the students, so I needed to host the app on my own server. I won’t go over that here, but I followed these guides to host it on an Amazon EC2 instance: blog1 blog2. There was one notable change I had to make while following these; the quotes in the install step needed to be escaped:

# like this
sudo su - -c "R -e \"install.packages('shiny', repos = 'http://cran.rstudio.com/')\""

# And not as the stated
sudo su - -c "R -e "install.packages('shiny', repos = 'http://cran.rstudio.com/')""

The little I know about Shiny

Shiny apps involve 2 scripts: ui.R and server.R (and can be combined into one script). The ui.R script has the layout and content of the app and the server.R contains the control of the app. The commands for adding content are apparently similar to HTML tags. So headers are h1(), h2(), etc., for different sizes, paragraphs are p(), breaks are br(), and so on. Don’t forget commas at the end of a line!

The ui.R script

This script starts off simple enough:

library(shiny)

shinyUI(
fluidPage(

)
)

This all loads the shiny library, defines the app content area (shinyUI()) and creates a fluidPage (meaning, I think, that the app will fill to the size of the browser window).

We can define a little structure for the layout of the app.

library(shiny)

shinyUI(
fluidPage(
titlePanel("Problem Set"),
sidebarLayout(
sidebarPanel(

),

mainPanel("",

)
)
)
)

Here I have defined a layout with a sidebar and a main panel, which we can add content to both. I have read that there are (many?) other layout options, and I suppose anything is customizable, but this is what I’ve used so far.

Now we can begin to add content.

library(shiny)

shinyUI(
fluidPage(
titlePanel("Problem Set"),
sidebarLayout(
sidebarPanel(
textInput("name", label = "Name", value = "Enter text...")
),

mainPanel("",
h1("Questions"),
p("Answer all that you can. We will go over these next week."),
br(),
h3("Question 1"),
p("Please draw all possible unrooted phylogenetic relationships between
the four taxa listed above. How many different unrooted relationships
are possible? Write them in newick format, separated by a space:
e.g. (a,(b,c)); ((a,b),c);"),
textInput("trees", label = "", value = "Trees..."),
)
)
)
)

What I’ve done here is put a space for the name in the side panel. Then, I’ve added one question to the main panel with a text box to take the answer. There are many Shiny commands for things like text boxes, check boxes, lists, slider bars, etc. Here I have just used a simple text box with an internal label of “trees” (this will be important later), no label (which would show up as a header for the text box), and inside the text box will be displayed “Trees…”, which can be replaced with user content.

For a Question and Answer format, this set up will work alright. You could certainly get fancy with multiple choice and the like.

For some questions, I wanted a larger text area for input with multiple lines and what not. This involved a bit of customization, but thankfully the R community had me covered.

We start by defining a custom function called “textareaInput” at the head of the ui.R script. Then we can create a text input area question. To give students a window in which to respond with longer answers that may have multiple lines.

library(shiny)

textareaInput <- function(id, label, value, rows=20, cols=35, class="form-control"){
tags$div( class="form-group shiny-input-container", tags$label('for'=id,label),
tags$textarea(id=id,class=class,rows=rows,cols=cols,value)) } shinyUI( fluidPage( titlePanel("Problem Set"), sidebarLayout( sidebarPanel( textInput("name", label = "Name", value = "Enter text...") ), mainPanel("", h1("Questions"), p("Answer all that you can. We wil go over these next week."), br(), h3("Question 1"), p("Please draw all possible unrooted phylogenetic relationships between the four taxa listed above. How many different unrooted relationships are possible? Write them in newick format, seperated by a space: eg. (a,(b,c)); ((a,b),c);"), textInput("trees", label = "", value = "Trees..."), h3("Question 2"), p("What is the difference between vertical and horizontal transmission?"), textareaInput("horVert","", "Enter text...", rows = 10, cols = 60), ) ) ) ) Now we can define text box areas with a certain number of rows/columns, but it can be stretched in the browser if a student preferred. I’ll show one more example, which involved a question that needed a picture. For this, we need to create a folder in the directory called “www” that contains the ui.R and server.R scripts. Then we can drop the jpg into that directory. library(shiny) textareaInput <- function(id, label, value, rows=20, cols=35, class="form-control"){ tags$div(
class="form-group shiny-input-container",
tags$label('for'=id,label), tags$textarea(id=id,class=class,rows=rows,cols=cols,value))
}

shinyUI(
fluidPage(
titlePanel("Problem Set"),
sidebarLayout(
sidebarPanel(
textInput("name", label = "Name", value = "Enter text...")
),

mainPanel("",
h1("Questions"),
p("Answer all that you can. We wil go over these next week."),
br(),
h3("Question 1"),
p("Please draw all possible unrooted phylogenetic relationships between
the four taxa listed above. How many different unrooted relationships
are possible? Write them in newick format, separated by a space:
eg. (a,(b,c)); ((a,b),c);"),
textInput("trees", label = "", value = "Trees..."),

h3("Question 2"),
p("What is the difference between vertical and horizontal transmission?"),
textareaInput("horVert","", "Enter text...", rows = 10, cols = 60),
br(),

h3("Question 3"),
p("Please tell me the numbers corresponding to the characters (i.e. the first
column is 1, second is 2) that are parsimony informative and not parsimony
informative.  No need to tell me the invariant characters."),
textInput("chars1", label = "Parsimony informative character numbers",
value = "..."),
textInput("chars2", label = "Parsimony uniformative characters numbers", value = "..."),
br(),
img(src="alingment.JPG",height=90),
br(),

actionButton("submit", "Submit")
)
)
)
)

We also added to the end an “actionButton”, which will be the submit button. This is named “submit”.

General notes: make sure to give names to the Input commands, why will become clear in a minute. Labels can be left blank. Alternatively, the question could be displayed in the command label (I didn’t like how it looked).

That is the ui.R script. Of course the real assignment had more content, but this showcases a few examples. Now lets turn our attention to the server.R script, something I know much less about :/

The server.R script

This script will handle the running of the app and the saving of content from the students. This script for me involves 2 parts:

1. The server script part

2. The definition of fields to save, based on the names given to the Input commands

The head of the script starts with a definition of what to save.

fields <- c("name","trees","horVert", "chars1", "chars2")

With more questions, you’d need to add the names here. This is why naming the input functions was important, as this allows their input to be associated with the name and saved to the output file.

Now we build up the server script

fields <- c("name","trees","horVert", "chars1", "chars2")

shinyServer(function(input, output, session) {
})

This just defines the server script area and that there will be input, output, and this session command.

Now we add the command to collect the data submitted in the fields.

fields <- c("name","trees","horVert", "chars1", "chars2")

shinyServer(function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data <- t(data)
data
})
})

And we can tell it to save it to a file.

fields <- c("name","trees","horVert", "chars1", "chars2")

shinyServer(function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data <- t(data)
data
})

saveData <- function(data) {
fileName <- sprintf("%s.txt", data[1])
write.table(x = data, sep = "\nendQ\n\n", file = file.path("./responses/", fileName),
row.names = FALSE, quote = F,col.names = F)
}
})

This function take in the field data from the fields in the ui.R script (i.e. the textInput() commands), creates a name bases off the name field, and writes a text file. I have the responses on different lines, separated by a newline, the word “endQ”, followed by 2 newlines. Seems funny, I know, but I like how it looks…so ya.

An important point, this function saves the files to a directory called “responses/”, which needs to be created in the same directory that hosts the ui.R and server.R scripts (like we did for the picture and the www file).

Now what we want is to save when the submit button is pressed. Remember we named it “submit”, so we can observe its action with the following bit added.

fields <- c("name","trees","horVert", "chars1", "chars2")

shinyServer(function(input, output, session) {
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data <- t(data)
data
})

saveData <- function(data) {
fileName <- sprintf("%s.txt", data[1])
write.table(x = data, sep = "\nendQ\n\n", file = file.path("./responses/", fileName),
row.names = FALSE, quote = F,col.names = F)
}

observeEvent(input$submit, { saveData(formData()) }) }) So what we have now is an R app that will present questions to students and save the output that they ender in the folder where we’re hosting the app. But when they hit the submit button nothing will happen. If they continue to hammer on it, it will just re-save the file over and over. One way to provide a little confidence is to add a little pop-up message saying we’ve received the input. The way to do this is with a little javascript, which I found on this GitHub Repo (thanks!). This little script should be called “message-handler.js” and placed in the www folder (same place as the picture). // This recieves messages of type "testmessage" from the server. Shiny.addCustomMessageHandler("testmessage", function(message) { alert(JSON.stringify(message)); } ); Over in the ui.R script we need to add a little command telling it to use this js script. Add this right after the definition of the fuildPage() shinyUI( fluidPage( tags$head(tags$script(src = "message-handler.js")), titlePanel("Problem Set 5"), # and so on with the rest of the ui.R script... Back in the server.R script… Now we tell the app to react to the pressing of the submit button and create the pop up. fields <- c("name","trees","horVert", "chars1", "chars2") shinyServer(function(input, output, session) { formData <- reactive({ data <- sapply(fields, function(x) input[[x]]) data <- t(data) data }) saveData <- function(data) { fileName <- sprintf("%s.txt", data[1]) write.table(x = data, sep = "\nendQ\n\n", file = file.path("./responses/", fileName), row.names = FALSE, quote = F,col.names = F) } observeEvent(input$submit, {
saveData(formData())
})

observeEvent(input$submit, { session$sendCustomMessage(type = 'testmessage',
})

})

The name (i.e. “type”) needs to be “testmessage”, as that what the javascript will react to. The pop-up will say “Submission Received!” and provide a little ok button.

Conclusions

I have found this a handy way to do student assignments, as I simply send them the link to the webpage, and all their responses are in plain text where I am hosting the assignment.

If I wanted to get really crazy (and the assignment didn’t have a lot of writing), it would be dead easy to write another script (or add a section to the app) to mark it for me. How sweet would that be!

You can see this example by running the following in an R session, providing you have the shiny package installed (but the submit button won’t pop up – the app will just crash).

runGitHub("playing_with_Shiny", "benjaminfurman", subdir = "example_assignment")

I am hosting it here for a while if you want to see the submit button in action.

Also, the code is available here.

–Ben