RShiny Lab: Part II
Workshop on Plotting in R
Lokesh Mano • 18-Jan-2022
1 Reactivity
We will here first look into the example of what the automatic reactivity of Rshiny looks like. The reactive functions like renderPlot() and renderPrint() are always looking for any changes in the input values and are updated quickly! Although this is super handy for any app, sometimes this can lead to unwanted confusion. Like, take the R function rnorm(), this function basically spits out random numbers. If you use this function in an app, everytime this function is called, it will output different random number sets. This can cause problems like in the example below:
Task Try to change the slider input values and check if the summary and hist match with each other?
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
plotOutput("hist"),
verbatimTextOutput("stats")
)
server <- function(input, output) {
output$hist <- renderPlot({
hist(rnorm(input$num))
})
output$stats <- renderPrint({
summary(rnorm(input$num))
})
}
shinyApp(ui = ui, server = server)plot
So, in order to make it consistent, we have to use the rnorm() only once and save it as a reactive function and then apply it to both the hist() and summary(). We do this by using reactive() function to store it as a variable. See the example below:
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
plotOutput("hist"),
verbatimTextOutput("stats")
)
server <- function(input, output) {
data <- reactive({
rnorm(input$num)
})
output$hist <- renderPlot({
hist(data())
})
output$stats <- renderPrint({
summary(data())
})
}
shinyApp(ui = ui, server = server)plot
Note As the data variable we have in the example above is a reactive function, you have to remember to use () whenever you call that particular variable.
2 Isolating reactivity
In the same manner as above, sometimes you will notice that the Rshiny’s reactivity can be very quick! Take the below example and try to type in the title of the histogram slowly. You will notice that the histogram will keep changing as you type, because the rnorm() gets updated constantly as you type!
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
textInput(inputId = "title",
label = "Write a title",
value = "Histogram of Random Normal Values"),
plotOutput("hist")
)
server <- function(input, output) {
output$hist <- renderPlot({
hist(rnorm(input$num), main = input$title)
})
}
shinyApp(ui = ui, server = server)plot
By using the isolate() function, we can make certain UI input components to not react for changes! This means you can change/decide the title of the plot first and then you can change the slider in the example above to decide on the histogram you want for a particular value!
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
textInput(inputId = "title",
label = "Write a title",
value = "Histogram of Random Normal Values"),
plotOutput("hist")
)
server <- function(input, output) {
output$hist <- renderPlot({
hist(rnorm(input$num), main = isolate(input$title))
})
}
shinyApp(ui = ui, server = server)plot
3 eventReactive()
This is similar to the observeEvent(), where it is used to send message like logs when you click on a button.
In the following example, we will see how to use eventReactive() with an action button and when you press it, the random numbers are only generated then. You can think of it as an update button. Let us look at the example below:
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
textInput(inputId = "title",
label = "Write a title",
value = "Histogram of Random Normal Values"),
plotOutput("hist"),
actionButton(inputId = "click", label = "Update")
)
server <- function(input, output) {
randomVals <- eventReactive(input$click, {
rnorm(input$num)
})
output$hist <- renderPlot({
hist(randomVals(), main = input$title)
})
}
shinyApp(ui = ui, server = server)plot
4 Updating widgets
Widgets can be updated with new values dynamically. observe() and observeEvent() functions can monitor the values of interest and update relevant widgets.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",choices=c("mtcars","faithful","iris")),
selectInput("header_input",label="Select column name",choices=NULL),
plotOutput("plot_output",width="400px")
),
server=function(input,output,session) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
observe({
updateSelectInput(session,"header_input",label="Select column name",choices=colnames(getdata()))
})
output$plot_output <- renderPlot({
#shiny::req(input$header_input)
#validate(need(input$header_input %in% colnames(getdata()),message="Incorrect column name."))
hist(getdata()[, input$header_input],xlab=input$header_input,main=input$data_input)
})
},
options=list(height=600))plot
In this example, the user selects a dataset and a column from the selected dataset to be plotted as a histogram. The column name selection widget must automatically update it’s choices depending on the selected dataset. This achieved using observe() where the updateSelectInput() function updates the selection choices. Notice that a third option session is in use in the server function. ie; server=function(input,output,session). And session is also the first argument in updateSelectInput(). Session keeps track of values in the current session.
When changing the datasets, we can see that there is a short red error message. This is because, after we have selected a new dataset, the old column name from the previous dataset is searched for in the new dataset. This occurs for a short time and causes the error. This can be fixed using careful error handling. We will discuss this in another section.
5 Error validation
Shiny returns an error when a variable is NULL, NA or empty. This is similar to normal R operation. The errors show up as bright red text. By using careful error handling, we can print more informative and less distracting error messages. We also have the option of hiding error messages.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input,'package:datasets') })
output$table_output <- renderTable({head(getdata())})
},
options=list(height="350px"))plot
In this example, we have a list of datasets to select which is then printed as a table. The first and default option is an empty string which cannot be printed as a table and therefore returns an error.
We can add an extra line to the above app so that the selected string is validated before running downstream commands in the getdata({}) reactive function. The function validate() is used to validate inputs. validate() can be used with need() function or a custom function.
Below we use the need() function to check the input. It checks if the input is NULL, NA or an empty string and returns a specified message if TRUE. try() is optional and is used to catch any other unexpected errors.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
validate(need(try(input$data_input),"Please select a data set"))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
},
options=list(height="350px"))plot
Now we see an informative grey message (less scary) asking the user to select a dataset.
We can use a custom function instead of using need(). Below, we have created a function called valfun() that checks if the input is NULL, NA or an empty string. This is then used in validate().
valfn <- function(x) if(is.null(x) | is.na(x) | x=="") return("Input data is incorrect.")
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
validate(valfn(try(input$data_input)))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
},
options=list(height="350px"))plot
The last option is to simple hide the error. This may be used in situations where there is no input needed from the user. We use req() to check if the input is valid, else stop execution there till the condition becomes true.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("","mtcars","faithful","iris")),
tableOutput("table_output")
),
server=function(input, output) {
getdata <- reactive({
shiny::req(try(input$data_input))
get(input$data_input,'package:datasets')
})
output$table_output <- renderTable({head(getdata())})
},
options=list(height="350px"))plot
As expected there is no error or any message at all. This is not always the best to use this option as we need the user to do something. An informative message may be better than nothing.
Finally, instead of printing messages about the error or hiding the error, we can try to resolve the errors from the previous section in a more robust manner. shiny::req(input$header_input) is added to ensure that a valid column name string is available before running any of the renderPlot() commands. Second, we add validate(need(input$header_input %in% colnames(getdata()),message="Incorrect column name.")) to ensure that the column name is actually a column in the currently selected dataset.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",choices=c("mtcars","faithful","iris")),
selectInput("header_input",label="Select column name",choices=NULL),
plotOutput("plot_output",width="400px")
),
server=function(input,output,session) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
observe({
updateSelectInput(session,"header_input",label="Select column name",choices=colnames(getdata()))
})
output$plot_output <- renderPlot({
shiny::req(input$header_input)
validate(need(input$header_input %in% colnames(getdata()),message="Incorrect column name."))
hist(getdata()[, input$header_input],xlab=input$header_input,main=input$data_input)
})
},
options=list(height=600))plot
Now, we do not see any error messages. Note that shiny apps on shinyapps.io do not display the complete regular R error message for security reasons. It returns a generic error message in the app. One needs to inspect the error logs to view the actual error message.
6 Download • Data
It is often desirable to let the user down data tables and plots as images. This is done using downloadHandler().
In the example below, we are downloading a table as a csv text file. We define a button that accepts the action input from the user. The downloadHandler() function has the file name argument, and the content argument where we specify the write.csv() command. Note that this example needs to be opened in a browser and may not in the RStudio preview. In the RStudio preview, click on Open in Browser.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("mtcars","faithful","iris")),
textOutput("text_output"),
downloadButton("button_download","Download")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
output$text_output <- renderText(paste0("Selected dataset: ",input$data_input))
output$button_download <- downloadHandler(
filename = function() {
paste0(input$data_input,".csv")
},
content = function(file) {
write.csv(getdata(),file,row.names=FALSE,quote=F)
})
},
options=list(height="200px")
)plot
7 Download • Plot
In this next example, we are downloading a plot. In the content part of downloadHandler(), we specify commands to export a png image. Note that this example needs to be opened in a browser and may not in the RStudio preview. In the RStudio preview, click on Open in Browser.
shinyApp(
ui=fluidPage(
selectInput("data_input",label="Select data",
choices=c("mtcars","faithful","iris")),
textOutput("text_output"),
plotOutput("plot_output",height="300px",width="300px"),
downloadButton("button_download","Download")
),
server=function(input, output) {
getdata <- reactive({ get(input$data_input, 'package:datasets') })
output$text_output <- renderText(paste0("Selected dataset: ",input$data_input))
output$plot_output <- renderPlot({hist(getdata()[,1])})
output$button_download <- downloadHandler(
filename = function() {
paste0(input$data_input,".png")
},
content = function(file) {
png(file)
hist(getdata()[, 1])
dev.off()
})
},
options=list(height="500px")
)plot
8 Shiny in Rmarkdown
Shiny interactive widgets can be embedded into Rmarkdown documents. These documents need to be live and can handle interactivity. The important addition is the line runtime: shiny to the YAML matter. Here is an example:
output
---
runtime: shiny
output: html_document
---
```{r}
library(shiny)
```
This is a standard RMarkdown document. Here is some code:
```{r}
head(iris)
```
```{r}
plot(iris$Sepal.Length,iris$Petal.Width)
```
But, here is an interactive shiny widget.
```{r}
sliderInput("in_breaks",label="Breaks:",min=5,max=50,value=5,step=5)
```
```{r}
renderPlot({
hist(iris$Sepal.Length,breaks=input$in_breaks)
})
```This code can be copied to a new file in RStudio and saved as, for example, shiny.Rmd. Then click ‘Knit’. Alternatively, you can run rmarkdown::run("shiny.Rmd").
9 Session info
sessionInfo()## R version 4.1.2 (2021-11-01)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 18.04.6 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/libopenblasp-r0.2.20.so
##
## locale:
## [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
## [4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
## [7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
## [10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] shiny_1.7.1 ggimage_0.3.0 treeio_1.18.1
## [4] ggtree_3.2.1 pheatmap_1.0.12 leaflet_2.0.4.1
## [7] swemaps_1.0 mapdata_2.3.0 maps_3.4.0
## [10] ggpubr_0.4.0 cowplot_1.1.1 ggthemes_4.2.4
## [13] scales_1.1.1 ggrepel_0.9.1 wesanderson_0.3.6
## [16] forcats_0.5.1 stringr_1.4.0 purrr_0.3.4
## [19] readr_2.1.1 tidyr_1.1.4 tibble_3.1.6
## [22] tidyverse_1.3.1 reshape2_1.4.4 ggplot2_3.3.5
## [25] formattable_0.2.1 kableExtra_1.3.4 dplyr_1.0.7
## [28] lubridate_1.8.0 yaml_2.2.1 fontawesome_0.2.2.9000
## [31] captioner_2.2.3 bookdown_0.24 knitr_1.37
##
## loaded via a namespace (and not attached):
## [1] colorspace_2.0-2 ggsignif_0.6.3 ellipsis_0.3.2
## [4] fs_1.5.2 aplot_0.1.2 rstudioapi_0.13
## [7] farver_2.1.0 fansi_1.0.2 xml2_1.3.3
## [10] splines_4.1.2 cachem_1.0.6 jsonlite_1.7.3
## [13] broom_0.7.11 dbplyr_2.1.1 compiler_4.1.2
## [16] httr_1.4.2 backports_1.4.1 assertthat_0.2.1
## [19] Matrix_1.3-4 fastmap_1.1.0 lazyeval_0.2.2
## [22] cli_3.1.0 later_1.3.0 leaflet.providers_1.9.0
## [25] htmltools_0.5.2 tools_4.1.2 gtable_0.3.0
## [28] glue_1.6.0 Rcpp_1.0.8 carData_3.0-5
## [31] cellranger_1.1.0 jquerylib_0.1.4 vctrs_0.3.8
## [34] ape_5.6-1 svglite_2.0.0 nlme_3.1-153
## [37] crosstalk_1.2.0 xfun_0.29 ps_1.6.0
## [40] rvest_1.0.2 mime_0.12 lifecycle_1.0.1
## [43] rstatix_0.7.0 promises_1.2.0.1 hms_1.1.1
## [46] parallel_4.1.2 RColorBrewer_1.1-2 curl_4.3.2
## [49] gridExtra_2.3 ggfun_0.0.4 yulab.utils_0.0.4
## [52] sass_0.4.0 stringi_1.7.6 highr_0.9
## [55] tidytree_0.3.7 rlang_0.4.12 pkgconfig_2.0.3
## [58] systemfonts_1.0.3 evaluate_0.14 lattice_0.20-45
## [61] patchwork_1.1.1 htmlwidgets_1.5.4 labeling_0.4.2
## [64] processx_3.5.2 tidyselect_1.1.1 plyr_1.8.6
## [67] magrittr_2.0.1 R6_2.5.1 magick_2.7.3
## [70] generics_0.1.1 DBI_1.1.2 pillar_1.6.4
## [73] haven_2.4.3 withr_2.4.3 mgcv_1.8-38
## [76] abind_1.4-5 modelr_0.1.8 crayon_1.4.2
## [79] car_3.0-12 utf8_1.2.2 tzdb_0.2.0
## [82] rmarkdown_2.11 grid_4.1.2 readxl_1.3.1
## [85] callr_3.7.0 reprex_2.0.1 digest_0.6.29
## [88] webshot_0.5.2 xtable_1.8-4 httpuv_1.6.5
## [91] gridGraphics_0.5-1 munsell_0.5.0 viridisLite_0.4.0
## [94] ggplotify_0.1.0 bslib_0.3.1