slides.qmd

---
title: "Shiny workshop"
subtitle: "Natural History Museum"
author: "Simon Smart"
format: 
  revealjs:
    logo: images/uol_logo.png
    chalkboard: true
    code-line-numbers: false
server: shiny
date: "7 February 2024"
preload-iframes: true
---

## About me

```{css}
code.sourceCode {
  font-size: 0.8em;
}

.largecode code.sourceCode {
font-size: 1.5em;
}

.mediumcode code.sourceCode {
font-size: 1.1em;
}

p.smalltext {
font-size: 30px !important;
}

table {
font-size: 30px;
}

/*logo*/
.reveal .slide-logo {
  height: 100px !important;
  max-width: unset !important;
  max-height: unset !important;
}

/*Shiny input and outputs*/
.shiny-input-container, .shiny-bound-output, .shiny-input-text {
box-sizing: border-box;
color: rgb(51, 51, 51);
font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
font-size: 22px;
line-height: 25px;
margin-bottom: 15px;
max-width: 100%;
width: 400px
}


/*Datatable*/
table.dataTable {
font-size: 16px;
}

table.dataTable tbody td {
padding: 2px 2px;
}

.dataTables_wrapper, .dataTables_info {
font-size: 16px;
}

/* Shiny error message*/
.shiny-output-error-validation {
color: green;
}

/*mermaid-diagrams*/
/*input, server, output*/
.sin > rect {
    fill: #b5e9ec !important;
}
.sser > rect {
    fill: #b5ecb6 !important;
}
.sout > rect {
    fill: #d6b5ec !important;
}


```

```{r eval=TRUE, echo=FALSE}
library(shiny)
library(dplyr)
library(leaflet)
```

-   Background in plant sciences and agricultural science
-   Latecomer to R, only started in 2018
-   Software developer in Population Health Sciences at University of Leicester with Tim Lucas
-   Collaborating with Dave Redding on Disagapp for high-resolution mapping of disease
-   <https://github.com/simon-smart88>

## Workshop overview

-   Trying to be broad but shallow so you know what's possible, rather than narrow but exhaustive
-   Please interrupt: If you're not sure then someone else isn't
-   Aiming for 50:50 me talking:you writing
-   Code examples are not always complete i.e. not all required arguments are used 
-   Natalie can help with Shiny, Tim with general R

## Overview for this morning

-   Introduction to Shiny
-   Reactivity and why writing Shiny code differs from normal R
-   Create example apps

## Overview for the afternoon

-   User interface design
-   Interactive tables and maps
-   Deploying your app to the web
-   Common problems and debugging

## What is Shiny?

-   R package developed by Posit/Rstudio, first released in 2012
-   Framework for developing interactive web apps using R
-   No need to learn any web development (html, css, javascript)
-   If you can do something in R, you can publish it online using Shiny

## Download materials {.largecode}

-   `git clone https://github.com/simon-smart88/shinyworkshop`

```{r eval = FALSE, echo = TRUE}
unzip(download.file(url = "t.ly/Y6ZDH", 
                    destfile = "shinyworkshop.zip"))
```

- `install.packages(c("shiny","leaflet", "DT", "rsconnect", "sf", "terra"))`
-   For the slides to be interactive, you need to run `slides.qmd`

```{r}
## These are commented out because they will break if 15 people try to load them at once!
## {data-menu-title="Tomvision"}
## {=html} 
##<iframe width="100%" height="100%" src="https://tomvision.shinyapps.io/tomvision/"</iframe>

## {data-menu-title="Potato dashboard"}
## {=html} 
##<iframe width="100%" height="100%" src="https://web.niab.com/pym-dashboard/?page=sign_in"</iframe>

## {data-menu-title="Shinyscholar"}
## {=html} 
##<iframe width="100%" height="100%" src="https://simonsmart.shinyapps.io/shinyscholar/"</iframe>
```

## Structure of a Shiny app {.largecode}

Shiny apps consist of a user interface object (UI) and a server object

```{r eval = FALSE, echo = TRUE}
ui <- fluidPage() 

server <- function(input, output) {}

shinyApp(ui = ui, server = server)
```

## Structure of a Shiny app {.largecode}

Shiny apps consist of a user interface object (UI) and a server object

::: columns
::: {.column width="80%"}
```{r eval = FALSE, echo = TRUE}
ui <- fluidPage() 

server <- function(input, output) {}

shinyApp(ui, server)
```
:::

::: {.column width="20%"}
-   Seeing

-   Doing
:::
:::

-   Our job is to make these objects talk to each other

## Communication between the UI and server {.smaller}
::: columns
::: {.column width="60%"}
-   The server function takes two `list()`-like objects as arguments:
    -   `input$` where settings made in the UI are stored
        -   Created for you by objects in the UI
        -   Values are read-only
    -   `output$` where objects created in the server that need to be displayed in the UI are stored
        -   You create them
:::
::: {.column width="40%"}
```{mermaid}
%%| fig-width: 4
%%| fig-height: 5
flowchart TD
A[Input in UI] --> |input$| B([Computation in server])
B --> |output$| C(Output in UI)

class A sin
class B sser
class C sout
```
:::
:::
## Input and output IDs {.largecode}

