Introduction to Shiny, Session 3

.title[
# Introduction to Shiny, Session 3
]
.subtitle[
## <html><br />
<br />
<hr color='#EB811B' size=1px width=796px><br />
</html><br />
Bioinformatics Resource Center - Rockefeller University
]
.author[
### <a href="http://rockefelleruniversity.github.io/RU_course_template/" class="uri">http://rockefelleruniversity.github.io/RU_course_template/</a>
]
.author[
### <a href="mailto:brc@rockefeller.edu" class="email">brc@rockefeller.edu</a>
]

---

# Session 3 - Improving app experience - dynamic UIs and user feedback

---

##  Recap

- Session 1 - 
    + Shiny basics
    + app layouts 
    + app theming
    
  - Session 2 -
    + Input types 
    + basic reactivity 
    + interactive plots 
    + downloading files from apps
    
  - **Session 3** - 
    + uploading files and conditional UIs 
    + observers/user feedback
    + publishing apps
    + basic debugging

---

## Upload a file

We will pick up wih the app we built in Sessions 1 and 2 (below).  This is saved as a Rscript in the 'data' folder called 'app_endSess2.R'.

The app contains some nice reactive elements, but this app would be more useful if you could use any file on your computer with differential expression results as opposed to having to change the path in our app to look at a different set of results.

We will modify our app to upload a file.

<img src="imgs/add_interactivity.png"height="350" width="450">
  
---
## Upload a file

We can use the *fileInput* function in the UI to allow the user to input a file. The 'accept' argument to limit the type of file the user can try to upload.

``` r
ui <- page_fluid(
* fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")),
  
  dataTableOutput(outputId = "all_data"),
)

server <- function(input, output){
  de_table_in <- reactive({
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
  output$all_data = renderDataTable({
    datatable(de_table_in(),
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })

}
```

---
## Upload a file

The help page for fileInput (?fileInput) explains that once a file is loaded, then the value returned to the server is a data frame, and one of the columns is the path to the temporary file path where Shiny is holding the file.

This path is used below in the *de_table_in* reactive expression to read in the dataframe.

``` r
ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
  dataTableOutput(outputId = "all_data"),
)

server <- function(input, output){
  de_table_in <- reactive({
*   rio::import(input$de_file$datapath) %>%
      dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
  output$all_data = renderDataTable({
    datatable(de_table_in(),
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })

}
```

---
## Launch app

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

---

## The req() function

In the previous UI, the user sees an error until a file is uploaded. This is because the file path is NULL and the *rio::import* function throws an error.

Shiny has a handy function *req* that can be added to a reactive context and the reactive or output function won't run if the value passed to *req* is NULL. We modify the reactive in the server function that reads in the table.

``` r
server <- function(input, output){
  
  de_table_in <- reactive({
*   req(input$de_file)
    rio::import(input$de_file$datapath) %>%
      dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
  output$all_data = renderDataTable({
    datatable(de_table_in(),
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
}
```

---

## The req() function

``` r
shinyApp(ui = ui, server = server)
```
<img src="imgs/addReq.png"height="400" width="800">

---

## Add upload to main app - UI

``` r
ui <- page_navbar(
  title = "RNAseq tools",
  theme = custom_theme,
  nav_panel(
    title = "DE Analysis",
    layout_sidebar(
      sidebar = sidebar(
        width = 300,
        # >>>>>>>>>
        fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
        # >>>>>>>>>
        numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
        
        numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
        
        actionButton("de_filter", "Apply filter"),
        br(),
        br(),
        value_box(title = "Number of genes that go up:", value = textOutput("num_up"), 
                  showcase = icon("arrow-up"), 
                  theme = value_box_theme(bg = "#22b430")), 
        value_box(title = "Number of genes that go down:", value = textOutput("num_down"), 
                  showcase = icon("arrow-down"), 
                  theme = value_box_theme(bg ="#c34020" ))
      ),
      
      layout_columns(
        navset_card_tab(
          title = "DE result tables",
          nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
          nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
        ),
        card(card_header("MA plot"),
             plotlyOutput("ma_plot"),
             downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")), 
        card(card_header("Volcano plot"),
             plotlyOutput("volcano_plot"),
             downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")), 
        col_widths = c(12,6,6), row_heights = c("750px", "500px")
      )
    )
  ),
  nav_panel(title = "Next steps","The next step in our analysis will be..."),
  nav_spacer(),
  nav_menu(title = "Links",
           align = "right",
           nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
  )
)
```

---

## Add upload to main app - server

The filtered table reactive and plot reactives use this table to apply the filtering cut offs, so we change these reactives to use this table and add de_table_in() to *bindEvent* so that they are updated when a new dataset is uploaded.

