Learn how to create and publish interactive web applications
shiny
dashboard
quarto
website
map
reactive
presentation
revealsj
These are the best sessions, bringing together all the tools from previous sessions to create interactive apps. You’ll learn how to build and publish Shiny dashboards and RevealJS presentations.
Author
Nelson Amaya
Published
July 31, 2022
Modified
November 21, 2024
“The internet broke the private-public wall; impulsive and inelegant utterances that used to be kept private are now available for literal interpretation.” – N. N. Taleb
One of the best things about working with R is publishing your work online. The possibilities are endless: blogs, books, articles, games, dashboards can all be published from R. You already know Quarto is a great builder of HTML and interactive content.
In these final sessions you will learn how to build apps. Let’s get started.
PART I: The real beauty of R
My favorite tool is Shiny for a simple reason –immediacy. Shiny allows full and immediate interactivity between inputs and outputs. It is very simple to build and quite flexible in structure, but in general every Shiny app has two parts: The User Interface, the face, and the Server, the brain. The user makes choices in the user interface over inputs, which are sent to the server to be calculated or reflected into outputs, which are then displayed in the user interface.
Open a free Shinyapps.io account to host your app online
💔 Two apps on infidelity for the price of one
We’ll build 2 apps on the same data using different options, just to showcase how versatile Shiny is. We’ll use data from a survey carried out in 1969: 601 married adults were asked about infidelity –a difficult topic to inquire because people probably are not super honest about their responses.
App I 🎬: page_sidebar
The first app is simple, a bit boring. The User Interface (UI) for a shiny dashboard with a sidebar starts with page_sidebar() and includes a sidebar() where inputs usually go. In the sidebar we include a selectInput() function that will filter the data by self-declared level of happiness in the marriage by respondents. Also in the sidebar we include our first output: a reference plot with the levels of happiness of all respondents, that we call plotOutput("happiness"). We use a Boostwatch theme, just as you use for your blog.
The body of the app is defined directly with a card() object, that boxes any element you include inside, and where we add our expected output: a plotOutput() object where our filtered graph will be displayed.
Let’s build a very simple sidebar dashboard for some data on cheating. The app will show how many cheating “incidents” happened in the sample by gender and age, according to self-declared happiness.
Click me!
# Packages neededlibrary(shiny)library(RColorBrewer)library(tidyverse)library(bslib)# Data #affairs_1969 <- readr::read_csv("https://raw.githubusercontent.com/vincentarelbundock/Rdatasets/master/csv/AER/Affairs.csv") |> dplyr::mutate(happy =case_when(rating==1~"very unhappy", rating==2~"somewhat unhappy", rating==3~"average", rating==4~"happier than average", rating==5~"very happy")) dplyr::mutate(happy =fct_reorder(happy, rating),cheat =factor(ifelse(affairs==0,"Faithful","Cheater")))# Define simple User Interface ####ui_affair <-page_sidebar(# We start with the header with a titletitle ="Fair's Affairs 1969",# Color theme for the dashboardtheme = bslib::bs_theme(bootswatch ="litera" ),# Now we define the sidebarsidebar =sidebar(width =350,p("A survey with 601 respondents (315 female/286 male) on extra-marital affairs"),plotOutput("happiness", height ="150px"),# SelectorselectInput(inputId ="happy",label ="Select self-evaluation of marriage:",choices =unique(affairs_1969$happy),selected ="average") ),# Finally we define the body of the resultplotOutput("affairs") )# Define the server function inputs and outputs ####server_affair <-function(input, output) {# Plot without selection output$happiness <-renderPlot({ affairs_1969 %>% dplyr::count(happy) |>ggplot(aes(y=happy,x=n,fill=happy))+geom_col()+geom_label(aes(label=n), fill="white",color="black",nudge_x =-10)+scale_fill_viridis_d(name ="turbo", direction=1)+labs(x=NULL, y=NULL)+theme_classic()+theme(legend.position ="none") })# Plot with selection output$affairs <-renderPlot({ affairs_1969 %>% dplyr::filter(happy==print(input$happy)) |> dplyr::group_by(gender,age) |> dplyr::count(cheat) |>ggplot(aes(x=age,y=n,fill=gender))+geom_col()+geom_label(aes(label=n), fill="black",color="white", vjust=-0.5)+ylim(c(0,80))+facet_grid(gender~cheat)+scale_fill_brewer(palette ="Set1")+scale_color_viridis_d()+theme_classic()+theme(text=element_text(size=18), legend.position ="none")+labs(title ="Respondents by self-declared happiness, by age and gender",subtitle =paste("Among", input$happy, "respondents"),x="Respondent age",y="# respondents") }) }# Run App ####shinyApp(ui=ui_affair, server = server_affair)
1
We first download the data from the GitHub repository
2
We code new variables: happy using the case_when() function, factoring using fct_reorder(), and cheat to count respondents who cheated and also factor.
3
First part we define the page_sidebar structure
4
We use p() to write Markdown text
5
First output: plotOutput. We call it happiness
6
We use a selectInput object to filter the data in the graph
7
Another output as a plotOutput and call it affairs
8
We define the server function, with inputs and outputs
9
We recall the output in the UI that we called happiness, and use the output renderOutput to produce the plot. This plot is independent of the selectInput
10
We recall the output in the UI that we called affairs, and use the output renderOutput to produce the plot. This plot is affected by decisions in the selectInput
11
Here is where the UI and server connect: the input$happy filters the data in the graph and also changes the subtitle in labs(), as they are both affected by the selectInput choice.
12
We combine the UI and server objects we created in the shinyApp() function and watch the magic unfold
App 2 🎬: page_navbar
The second app is fancier, has more elements, more interactivity, and better design principles.
First we start with a webpage layout –a navigation bar defined by page_navbar from the bslib package. We theme the app just as we did the blog using Bootswatch. We can define more element, like foreground and background colors of the colors of buttons.
The UI ui_affair_alt has a navigation bar at the top with two tabs: “Happy cheaters?” and “Who cheated?”. Each tab is defined using the tabPanel() function, and has a title, an icon from the font-awesome library, and card() elements that holds the content of the tab. It also includes a uiOutputvalue_box() that can be clicked to see in full-screen mode. The content of the value_box() will be defined in the server. In the tabs, there are different input elements such as selectInput and switchInput from the shinyWidgets package, allowing the user to make selections and toggle switches to customize the displayed data.
Output elements include girafeOutput, for interactive plots, a dataTableOutput that produces interactive tables, and a simple pair of plotOutput.
The server function server_affair_alt, defines the logic and calculations for the Shiny app. The renderGirafe function generates interactive girafe plots based on the user’s selection and filters the data accordingly using dplyr functions such as filter(), group_by(), and count(). Using girafe in Shiny gives us additional options using the opts_selected(), like clicking on parts of the graph that are then filtered into a table because girafe saves the selection in input$outpuname_selected for the variable defined in the data_id. The renderDataTable function creates a data table using the DT package, and filters the data based on the selected values from the girafe. This feature makes girafe one of the most powerful packages to work with in Shiny.
In the second tab we include 2 renderPlot that react to the user’s button selection. There is a better way of approaching the problem of multiple inputs outputs that interact with one another called reactivity, which we will see in the next example.
For now let’s see the code and the resulting app:
Click me!
# Packages needed ####library(shiny)library(shinydashboard)library(RColorBrewer)library(tidyverse)library(bslib)library(bsicons)library(shinyWidgets)library(ggiraph)library(viridis)library(DT)library(fontawesome)library(htmltools)# Data ####affairs_1969 <- readr::read_csv("https://raw.githubusercontent.com/vincentarelbundock/Rdatasets/master/csv/AER/Affairs.csv") |> dplyr::mutate(happy =case_when(rating==1~"very unhappy", rating==2~"somewhat unhappy", rating==3~"average", rating==4~"happier than average", rating==5~"very happy")) |> dplyr::mutate(happy =fct_reorder(happy, rating)) |> dplyr::mutate(cheat=factor(ifelse(affairs==0,"Faithful","Cheater"))) # Define User Interface ####{ui_affair_alt <-page_navbar(# Page options ####title ="Fair's Affairs 1969",footer ="R4DEV",theme = bslib::bs_theme(bootswatch ="united",bg ="white",fg ="purple",success ="red",danger ="orange",base_font ="News Cycle",font_scale =1.1 ),# First panel ####tabPanel(title ="Happy cheaters?",icon =icon("heart-crack", lib ="font-awesome"), layout_column_wrap(width =1/2,uiOutput("cheating_rate"),card(card_header("Survey from 1969 in Psychology Today"),card_body(p("Was cheating more likely in unhappy marriages?"),p("Were most educated couples more or less likely to have an unfaithful partner?"),p("What about couples with children?") ) )),layout_column_wrap(width=1/2,card(full_screen =TRUE,card_header(selectInput(inputId ="happy",label ="Select respondents by self-evaluation of marriage:",choices =unique(affairs_1969$happy),selected ="average") ),girafeOutput("affairs") ),card(full_screen =TRUE,card_header("Respondents:"), DT::dataTableOutput("table") ))),# Second panel #### tabPanel(title ="Who cheated?",icon =icon("triangle-exclamation", lib ="font-awesome"),layout_column_wrap(width=1/2,height ="150px",uiOutput("cheating_children"),card(card_header("Who cheated more frequently?"),card_body( shinyWidgets::switchInput(inputId ="children",label ="Respondent has children?",value =FALSE,onLabel ="Yes",offLabel ="No",onStatus ="success",offStatus ="danger") ))),layout_column_wrap(width =1/2,card(full_screen =TRUE,card_header("By years of education"),card_body(plotOutput("affairs_edu") )),card(full_screen =TRUE,card_header("By years of marriage"),card_body(plotOutput("affairs_years") )))))}# Define the server function ####server_affair_alt <-function(input, output) {# First tab ###### Cheating rate value box #### output$cheating_rate <-renderUI({value_box(title ="Cheating rate in the sample:",height ="200px",value = affairs_1969 |> dplyr::count(cheat) |> dplyr::mutate(sample =sum(n)) |> dplyr::transmute(cheat_rate = scales::percent(n/sample)) |> dplyr::slice(1) |>as.character(),showcase = bsicons::bs_icon("heart-pulse-fill"), p("Infidelity varies by age, occupation, children and years of marriage"),full_screen =TRUE,theme_color ="success" ) })## Plot #### output$affairs <-renderGirafe({ affairs_gg <- affairs_1969 |> dplyr::filter(happy==input$happy) |> dplyr::count(cheat,gender,age) |>ggplot(aes(x=age,y=n,fill=cheat,data_id=age, tooltip=paste0("Type: ", cheat,"<br>Respondents: ", n,"<br>Age: ", age)))+ ggiraph::geom_col_interactive()+theme_classic()+facet_wrap(gender~cheat)+scale_fill_viridis_d("plasma")+theme(legend.position ="none")+labs(title ="Respondents by self-declared happiness, by age and gender",subtitle =paste("Among", input$happy, "respondents"),x="Respondent age",y="# respondents") ggiraph::girafe(ggobj = affairs_gg,opts_selection(type ="multiple")) })## Table #### output$table <- DT::renderDataTable({ affairs_1969 |> dplyr::filter(happy==input$happy) %>% dplyr::group_by(cheat,age) |> dplyr::mutate(n=n()) |> dplyr::filter(age %in% input$affairs_selected) |> dplyr::ungroup() |> dplyr::select(affairs, age, education,children, happy, n) })# Second tab ###### Value box #### output$cheating_children <-renderUI({value_box(title ="How many respondents who cheated had children?",height ="200px",value = affairs_1969 |> dplyr::filter(children=="yes") |> dplyr::count(cheat) |> dplyr::mutate(sample =sum(n)) |> dplyr::transmute(cheat_rate = scales::percent(n/sample)) |> dplyr::slice(1) |>as.character(),showcase =icon("children", lib ="font-awesome"), p("Cheaters with children in the sample"),full_screen =TRUE,theme_color ="danger" ) })## Plot by education #### output$affairs_edu <-renderPlot({if (input$children) { affairs_1969 %>% dplyr::filter(children=="yes") |> dplyr::count(cheat, gender, education) |>ggplot(aes(x=education,y=n,fill=cheat))+geom_col()+geom_label(aes(label=n), fill="black",color="white", vjust=-0.5)+scale_fill_brewer("Set2")+facet_wrap(gender~cheat)+theme_classic()+theme(legend.position ="none")+labs(title =paste("Among", input$happy, "respondents"),x="Respondent education",y="# respondents") }else { affairs_1969 %>% dplyr::filter(children=="no") |> dplyr::count(cheat, gender, education) |>ggplot(aes(x=education,y=n,fill=cheat))+geom_col()+geom_label(aes(label=n), fill="black",color="white", vjust=-0.5)+facet_wrap(gender~cheat)+scale_fill_viridis_d("rocket")+theme_classic()+theme(legend.position ="none")+labs(title =paste("Among", input$happy, "respondents"),x="Respondent education",y="# respondents") } })## Plot by years of marriage #### output$affairs_years <-renderPlot({if (input$children) { affairs_1969 %>% dplyr::filter(children=="yes") |> dplyr::count(cheat, gender, yearsmarried) |>ggplot(aes(x=yearsmarried,y=n, fill=cheat))+geom_col()+geom_label(aes(label=n), fill="black",color="white", vjust=-0.5)+facet_wrap(gender~cheat)+scale_fill_brewer("Set2")+theme_classic()+theme(legend.position ="none")+labs(title =paste("Among", input$happy, "respondents"),x="Respondent years of marriage",y="# respondents") }else { affairs_1969 %>% dplyr::filter(children=="no") |> dplyr::count(cheat, gender, yearsmarried) |>ggplot(aes(x=yearsmarried,y=n, fill=cheat))+geom_col()+geom_label(aes(label=n), fill="black",color="white", vjust=-0.5)+facet_wrap(gender~cheat)+scale_fill_viridis_d("rocket")+theme_classic()+theme(legend.position ="none")+labs(title =paste("Among", input$happy, "respondents"),x="Respondent years of marriage",y="# respondents") } })}# Run App ####shinyApp(ui_affair_alt, server_affair_alt)
Infidelity apps, side by side
Look at the two deployed apps side by side:
Deploying ShinyApps 🚀
When you create an App and run it from your computer, only you can access it. But if you want to make it public, you need to deploy it to your account, which will run the app on a server for anyone to see.
To deploy the app you need to register your Shinyapps.io account in RStudio following the steps below.
Link your Shinyapps.io account
Enter secret
How do you embed a Shiny app in a website?
The app above is hosted in my Shinyapps.io account and running from the Shiny server there, but can be accessed directly in this site by using the iframe HTML.
To embed a deployed ShinyApp in your blog, just place the URL inside of an iframe src outside of a code chunk:
<iframe src="YOUR SHINYAPP URL">
PART II: Shiny, in all its glory
Now let’s create a proper Shiny app that uses many of the elements from previous sessions: interactive graphs and maps to visualise COVID-19.
We’ll look at each part of the app separately and then put them together.
The Data 📊
This step is similar to the one we did before. We’ll download the COVID-19 data and a map of the world. We’ll use an sp map, just to vary things a bit and show you how to work with other formats of geospatial data.
Click me!
# Packages ####library(rworldmap)library(lubridate)library(tidyverse)# Data ####covid_df <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/refs/heads/master/public/data/cases_deaths/full_data.csv") %>% dplyr::mutate(date = lubridate::as_date(date),n =row_number(),year =year(date)) %>% dplyr::mutate(iso3c = countrycode::countrycode(location, "country.name","iso3c")) |> dplyr::select(iso3c, country=location, date, total_deaths, new_deaths)# let's download the worldmap as a sp file. Look at the file in the Viewer, what is different from other data frames? ####world_sp <- rworldmap::getMap(resolution ="low")
The UI 🙂
Let’s first look at the UI. We first start by using the page_navbar layout which will put a horizontal bar at the top of the page. Inside we start by providing a title to the app, and defining a theme using bslib. I’ve chosen a very psychedelic theme –just because I can, not because I like it but to show how many things change in the dashboard look by picking a particular template (in this case, quartz). Color, fonts, buttons –all are parameters that you can customize with bslib.
Then comes the sidebar where we will organise our inputs. We’ll have three types inputs: button, date selector and countries selector, which will together define the time span for COVID-19 and the geographical scope we want to map. We use card to box-in the inputs and a short description of the app, and an accordion layout to collapse the selectors.
Within the sidebar, we first add a value_box to summarise a key data point using the uiOutput option, and then the actionButton. The actionButton will trigger the update, and we will use dateInput for selecting a moment in time and selectInput to select countries to map. The date is pretty simple, but for the countries we need to make sure the input recognises multiple countries adding the option multiple = TRUE, so we can select one if we like or many.
Finally, we use two navset_panel layout to place our 2 tab outputs: a leaflet map and an plotly chart. We give them icons and names that will need to match what we compute in the server, and make sure we use the correct type of outputs: In this case, we’ll want a Leaflet map and a Plotly graph, so we need to use leafletOutput and plotlyOutput.
We’ll use that truly ugly quartz Bootswatch theme, just for pedagogical purposes.
Click me!
library(shiny)library(bslib)library(hrbrthemes)library(tidyverse)library(plotly)library(ggthemes)library(bslib)library(bsicons)library(shinyWidgets)library(leaflet)library(plotly)# The UI ####{ui_covid <-page_navbar(# Here we add the Quartz Bootswatch themetheme = bslib::bs_theme(bootswatch ="quartz"),title ="COVID-19: Aftermath",sidebar =sidebar(gap ="5px",width =500,# Value box card(full_screen =TRUE,card_header(uiOutput("total_deaths"), ),card_body(markdown("Shiny App to show the evolution of Covid-related deaths around the world since March 2020, using the repository of [OWID](https://github.com/owid/covid-19-data/tree/master/public/data)"),# A button that will trigger the update of the map/graphactionButton(inputId ="update",label ="Update data", icon =icon("refresh"),class ="btn-primary" )),accordion(open =TRUE,accordion_panel("Selectors:",# Adding the period inputdateInput(inputId ="date",label ="Select date:",value ="2023-06-30",min=min(covid_df$date),max=max(covid_df$date)),# Adding the countries inputselectInput(inputId ="country",label ="Select countries:",choices =sort(unique(covid_df$country)),selected =c("France","Italy","Colombia","India","Brazil","Japan","Nigeria"),multiple =TRUE ))) )),# Now we add the tabsnav_panel(title ="Map",icon = bsicons::bs_icon("compass"),leafletOutput("map") ),nav_panel(title ="Trajectories", icon = bsicons::bs_icon("clock-history"),plotlyOutput("countries") ),nav_item(input_dark_mode(id ="dark_mode",mode ="light")) )}
Help! Is there’s an easier way to design User Interfaces?
You can use the recently released shinyeditor package to design your UI elements and layout.
Now we build the server function, where things get interesting for two reasons: reactive functions and events.
The server function for Shiny has 2 main parts: input, which connect the server with the objects defined in the UI labelled inputs, and output, which calculates something based in the inputs and produces a result –a plot, a table, a map, you name it. So the server is always saved a a function with those two arguments 1.
Put differently, reactive functions make it easier to link inputs-and-outputs by creating an intermediary object that changes with inputs, so we can unify in a single object all the changes produced by inputs. I know this sounds abstract now, but it will become clear soon.
In the server of this app we are expecting two outputs: a map and a plot. But we have some intermediary steps to build before we can render both outputs. Let’s go one by one:
Working with buttons: We included an actionButton in the UI, but how do we use it? A button usually triggers something, and in this case we want the clicking of the button to send the filtered data to the output we want to observe, so that the map and plot are updates with country and date inputs only when the button is clicked. This is very simple to do: we wrap the filtered data around an eventReactive() function, so that this event will be triggered with the clicking of the button including the input$update argument and then the action it will perform –in this case, the action is updating the data that will be fed into the map and plot.
Our reactive functions: We will create two reactive() functions that will feed filtered data into each of our outputs. These functions will store the data that is affected by input changes and be the sole object within the outputs that change with inputs. The reactive function data() will be the one that affects the plot, and that function will also affect data_map() which will filter the data for the map. Once we have defined the reactive function, we call it by its name and end with a parenthesis reactive(), as it is a function, and include it as the starting point for our outputs.
Reactivity is not easy and takes practice, but it is very useful because apps can get complex really fast, and you can lose track of which inputs affect what.
The other key part of this app is a leaflet map, which you already know how to build. However, for Shiny apps, there is a trick you need to use to make your leaflet map not to computationally heavy and the app slow. You first need to render an empty map using the leaflet standard function, and then you need to include reactivity within the leafletProxy output.
Look at every piece of the server function below. Even the fancy leaflet background and the customised icon for the marker.
Click me!
# Packages ####library(rworldmap)library(rnaturalearth)library(leaflet)library(leaflet.providers)library(sp)library(lubridate)library(shiny)library(RColorBrewer)library(tidyverse)library(plotly)library(ggthemes)# Server ####server_covid <-function(input,output) {# A data object is created so that each click of the button updates the data that is fed to the map data <-eventReactive(input$update,{ covid_df %>%# Filter the date and countries selected in each input dplyr::filter(date==input$date,!str_detect(iso3c,"_"),!is.na(total_deaths), country %in% input$country) %>% dplyr::group_by(iso3c,country) %>% dplyr::summarise(country_deaths =sum(total_deaths)) })# Value boxes #### output$total_deaths <-renderUI({value_box(title ="Total COVID-19 deaths",value = covid_df %>% dplyr::filter(!str_detect(iso3c,"_")) |> dplyr::summarise(deaths =sum(new_deaths, na.rm =TRUE)) |> dplyr::transmute(deaths = deaths |>round(digit=1) |>format(big.mark =" ")) |>as.character(),theme ="danger",showcase =bs_icon("virus"),p("Source: WHO & OWID") ) })# The data that goes to the map data_map <-reactive({# First create a copy of the base map world_sp2 <- world_sp# Then join the selected data inside of the sp object world_sp2@data <- world_sp2@data %>% dplyr::inner_join( covid_df %>% dplyr::filter(date==input$date,!str_detect(iso3c,"_"),!is.na(total_deaths), country %in% input$country), by=c("ISO3"="iso3c")) })# Create an empty map output$map <-renderLeaflet({leaflet() |>addTiles() |>addProviderTiles("Esri.WorldImagery") |>setView(lng =-20, lat=30, zoom =3) })# Overlay in the empty map the selected dataobserveEvent(input$update, {leafletProxy("map") |>clearMarkers() |>addMarkers(data =data_map(),icon = covid_icon,label=~paste0(country,": ",as.integer(total_deaths) |>format(big.mark =" "))) })# Another graph with plotly in the second tab output$countries <-renderPlotly({ p <- covid_df %>% dplyr::filter(country %in% input$country) |>ggplot(aes(x=date, y=total_deaths, color=country))+geom_path(show.legend =FALSE)+labs(x=NULL,y="Registered deaths",title="Progression in selected countries",caption ="Source: OWID")+ hrbrthemes::theme_ipsum()ggplotly(p) })}
The Full ShinyApp ✨
Below you can see the app running from the server.
The app is not even close to being ready for publishing: it has many questionable aesthetic choices, the value_box takes too much space, etc. There is more work to be done.
Making an app quickly is easy, making a good app is not and requires a lot more tinkering to make sure the computations are efficient, and the UI is user-friendly, clear and useful. Otherwise it will be another app in a website nobody has any use for.
Open the app in a full screen clicking here. Click below to get the raw code for the app and replicate it:
Interact with the app. Better if you open it in a new window in your browser. You can also download the code to reproduce the app from your own computer.
Go nuts with Shiny extensions and improve the User Interface
Shiny has a large and expanding universe of extensions, have a look
Quarto produces other outputs beyond HTML, Word and PDF. One nice output includes RevealJS presentations, which are easy to do and display results computed in Quarto, so that you can include any object you’re learned so far into a presentation directly.
To create a RevealJS presentation you only need to change the format to format: revealjs and become familiar with the structure of these presentations. RevealJS also has themes you can use, check them out here.
Replicate all apps here and deploy them into your own Shinyapps.io free account. Embed them into a new blog post and publish it
Use the UI and Server design for the COVID-19 app and deploy it to your account. Share resulting URL
Create a RevealJS presentation with the best outputs in your blog
Intermediate
Create a Shiny app that shows the frequency of use of all Eunoia words you scraped, by country. Use gtrendsR package to look up the frequency of each word by country.
