+ - 0:00:00
Notes for current slide
Notes for next slide

Interactive web apps with Shiny

RaukR 2019 • Advanced R for Bioinformatics

Roy Francis

RaukR 2019 • 1/23

RaukR 2019 • 3/23

What is shiny?

  • Interactive documents & web applications
  • Completely created using R
  • Needs a live environment
RaukR 2019 • 4/23

What is shiny?

  • Interactive documents & web applications
  • Completely created using R
  • Needs a live environment

Usage

RaukR 2019 • 4/23

What is shiny?

  • Interactive documents & web applications
  • Completely created using R
  • Needs a live environment

Usage

App structure

RaukR 2019 • 4/23

Code structure

One file format

app.R

ui <- fluidPage()
server <- function(input,output) {}
shinyApp(ui=ui,server=server)

Two file format

ui.R

ui <- fluidPage()

server.R

server <- function(input,output) {}
RaukR 2019 • 5/23

Running the app

  • Change to app directory, then run runApp()
  • Use shinyApp()
shinyApp(
ui=fluidPage(),
server=function(input,output) {}
)
  • From Rmd file using rmarkdown::run()
  • Running as a separate process from terminal
R -e "shiny::runApp('~/shinyapp')"
RaukR 2019 • 6/23

UI • Layout

shinyApp(
ui=fluidPage(
titlePanel("Title Panel"),
sidebarLayout(
sidebarPanel(
helpText("Sidebar Panel")
),
mainPanel(tabsetPanel(
tabPanel("tab1",
fluidRow(
column(6,helpText("Col1")),
column(6,
helpText("Col2"),
fluidRow(
column(4,style="background-color:#b0c6fb",
helpText("Col1")
),
column(4,style="background-color:#ffa153",
helpText("Col2")
),
column(4,style="background-color:#b1f6c6",
helpText("Col3")
)
)
)
)
),
tabPanel("tab2",
inputPanel(helpText("Input Panel"))
),
tabPanel("tab3",
wellPanel(helpText("Well Panel"))
)
)
)
)
),
server=function(input,output) {})

RaukR 2019 • 7/23

UI • Widgets • Input

shinyApp(
ui=fluidPage(
fluidRow(
column(4,
fileInput("file-input","fileInput:"),
selectInput("select-input",label="selectInput",choices=c("A","B","C")),
numericInput("numeric-input",label="numericInput",value=5,min=1,max=10),
sliderInput("slider-input",label="sliderInput",value=5,min=1,max=10),
textInput("text-input",label="textInput"),
textAreaInput("text-area-input",label="textAreaInput"),
dateInput("date-input",label="dateInput"),
dateRangeInput("date-range-input",label="dateRangeInput"),
radioButtons("radio-button",label="radioButtons",choices=c("A","B","C"),inline=T),
checkboxInput("checkbox","checkboxInput",value=FALSE),
actionButton("action-button","Action"),
hr(),
submitButton()
)
)
),
server=function(input,output) {
})

Widgets gallery

RaukR 2019 • 8/23

Widgets are visual objects on a page to allow for data input. Input and output variables.

UI • Widgets • Outputs

shinyApp(
ui=fluidPage(fluidRow(column(5,
textInput("text_input",label="textInput",value="<h3 style='color:red'>Red text</h3>"),
hr(),
htmlOutput("html_output"),
textOutput("text_output"),
verbatimTextOutput("verbatim_text_output"),
tableOutput("table_output"),
plotOutput("plot_output",width="300px",height="300px")
))),
server=function(input, output) {
output$html_output <- renderText({input$text_input})
output$text_output <- renderText({input$text_input})
output$verbatim_text_output <- renderText({input$text_input})
output$table_output <- renderTable({iris[1:3,1:3]})
output$plot_output <- renderPlot({
plot(iris[,1],iris[,2])
})
})

RaukR 2019 • 9/23

Dynamic UI

  • UI elements are created conditionally using uiOutput()/renderUI()
shinyApp(
ui=fluidPage(
selectInput("data",label="Select data",
choices=c("mtcars","faithful","iris")),
tableOutput("table"),
uiOutput("ui")
),
server=function(input, output) {
data <- reactive({ get(input$data, 'package:datasets') })
output$ui <- renderUI({
if(input$data=="iris") plotOutput("plot",width="400px")
})
output$plot <- renderPlot({hist(data()[, 1])})
output$table <- renderTable({head(data())})
})
  • Other options include conditionalPanel(), ìnsertUI() and removeUI()
RaukR 2019 • 10/23

Code execution

App launch

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}
RaukR 2019 • 11/23