``` r
server = function(input, output) {
  
  # >>>>>>>>>>>>>>>>>>>>>>>>
  de_table_in <- reactive({ 
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  # >>>>>>>>>>>>>>>>>>>>>>>>
  
  output$all_data = renderDataTable({
    datatable(de_table_in(), # >>>>>>>>>>>>>>>>>>>>>>>>
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
  filtered_de <- reactive({
    de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
      dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
  }) %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
  
  output$de_data = renderDataTable({
    datatable(filtered_de(), 
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
  num_up_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange > 0 & padj < 0.05) %>% nrow) 
  num_down_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange < 0 & padj < 0.05) %>% nrow) 
  output$num_up <- renderText(num_up_genes())
  output$num_down <- renderText(num_down_genes())
  
  ma_plot_reac <- reactive({
    de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
      dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
      ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
      scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
      xlab("baseMean (log scale)") + theme_bw() 
  })  %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
  
  output$ma_plot = renderPlotly({
    ggplotly(ma_plot_reac())
  }) 
  
  volcano_plot_reac <- reactive({
    de_table_in() %>% # >>>>>>>>>>>>>>>>>>>>>>>>
      dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
      ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig)) +
      geom_point() +
      scale_color_manual(name = "DE status", values = c("red","grey")) + theme_bw()  
    
  }) %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) # >>>>>>>>>>>>>>>>>>>>>>>>
  
  output$volcano_plot = renderPlotly({
    ggplotly(volcano_plot_reac())
  }) 
  
  output$download_ma_plot <- downloadHandler(
    filename = function() {
      "maplot.pdf"
    },
    content = function(file) {
      ggsave(filename = file, plot = ma_plot_reac())
    }
  )
  
  output$download_volcano_plot <- downloadHandler(
    filename = function() {
      "volcanoplot.pdf"
    },
    content = function(file) {
      ggsave(filename = file, plot = volcano_plot_reac())
    }
  )
  
  
}
```

---
## Starting with an uploaded file

``` r
shinyApp(ui = ui, server = server)
```
<img src="imgs/mainApp_beforeUI.png"height="400" width="900">

---

## Using uiOutput/renderUI functions

.pull-right[
We still have empty boxes when the app starts even though we don't have any data to fill that space. There are also buttons  that don't do anything because there is no data yet. This is likely to be confusing for a user.

A nice way to deal with this is the *uiOutput* function, which allows you to change the user interface **after the app is running** based on other inputs or code in the server.

So far our user interface is set up at the start and while the contents might change based on other reactives, we haven't been able to make new inputs or outputs after the app has been started.
]

---
## Using uiOutput/renderUI functions

.pull-right[
We could improve the flow of our app by making the filter inputs in the sidebar only appear once a user has loaded in a differential table.

These filter inputs aren't relevant until the data is loaded, so we will only make them appear once the *de_table_in()* value is a dataframe, suggesting a file has been loaded and a table successfully read in.
]

---
## Using uiOutput/renderUI functions

The inputs for applying filters to our differential table are replaced with a *uiOutput* function call with an ID used in the output object in the server function This holds a location within the UI for us to eventually fill with server code.

``` r
ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
*  uiOutput("sidebar_filters_UI"),
)

server <- function(input, output){
  de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
  output$sidebar_filters_UI <- renderUI({ 
    req(de_table_in())
      div(numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
          numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
          actionButton("de_filter", "Apply filter"))
  })
}
```

---
## Using uiOutput/renderUI functions

These inputs are moved to the server within an output object paired with *renderUI* and are conditional on *de_table_in()* being a dataframe.

``` r
library(rio)

ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
   uiOutput("sidebar_filters_UI"), 
)

server <- function(input, output){
  de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
* output$sidebar_filters_UI <- renderUI({
*   req(de_table_in())
*   div(numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
*       numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
*       actionButton("de_filter", "Apply filter"))
* })
}
```

---
## The div() function

You might have noticed in the server function that we wrapped the three UI elements within *renderUI* in a div() function call.

We do this because *renderUI* will only return a single UI element. The R function *div*  will group mutliple HTML elements into one object that is compatible with *renderUI*.

If you've ever looked at HTML code, you'll notice it's containerized into chunks divided by `<div>` tags, and *div* is one of the HTML helper functions in R, grouping mutliple elements into one of these containers.

``` r
server <- function(input, output){
  de_table_in <- reactive({ 
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$sidebar_filters_UI <- renderUI({ 
    req(de_table_in()) 
*   div(
      numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
      numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
      actionButton("de_filter", "Apply filter")
*   )
  })
}
```

---
## Launch uiOutput/renderUI app

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

---
## Using uiOutput/renderUI functions

.pull-right[
We will also hide the tables and plots since they are of no use until a file is uploaded. Empty elements can confuse the user and make it seem like something is wrong.
]

---
## Using uiOutput/renderUI functions

Conditional UIs can also take advantage of more complex if statements to determine what is shown. In the example below, if no data frame is loaded, then we output a message for the user and once data is loaded, the table is shown.

``` r
ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
  
* uiOutput("all_data_UI")
)

server <- function(input, output){
  de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
* output$all_data_UI <- renderUI({
*   if(is.null(input$de_file)) {
*     div("You must load data!", style = "color: #273449; font-weight: bold;")
*   }else if(!is.null(de_table_in())){
*     navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data")))
*   }
* })
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}
```

---
## Launch uiOutput/renderUI app

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

---

## conditionalPanel

The *conditionalPanel* function can also be used for dynamic display of UI elements. It allows the defining of mutliple UI options in the UI object based on another input, so uiOutput/renderUI is not necessary.

