04-server-reactive-programming-i.qmd

--- 
title: "Server: Reactive programming"
---

- Learning outcomes:
  - Understand the logic underlying reactivity in Shiny apps
  - Conceiving and constructing reactive graphs
  - Implement a basic I/O structure based on reactive elements

Sources: @wickham2021mastering [Ch. 3]

```{r 04-server-reactive-programming-1, message=FALSE, warning=FALSE, include=FALSE}
# namer::unname_chunks("04-server-reactive-programming.qmd")
# namer::name_chunks("04-server-reactive-programming.qmd")

# install.packages("pacman)
pacman::p_load(knitr, quarto, tidyverse)
```




## Basics
- In Shiny, server logic is expressed using **reactive programming** (*elegant powerful programming paradigm!*)
- Very different to writing script that runs from start to end
- **Key idea**: specify a graph of dependencies so that when an input changes, all related outputs are automatically updated
- **Reactive programming** makes flow of an app considerably simpler


## The server function
- "Guts" of every shiny app below

```{r 04-server-reactive-programming-2, echo=TRUE, eval=FALSE}
library(shiny)

# front end interface (Html)
ui <- fluidPage() # <1>

# backend logic
server <- function(input, output, session) {} # <2>

shinyApp(ui, server)
```

1. User interface
2. Server

- `ui` simple because every user gets same html
- `server` more complicated because every user needs independent version of the app
  - e.g., Julia using slider should not affect Petra's ui!
- `server()` is invoked each time new session starts
  - 3 parameters (`input`, `output`, `session`) that are created by Shiny (not by us!) when user starts  connecting to specific session



## Input & output (lists)
- `input`: a list-like object that contains all the **input data sent from the browser**, named according to the **input ID**
  - e.g., `numericInput("count", label = "Number of values", value = 100)` generates element `input$count`
  - `input` can only be read from within reactive contexts created by a **reactive functions** like `renderText()` or `reactive()`
    - **reactive functions** allow for outputs to automatically update when an input changes

- `output`: a list-like object containing outputs named according to `output ID`
  - **Difference**: `output` list used for sending output instead of receiving input through `input` list (always in concert with a **render function**)

- *Q: How many inputs/outputs/render functions are there in the code below? What does it do?*
  
```{r 04-server-reactive-programming-3, echo=TRUE, eval=FALSE}
#| code-fold: true
#| code-summary: "Simple input/output example"
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  output$greeting <- renderText({ # <1>
    paste0("Hello ", input$name, "!")
  })
}
shinyApp(ui, server)
```

1. render functions, e.g., `renderText()` set up special reactive context that automatically tracks what inputs the output uses AND converts output of R code into HTML suitable for display on a web page





## Render functions

- **render functions**, located in `server`, wrap generated outputs and correspond to the type or reactive output
  - resulting values are stored in the `output$...` list
- Q: What do you think are the following render functions used for? (e.g., )
  - `renderImage({...})`
  - `renderPlot({...})`
  - `renderPlotly({...})` (!)
  - `renderPrint({...})`
  - `renderTable({...})` (!)
  - `renderDataTable({...})`
  - `renderText({...})`
  - `renderUI({...})`
  - `renderLeaflet({...})`(!)

- Our app uses those marked with  (!).

::: {.callout-warning collapse="true"}

#### Solution

- `renderImage({...})` creates images (saved as a link to a source file)
- `renderPlot({...})` creates plots
- `renderPlotly({...})` creates interactive plotly graph
- `renderPrint({...})` creates any printed output
- `renderTable({...})` creates data frame, matrix, other table like structures
  - `renderDataTable({...})` creates interactive datatable
- `renderText({...})` creates character strings
- `renderUI({...})` creates a Shiny tag object or HTML
- `renderLeaflet({...})` create a leaflet map

:::


## Reactive programming 
### How does reactivity work? {#sec-name-app}

