Introduction to R Shiny

.title[
# Introduction to R Shiny
]
.subtitle[
## SBW - Data Visualization Workshop
]
.author[
### Lokesh Mano • 28-Oct-2022
]
.institute[
### NBIS, SciLifeLab
]

---

---

## Contents

* [Introduction to RShiny](#intro)
* [Code Structure](#code-structure)
* [App execution](#execute)
* [UI](#ui-layout)
* [Server](#server)
* [Reactivity](#react)
* [Isolate reactivity](#isolate)
* [observeEvent()](#observe)
* [Updating Widgets](#updating)
* [Error Validation](#error)
* [Download Button](#download)
* [Modularizing reactivity](#module)

---

.size-95[
<img src="assets/images/shiny_gallery.png" alt="drawing" width="800"/>
](https://shiny.rstudio.com/gallery/)

---

## What is shiny?

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

### Usage

* [Standalone web applications](http://shiny.rstudio.com/gallery/see-more.html)
* [Dashboard/Flexboard](http://rstudio.github.io/shinydashboard/examples.html)
* Interactive RMarkdown
* Gadgets/RStudio extensions

### App structure

* UI Layout
* UI Inputs (Widgets)
* UI Outputs
* Renderer
* Builder

---

## Code structure

_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) {}
```
]

---

## App execution

* Change to app directory, then run `runApp()`
* Use `shinyApp()`

```r
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

```r
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

```r
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) {
})
```
]
.pull-right-40[
<img src="assets/images/app-widgets-input.png" style="width: 60%;" />
]

???

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

---

## UI • Widgets • Outputs

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

---

## Server

* `Server` is a function that assembles your `input` into `output` using R based code.
* Three rules to be followed to write a server function:

**Rule 1:** Save objects to display to `output$`

---

## Server

**Rule 2:** Build objects to display with `render*()`

* R-Code block (can even be an entire R script) between the braces `{}` inside the `render*()` function.

```
 output$hist <- renderPlot({
 tile <- "histogram of 100 random numbers"
 hist(rnorm(100), main = title)
 })
```
--

---

## Server

**Rule 3:** Use input values with `input$`

---

## Reactivity

---

## Reactivity

---

## Reactivity

---

## Reactivity

---

## Reactivity

---

## Reactivity

---

## Isolate reactivity

* Reactivity can be controlled.

* You will notice that as soon as you try to change the title, the histogram will update with new values

---

## Isolate reactivity

---

## Isolate reactivity

---

name:isolate4

## Isolate reactivity

---

name:observe

## observeEvent()

---

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

---

## Error validation

* Shiny returns an error with missing or incorrect values

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

.pull-left-70[.limity100[
```
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

.pull-left-70[.limity100[
```
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

---

## 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
* See usage of download buttons

---

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

---

## Modularizing Reactivity

---

# Thank you. Questions?

Slide courtesy: Roy Francis (NBIS, RaukR2021)

<hr>

Built on : 28-Oct-2022 at 07:32:29

2022 • [SciLifeLab](https://www.scilifelab.se/) • [NBIS](https://nbis.se/)
]