It’s not rare for most of us it seems to end up with huge markdown files due to the extensive data exploration. Perhaps your PI wants to see it all (even if it’s not linked to their hypothesis … if they have one). They might sometimes be frustrated because they asked for all this information and now they can’t find the very specific thing they are interested in. In these situations an app can come very handy as it let’s them explore the results you put together without having to hold their hand while you go through it. It can be a very efficient way to report your results in a fun and interactive way. Building these apps can be tidious in the first place, some time is needed to adapt to it’s particular syntax and structuring it properly. Not mentioning the debugging that can be a pain. But once you get used to it, you might find it actually both entertaining and rewarding.
Before we dive in actually building a toy app, I believe it is important to understand the fundamental components of a shiny app. For the rest of this talk I will be assuming that you are somewhat familiar with R … and if you are not SHAME ON YOU!! If you are a SAS user and you want to learn R I invite you to go bug Margie (she doesn’t know how to say no!).
The first difference between a Shiny app and a classic R function is that it is based on the interaction of two separate function. Indeed what would be the equivalent to the arguments of a function is contained in the ui function. While the processing, which is usually done in the body of a function, is done in the server function. Note that when you open a new shiny app file in R studio that structure will already be layout for you. You will be asked if you want to keep these in separate files (ui, server files will be created) or in a single one (app.R will be created). Unless you are building a very large application I would recommend using a single file. Finally note that a Shiny app is comparable to a project in R, when ran the working directory will be set to where the app file is stored.
Before we start here a few packages that will be necessary:
install.packages("shiny")
install.packages("shinydashboard")
# this might be handy too
install.packages("ggplot2")
install.packages("plotly")As mentioned above the UI is the center for arguments. Here the user will be able to update the inputs of interests which will ultimately update the output of the reactive system. The UI function in its self does not take any arguments.
library(shiny)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# body
)
server <- function(input, output) {}
# Run the application
shinyApp(ui = ui, server = server)Note that for many functions the use of “{}” are replaced with “()” in shiny.
Shiny comes with a pre-built in family of so called widgets. These enable the parsing of various types of arguments, we show below a few of those. Each has a specific function associated with them, they all take as two first arguments a name by which to be called in the server function and a label. Further arguments will be specific to the widget used.
library(shiny)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10),
submitButton(text = "Submit new inputs")
),
# Main panel for displaying outputs ----
mainPanel()
)
)
server <- function(input, output) {}
# Run the application
shinyApp(ui = ui, server = server)The code above will let the user select a distribution of interest and a number of observations. Note that the end of each command needs to be terminated using “,” if another command will be following it. Another note some things are not very well optmized in shiny. An example of this is for the slider input, when dragged every single value passed on the way will be evaluated. To overcome unnecessary computations I added a submit button that will delay any updating before it is activitated.
In the vast majority of cases the built-in widgets will be enough, a more complete list can be found at the following link including the code to use them (
The counterpart to the UI is the server. Unlike the UI the server takes two arguments, the input and ouput of the UI (we will cover the output of the UI later in this section). It will enable us to work with our input and generated the desired output that will be sent back to the UI for rendering.
An obvious first constructing an app is how to output the analysis to the screen after adapting the parameters. Just like each type of argument has its own input function, each output type has its own rendering function. To make use of the arguments in the rendering function we can call them using “input\(NameOfTheInput". Let's say we want to draw a histogram from a normal distribution for the specified number of observations. Similarly to how we call the inputs using the dollar sign the output are defined using "output\)NameOfOuput”.
server <- function(input, output) {
# generate some random data
output$hist <- renderPlot({
dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
ggplot(dat,aes(Obs)) + geom_histogram()
}
)
}We generated data and saved the plotted output in a output object as “hist”. In order to print it we must add it as an output in the main panel of the UI.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10),
submitButton(text = "Submit new inputs")
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("hist")
)
)
)
server <- function(input, output) {
# generate some random data
output$hist <- renderPlot({
dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
ggplot(dat,aes(Obs)) + geom_histogram()
}
)
}
# Run the application
shinyApp(ui = ui, server = server)If we wish to choose which distribution to plot we can simply add if statements to the rendering function.
server <- function(input, output) {
# generate some random data
output$hist <- renderPlot({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
ggplot(dat,aes(Obs)) + geom_histogram()
}
)
}The strength of the rendering functions lies in their simplicity, however in many cases this becomes inconvenient.
It is not unsual for us to have to build functions that return more than a single output. Unfortunately the rendering function can only parse a single object of a specific type back to the UI. In order to avoid this issue reactive functions. These function as any function in R and follow their familiar structure except for a couple small details and allow you to return multiple outputs in a list. As an example let’s transfer what we have done above in the renderPlot function into a reactive function, note the particular use of “({})”. The reactive function will be run everytime one of the inputs called in it is updated. In order to use the output of the reactive function we must use the syntax “functionName()$NameOfObject”:
dat <- reactive({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
return(list(dat=dat,other="I was too lazy to come up with something else to do"))
})Putting everything together:
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10),
submitButton(text = "Submit new inputs")
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("hist"),
textOutput("ThatsMe")
)
)
)
server <- function(input, output) {
# generate some random data in a reactive function
dat <- reactive({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
return(list(dat=dat,other="I was too lazy to come up with something else to do"))
})
# output plot
output$hist <- renderPlot({
ggplot(dat()$dat,aes(Obs)) + geom_histogram()
})
# I am lazy output
output$ThatsMe <- renderText({
dat()$other
})
}
# Run the application
shinyApp(ui = ui, server = server)Obviously this is not the best example, but when constructing more complex apps this reactive functionality will become very useful.
Now that you know how to build the functionalities of your app and how to output the results to the screen with each updated input, we will see a couple ways to optimize layout. The goal here is to make the app more user friendly, more efficient and more readable.
When a lot of output has to go to the screen it can become messy to keep everything on the same page and have the user scroll down. Particularly when you have output that is not particularly linked (say different outcomes of interest). Then it seems natural to divide the app in tabs just like any of us would do a report. Note that in the first section all the input widgets are common to all tabs, but each tab is updated individually when opened. Making tabs a great tool for readability but also for efficiency avoiding lengthy computations to occur all at once, or occur at all if not going to be explored! This can be achieved fully in the UI’s mainPanel using the tabsetPanel() and tabPanel() functions.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10),
submitButton(text = "Submit new inputs")
),
# Main panel for displaying outputs ----
mainPanel(tabsetPanel(type = "tabs",
tabPanel("Resampling",
plotOutput("hist")),
tabPanel("Lazyness is a virtue",
textOutput("ThatsMe"),
imageOutput("sloth"))
)
)
)
)
server <- function(input, output) {
# generate some random data in a reactive function
dat <- reactive({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
return(list(dat=dat,other="I was too lazy to come up with something else to do"))
})
# output plot
output$hist <- renderPlot({
ggplot(dat()$dat,aes(Obs)) + geom_histogram()
})
# I am lazy output
output$ThatsMe <- renderText({
dat()$other
})
#### my best potrait
output$sloth <- renderImage({
# When input$n is 1, filename is ./images/image1.jpeg
filename <- normalizePath(file.path("Sloth.png"))
# Return a list containing the filename
list(src = filename,
width = 600,
height = 500)
}, deleteFile = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)In other circumstances we will end up in a situation where some input will make sense only if previous specific output was selected. An example could be ajusting for a specific confounder only for a single of the multiple outcomes of interest. Shiny let’s the designer generate input reactive inputs to create chains of inputs that make sense. This can be achieved by using the convinenient conditionalPanel() function. Here say we want to choose between doing stats or being lazy and have options that make sense for the choice we made.
We can simply add the conditionalPanel function with the right condition and repeat the code above. Note that this input based condition is called using condition = “input.decision == ‘stats’”. It works both in the sidebarPanel and the mainPanel.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Example app in shiny"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
radioButtons("decision", "Big decision ...:",
c("Work on some stats"="stats",
"Being lazy is nice ..."="lazy"
)),
conditionalPanel(
condition = "input.decision == 'stats'",
# Input: Select the random distribution type ----
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
# br() element to introduce extra vertical spacing ----
br(),
# Input: Slider for the number of observations to generate ----
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10)),
conditionalPanel(
condition = "input.decision == 'lazy'",
radioButtons("sloth.type", "Good decision, as a reward choose a sloth:",
c("Napping sloth" = "nap",
"Active sloth"="active"
))
)
),
# Main panel for displaying outputs ----
mainPanel(
conditionalPanel(
condition = "input.decision == 'stats'",
plotOutput("hist")),
conditionalPanel(
condition = "input.decision == 'lazy'",
imageOutput("sloth"))
)
)
)
server <- function(input, output) {
# generate some random data in a reactive function
dat <- reactive({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
return(list(dat=dat,other="I was too lazy to come up with something else to do"))
})
# output plot
output$hist <- renderPlot({
ggplot(dat()$dat,aes(Obs)) + geom_histogram()
})
# I am lazy output
output$ThatsMe <- renderText({
dat()$other
})
#### my best potrait
output$sloth <- renderImage({
if(input$sloth.type == "nap"){
# When input$n is 1, filename is ./images/image1.jpeg
filename <- normalizePath(file.path("Sloth.png"))}
if(input$sloth.type == "active"){
# When input$n is 1, filename is ./images/image1.jpeg
filename <- normalizePath(file.path("Sloth_active.png"))}
# Return a list containing the filename
list(src = filename,
width = 600,
height = 500)
}, deleteFile = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)Finally you might be interested in making tabs that are completely unlinked (for example a single PI two or more projects). In this case it doesn’t make sense to have a single set of parameters even with conditional panels. You want to make a clear separation between each project. Perhaps as I should have done from the start to separate statistics and sloths! There are a lot of ways to accomplish this and I will not attempt an exhaustive list of options here but rather show the one that I like the most. It requires the shinydashboard library that was listed earlier. This will let us generate very distinct tabs with a simple interface. It requires new functions though such as dashboardPage(), dashboardSidebar() … But the overall system and syntax are the same.
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- dashboardPage(
dashboardHeader(title = "Stats VS Sloths: The final smackdown",titleWidth = 400),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem("Stats stuff", tabName = "stats", icon = icon("columns")),
menuItem("Sloth party", tabName = "sloth", icon = icon("github-alt"))
)
),
dashboardBody(
tabItems(
### Stats ###
tabItem(tabName = "stats",
sidebarLayout(
sidebarPanel(
width=12,
h2("Choose a distribution"),
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp"
)),
sliderInput("n", "Number of observations:",
min = 2, max = 100, value = 10)
),
mainPanel(
width = 12,
plotOutput("hist")
)
)
),
#SLOTHS
tabItem(tabName = "sloth",
sidebarLayout(
sidebarPanel(
width=12,
h2("Choose a sloth:"),
radioButtons("sloth.type", "Good decision, as a reward choose a sloth:",
c("Napping sloth" = "nap",
"Active sloth"="active"
))
),
mainPanel(
width = 12,
imageOutput("sloth")
)
)
)
)
)
)
server <- function(input, output) {
# generate some random data in a reactive function
dat <- reactive({
if(input$dist == "norm") dat <- as.data.frame(matrix(rnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "unif") dat <- as.data.frame(matrix(runif(as.numeric(input$n)),ncol = 1))
if(input$dist == "lnorm") dat <- as.data.frame(matrix(rlnorm(as.numeric(input$n)),ncol = 1))
if(input$dist == "exp") dat <- as.data.frame(matrix(rexp(as.numeric(input$n)),ncol = 1))
colnames(dat) <- "Obs"
return(list(dat=dat,other="I was too lazy to come up with something else to do"))
})
# output plot
output$hist <- renderPlot({
ggplot(dat()$dat,aes(Obs)) + geom_histogram()
})
# I am lazy output
output$ThatsMe <- renderText({
dat()$other
})
#### my best potrait
output$sloth <- renderImage({
if(input$sloth.type == "nap"){
# When input$n is 1, filename is ./images/image1.jpeg
filename <- normalizePath(file.path("Sloth.png"))}
if(input$sloth.type == "active"){
# When input$n is 1, filename is ./images/image1.jpeg
filename <- normalizePath(file.path("Sloth_active.png"))}
# Return a list containing the filename
list(src = filename,
width = 600,
height = 500)
}, deleteFile = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)As you may know a strong dark cult has been growing in strength in recent years, it’s members can’t live without it (even though notebooks are clearly better and that Jupyter did it first hmhm). Anyway you guys will be happy to know that you can actually execute shiny scripts inside rmarkdown! I am not a specialist of this but it is easy to find examples of this:
kmeans_cluster <- function(dataset) {
shinyApp(
ui = fluidPage(responsive = FALSE,
fluidRow(style = "padding-bottom: 20px;",
column(4, selectInput('xcol', 'X Variable', names(dataset))),
column(4, selectInput('ycol', 'Y Variable', names(dataset),
selected=names(dataset)[[2]])),
column(4, numericInput('clusters', 'Cluster count', 3,
min = 1, max = 9))
),
fluidRow(
plotOutput('kmeans', height = "400px")
)
),
server = function(input, output, session) {
# Combine the selected variables into a new data frame
selectedData <- reactive({
dataset[, c(input$xcol, input$ycol)]
})
clusters <- reactive({
kmeans(selectedData(), input$clusters)
})
output$kmeans <- renderPlot(height = 400, {
par(mar = c(5.1, 4.1, 0, 1))
plot(selectedData(),
col = clusters()$cluster,
pch = 20, cex = 3)
points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
})
},
options = list(height = 500)
)
}