- Q: How does reactivity work? What does the app below do? (Let's run it too!)

```{r 04-server-reactive-programming-4, echo=TRUE, eval=FALSE}
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting")
)

server <- function(input, output, session) {
  output$greeting <- renderText({
    paste0("Hello ", input$name, "!")
  })
}
shinyApp(ui, server)
```

- Shiny performs the `renderText()` action every time we update `input$name` (automatically!)
- **reactive** refers to any expression that automatically updates itself when its dependencies change
- **Important**: Code within `renderText({})` informs Shiny how it could create the string if it needs to, but it's up to Shiny when (and even if!) the code should be run
- **Recipe**: App provides Shiny with **recipe** (not commands) what to do with inputs



### The reactive graph
- Usually R code can be read from top to bottom (= order of execution)... not in Shiny!
- **Reactive graph**: describes how inputs/outputs are connected to understand order of execution
- @fig-graph-simple describes app in @sec-name-app above.
  - says that `output$greeting` will need to be recomputed whenever `input$name` is changed
  - `greeting` has a reactive dependency on `name`

```{r 04-server-reactive-programming-5, echo = FALSE, out.width = NULL}
#| label: fig-graph-simple
#| fig-cap: "The reactive graph shows how the inputs and outputs are connected (Source: Wickham 2021)"
knitr::include_graphics("resources/graph-1b.png", dpi = 300)
```


- Quick high-level sketch of reactive graphs help to understand how pieces fit together


### Reactive expressions
- **Reactive expressions** take inputs and produce outputs
  - can reduce duplication in reactive code by introducing additional nodes into reactive graph
  - @fig-graph-expression contains reactive expression `string` (inspect shape!) with code shown below

```{r 04-server-reactive-programming-6, echo = FALSE, out.width = NULL}
#| label: fig-graph-expression
#| fig-cap: "A reactive expression is drawn with angles on both sides because it connects inputs to outputs (Source: Wickham 2021)"
knitr::include_graphics("resources/graph-2b.png", dpi = 300)
```

- Below `string` is created with `reactive()` function to app in @sec-name-app.

```{r 04-server-reactive-programming-7, echo=TRUE, eval=FALSE}
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting"),
)

server <- function(input, output, session) {
  string <- reactive(paste0("Hello ", input$name, "!"))
  
  output$greeting <- renderText(string())
}
shinyApp(ui, server)
```


### Reactive expressions: May avoid duplications
- *Q: How does the code below avoid duplicating code?*

```{r 04-server-reactive-programming-7-2, echo=TRUE, eval=FALSE}
#| code-fold: false
#| code-summary: "Show the code"
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting"),
  textOutput("greeting2")
)

server <- function(input, output, session) {
  string <- reactive(paste0("Hello ", input$name, "!"))
  output$greeting <- renderText(string())
  output$greeting2 <- renderText(string())
}
shinyApp(ui, server)
```


### Executation order
- Order Shiny code is run is solely determined by reactive graph
- We can flip code as we want below..
  - But better **keep order for easier understanding**!

```{r 04-server-reactive-programming-8-2, echo=TRUE, eval=FALSE}
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting"),
)

server <- function(input, output, session) {
  output$greeting <- renderText(string())
  string <- reactive(paste0("Hello ", input$name, "!"))
}
shinyApp(ui, server)
```


### Exercises
1. Below you find code for three different servers (`server1`, `server2` and `server3`). Can you spot errors the programmer made?

```{r 04-server-reactive-programming-9, echo=TRUE, eval=FALSE}
# UI
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting")
)

# SERVERS
server1 <- function(input, output, server) {
  input$greeting <- renderText(paste0("Hello ", name))
}

server2 <- function(input, output, server) {
  greeting <- paste0("Hello ", input$name)
  output$greeting <- renderText(greeting)
}

server3 <- function(input, output, server) {
  output$greting <- paste0("Hello", input$name)
}



```





::: {.callout-warning collapse="true"}

#### Solution(s)

* Server 1: Forgot to specify that list and uses `name` instead of `input$name`.
* Server 2: Forgot to specify that greeting is a reactive using `greeting` intead of `greeting()` within `renderText()`. Besides, `input$name` is not wrapped into a reactive function like `renderText()` or `reactive()`.
* Server 3: Called the output that is stored in list `output` `greting` instead of `greeting`. Hence, it can not be found by the `textOutput()` function.


:::







2.  Using the same symbols as in @fig-graph-expression, please draw the reactive graphs for the following three server functions. Always start by making a list of all the contained inputs, reactives and ouputs (**do server1 in the group!**).

::: {.callout-tip collapse="true"}
Start by deciding **how many** and **which inputs (1)**, **reactives (2)** and **ouputs (3)** there are. Then start drawing with inputs represented in the first column on the left. You could use, e.g., `name>` for inputs, `>name>` for reactives and `>name` for outputs and arrows to connect them.
:::

```{r 04-server-reactive-programming-10}
server1 <- function(input, output, session) {
  c <- reactive(input$a + input$b)
  e <- reactive(c() + input$d)
  output$f <- renderText(e())
}

server2 <- function(input, output, session) {
  x <- reactive(input$x1 + input$x2 + input$x3)
  y <- reactive(input$y1 + input$y2)
  output$z <- renderText(x() / y())
}

server3 <- function(input, output, session) {
  d <- reactive(c() ^ input$d)
  a <- reactive(input$a * 10)
  c <- reactive(b() / input$c) 
  b <- reactive(a() + input$b)
}
```
    

::: {.callout-warning collapse="true"}

#### Solution(s)


* ([Solution source](https://mastering-shiny-solutions.org/basic-reactivity.html#exercise-4.3.6.1)):

To create the reactive graph we need to consider the inputs, reactive
expressions, and outputs of the app.

For `server1` we have the following objects:

- inputs: `input$a`, `input$b`, and `input$d`
- reactives: `c()` and `e()`
- outputs: `output$f`

Inputs `input$a` and `input$b` are used to create `c()`, which is combined with
`input$d` to create `e()`. The output depends only on `e()`.

<center>
![reactive graph - server 1](resources/4.3.6.1-s1.png){width=500px}
</center>
<br>

For `server2` we have the following objects:

- inputs: `input$y1`, `input$y2`, `input$x1`, `input$x2`, `input$x3`
- reactives: `y()` and `x()`
- outputs: `output$z`

Inputs `input$y1` and `input$y2` are needed to create the reactive `y()`. In
addition, inputs `input$x1`, `input$x2`, and `input$x3` are required to create
the reactive `x()`. The output depends on both `x()` and `y()`.

<center>
![reactive graph - server 2](resources/4.3.6.1-s2.png){width=400px}
</center>
<br>

For `server3` we have the following objects:

- inputs: `input$a`, `input$b`, `input$c`, `input$d`
- reactives: `a()`, `b()`, `c()`, `d()`

As we can see below, `a()` relies on `input$a`, `b()` relies on both `a()` and
`input$b`, and `c()` relies on both `b()` and `input$c`. The final output
depends on both `c()` and `input$d`.

<center>
![reactive graph - server 3](resources/4.3.6.1-s3.png){width=600px}
</center>
<br>


:::





## `reactive()` and other functions
- Shiny provides a variety of reactive functions such as `reactive()`, `observe()`, `bindevent()` etc.
- So far we have seen `reactive()` (more later!)
- `reactive()`: wraps a normal expression to create a reactive expression
  - is "reactive" in the sense that if its dependencies change, it will automatically update.
  - Below reactive `string` changes whenever dependency `input$name` changes.


```r
ui <- fluidPage(
  textInput("name", "What's your name?"),
  textOutput("greeting"),
)

server <- function(input, output, session) {
  string <- reactive(paste0("Hello ", input$name, "!"))
  output$greeting <- renderText(string())
}
shinyApp(ui, server)
```



## Summary: reactive expressions
- [Chapter 3.4](https://mastering-shiny.org/basic-reactivity.html#reactive-expressions-1) is recommended reading!
- **Reactive expressions** (e.g., `reactive()`) are important because...
  - give Shiny more information so that it can do less recomputation when inputs change
  - make apps more efficient and easier for humans to understand (simplify reactive graph!)
- Are like inputs since you can use results of a reactive expression in an output
- Are like outputs since they depend on inputs and automatically know when they need updating
- **Inputs** also called **Producers** (see @fig-prod-consumer)
- **Outputs** also called **Consumers**
- **Reactive expressions** are both **producers** and **consumers**.

```{r 04-server-reactive-programming-11, echo = FALSE, out.width = NULL}
#| label: fig-prod-consumer
#| fig-cap: "Inputs and expressions are reactive producers; expressions and outputs are reactive consumers (Source: Wickham 2021)"

knitr::include_graphics("resources/producers-consumers.png", dpi = 300)
```






## ESS app (reactivity): Tabulate data tab exercise
* Below you find the basic code underlying the Table tab of our app.


```{r eval=FALSE}
#| code-fold: true
#| code-summary: R code underlying (necessary for the) Table tab


library(tidyverse)
library(shiny)
library(plotly)
library(leaflet)
library(haven)

ess <- readRDS("ess_trust.rds")
ess_geo <- readRDS("ess_trust_geo.rds")

# UI ----
ui <- fluidPage(
  titlePanel("European Social Survey - round 10"),
  
  ## Sidebar ----
  sidebarLayout(
    sidebarPanel(
      ### select dependent variable
      selectInput(
        "xvar",
        label = "Select a dependent variable",
        choices = c(
          "Trust in country's parliament" = "trust_parliament",
          "Trust in the legal system" = "trust_legal",
          "Trust in the police" = "trust_police",
          "Trust in politicians" = "trust_politicians",
          "Trust in political parties" = "trust_parties",
          "Trust in the European Parliament" = "trust_eu",
          "Trust in the United Nations" = "trust_un"
        )
      ),
      
      ### select a variable ----
      selectInput(
        "yvar",
        label = "Select an independent variable",
        choices = c(
          "Placement on the left-right scale" = "left_right",
          "Age" = "age",
          "Feeling about household's income" = "income_feeling",
          "How often do you use the internet?" = "internet_use",
          "How happy are you?" = "happiness"
        )
      ),
      
      ### select a country ----
      selectizeInput(
        "countries",
        label = "Filter by country",
        choices = unique(ess$country),
        selected = "FR",
        multiple = TRUE
      ),
      
      ### filter values ----
      sliderInput(
        "range",
        label = "Set a value range (dependent variable)",
        min = min(ess$trust_parliament, na.rm = TRUE),
        max = max(ess$trust_parliament, na.rm = TRUE),
        value = range(ess$trust_parliament, na.rm = TRUE),
        step = 1
      )
    ),
    
    ## Main panel ----
    mainPanel(
      tabsetPanel(
        type = "tabs",
        
        ### Table tab ----
        tabPanel(
          title = "Table",
          div(
            style = "height: 600px; overflow-y: auto;",
            tableOutput("table")
          )
        )
      )
    )
  )
)


# Server ----
server <- function(input, output, session) {
  # update slider ----
  observe({
    var <- na.omit(ess[[input$xvar]])
    is_ordered <- is.ordered(var)
    var <- as.numeric(var)
    updateSliderInput(
      inputId = "range",
      min = min(var),
      max = max(var),
      value = range(var),
      step = if (is_ordered) 1
    )
  }) %>%
    bindEvent(input$xvar)
  
  # filter data ----
  filtered <- reactive({
    req(input$countries, cancelOutput = TRUE)
    
    xvar <- input$xvar
    yvar <- input$yvar
    range <- input$range
    
    # select country
    ess <- ess[ess$country %in% input$countries, ]
    
    # select variable
    ess <- ess[c("idno", "country", xvar, yvar)]
    
    # apply range
    ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ]
    ess
  })
  
  # render table ----
  output$table <- renderTable({
    filtered()
  }, height = 400)
  
}

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

1. How many inputs, reactives and outputs can you identify (Tipp: Only keep the code of the server and search for `input$`,  `output$` and `reactive`)?
2. What would the reactive graph look like for the app?
3. In an exercise in the previous chapter we used `renderDataTable()` and `dataTableOutput()` to create an interactive table for the data. Please try to replace the corresponding code lines in our so that we get an interactive table out of the box (Tipp: Since `renderDataTable()` does not like labelled datasets we have to zap them as follows: `filtered() %>% zap_labels()`).



::: {.callout-warning collapse="true"}

#### Solution

1. 
* Inputs: `input$xvar`, `input$yvar`, `input$countries`, `input$range`
* Reactives: `filtered`
* Outputs: `output$table`

2. The reactive graph is shown in @fig-reactive-graph-ess-app-table.

```{r 04-server-reactive-programming-113454, echo = FALSE, out.width = NULL}
#| label: fig-reactive-graph-ess-app-table
#| fig-cap: "Reactive graph for app version that only includes the table"

knitr::include_graphics("resources/reactive-graph-ess-app-table.drawio.svg")
```


3. Using `renderDataTable()` and `dataTableOutput()` instead of the standard table.

```{r eval=FALSE}
library(tidyverse)
library(shiny)
library(plotly)
library(leaflet)
library(haven)

ess <- readRDS("ess_trust.rds")

# UI ----
ui <- fluidPage(
  titlePanel("European Social Survey - round 10"),
  
  ## Sidebar ----
  sidebarLayout(
    sidebarPanel(
      ### select dependent variable
      selectInput(
        "xvar",
        label = "Select a dependent variable",
        choices = c(
          "Trust in country's parliament" = "trust_parliament",
          "Trust in the legal system" = "trust_legal",
          "Trust in the police" = "trust_police",
          "Trust in politicians" = "trust_politicians",
          "Trust in political parties" = "trust_parties",
          "Trust in the European Parliament" = "trust_eu",
          "Trust in the United Nations" = "trust_un"
        )
      ),
      
      ### select a variable ----
      selectInput(
        "yvar",
        label = "Select an independent variable",
        choices = c(
          "Placement on the left-right scale" = "left_right",
          "Age" = "age",
          "Feeling about household's income" = "income_feeling",
          "How often do you use the internet?" = "internet_use",
          "How happy are you?" = "happiness"
        )
      ),
      
      ### select a country ----
      selectizeInput(
        "countries",
        label = "Filter by country",
        choices = unique(ess$country),
        selected = "FR",
        multiple = TRUE
      ),
      
      ### filter values ----
      sliderInput(
        "range",
        label = "Set a value range (dependent variable)",
        min = min(ess$trust_parliament, na.rm = TRUE),
        max = max(ess$trust_parliament, na.rm = TRUE),
        value = range(ess$trust_parliament, na.rm = TRUE),
        step = 1
      )
    ),
    
    ## Main panel ----
    mainPanel(
      tabsetPanel(
        type = "tabs",
        
        ### Table tab ----
        tabPanel(
          title = "Table",
          div(
            style = "height: 600px; overflow-y: auto;",
            dataTableOutput("table")
          )
        )
      )
    )
  )
)


# Server ----
server <- function(input, output, session) {
  # update slider ----
  observe({
    var <- na.omit(ess[[input$xvar]])
    is_ordered <- is.ordered(var)
    var <- as.numeric(var)
    updateSliderInput(
      inputId = "range",
      min = min(var),
      max = max(var),
      value = range(var),
      step = if (is_ordered) 1
    )
  }) %>%
    bindEvent(input$xvar)
  
  # filter data ----
  filtered <- reactive({
    req(input$countries, cancelOutput = TRUE)
    
    xvar <- input$xvar
    yvar <- input$yvar
    range <- input$range
    
    # select country
    ess <- ess[ess$country %in% input$countries, ]
    
    # select variable
    ess <- ess[c("idno", "country", xvar, yvar)]
    
    # apply range
    ess <- ess[ess[[xvar]] > range[1] & ess[[xvar]] < range[2], ]
    ess
  })
  
  # render table ----
   output$table <- renderDataTable(filtered() %>% zap_labels(), 
                                  options = list(pageLength = 5,
                                                 searching = FALSE,
                                                 paging = FALSE,
                                                 ordering = FALSE,
                                                 filtering = FALSE))
}

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


::: 








## Loading things in Shiny

### When is code run?
* When is code in a shiny app run? ([Source](https://shiny.posit.co/r/getstarted/shiny-basics/lesson5/))

* Code outside of ui and server is run once, when the app is launched.

![](resources/run-once.png)

* Code inside the server function is run once each time a user visits the app (opens the webpage).

![](resources/run-once-per-user.png)

* Code inside render functions is run each time a user changes a widget (`input$...`) that `ouput$...` depends on

![](resources/run-many-times.png)

* Where shall we load datasets?
* Where shall we load libraries?
* Where shall we load manual functions?
* What problem might occur if we place certain code wrongly ? Where would you place data management tasks?
* Where should we place code that is affected by widget choices?

::: {.callout-warning collapse="true"}

#### Insight

- If possible place anything computationally intensive outside of the render functions.
  - e.g., might make sense to estimate models/subset data beforehand if possible and access precalculated objects in reactive functions

:::



### Where to load things
* Code outside ```server <- function(input, output, session) {}``` is run once, when you launch your app
* Code inside ```server <- function(input, output, session) {}``` is run once each time a user visits your app
* Code inside ```render*``` functions is rerun constantly (not only when user changes widget value ( see [reactivity](https://shiny.posit.co/r/articles/build/understanding-reactivity/))
* That means...
    + Load **Source scripts, libraries, and data** outside of ```server``` function (at the beginning)
        + Store data in ```www/``` folder in your app directory
        + Access with ```read.table("www/swiss.csv", sep=",")```
        + Access online data by inserting the url into the ```read*``` function (e.g. ```read.table()```)
    + **User specific objects** (e.g. object that records user's session information) are defined inside shinyServer’s unnamed function, but outside of any render* calls
        + e.g. user registers himself, user data as input data (compare income)
    + **Code/objects that are affected by choices in widgets** must be placed within the a ```render*``` function
        + Shiny reruns code in a ```render*``` chunk each time a user changes a widget mentioned in the chunk
* **Avoid** placing code within render function that does not need to be there... for performance reasons!


## Data storage
- Things might get tricky for more data-hungry Shiny apps
- The way data is stored and accessed has some important implications for
    - **Memory allocation**: R stores objects in the working memory
    - **Performance**: "R does too much" - Colin Fay
    - **Readability**: Putting everything in one file might get messy
- For more sophisticated setups: **databases** (e.g., SQLite, PostgreSQL, MongoDB)
- R can work perfectly well with database connections (R Packages: DBI, dbplyr, sf) ([see overview here](https://solutions.posit.co/connections/db/))
  - SQLite works well for casually trying out databases ([see overview here](https://solutions.posit.co/connections/db/databases/sqlite/index.html))





## Summary

To build reactive shiny apps...

* Use `*Output` functions to place reactive objects in the UI (webpage)
* Use `render*` functions to let R build output objects (on the server)
    + Render functions are located in `server <- function(input, output, session) {...})` 
    + R expressions are surrounded by braces, `{}` in `render*` functions
    + Outputs of `render*` are saved in the `output` list, with one entry for each reactive object in your app
    + Reactivity by including an `input` values in a `render*` expression
* Often times you will adapt/modify [examples](http://shiny.rstudio.com/gallery/) that you find online






## Appendix: Visualizing reactivity with reactlog
- `reactlog` can be used to visualize and explore the reactivity of a Shiny app
- Below we do so for the Shiny app above (app is stored in a folder)
```{r 04-server-reactive-programming-14, eval=FALSE, echo=TRUE}
# Restart R to delete log
.rs.restartR()

library(shiny)
library(reactlog)

# tell shiny to log all reactivity
reactlog_enable()
# reactlog_disable()

# run a shiny app
runApp("C:/Users/Paul/Google Drive/13_SHINY_Workshop/shinyapps/example/app_table_tab.R")

# once app has closed, display reactlog from shiny
shiny::reactlogShow()
```











## Appendix: Imperative vs. Declarative programming and laziness

- **Imperative vs. declarative programming** ([Chapter 3.3.1](https://mastering-shiny.org/basic-reactivity.html#imperative-vs-declarative-programming))
  - **Imperative code**: "Make me a sandwich" (*"assertive" code*)
  - **Declarative code**: "Ensure there is a sandwich in the refrigerator whenever I look inside of it" (*"passive-aggressive" code*)
  - Shiny follows the latter principles
- **Laziness** as strength of **declarative programming** ([Chapter 3.3.2](https://mastering-shiny.org/basic-reactivity.html#laziness))
  - app will only ever do the minimal amount of work needed to update the output controls that you can currently see