-   The objects in `input$` and `output$` have an ID used to refer to them
-   These must be unique or you will get errors
-   For `input$` objects, the ID is always the first argument of the function used to create them:

```{r eval = FALSE, echo = TRUE}
textInput("my_first_input") 
#allows you to use this in server:
input$my_first_input
```

## Input and output IDs {.largecode}

-   For `output$` objects, you declare them and then reference them by ID in the UI:

```{r eval = FALSE, echo = TRUE}
output$my_first_output <- renderText("Hello world") 
#allows you to use this in UI:
textOutput("my_first_output")
```

-   Both are referenced as strings in the UI but as variables in the server

## Reactivity basics
::: columns
::: {.column width="60%"}
-   Code in the server function is *reactive*
-   If an `input$` value changes, then any code which uses the input is rerun
-   Similarly, any code that uses a value calculated from the input is also rerun
-   Unlike in a normal R script, code isn't executed from top to bottom
:::
::: {.column width="40%"}
```{mermaid}
%%| fig-width: 4
%%| fig-height: 5
flowchart TD
A[Input in UI] --> |input$| B([Computation in server])
B --> |output$| C(Output in UI)

class A sin
class B sser
class C sout
```
:::
:::

## A simple example

::: columns
::: {.column width="70%"}
```{r eval = FALSE, echo = TRUE}
ui <- fluidPage(textInput("name", "What is your name?"),
                textOutput("name_out"))

server <- function(input, output) {
  output$name_out <- renderText(paste0("My name is ", input$name))
}

shinyApp(ui, server)
```

```{r}
br()
textInput("name", "What is your name?")
textOutput("name_out")
```

```{r}
#| context: server
output$name_out <- renderText(paste0("My name is ", input$name))
```
:::
::: {.column width="30%"}
```{mermaid}
%%| fig-width: 3
%%| fig-height: 5
flowchart TD
A["textInput()"] --> |input$name| B(["renderText()"])
B --> |output$name_out| C("textOutput()")

class A sin
class B sser
class C sout

```
:::
:::

## Shiny input widgets

::: columns
::: {.column width="30%"}
```{r eval = FALSE, echo = TRUE}
actionButton()
checkboxInput()
dateInput()
dateRangeInput()
fileInput()
numericInput()
radioButtons()
selectInput()
sliderInput()
textInput()
```
:::

::: {.column width="70%"}
![](images/basic-widgets.png){height="400px"}
:::
:::

Source: <https://shiny.posit.co/r/getstarted/shiny-basics/lesson3/>

```{r}
##  {background-iframe="https://gallery.shinyapps.io/081-widgets-gallery/" background-interactive="true"}
```

## Output functions

Outputs are generated in the server using `render*` functions and displayed in the UI using `*Output` functions

| Data type         | Render function     |     Output function |
|-------------------|---------------------|--------------------:|
| Table             | `renderTable()`     |     `tableOutput()` |
| Plot              | `renderPlot()`      |      `plotOutput()` |
| Text              | `renderText()`      |      `textOutput()` |
| Image             | `renderImage()`     |     `imageOutput()` |
| Interactive table | `renderDataTable()` | `dataTableOutput()` |

## Curly bracket syntax

-   Typically `render*()` functions are used with curly brackets `{}` inside the function
-   This lets you write multiple lines of code, but only the last line is returned

## Another example

```{r eval = FALSE, echo = TRUE}
ui <- fluidPage(selectInput("animal", "Choose your favourite animal", 
                            choices = c("","Whale", "Dinosaur")),
                textOutput("animal_name"))

server <- function(input, output) {
  output$animal_name <- renderText({
    animal_names = list("Whale" = "Hope", "Dinosaur" = "Dippy")
    paste0("Your favourite animal's name is ", animal_names[[input$animal]])})
}

shinyApp(ui = ui, server = server)
```

::: columns
::: {.column width="40%"}
```{r}
br()
selectInput("animal", "Choose your favourite animal", choices = c("", "Whale", "Dinosaur"))
```
:::

::: {.column width="40%"}
```{r}
br()
textOutput("animal_name")
htmlOutput("animal_photo")
```
:::
:::

```{r}
#| context: server
 output$animal_name <- renderText({
    animal_names = list("Whale" = "Hope", "Dinosaur" = "Dippy")
    paste0("Your favourite animal's name is ", animal_names[[input$animal]])
    })

output$animal_photo <- renderUI({
  req(input$animal)
  url <- switch(input$animal,
  Dinosaur = "https://upload.wikimedia.org/wikipedia/commons/thumb/c/cf/Diplodocus_%28replica%29.001_-_London.JPG/1280px-Diplodocus_%28replica%29.001_-_London.JPG",
  Whale = "https://upload.wikimedia.org/wikipedia/commons/thumb/5/54/Blue_Whale_-_Natural_History_Museum%2C_London_-_Joy_of_Museums.jpg/1280px-Blue_Whale_-_Natural_History_Museum%2C_London_-_Joy_of_Museums.jpg")
  
  credit <- switch(input$animal,
  Dinosaur = '<a href="https://commons.wikimedia.org/wiki/User:Drow_male" style="font-size:10px;">Fernando Losada Rodríguez</a>',
  Whale = '<a href="https://commons.wikimedia.org/wiki/User:Joyofmuseums" style="font-size:10px;">Joyofmuseums</a>')
  
  HTML(glue::glue('<img src="{url}" height="180px">{credit}'))
})
```