Code execution

App launch

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}

New user

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}
RaukR 2019 • 11/23

Code execution

App launch

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}

New user

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}

Widget update

ui <- fluidPage(
textInput("text_input",label="textInput"),
textOutput("text_output"))
server <- function(input,output) {
output$text_output <- renderText({input$text_input})
}
RaukR 2019 • 11/23

Reactivity

shinyApp(
ui=fluidPage(
numericInput("num_input",label="Observations",value=50),
plotOutput("plot_output")),
server=function(input,output) {
output$plot_output <- renderPlot({
hist(rnorm(input$num_input))
})
}
)

RaukR 2019 • 12/23

Reactivity

shinyApp(
ui=fluidPage(
numericInput("num_input",label="Observations",value=50),
plotOutput("plot_output"),
textOutput("text_output")),
server=function(input,output) {
output$plot_output <- renderPlot({
hist(rnorm(input$num_input))
})
output$text_output <- renderText({
mean(rnorm(input$num_input))
})
}
)

RaukR 2019 • 13/23

Reactivity

shinyApp(
ui=fluidPage(
numericInput("num_input",label="Observations",value=50),
plotOutput("plot_output"),
textOutput("text_output")),
server=function(input,output) {
rand <- reactive({ rnorm(input$num_input) })
output$plot_output <- renderPlot({
hist(rand())
})
output$text_output <- renderText({
mean(rand())
})
}
)

RaukR 2019 • 14/23

Reactive functions can be use to share output from a common source. They can be used to reduce computation for demanding functions. Reactive values cannot be accessed from outside the reactive environment.

Try changing the reactive function

rand <- reactive({ rnorm(input$num_input) })

to a regular function

rand <- function(){ rnorm(input$num_input) }

Updating widgets

  • Widgets can be updated once initialised.
  • Add third argument session to server function
server=function(input,output,session) {}
RaukR 2019 • 15/23

Updating widgets

  • Widgets can be updated once initialised.
  • Add third argument session to server function
server=function(input,output,session) {}
  • Example of a typical UI
ui=fluidPage(
selectInput("select-input",label="selectInput",choices=c("A","B","C")),
numericInput("numeric-input",label="numericInput",value=5,min=1,max=10),
sliderInput("slider-input",label="sliderInput",value=5,min=1,max=10),
)
RaukR 2019 • 15/23

Updating widgets

  • Widgets can be updated once initialised.
  • Add third argument session to server function
server=function(input,output,session) {}
  • Example of a typical UI
ui=fluidPage(
selectInput("select-input",label="selectInput",choices=c("A","B","C")),
numericInput("numeric-input",label="numericInput",value=5,min=1,max=10),
sliderInput("slider-input",label="sliderInput",value=5,min=1,max=10),
)
  • Update functions can be used to update input widgets
  • Reactive observer observe({}) monitors for a conditional change
server=function(input,output,session) {
observe({
if(something) {
updateSelectInput(session,"select-input",label="selectInput",choices=c("D","E","F"))
updateNumericInput(session,"numeric-input",label="numericInput",value=10,min=1,max=10)
updateSliderInput(session,"slider-input",label="sliderInput",value=8,min=1,max=10)
}
})
}
RaukR 2019 • 15/23

Isolate reactivity

  • Reactivity can be controlled.
shinyApp(
ui=fluidPage(
textInput("text_input",label="textInput"),
actionButton("btn_go", "Go!"),
textOutput("text_output")),
server=function(input,output) {
output$text_output <- renderText({
input$btn_go
isolate(input$text_input)
})
}
)
RaukR 2019 • 16/23

Error validation

  • Shiny returns an error with missing or incorrect values
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
})

RaukR 2019 • 17/23

Error validation

  • Shiny returns an error with missing or incorrect values
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
})

  • Errors can be handled in a controlled manner
RaukR 2019 • 17/23

Error validation

  • Shiny returns an error with missing or incorrect values
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
})

  • Errors can be handled in a controlled manner

  • validate() can be used to check input

  • validate() using need()
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
validate(need(try(input$data_input),"Please select a data set"))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
})

RaukR 2019 • 17/23

Error validation

  • Shiny returns an error with missing or incorrect values
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
})

  • Errors can be handled in a controlled manner

  • validate() can be used to check input

  • validate() using need()
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
validate(need(try(input$data_input),"Please select a data set"))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
})

  • validate() using custom function