*conditionalPanel* works well when you have multiple options that can be displayed downstream of a TRUE/FALSE input like a check box or radio button, or something with discrete and known outputs, like dropdown lists.

---

## conditionalPanel

The two important arguments are 'condition', and if this expression evaluates as TRUE, then the UI elements within the function will be displayed.

Note that the conditional statement takes a different form then we are used to, its actually a JavaScript expression. These can get complex, but generally you will be using as shown below: 'input.*inputID* is equal (==) ir not equal (!=) to a value (eg '1' for TRUE or '0' for FALSE)

We won't use this function in our app, but here is a simple example of *conditionalPanel* using a nested structure which creates a cascading set of panels.

``` r
ui <- page_fluid(
  checkboxInput("question", "Do you want to use my app?"),
  conditionalPanel(condition = "input.question == '1'",
                   selectInput("experiment", "What kind of experiment is this?",
                                choices = c("", "RNAseq", "ATACseq")),
                   conditionalPanel(condition = "input.experiment == 'RNAseq'",
                                    fileInput("file_in", "Great!, upload your RNAseq file:")),
                   conditionalPanel(condition = "input.experiment == 'ATACseq'",
                                    "Sorry, but this app won't help you"))
  
)

server = function(input, output){}
```

---

## Launch conditionalPanel app

``` r
shinyApp(ui = ui, server = server)
```
.pull-left[
<img src="imgs/cond_panel.png"height="450" width="500">
]

.pull-right[
  - When the user checks the box, the dropdown appears 
    + condtion = "input.question == '1'".
  - If the user selects RNAseq, then we let them upload a file.
    + condition = "input.experiment == 'RNAseq'"
  - If the user selects ATACseq, we give a message saying this app isn't for them. 
    + condition = "input.experiment == 'ATACseq'"
]

---

## conditionalPanel vs uiOutput

- *conditionalPanel* works nicely when the UI that you want hidden will not change how it looks based on things that are happening in the server function. 
    + In our example, we know exactly how the *selectInput*, *fileInput*, and text will look. They are fixed, but we just want them hidden and dependent on inputs that are already in the UI object.

- Once you start depending on server side logic to render your UI elements, then *uiOutput* is likely the better option. 
    + In our example, we need the reactive that reads the table to return a dataframe before we can display the table. This needs work in the server function to figure this out, so we use *uiOutput*.

- In more complicated apps that are beyond the scope of this course, you can dynamically make varying numbers of inputs based on user input, and *uiOutput* is good for this as well.

---

## Update main app

Recap of changes:

- use *uiOutput/renderUI* to make the filter inputs and button from the sidebar conditional on the table being uploaded
  - use *uiOutput/renderUI* to display a message if there is no datapath loaded and only show the DE table one a valid table is read into the app.

---
## Update main app - UI

``` r
ui <- page_navbar(
  title = "RNAseq tools",
  theme = custom_theme,
  nav_panel(
    title = "DE Analysis",
    layout_sidebar(
      sidebar = sidebar(
        width = 300,
        fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
        uiOutput("sidebar_filters_UI") # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      ),
      uiOutput("table_plots_UI"), # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    )
  ),
  nav_panel(title = "Next steps","The next step in our analysis will be..."),
  nav_spacer(),
  nav_menu(title = "Links",
           align = "right",
           nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
  )
)
```

---
## Update main app - server

``` r
server = function(input, output) {
  
  de_table_in <- reactive({
    req(input$de_file)
    file_in <- rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })

# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  output$table_plots_UI <- renderUI({
    if(is.null(input$de_file)) { 
      layout_columns("No data has been loaded! Upload a DE table with the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'", style = "color: #273449; font-weight: bold;")
    }else if(!is.null(de_table_in())){ 
      layout_columns(
        navset_card_tab(
          title = "DE result tables",
          nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
          nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
        ),
        card(card_header("MA plot"),
             plotlyOutput("ma_plot"),
             downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")), 
        card(card_header("Volcano plot"),
             plotlyOutput("volcano_plot"),
             downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")),
        col_widths = c(12,6,6), row_heights = c("750px", "500px")
      )
      }
  })
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  output$sidebar_filters_UI <- renderUI({
    req(de_table_in())
      div(
        "DE filters",
        numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
        
        numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
        
        actionButton("de_filter", "Apply filter"),
        br(),
        br(),
        value_box(title = "Number of genes that go up:", value = textOutput("num_up"), 
                  showcase = icon("arrow-up"), 
                  theme = value_box_theme(bg = "#22b430")), 
        value_box(title = "Number of genes that go down:", value = textOutput("num_down"), 
                  showcase = icon("arrow-down"), 
                  theme = value_box_theme(bg ="#c34020" ))
      )
  })
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  
  output$all_data = renderDataTable({
    datatable(de_table_in(), filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
  filtered_de <- reactive({
    de_table_in() %>% 
      dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
  }) %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)

num_up_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange > 0 & padj < 0.05) %>% nrow) 
  num_down_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange < 0 & padj < 0.05) %>% nrow) 
  output$num_up <- renderText(num_up_genes())
  output$num_down <- renderText(num_down_genes())
  
  output$de_data = renderDataTable({
    datatable(filtered_de(),
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
    ma_plot_reac <- reactive({
      de_table_in() %>% 
        dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
         ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
          scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
          xlab("baseMean (log scale)") + theme_bw()
  })  %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)

output$ma_plot = renderPlotly({
      ggplotly(ma_plot_reac())
    }) 
  
    volcano_plot_reac <- reactive({
        de_table_in() %>% 
          dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
          ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig, label = Symbol)) +
            geom_point() +
            scale_color_manual(name = "DE status", values = c("red","grey"),) + theme_bw() 
      
    }) %>%
      bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) 
  
    output$volcano_plot = renderPlotly({
      ggplotly(volcano_plot_reac())
    })
  
    # download handlers for plots
    output$download_ma_plot <- downloadHandler(
    filename = function() {
      "maplot.pdf"
    },
    content = function(file) {
      ggsave(filename = file, plot = ma_plot_reac())
    }
  )
  
  output$download_volcano_plot <- downloadHandler(
    filename = function() {
      "volcanoplot.pdf"
    },
    content = function(file) {
      ggsave(filename = file, plot = volcano_plot_reac())
    }
  )
  
}
```