## UI development {.largecode}

::: columns
::: {.column width="50%"}
-   The UI object is one long list
-   `fluidPage()` makes the design *responsive* so that it fits on different sized screens
-   The first item will be placed in the top left
-   Functions need separating by commas
:::
::: {.column width="50%"}
\

```{r echo=TRUE, eval=FALSE}
ui <- fluidPage(
      actionButton(),
      checkboxInput(),
      dateInput(),
      textOutput(),
      plotOutput(),
      tableOutput()
      )
```
:::
:::

## Server development

-   Shiny code is more complex to debug and errors may not be simple to understand
-   Some mistakes won't produce any errors at all
-   First write code in an .Rmd file and then refactor for reactivity
-   Start simple and build complexity gradually
-   If you don't already, use the F1 key to look at documentation

## Static code can be put in different places

```{r eval = FALSE, echo = TRUE}
df <- read.csv()

ui <- fluidPage()

server <- function(input, output) {
  
  df <- read.csv()
  
  output$table <- renderTable({
    df <- read.csv()
  })
}  

shinyApp(ui = ui, server = server)
```

## Static code can be put in different places

```{r eval = FALSE, echo = TRUE}
df <- read.csv()
# run once when the app starts

ui <- fluidPage()

server <- function(input, output) {
  
  df <- read.csv()
  # run whenever a new user uses the app
  
  output$table <- renderTable({
    df <- read.csv()
    # run whenever input$value changes
    df <- df[df$column == input$value,]
  })
}  

shinyApp(ui = ui, server = server)
```

## tidyverse peculiarities

Unfortunately this will not work as you might expect:

```{r echo=TRUE, eval=FALSE}
#UI
selectInput("var", "Variable", choices = 
              c("carat", "depth", "table", "price", "x", "y", "z"))
numericInput("min", "Minimum", value = 1)

#Server
output$table <- renderTable(diamonds %>% filter(input$var > input$min))
```

## tidyverse peculiarities

-   This is the correct syntax:

```{r echo=TRUE, eval=FALSE}
output$table <- renderTable(diamonds %>% filter(.data[[input$var]] > .env$input$min))
```