valfn <- function(x) if(is.null(x) | is.na(x) | x=="") return("Input data is incorrect.")
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input,output) {
getdata <- reactive({
validate(valfn(try(input$data_input)))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
})

RaukR 2019 • 17/23

Error validation

  • Shiny returns an error with missing or incorrect values
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
})

  • Errors can be handled in a controlled manner

  • validate() can be used to check input

  • validate() using need()
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
validate(need(try(input$data_input),"Please select a data set"))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
})

  • validate() using custom function
valfn <- function(x) if(is.null(x) | is.na(x) | x=="") return("Input data is incorrect.")
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input,output) {
getdata <- reactive({
validate(valfn(try(input$data_input)))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
})

  • shiny::req() checks input variable and silently stops execution
RaukR 2019 • 17/23

Download • Data

  • Add button and downloadHandler() function
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("mtcars","faithful","iris")),
textOutput("text_output"),
downloadButton("button_download","Download")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
output$text_output <- renderText(paste0("Selected dataset: ",input$data_input))
output$button_download <- downloadHandler(
filename = function() {
paste0(input$data_input,".csv")
},
content = function(file) {
write.csv(getdata(),file,row.names=FALSE,quote=F)
})
})
  • Must be run in a browser to work
  • See usage of download buttons
RaukR 2019 • 18/23

Download • Plots

shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("mtcars","faithful","iris")),
textOutput("text_output"),
plotOutput("plot_output",width="400px"),
downloadButton("button_download", "Download")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
output$text_output <- renderText(paste0("Selected dataset: ",input$data_input))
output$plot_output <- renderPlot({hist(getdata()[, 1])})
output$button_download <- downloadHandler(
filename = function() {
paste0(input$data_input,".png")
},
content = function(file) {
png(file)
hist(getdata()[, 1])
dev.off()
})
})
  • Must be run in a browser to work
  • See usage of download buttons
RaukR 2019 • 19/23

Deployment

  • R scripts

    • R Package
  • Webpage

    • Shinyapps.io
    • Shiny Server (Free)
    • Shiny Server Pro
RaukR 2019 • 20/23

Deployment

  • R scripts

    • R Package
  • Webpage

    • Shinyapps.io
    • Shiny Server (Free)
    • Shiny Server Pro
  • Automatically deploying to shinyapps.io

library(rsconnect)
rsconnect::setAccountInfo(name="user", token="HDFGT46YF7TDT6474G47", secret="hdgTDF5FStgdkpJ")
deployApp(appName="name")
RaukR 2019 • 20/23

Deployment

  • R scripts

    • R Package
  • Webpage

    • Shinyapps.io
    • Shiny Server (Free)
    • Shiny Server Pro
  • Automatically deploying to shinyapps.io

library(rsconnect)
rsconnect::setAccountInfo(name="user", token="HDFGT46YF7TDT6474G47", secret="hdgTDF5FStgdkpJ")
deployApp(appName="name")
RaukR 2019 • 20/23

Interactive documents

  • Shiny can run in RMarkdown documents. Set YAML runtime: shiny.
---
title: Interactive document
output: html_document
runtime: shiny
---
  • Shiny widgets can be included directly
```{r}
selectInput('n_breaks',label='Number of bins:',choices=c(10,20,35,50),selected=20)
```
  • Whole shiny apps can be included directly
```{r}
shinyApp(
ui=fluidPage(),
server=function(input,output) {}
)
```
  • Hosted shiny apps can be embedded using <iframe>
<iframe src="https://user.shinyapps.io/app"></iframe>

Demo: shiny-rmarkdown.R

RaukR 2019 • 21/23

Extensions

  • Naxstats: Repo collection all shiny extensions
  • shinythemes: Bootswatch themes for shiny
  • shinyurl: using URLs to recreate state of an app
  • shinypod: Reusable modules
  • shinyjs: custom javascript functionality
  • shinyWidgets: Bootstrap 3 custom widgets
  • shinyBS: Bootstrap 3 widgets
RaukR 2019 • 22/23

Thank you. Questions?

R version 3.5.2 (2018-12-20)

Platform: x86_64-pc-linux-gnu (64-bit)

OS: Ubuntu 18.04.2 LTS


Built on : 14-Jun-2019 at 07:10:05

2019SciLifeLabNBIS

RaukR 2019 • 23/23
Paused

Help

Keyboard shortcuts

, , Pg Up, k Go to previous slide
, , Pg Dn, Space, j Go to next slide
Home Go to first slide
End Go to last slide
Number + Return Go to specific slide
b / m / f Toggle blackout / mirrored / fullscreen mode
c Clone slideshow
p Toggle presenter mode
t Restart the presentation timer
?, h Toggle this help
Esc Back to slideshow