---
## Update main app - launch

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

---

# User Feedback and observers

---

## Handling invalid input files

A common problem when allowing an input file is the likelihood a user uploads a file that causes an error in the app. Here we are looking for a table with speific columns, so we should confirm that the file is valid.

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

---
## Use validate function to check input file

There are a few ways to do this in Shiny, and we will introduce a new Shiny function to handle this, the *validate* function.

*Validate* prevents the alarming red error messages that are unhelpful to the user. This function can be used within a reactive expression, and the validation test is often called within a *need* function call.

*Need* takes an expression to evaluate, and if it is FALSE, then it will display a string provided in the 'message' argument in any output that depends on this reactive.

---
## Use validate function to check input file

We use *validate* in the server function to check for the key columns in the table as we know that not having these columns will cause a downstream error in the app.

``` r
ui <- page_fluid(fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), uiOutput("all_data_UI")
)

server <- function(input, output){
  de_table_in <- reactive({
    req(input$de_file)
    file_in <- rio::import(input$de_file$datapath)
*   validate(need(expr = all(c("baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj") %in% colnames(file_in)),
*                 message = "You must have the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'"))
    file_in %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  output$all_data_UI <- renderUI({
    if(is.null(input$de_file)) {
      div("You must load data!", style = "color: #273449; font-weight: bold;")
    }else if(!is.null(de_table_in())){ 
      navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data")))
    }
  })
  output$all_data = renderDataTable(datatable(de_table_in()))
}
```

---
## Use validate function to check input file

``` r
shinyApp(ui = ui, server = server)
```
<img src="imgs/validate_small.png"height="300" width="800">

---

## Observers

Sometimes we might want our app to react to a change in an input, but we don't need to return a value like *reactive* or we don't need to change one of the outputs. Maybe we want to write to a database when a button is clicked, or notify the user that something has happened.

Often the *observe* function is used for this purpose, to **perform a side effect when an input changes**.

- Like the *reactive* function or an output, *observe* **creates a reactive context** that takes dependencies on inputs or reactives. 
 - Unlike a reactive expression, an observer **does not return a value** 
 - Also different from reactive, it is **eager in its evaluation**
    + this means that it will evaluate the code **every time** a dependency changes. 
 - *bindEvent* can be used to control when it runs
 
Note: there is another function called *observeEvent* that was used in older versions of shiny, so you might see this in forums and tutorials. It still works, and is essentially the same as observe + bindEvent with different implementation.

---
## Observers - notification for user

We will add a nice message for the user to notify them that a new data set has been loaded.

To do this we use the Shiny function *showNotification*. This takes a few key arguments:
  - text that will be the message
  - 'duration' - the seconds for the notification to remain open
  - 'type' - control the color. 
  
We set 'duration' to be NULL, which means the user will have to click to close the notification, guaranteeing they will see it.

This function is within an *observe* function call in the server and takes a dependency on the input table with *bindEvent*. Notice we don't set the result to be a variable because an observer returns nothing, it just runs the code it contains.

---

## Observers - notification for user

``` r
ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
  uiOutput("all_data_UI"))

server <- function(input, output){
  de_table_in <- reactive({
    req(input$de_file)
    file_in <- rio::import(input$de_file$datapath)
  })
  
* observe({
*   showNotification("A new table has been loaded into the app!", duration = NULL, type = "message")
* }) %>%
*   bindEvent(de_table_in())
  
  output$all_data_UI <- renderUI({
    if(is.null(input$de_file)) {
      div("Load data!", style = "color: #273449; font-weight: bold;")
    }else{ navset_card_tab(nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))) }
  })
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}
```

---
## Observers - notification for user

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

---

## Modals for messages to user

Another commonly used element paired with *observe* is an modal, which is essentially a pop up window that can simply display a message to the user, or contain additional UI elements.