-   See [Mastering Shiny](https://mastering-shiny.org/action-tidy.html) for more details
-   For now, just use the old-fashioned method:

```{r echo=TRUE, eval=FALSE}
output$table <- renderTable(diamonds[diamonds[[input$var]] > input$min,])
```

## Exercise 1

-   Create an app where you:
    -   Load data from `iris`
    -   Filter the data in some way using `sliderInput()`, `numericInput()` or `selectInput()`
    -   Display the filtered data using `renderTable()` and `tableOutput()`
-   Rstudio automatically detects `shinyApp()` in a file and clicking on ![](images/run_app.png) will run the app 

## `reactive()`

-   If you want to access an `input$` you must do so inside reactive objects
-   You have already done this - all the `render*` functions are reactive
-   If you want to create an object without making an output though, you need to wrap it inside `reactive()`
-   The resultant object is a function, so you need to append `()` when you access the values

## `reactive()` example {.largecode}

❌

```{r echo=TRUE, eval=FALSE}
df <- iris[iris$Species == input$species,]
min_petal_length <- min(df$Petal.Length)
```

✅

```{r echo=TRUE, eval=FALSE}
df <- reactive(iris[iris$Species == input$species,])
min_petal_length <- min(df()$Petal.Length)
```

- Just like the `render*` functions, you can make these multi-line using `{}`

## File uploads {.largecode}

-   `fileInput()` uploads the file to the web server, but not into the R environment
-   The resulting `input$` value is a dataframe containing `name`, `size`, `type` and `datapath` columns
-   To access the data, you need to process the file using the `datapath` column e.g.:

```{r echo=TRUE, eval=FALSE}
fileInput("file", "Upload file")
df <- reactive(read.csv(input$file$datapath))
```

## `renderUI()` and `uiOutput()`

-   Used to generate UI elements containing values reliant on other inputs

```{r echo=TRUE, eval=FALSE}
#UI:
numericInput("max_value", "Max value", value = 10)
uiOutput("my_widget")
textOutput("slider_value")
#Server:
output$my_widget <- renderUI({
  sliderInput("slider", "Value", value = 5, min = 1, max = input$max_value)
  })
output$slider_value <- renderText(input$slider)
```

::: columns
::: {.column width="50%"}
```{r}
br()
numericInput("max_value", "Max value", value = 10)
```
::: 
::: {.column width="50%"}

```{r}
br()
uiOutput("my_widget")
textOutput("slider_value")

```
:::
:::

```{r}
#| context: server
output$my_widget <- renderUI({sliderInput("slider", "Value", value = 5, min = 1, max = input$max_value)})
output$slider_value <- renderText(input$slider)
```

## `observe()`
- Similar to `reactive()` but doesn't return a result

```{r echo=TRUE, eval=FALSE}
numericInput("max_value", "Max value", value = 10)
sliderInput("slider", "Value", value = 5, min = 1, 10)
textOutput("slider_value")
#Server:
observe({
  updateSliderInput(
      inputId = "slider",
      max = input$max_value
  )  
})
```
::: columns
::: {.column width="50%"}
```{r}
br()
numericInput("max_value2", "Max value", value = 10)
```
:::
::: {.column width="50%"}
```{r}
br()
sliderInput("slider2", "Value", value = 5, min = 1, 10)
textOutput("slider_value2")
```
:::
:::

```{r}
#| context: server
observe({
  updateSliderInput(
      inputId = "slider2",
      max = input$max_value2
  )  
})
output$slider_value2 <- renderText(input$slider2)
```

## Controlling reactivity

-   Reactivity is essential for creating an interactive application but requires managing:
    -   What if some of your functions take seconds or minutes to run?
    -   What if your function uses an `input$` which is `NULL` when the app initiates?

## Using `req()`

-   `req()` is used to control execution of a function by defining the values that it *requires*
-   Placed at the top of reactive functions i.e. `reactive()` and `render*()`
-   If the conditions are not met, execution is halted

```{r echo=TRUE, eval=FALSE}
req(input$name) #checks that the input is not NULL
req(input$name == "Simon") #checks a specific condition 
req(input$name == "Simon", input$check == TRUE) #checks both conditions
```

::: columns
::: {.column width="30%"}
```{r}
br()
textInput("name1", "What is your name?")
checkboxInput("check1", "Tick me!", value = FALSE)
```
:::
::: {.column width="50%"}
```{r}
br()
textOutput("name_out1a")
textOutput("name_out1b")
textOutput("name_out1c")
```
:::
:::

```{r}
#| context: server
output$name_out1a <- renderText({
req(input$name1) 
"The first condition is satisfied"})

output$name_out1b <- renderText({
req(input$name1) 
req(input$name1 == "Simon")
"The first and second conditions are satisfied"})

output$name_out1c <- renderText({
req(input$name1) 
req(input$name1 == "Simon")
req(input$name1 == "Simon", input$check1 == TRUE)
  "All three conditions are satisfied"})
```

## Using `validate()` and `need()`

-   `validate(need())` is similar to `req()` but more user-friendly as errors can be passed back to the UI

```{r echo = TRUE, eval = FALSE}
validate(need(input$name, "Please enter your name"))
validate(need(input$name == "Simon", "Your name must be Simon"))
validate(need(input$name == "Simon", "Your name must be Simon"),
         need(input$check == TRUE, "The checkbox must be ticked"))
```

```{r}
br()
textInput("name2", "What is your name?")
checkboxInput("check", "Tick me!", value = FALSE)
textOutput("name_out2")
```

```{r}
#| context: server
output$name_out2 <- renderText({
validate(need(input$name2, "Please enter your name"))
validate(need(input$name2 == "Simon", "Your name must be Simon"))
validate(need(input$name2 == "Simon", "Your name must be Simon"),
         need(input$check == TRUE, "The checkbox must be ticked"))
  paste0("My name is ",input$name2)})
```

## Using `actionButton()` and `bindEvent()` {.largecode}

-   Used to explicitly control when code is executed

```{r echo = TRUE, eval = FALSE}
actionButton("go", "Do stuff") #UI
output$name_out <- renderText(input$name) %>% #Server
  bindEvent(input$go) 
```

```{r}
br()
textInput("name3", "What is your name?")
actionButton("go", "Do stuff")
textOutput("name_out3")
textOutput("action_value")
```

```{r}
#| context: server
library(dplyr)
output$name_out3 <- renderText({paste0("My name is ",input$name3)}) %>% bindEvent(input$go)
output$action_value <- renderText({
  req(input$go > 1)
  paste0("actionButton value = ", input$go)})
```

## Using `actionButton()` and `observeEvent()` {.largecode}

-   Similar to using `bindEvent()` but for use when the action doesn't produce an output

```{r echo = TRUE, eval = FALSE}
actionButton("go", "Go!") #UI
observeEvent(input$go, {do_stuff()}) #Server
```

```{r}
br()
numericInput("number", "Number to send", value = 10)
actionButton("go_db", "Send to database")
textOutput("database")
```

```{r}
#| context: server
database_value <- reactiveVal(value = 1)
observeEvent(input$go_db, {database_value(input$number)}) 
output$database <- renderText({
  paste0("The database value is: ", database_value())})
```

## Exercise 2 {.smaller}

::: columns
::: {.column width="50%"}
Create an app where you:

-   Upload `iris.csv` using  `fileInput()`
-   Select the names of two columns - `renderUI()` and `selectInput()`
-   Plot the two columns in a scatter plot - `renderPlot()`
-   Optional extra: 
    - Use `actionButton` and `bindEvent()` to control when the plot is rendered
:::
::: {.column width="50%"}
```{mermaid}
flowchart TD
A["fileInput('file' ...)"] --> |input$file| B(["renderUI({<br/>selectInput(<br/>'variable_two' ...)<br/>})"])
A --> |input$file| C(["renderUI({<br/>selectInput(<br/>'variable_one' ...)<br/>})"])
B --> |output$select_two| D("uiOutput('select_two')")
C --> |output$select_one| E("uiOutput('select_one')")
E --> |input$variable_one|F
D --> |input$variable_two|F(["renderPlot()"])
F --> |output$plot|G("plotOutput('plot')")

class A sin
class B sser
class C sser
class D sout
class E sout
class F sser
class G sout
```
:::
:::

## Downloads
-   `downloadButton()` in the UI
-   `downloadHandler()` in the server

```{r echo=TRUE, eval=FALSE}
downloadButton("download_data")

output$download_data <- downloadHandler(
      filename = function() {
      paste("data.csv", sep="")
    },
    content = function(file) {
      write.csv(data, file)
    }
)
```

## Downloads
-  Typically, you want to reuse a `reactive()` that you have used to create a table or a graph inside the `content` part of the download handler

```{r echo = TRUE, eval=FALSE}
df <- reactive(iris[iris$Sepal.Length <= input$sepal_length,])
output$plot <- renderPlot(plot(df()$Sepal.Length, df()$Sepal.Width))
output$download_data <- downloadHandler(
      filename = function() {
      "your_plot.png")
    },
    content = function(file) {
      png(file, width = 1000, height = 500)
      plot(df()$Sepal.Length, df()$Sepal.Width)
      dev.off()
    }
)
```

## Interactive tables
- Datatables are created with `DT::renderDataTable()` in the server and `DT::dataTableOutput()` in the UI:
- For even fancier tables, check out `{reactable}` and `{gt}`

```{r echo = TRUE, eval=FALSE}
DT::dataTableOutput("datatable") 
output$datatable <- DT::renderDataTable(iris) 
```

```{r}
DT::dataTableOutput("datatable")
```

```{r}
#| context: server
output$datatable <- DT::renderDataTable(iris, options = list(pageLength = 5))
```

## Interactive tables

- You can access the selected row(s) using `input$<table ID>_rows_selected`

```{r}
DT::dataTableOutput("datatable2")
textOutput("selected_row")
```

```{r}
#| context: server
output$datatable2 <- DT::renderDataTable(iris, options = list(pageLength = 5))
output$selected_row <- renderText({glue::glue("You have selected rows: {paste(input$datatable2_rows_selected, collapse = ' ')}")})
```

## Interactive maps

-   `{leaflet}` is a package for creating interactive maps
-   `renderLeaflet()` for the server and `leafletOutput()` for the UI

```{r echo=TRUE, eval=FALSE}
output$map <- renderLeaflet({
    leaflet() %>%
    addProviderTiles("Esri.WorldTopoMap") %>%
    addPolygons(data = sf_object) %>%
    addRasterImage(raster_image) %>%
    terra::plet(terra_object) #currently requires dev version: 
                              #remotes::install_github("rstudio/leaflet")
})
```

## An example

```{r}
leafletOutput("map")
```

```{r}
#| context: server
fcover <- terra::rast("exercise3/London_fcover_2023-06-10.tif")
wards <- sf::st_read("exercise3/London_Ward.shp", quiet = TRUE)

#reproject shapes to same CRS as the raster
wards <- sf::st_transform(wards, terra::crs(fcover))

output$map <- leaflet::renderLeaflet({
              leaflet::leaflet() %>%
              leaflet::addProviderTiles("Esri.WorldTopoMap") %>%
              leaflet::addRasterImage(fcover) %>%
              leaflet::addPolygons(data = wards, color = "black", weight = 1)
              })
```
## More leaflet

-   Functions for:
    - background maps - `addProviderTiles()`
    - legends - `addLegend()`
    - symbols - `addMarkers()`
    - pop-ups - `addPopups()`
    - zooming - `setView()` and `fitBounds()`
    - controlling visible layers- `addLayersControl()`
-   `{leaflet.extras}` has tools for drawing shapes on the map which can be used to edit data

## Leaflet proxy

-   `leafletProxy()` prevents completely re-drawing the map whenever something changes:

```{r echo=TRUE, eval=FALSE}
output$map <- renderLeaflet({
  leaflet() %>%
    addPolygons(data = sf_object)
  })

proxy_map <- leafletProxy("map")

observe({
    proxy_map %>%
      addRasterImage(
        terra::clamp(
          fcover, input$threshold, value = FALSE))
})

```

## Without leafletproxy 

```{r}
leafletOutput("map2")
numericInput("thresh1", "Threshold", value = 0)
```

```{r}
#| context: server

pal <- leaflet::colorBin("Greens", domain = c(0:100), na.color = "#00000000")

output$map2 <- leaflet::renderLeaflet({
              leaflet::leaflet() %>%
              leaflet::addProviderTiles("Esri.WorldImagery") %>%
              leaflet::addRasterImage(terra::clamp(fcover, input$thresh1, value=FALSE), colors = pal, opacity = 0.7) %>%
              leaflet::addPolygons(data = wards, color = "black", weight = 1) %>%
              leaflet::addLegend(position = "bottomright", pal = pal, values = terra::values(fcover), title = "FCover")
              })
```

## With leafletproxy

```{r}
leafletOutput("map3")
numericInput("thresh2", "Threshold", value = 0)
```

```{r}
#| context: server

output$map3 <- leaflet::renderLeaflet({
              leaflet::leaflet() %>%
              leaflet::addProviderTiles("Esri.WorldImagery") %>%
              leaflet::addPolygons(data = wards, color = "black", weight = 1) %>%
              leaflet::addLegend(position = "bottomright", pal = pal, values = terra::values(fcover), title = "FCover")
              })

proxy_map <- leaflet::leafletProxy("map3")

observe({
  req(!is.na(input$thresh2))
  proxy_map %>%
    leaflet::addRasterImage(terra::clamp(fcover, input$thresh2 , value = FALSE), colors = pal, opacity = 0.7) 
})

```

## Accessing information from the map {.smaller}
- There are `input$` values that record events occurring in the map
- `input$<map ID>_<object type>_<event type>` e.g. `input$map_shape_click`
- The values are a `list()` containing `$lat` and `$lng` which can be used for further calculations
- See the Inputs/Events section of <https://rstudio.github.io/leaflet/shiny.html>

```{r echo=TRUE, eval=FALSE}
output$selected_shape <- renderText({
  selected_point <- data.frame(x = input$map_shape_click$lng, y = input$map_shape_click$lat ) %>% 
                     sf::st_as_sf(coords = c("x", "y"), crs = 4326) 
index_of_polygon <- sf::st_intersects(selected_point, wards, sparse = T) %>% 
                    as.numeric()
glue::glue("You clicked on the ward of {wards$NAME[index_of_polygon]} which is in {wards$DISTRICT[index_of_polygon]}")
  })
```
## Accessing information from the map

```{r}
leafletOutput("map4")
textOutput("clicked_shape")
textOutput("mouseover_shape")
```

```{r}
#| context: server

output$map4 <- leaflet::renderLeaflet({
              leaflet::leaflet() %>%
              leaflet::addProviderTiles("Esri.WorldTopoMap") %>%
              leaflet::addPolygons(data = wards, color = "black", weight = 1) %>%
              leaflet::addRasterImage(fcover, colors = pal) 
              })


output$clicked_shape <- renderText({
  req(input$map4_shape_click)
  selected_point <- data.frame(x = input$map4_shape_click$lng, y = input$map4_shape_click$lat ) %>% 
                     sf::st_as_sf(coords = c("x", "y"), crs = 4326) 

index_of_polygon <- sf::st_intersects(selected_point, wards, sparse = T) %>% 
                    as.numeric()

glue::glue("You clicked on the ward of {wards$NAME[index_of_polygon]} which is in {wards$DISTRICT[index_of_polygon]}")
  })


output$mouseover_shape <- renderText({
  req(input$map4_shape_mouseover)
  selected_point <- data.frame(x = input$map4_shape_mouseover$lng, y = input$map4_shape_mouseover$lat ) %>% 
                     sf::st_as_sf(coords = c("x", "y"), crs = 4326) 

index_of_polygon <- sf::st_intersects(selected_point, wards, sparse = T) %>% 
                    as.numeric()

glue::glue("The mouse is over the ward of {wards$NAME[index_of_polygon]} which is in {wards$DISTRICT[index_of_polygon]}")
  })
```

## Exercise 3
-   Use `{leaflet}` to select a ward or district of London and zoom when it is selected
    - Select the area either through clicking, or use a `selectInput()`
    - Set the zoom using `sf::st_bbox()` and `leaflet::fitBounds()`
-   Use a `downloadHandler` to download a `.png` of the satellite imagery of just that area
    - Use `terra::crop(mask = TRUE)`

## UI layouts
-   There are many different options for laying out the UI
-   Sidebars, tabs, rows and columns
-   Different components can be nested inside each other
-   The examples in these pages need `layout.R` to be run separately (sorry!)

## Sidebar layout
::: columns
::: {.column width="50%"}
```{r echo=TRUE, eval=FALSE}
fluidPage(
  titlePanel(
    # app title/description
  ),
  sidebarLayout(
    sidebarPanel(
      # inputs
    ),
    mainPanel(
      # outputs
    )
  )
)

```
::: 
::: {.column width="50%"}
```{r fig.height=8}
par(cex = 2, mar=c(0,0,0,0))
plot(0:400, 0:400, type="n", axes= F, ylab='', xlab='')
rect(0, 0, 400, 400, col="firebrick1")
text(50, 375,"fluidPage()")
rect(25, 350, 375, 300, col="lightblue")
text(75, 325, "titlePanel()")
rect(25, 300, 375, 25, col="lightgreen")
text(100, 275, "sidebarLayout()")
rect(50, 250, 200, 50, col="pink")
text(125, 225, "sidebarPanel()")
rect(200, 250, 350, 50, col="orange")
text(250, 225, "mainPanel()")
```
::: 
::: 

## Sidebar layout 

```{=html}
<iframe width="100%" height="100%" src="http://127.0.0.1:6110/?radio=1" ></iframe>
```

## Tab panels
::: columns
::: {.column width="30%"}

```{r echo=TRUE, eval=FALSE}
fluidPage(
  titlePanel(
  ),
  tabsetPanel(
    tabPanel( 
      sidebarLayout(
        sidebarPanel(
        ),
        mainPanel(
        )
      )
    )
    tabPanel(),
    tabPanel()
  )
)

```
::: 
::: {.column width="70%"}

```{r fig.height=8}
par(cex = 1.8, mar=c(0,0,0,0))
plot(0:400, 0:400, type="n", axes= F, ylab='', xlab='')
rect(0, 0, 400, 400, col="firebrick1")
text(50, 375,"fluidPage()")
rect(25, 350, 375, 300, col="lightblue")
text(75, 325, "titlePanel()")
rect(25, 300, 375, 25, col="darkorchid1")
text(90, 275, "tabsetPanel()")
rect(50, 250, 350, 100, col="maroon2")
text(100, 225, "tabPanel()")

rect(75, 200, 325, 125, col="lightgreen")
text(140, 185, "sidebarLayout()")
rect(100, 170, 200, 130, col="pink")
text(150, 150, "sidebarPanel()")
rect(200, 170, 300, 130, col="orange")
text(250, 150, "mainPanel()")

rect(50, 90, 350, 50, col="maroon2")
text(100, 70, "tabPanel()")

```
:::
:::

## Tab panels
```{=html}
<iframe width="100%" height="100%" src="http://127.0.0.1:6110/?radio=2" ></iframe>
```


## Fluid rows and columns

-  Gives you more control over layout - the screen width is split into 12 units and you set their relative width

::: columns
::: {.column width="40%"}

```{r echo=TRUE, eval=FALSE}
ui <- fluidPage(
  titlePanel(),
  fluidRow(
    column(width = 3,
    ),
    column(width = 6,
    ),
    column(width = 3,
    )
  )
)

```
::: 
::: {.column width="50%"}
```{r fig.height=8}
par(cex = 2, mar=c(0,0,0,0))
plot(0:400, 0:400, type="n", axes= F, ylab='', xlab='')
rect(0, 0, 400, 400, col="firebrick1")
text(50, 375,"fluidPage()")
rect(25, 350, 375, 300, col="lightblue")
text(75, 325, "titlePanel()")
rect(25, 300, 375, 25, col="darkorchid1")
text(90, 275, "fluidRow()")
rect(50, 250, 120, 50, col="palegreen")
text(90, 225, "column()")
rect(140, 250, 260, 50, col="palegreen")
text(180, 225, "column()")
rect(280, 250, 350, 50, col="palegreen")
text(320, 225, "column()")
```
:::
:::

## Fluid row and columns

```{=html}
<iframe width="100%" height="100%" src="http://127.0.0.1:6110/?radio=3" ></iframe>
```

## Structuring UI code
```{=html}
<iframe width="100%" height="100%" src="http://127.0.0.1:6110/?radio=4" ></iframe>
```

## Structuring UI code
-   Brackets are important for structuring layout of elements
-   Indentation and lines help to make your code readable
-   It can get very complicated!

```{r echo=TRUE, eval= FALSE}
fluidPage(titlePanel("My fourth app"),
tabsetPanel(tabPanel("Tab 1",sidebarLayout(sidebarPanel(
numericInput("number", "Pick a number", value = 10),
selectInput("select", "Select an animal", choices = c("Cat", "Dog"))),
mainPanel(plotOutput("plot"),tableOutput("table")))),
tabPanel("Tab 2",fluidRow(column(width = 3,textInput("word", "Type a word"),
sliderInput("slider", "Pick a value", min = 10, max = 100, value = 50)),
column(width = 6,leafletOutput("map")),
column(width = 3,checkboxInput("check", "Tick me")))),
tabPanel("Tab 3",plotOutput("another_plot"))))
```

## Structuring UI code

```{r echo=TRUE, eval= FALSE}

fluidPage(
  titlePanel("My fourth app"
  ),
  tabsetPanel(
    tabPanel("Tab 1", 
      sidebarLayout(
        sidebarPanel(
          numericInput("number", "Pick a number", value = 10),
          selectInput("select", "Select an animal", choices = c("Cat", "Dog"))
        ),
        mainPanel(
          plotOutput("plot"),
          tableOutput("table")
        )
      )
    ),
    tabPanel("Tab 2",
      fluidRow(
        column(width = 3,
          textInput("word", "Type a word"),
          sliderInput("slider", "Pick a value", min = 10, max = 100, value = 50)
        ),
        column(width = 6,
          leafletOutput("map")
        ),
        column(width = 3,
           checkboxInput("check", "Tick me")
        )
      )
    ),
    tabPanel("Tab 3",
      plotOutput("another_plot")
    )
  )
)

```

## Themes

-   Themes can be used to change the appearance of all the elements of an app in one go
-   `fluidPage(theme = bslib::bs_theme(bootswatch ="<theme name>"))`
-   [bootswatch.com](https://bootswatch.com/)

```{=html}
<iframe width="1000" height="400" src="https://bootswatch.com/" title="Bootswatch"></iframe>
```

## Cascading style sheets

-   css determines the appearance of elements on web pages
-   You can add your own css to the UI to change how elements appear
-   Right-clicking / Ctrl+clicking allows you to inspect the html
-   Often requires trial and error!

```{r echo = TRUE, eval = FALSE}
ui <- fluidPage(
  tags$head(
      tags$style(type="text/css", 
                 ".shiny-output-error-validation {color: green; font-size: 18px}"
      )))
```

## Exercise 4
-   Add a UI layout and a theme the app you created in Exercise 3
-   If time permits, add some more features:
    - Name the file by the name of the ward/district
    - Plot a histogram of the values of the ward
    - A league table of greenness where clicking on a row zooms to the ward
    - Anything else!
-   Deploy the app to shinyapps.io (coming up!)

## File naming conventions for deployment
-   Various file structures can be used depending on complexity
-   Standalone file as `app.R` - what we will use
-   Separate files for server and UI - `server.R` and `ui.R`
-   `global.R` - loaded before `server.R` and `ui.R` so can be a good place to load data
-   If `server.R` and `ui.R` become very long, code can be modularised into infinite files

## Deployment

-   Publish your app so that others can use it
-   We will use [shinyapps.io](https://shinyapps.io) run by Posit
-   Free and easy to use but has limitations:
    -   Only 1GB RAM on free tier which may not be enough to run models
    -   Limited amount of use per month (25 hours)
    -   Only 3-5 concurrent users 
    -   No persistent data storage
-   Many other options available - speak to IT

## What happens when you deploy

-   Copies the code from the app directory
-   Uses `{renv}` to check your R version and what package versions the app uses
-   Replicates the environment of your machine on their server
-   R runs on their server and sends the results to the browser

## How to deploy
-   Register: <https://www.shinyapps.io/auth/oauth/signup> 
-   Your username will become part of the URL 
-   Copy your token and secret: <https://www.shinyapps.io/admin/#/tokens>
-   Click "Show" on right hand side and then "Show secret"
-   Copy and run the code which looks like this:

```{r echo=TRUE, eval = FALSE}
rsconnect::setAccountInfo(name='simonsmart',
			  token='E72042914BFED931FDE0C96A1',
			  secret='kowe90erweioj2312iuj2o4ij2jij')
```

## How to deploy 
-  Rename `exercise3.R` to `app.R`
-  Run the `app.R` in Rstudio
-  Click the "Publish" button in the top right corner
-  Choose a URL for the app
-  Click "Publish" again and wait

## Applications vs. scripts

-   Execution is circular, not linear
-   You are creating a range of possibilities for your user
-   Applications have users and users can break things

## Applications vs. scripts
-   Try and consider all the possible ways a user could interact with your app and manage them
-   e.g. what happens if you write this, but a user uploads a `.jpeg` instead of `.csv`?

```{r echo=TRUE, eval=FALSE}
fileInput("file", "Upload .csv file")
df <- reactive({req(input$file)
                read.csv(input$file$datapath)})
```

## Applications vs. scripts
- Adding extra arguments to functions and using `validate(need())` can help:

```{r echo=TRUE, eval=FALSE}
fileInput("file", "Upload .csv file", accept = ".csv")
df <- reactive({req(input$file)
                ext <- tools::file_ext(input$file$datapath)
                validate(need(ext == "csv"), "Please upload a .csv file")
                read.csv(input$file$datapath)  
                })
```

## Common pitfalls

-   Trying to use reactive objects in a non-reactive context
-   Not appending reactive objects with `()` when accessing their values
-   Naming a `reactive()` variable the same as a loaded function
-   Typos in `input` or `output` IDs
-   Using the same ID twice
-   Misplaced brackets or commas in UI

## Debugging

-   Sooner or later you are going to run into a problem
-   Apps are run in their own environment, so you can't inspect objects in the Rstudio environment tab
-   Run the code in a standard R script or .Rmd to check it works as you expect
-   Use `verbatimTextOutput()` and `textOutput()` to display objects - are they in the state you expect?
-   Include `options(shiny.fullstacktrace = TRUE)` in the server 
-   Add `browser()` above where your code is failing and then inspect the objects in your environment
-   Create a simple app containing only the problematic elements (i.e. a minimal, reproducible example)

## Resources

-   [Get started guide from Posit](https://shiny.posit.co/r/getstarted/)
-   [Shiny functions reference](https://shiny.posit.co/r/reference/shiny/1.0.5/)
-   [Mastering Shiny](https://mastering-shiny.org/)
-   [Outstanding User Interfaces with Shiny](https://unleash-shiny.rinterface.com/)
-   [Engineering Production-Grade Shiny Apps](https://engineering-shiny.org/)

## Keep in touch
-   Please send me links to your creations!
-   I'm happy to help if you are really stuck
-   <ss1545@le.ac.uk>