Interactive web apps with Shiny

RaukR 2023 • Advanced R for Bioinformatics

Roy Francis

17-Jun-2023

Contents

• Introduction
• Code Structure
• App execution
• UI
• Code execution
• Reactivity
• Updating widgets
• Isolate
• Error validation
• Download
• Deploy
• Interactive documents
• Extensions

https://shiny.rstudio.com/gallery/

What is shiny?

• Web applications & interactive documents
• Completely created using R
• Needs a live environment

Usage

• Standalone web applications
• Dashboard/Flexboard
• Interactive RMarkdown
• Gadgets/RStudio extensions

App structure

• UI Layout
• UI Inputs (Widgets)
• UI Outputs
• Renderer
• Builder
• Function reference

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) {}

shiny::runApp("path/to/folder")

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')"

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) {})

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

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])
  })
})

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()

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})
}

Reactivity

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

Reactivity

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

Reactivity

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

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.

• 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),
)

• Add third argument session to server function
• 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)
    }
  })}

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)
      })
  }
)

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())})
})

Error validation

• 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("","unknown","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())})
})

Error validation

• 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("","unknown","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

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)
   })
})

• Run in system browser if Rstudio browser doesn’t work

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()
  })
})

• Run in system browser if Rstudio browser doesn’t work
• See usage of download buttons

Deployment

• R scripts
  • GitHub
  • R Package
  • Docker container
• Webpage
  • Shinyapps.io
  • Shiny Server (Free)
  • Shiny Server Pro

• Automatically deploying to shinyapps.io

library(rsconnect)
rsconnect::setAccountInfo(name="username", token="HDFGT46YF7TDT6474G47", secret="hdgTDF5FStgdkpJ")
deployApp(appName="name")

• Shiny apps user guide
• Shiny server guide

Interactive documents • Quarto

---
title: "Old Faithful"
format: html
server: shiny
---

```{r}
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
plotOutput("distPlot")
```

```{r}
#| context: server
output$distPlot <- renderPlot({
  x <- faithful[, 2]
  bins <- seq(min(x), max(x), length.out = input$bins + 1)
  hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
```

Interactive documents • Rmarkdown

• 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)
```

Interactive documents

• 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>

Extensions

• Naxstats: Repo collection of shiny extensions
• bslib: 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
• shinymanager: Authentication for shiny apps

Help

• Mastering Shiny Book
• Shiny Interfaces
• Posit Shiny home
• Posit Shiny articles

Other topics

• Shiny modules
• Shiny profiling
• Shiny unit tests
• Applications of action buttons
  
• Progress indicators
  
• …

Thank you! Questions?

         _                     
platform x86_64-conda-linux-gnu
os       linux-gnu             
major    4                     
minor    2.2                   

2023 • SciLifeLab • NBIS • RaukR