In the simple app below, we use the *showModal* and *modalDialog* functions within an observer that takes the button from the UI as a dependency.

``` r
ui <- page_fluid(
  
  actionButton("show_modal", 
               "Click me for modal!")
)

server <- function(input, output){
  observe({
    showModal(
      modalDialog(
        title = "The button was clicked!",
        easyClose = TRUE, 
        footer = modalButton("Dismiss")))
  }) %>% bindEvent(input$show_modal)
}
```

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

<img src="imgs/modal_button.png"height="350" width="300">
]

---

## Modals to confirm user action

Modals are often used to show additional UI elements, including user inputs, plots or tables. This can be especially useful to confirm actions that make permanent changes, such as writing to a database.

Modals can also be helpful to gather more information from the user for a particular action, and in the following app we add UI elements to the modal to get a file name from the user before downloading the file.

UI:

``` r
de_table <- read.csv("data/shP53_vs_control_DEG.csv")
de_table$negLog10_pval <- -log10(de_table$pvalue)

ui <- page_fluid(
  
  plotOutput("volcano_plot"),
  actionButton("volcano_download_modal", "Download volcano plot")
)
```

---

## Modals to confirm user action

In the server we add the UI elements to the *modalDialog* function and the use the name from the modal in the file name for download.

``` r
server <- function(input, output){
  volcano_plot_reac <- reactive(ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval, text = Symbol)) + geom_point() + theme_bw())
  
  output$volcano_plot = renderPlot(ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval, text = Symbol)) + geom_point() + theme_bw()) 
  
  observe({
    showModal(
      modalDialog(title = "Are you sure you want to download this plot? If so, provide a name for the file.",
*                 textInput("file_name", "Name for file (no extension):", value = "volcano_modal"),
*                 downloadButton("confirm_download", "Download plot"),
                  modalButton("Don't download plot"),
                  easyClose = TRUE, footer = NULL))
  }) %>% bindEvent(input$volcano_download_modal)
  
  output$confirm_download <- downloadHandler(
    filename = function() {
*     paste0(input$file_name, ".pdf")
    }, content = function(file) { 
      ggsave(filename = file, plot = volcano_plot_reac()) 
    }) 
}
```

---

## Modals to confirm user action

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

---

## Other user feedback packages

- [shinyFeedback](https://github.com/merlinoa/shinyFeedback) or [shinyValidate](https://rstudio.github.io/shinyvalidate/) to validate individual inputs
  - [shinybusy](https://cran.r-project.org/web/packages/shinybusy/vignettes/shinybusy.html) for busy spinners
  - [shinycssloaders](https://cran.r-project.org/web/packages/shinycssloaders/readme/README.html) for alerts and busy spinners
  - [Progress bars in shiny](https://shiny.posit.co/r/articles/build/progress/)
  - [Progress bars with waiter pacakge](https://waiter.john-coene.com/#/) 
---

## Update main app

Recap of changes:

- add *validate* + *need* to the reactive expression where we read in the table from the user to make sure a valid input file was used
  - add notification to user that a table has been uploaded
  - add modal dialog to confirm download and get filename
  
---
## Update main app - UI

The UI has not changed since we previously modified it, but it's shown below.

``` r
ui <- page_navbar(
  title = "RNAseq tools",
  theme = custom_theme,
  nav_panel(
    title = "DE Analysis",
    layout_sidebar(
      
      sidebar = sidebar(
        width = 300,
        fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
        uiOutput("sidebar_filters_UI") 
      ),
      uiOutput("table_plots_UI"),
    )
  ),
  nav_panel(title = "Next steps","The next step in our analysis will be..."),
  nav_spacer(),
  nav_menu(title = "Links",
           align = "right",
           nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
  )
)
```
---

## Update app with user feedback - server

``` r
server = function(input, output) {
  
  de_table_in <- reactive({
    req(input$de_file)
    file_in <- rio::import(input$de_file$datapath)
    # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    validate(
      need(expr = all(c("baseMean", "log2FoldChange", "lfcSE", "stat", "pvalue", "padj") %in% colnames(file_in)), 
           message = "You must have the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'")
    )
    # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    file_in %>% dplyr::mutate(negLog10_pval = -log10(pvalue))
  })
  
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  observe({
      showNotification("A new table has been loaded into the app!", duration = NULL, type = "message")
  }) %>%
    bindEvent(de_table_in())
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  
  output$sidebar_filters_UI <- renderUI({
    req(de_table_in())
      div(
        "DE filters",
        numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.001),
        
        numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
        
        actionButton("de_filter", "Apply filter"),
        br(),
        br(),
        value_box(title = "Number of genes that go up:", value = textOutput("num_up"), 
                  showcase = icon("arrow-up"), 
                  theme = value_box_theme(bg = "#22b430")), 
        value_box(title = "Number of genes that go down:", value = textOutput("num_down"), 
                  showcase = icon("arrow-down"), 
                  theme = value_box_theme(bg ="#c34020" ))
      )
  })
  
  output$table_plots_UI <- renderUI({
    if(is.null(input$de_file)) { 
      layout_columns("No data has been loaded! Upload a DE table with the following columns: 'baseMean', 'log2FoldChange', 'lfcSE', 'stat', 'pvalue', 'padj'", style = "color: #273449; font-weight: bold;")
    }else if(!is.null(de_table_in())){ 
      layout_columns(
        navset_card_tab(
          title = "DE result tables",
          nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
          nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
        ),
        card(card_header("MA plot"),
             plotlyOutput("ma_plot"),
             actionButton("ma_download_modal", "Download MA plot", width = "40%")),# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        card(card_header("Volcano plot"),
             plotlyOutput("volcano_plot"),
             actionButton("volcano_download_modal", "Download volcano plot", width = "40%")), # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        col_widths = c(12,6,6), row_heights = c("750px", "500px")
      )
      }
  })
  
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  observe({
    showModal(
      modalDialog(title = "Are you sure you want to download this plot? If so, provide a name for the file.",
                  textInput("file_name_ma", "Name for file (no extension):", value = "ma_plot"), 
                  downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;"),
                  br(),
                  br(),
                  modalButton("Don't download plot"),
                  easyClose = TRUE, footer = NULL))
  }) %>% 
    bindEvent(input$ma_download_modal)
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  observe({
    showModal(
      modalDialog(title = "Are you sure you want to download this plot? If so, provide a name for the file.",
                  textInput("file_name_volcano", "Name for file (no extension):", value = "volcano_plot"), 
                  downloadButton("download_volcano_plot", "Download plot", style = "width:40%;"),
                  br(), 
                  br(),
                  modalButton("Don't download plot"),
                  easyClose = TRUE, footer = NULL))
  }) %>% 
    bindEvent(input$volcano_download_modal)
  # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  
  output$all_data = renderDataTable({
    datatable(de_table_in(), filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
  
  filtered_de <- reactive({
    de_table_in() %>% 
      dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
  }) %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)

num_up_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange > 0 & padj < 0.05) %>% nrow) 
  num_down_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange < 0 & padj < 0.05) %>% nrow) 
  output$num_up <- renderText(num_up_genes())
  output$num_down <- renderText(num_down_genes())
  
  output$de_data = renderDataTable({
    datatable(filtered_de(),
              filter = 'top') %>%
      formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
      formatSignif(columns = c("pvalue", "padj"), digits = 3)
  })
  
    ma_plot_reac <- reactive({
      de_table_in() %>% 
      dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
      ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, label = Symbol)) + geom_point() +
      scale_x_log10() + scale_color_manual(name = "DE status", values = c("red", "grey")) +
      xlab("baseMean (log scale)") + theme_bw() 
  })  %>%
    bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE)

output$ma_plot = renderPlotly({
      ggplotly(ma_plot_reac())
    }) 
  
    volcano_plot_reac <- reactive({
        de_table_in() %>% 
          dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
          ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig, label = Symbol)) +geom_point() +
          scale_color_manual(name = "DE status", values = c("red","grey"),) +theme_bw()
    }) %>%
      bindEvent(input$de_filter, de_table_in(), ignoreNULL = FALSE) 
  
    output$volcano_plot = renderPlotly({
      ggplotly(volcano_plot_reac())
    })
    
    output$download_ma_plot <- downloadHandler(
    filename = function() {
      paste0(input$file_name_ma, ".pdf")
    },
    content = function(file) {
      ggsave(filename = file, plot = ma_plot_reac())
    }
  )
  
  output$download_volcano_plot <- downloadHandler(
    filename = function() {
      paste0(input$file_name_volcano, ".pdf")
    },
    content = function(file) {
      ggsave(filename = file, plot = volcano_plot_reac())
    }
  )
  
}
```

---

## Notification for user - app

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

---

## reactiveValues and reactiveVal

We will briefly introduce two more types of reactive variables that can be useful for certain use cases: *reactiveVal* and *reactiveValues*.

These differ from other reactive elements becuase they **are mutable** and **can be updated** in different parts of your app.

-  **reactiveVal** - a single reactive variable 
    + `counter <- reactiveVal(0)` - create a reactiveVal *counter* with a value of zero
    + `counter <- counter(counter+1)` - increase the value of *counter* with the current value of *counter* +1 (so now = 1)
  - **reactiveValues** - a list-like object that can store many reactive values
    + `rv <- reactiveValues(counter = 0, tracker = FALSE)` - create a reactiveValues object with two elements, *rv$counter* and *rv$tracker*.
    + `rv$counter <- rv$counter + 1` - increase value of only *rv$counter* to 1, while *rv$tracker* is unchanged. 
    + `rv$tracker <- TRUE` - change value of *rv$tracker* to TRUE

---

## reactiveValues and reactiveVal

There are many use cases for these two types of variables, and often it's more useful in more complicated apps, so we won't get into too much detail here.

Whether you use *reactiveVal* or *reactiveValues* is often a matter of personal preference as they can oftne be used to accomplish the same thing.

Here are a couple of examples of how they may be used:

-  Tracking the state of the app, for example to know how **many times** something has happened (a button click) or know **if** something key has happened.
  - If a reactive value needs to be updated in different ways by two distinct dependencies, reactiveValues and reactiveVal can be used. 
    + See the next slide for an example of this.

---

## reactiveValues example

We have a simple app where the user is generating a list of genes of interest as they go through the app. We have a button to add a gene to this list and another to remove a gene from this list.

A reactiveVal or reactiveValues object makes it easy to modify this gene list, and importantly, they are reactive and can be used in reactive contexts (see server function)

``` r
de_table <- read.csv("data/shP53_vs_control_DEG.csv")

ui <- page_fluid(
  
  dataTableOutput(outputId = "all_data"),
  actionButton("add_gene", "Add gene to list"),
  actionButton("remove_gene", "Remove gene from list"),
  br(),
  br(),
  textOutput("selected_gene_info")
)
```

---

## reactiveValues example

We make two separate observers that make distinct modifications to the reactiveValues object *rv$genes*.

``` r
server <- function(input, output){
  # initialize the reactiveValues object
* rv <- reactiveValues(genes = character())
  
  output$all_data = renderDataTable(datatable(de_table, selection = "single", filter = 'top'))
  
  observe({
    selected_gene <- de_table[input$all_data_rows_selected, "Symbol"]
*   rv$genes <- c(rv$genes, selected_gene)
  }) %>% bindEvent(input$add_gene) # observer when 'add_gene' button is pressed

observe({
    selected_gene <- de_table[input$all_data_rows_selected, "Symbol"]
*   rv$genes <- rv$genes[!rv$genes == selected_gene]
  }) %>% bindEvent(input$remove_gene) # observer when 'remove_gene' button is pressed
  
  output$selected_gene_info <- renderText({
    paste0("The selected genes are ", paste(rv$genes, collapse = ", ")) 
  })
}
```

---

## reactiveValues example

Then because *rv$genes* is reactive, using it within *output$selected_gene_info* will trigger that output to change as we add and remove genes.

``` r
server <- function(input, output){
  
  rv <- reactiveValues(genes = character())
  
  output$all_data = renderDataTable(datatable(de_table, selection = "single", filter = 'top'))
  
  observe({
    selected_gene <- de_table[input$all_data_rows_selected, "Symbol"]
    rv$genes <- c(rv$genes, selected_gene) 
  }) %>% bindEvent(input$add_gene)
    
  observe({
    selected_gene <- de_table[input$all_data_rows_selected, "Symbol"]
    rv$genes <- rv$genes[!rv$genes == selected_gene] 
  }) %>% bindEvent(input$remove_gene)
  
  output$selected_gene_info <- renderText({ 
*   paste0("The selected genes are ", paste(rv$genes, collapse = ", "))
  }) 
}
```

---

## reactiveValues example

``` r
shinyApp(ui, server)
```

---

## Publishing apps on shinyapps.io

While it may be useful to simply have a Shiny app on your computer that you can run and analyze data locally, you might also want to publish the app in order to share with others, or allow you to access it anywhere.

Posit (aka RStudio) provides the opportunity to deploy apps for free on [shinyapps.io](https://www.shinyapps.io/), which is nicely integrated into RStudio. The free version allows for a limited number of apps and not much memory, but is a good place to get started. We will go through a simple deployment.

We first need to install and load the *rsconnect* package.

``` r
library(rsconnect)
```

---

## Publishing apps on shinyapps.io

It is then necessary to make an account on [shinyapps.io](https://www.shinyapps.io/), and then use the *rsconnect* package to connect RStudio to the shinyapps.io account.

First the token from shinyapps.io needs to be retrieved:

---

## Publishing apps on shinyapps.io

After running the command copied from shinyapps.io that includes the token and secret, we can then publish our app.

If you have a valid app file open, right next to the 'Run App' button, there is another button that allows you to publish the app. The shinyapps.io account that you just linked should be there for deployment.

---

## Publishing apps on shinyapps.io

The *rsconnect* package will then bundle the app and any packages the app uses. After some time, the log in the 'Deploy' tab in the RStudio console (bottom of IDE) will indicate sucessful deployment and the app should appear on shinyapps.io with a valid and public URL.

---

## Debugging

Debugging can be tricky in Shiny apps due to the fact that the code is not run sequentially and you aren't actually running the code yourself, it's run in the background as the app is running. Especially once you have a lot of reactivity finding the exact source of the bug can be challenging.

You'll find the ways that work best for you, but two common strategies I use are the following:
  - print variables to the screen within an *observe* function or within specific reactives
  - use the *browser* function

---

## Debugging

Here is an app that contains a couple simple bugs and opportunities for optimization where these strategies can be helpful. This app exists as a file called 'app_debug.R' in the data folder of the course.

``` r
ui <- page_fluid(
  fileInput("de_file", "Upload a DE file", accept = c(".csv", ".tsv", "xlsx", "xls")), 
  uiOutput("all_data_UI")
)

server <- function(input, output){

de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$all_data_UI <- renderUI({ 
    req(de_table_in)
    card(card_header("All genes"), dataTableOutput(outputId = "all_data"))
  }) 
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}

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

---

## Debugging

Two bugs are apparent:

---

# Upload error - print to screen

Usually bugs with reasonable errors printed to the console are easier to debug, so we will start there. Here is the error form the console:
<img src="imgs/uploadBug.png"height="200" width="700">

If you think you know the variable causing the bug, then printing it to the screen is one way to peek inside the app and look at it. We can tell from the error in the console that it's occurring in the *de_table_in* reactive and some kind of issue with a 'file' argument. It must be a problem with the command `rio::import(input$de_file)`

---

# Upload error - print to screen

You can use the *observe* function to print a reactive variable, like *input$de_file*, and every time it changes, the observer will run and the variable will print to the screen.

``` r
# UI object not shown
server <- function(input, output){

observe({
*   print("file_path")
*   print(input$de_file)
  }) 
  
  de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$all_data_UI <- renderUI({ 
    req(de_table_in)
    card(card_header("All genes"), dataTableOutput(outputId = "all_data"))
  }) 
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}

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

---

# Upload error - print to screen

From the console, we can see that the variable *input$de_file* is a dataframe, not a file path like we need for this command. We then remember that we actually want *input$de_file$datapath*.

---

# Upload error - print to screen

We could also put the *print* function within the specific reactive context where we think it breaks, in this case the *de_table_in()* reactive.

Sometimes you might want to know the value of *input$de_file* only within this reactive and this would be the best strategy, and sometimes you might want to track how its changing as the user goes through the app, and printing within an *observe* function might be more useful.

``` r
# UI object not shown
server <- function(input, output){
  
  de_table_in <- reactive({
    req(input$de_file)
*   print("file_path")
*   print(input$de_file)
    rio::import(input$de_file) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$all_data_UI <- renderUI({ 
    req(de_table_in)
    card(card_header("All genes"), dataTableOutput(outputId = "all_data"))
  }) 
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}

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

---

## Upload error - browser

The browser in R, called with the function *browser()* is a really useful way to debug functions and Shiny apps. In both cases, code is being run within a contained environment without you running it line by line.

By inserting *browser()* into an app or function, the code execution will pause, allowing you to manually run code **within the environment of the app**. So any temporary variables available to that function or Shiny app can be viewed.

Note: the browser won't work properly if you are running this within an R markdown chunk, so open up the demo app ('app_debug.R') and run the app using the 'runApp' button at the top right.

---

## Upload error - browser

We insert a *browser* function call within the *de_table_in* reactive, and when we run this (run in separate script), after a file is uploaded we can go into the console and run code from within the app environment.

``` r
# UI object not shown
server <- function(input, output){

de_table_in <- reactive({
    req(input$de_file)
*   browser()
    rio::import(input$de_file) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$all_data_UI <- renderUI({ 
    req(de_table_in)
    card(card_header("All genes"), dataTableOutput(outputId = "all_data"))
  }) 
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}

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

---

## Upload error - browser

By printing *input$de_file* within the browser, its clear that we need to change it to *input$de_file$datapath*

---

## uiOutput error - browser

The second bug is trickier because there is no error. A version of this app with the upload bug from above fixed is in the 'data' folder of the course materials called 'app_debug2.R'. Run this script with the 'Run App' button to see the bug.

<img src="imgs/bug_descriptions2.png"height="450" width="800">
---

## uiOutput error - browser

We don't have an error to pinpoint where in our app the bug exists, but since the card is appearing inappropriately, we can assume it's an issue in the *renderUI* function that renders the card.

Similar to the last bug, we can insert a *browser* function call within *renderUI* and every time that funciton is run, we will know and can explore the issue.

``` r
# UI object not shown
server <- function(input, output){

de_table_in <- reactive({
    req(input$de_file)
    rio::import(input$de_file$datapath) %>% dplyr::mutate(negLog10_pval = -log10(pvalue))})
  
  output$all_data_UI <- renderUI({ 
    req(de_table_in)
*   browser()
    card(card_header("All genes"), dataTableOutput(outputId = "all_data"))
  }) 
  
  output$all_data = renderDataTable(datatable(de_table_in()))
}

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

---

## uiOutput error - browser

.pull-left[
In the browser we are able to look at the *de_table_in* variable we have used in *req()* a d notive that it's a function, not a table as we intended.

It's clear now that we forgot to add the parenthesis required to get the actual value from the reactive. We have returned the reactive function itself. Because this is not null, the *req()* function was satisfied and the card was rendered.

The old line of code `req(de_table_in)` should be changed to `req(de_table_in())`.
]

---
## Further Resources

- [Mastering Shiny book](https://mastering-shiny.org/index.html)
- [The Shiny cheatsheet](https://shiny.posit.co/r/articles/start/cheatsheet/)
- [More widgets](https://dreamrs.github.io/shinyWidgets/)

---
## Contact

Any suggestions, comments, edits or questions (about content or the slides themselves) please reach out to our [GitHub](https://github.com/RockefellerUniversity/Intro_to_Shiny/issues) and raise an issue.

---
## Time for an exercise!

Exercises for Session 3 are [here](../../exercises/exercises/shiny_exercise3_exercise.html)

---
## Answers to exercise

Answers can be found [here](../../exercises/answers/shiny_exercise3_answers.html)

R code for solutions can be found [here](../../exercises/answers/shiny_exercise3_answers.R)