Most web applications have a client or user-interface that users interact with and a server (or backend) that carries out computations based on the user interactions.
It can be beneficial for a data scientist to turn their analyses into a web application, especially when interactive exploration of the results are useful. It is important to be able to recognize when building an app is an appropriate solution and when it might not be.
Though this app doesn’t actually do anything other than display the text “Hello, world!!!”, you should get used to loading shiny and using the appropriate functions to create the UI, server, and actually run the app.
For this example, we make sure to create the UI before the server. We can do them in any order when building our own apps later, but for this course we’ll write them in that order.
library(shiny)
ui <- fluidPage(
"Hello, world!!!"
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3371NAExtend the app and have it wish a hello to a specific person. A user will enter a name and the app will update to wish that name “Hello”.
For users to enter text, you’ll have to use a text-specific shiny input function to capture it. Recall that shiny makes available a number of input functions depending on what kind of input you’d like to capture from your users.
ui <- fluidPage(
# CODE BELOW: Add a text input "name"
textInput("name", "Enter a name:")
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3371NAtextInput() is the way to capture what it says - text input from your user - but there’s a lot of other kinds of input functions provided in shiny that will let you capture other types.
To finish up your “Hello, world” app, we’ll have to actually display the text that’s input.
# Render output y using input x
output$y <- renderText({
input$x
})If we get an error message resembling “Parsing error in script.R:4:3: unexpected symbol”, it is very likely that you have forgotten to use a comma to separate the arguments to one of the functions.
ui <- fluidPage(
textInput("name", "What is your name?"),
# CODE BELOW: Display the text output, greeting
# Make sure to add a comma after textInput()
textOutput("greeting")
)
server <- function(input, output) {
# CODE BELOW: Render a text output, greeting
output$greeting <- renderText({
paste("hello",
input$name)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3371NAThis app will allow users to enter a baby name and visualize the popularity of that name over time.
The first step is to add a text input to the UI that will allow a user to enter their (or any other) name. Try using the optional default argument this time around.
library(babynames)
library(dplyr)
library(ggplot2)
babynames <- babynames %>%
select(year, sex, name, n, prop)ui <- fluidPage(
# CODE BELOW: Add a text input "name"
textInput("name", "Enter your Name", "David")
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)The next step in building your app is to add an empty plot as a placeholder. Recall that in order to add a plot p assigned to an object named x to a Shiny app, you need to:
ui <- fluidPage(
textInput('name', 'Enter Name', 'David'),
# CODE BELOW: Display the plot output named 'trend'
plotOutput("trend")
)
server <- function(input, output, session) {
# CODE BELOW: Render an empty plot and assign to output named 'trend'
output$trend <- renderPlot({
ggplot()
})
}
shinyApp(ui = ui, server = server)You can use layout functions provided by Shiny to arrange the UI elements. In this case, we want to use a sidebarLayout(), where the input is placed inside a sidebarPanel() and the output is placed inside the mainPanel(). You can use this template to update the layout of your app.
sidebarLayout(
sidebarPanel(p("This goes into the sidebar on the left")),
mainPanel(p("This goes into the panel on the right"))
)ui <- fluidPage(
titlePanel("Baby Name Explorer"),
# CODE BELOW: Add a sidebarLayout, sidebarPanel, and mainPanel
sidebarLayout(
sidebarPanel(
textInput('name', 'Enter Name', 'David')
),
mainPanel(
plotOutput('trend')
)
)
)
server <- function(input, output, session) {
output$trend <- renderPlot({
ggplot()
})
}
shinyApp(ui = ui, server = server)The final step is to update the plot output to display a line plot of prop vs. year, colored by sex, for the name that was input by the user. You can use this plot template to create your plot:
ggplot(subset(babynames, name == "David")) +
geom_line(aes(x = year, y = prop, color = sex))Recall that a user input named foo can be accessed as input$foo in the server.
ui <- fluidPage(
titlePanel("Baby Name Explorer"),
sidebarLayout(
sidebarPanel(textInput('name', 'Enter Name', 'David')),
mainPanel(plotOutput('trend'))
)
)
server <- function(input, output, session) {
output$trend <- renderPlot({
# CODE BELOW: Update to display a line plot of the input name
ggplot(subset(babynames, name == input$name)) +
geom_line(aes(x = year, y = prop, color = sex))
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3371This is now a complete app, and is much more informative than the app that only had the name-entering functionality.
Shiny provides a wide variety of inputs that allows users to provide text (textInput, selectInput), numbers (numericInput, sliderInput), booleans (checkBoxInput, radioInput), and dates (dateInput, dateRangeInput).
Adding an input to a shiny app is a two step process, where you first add an ___Input(“x”) function to the UI and then access its value in the server using input$x.
For example, if we want users to choose an animal from a list, we can use a selectInput, and refer to the chosen value as input$animal:
selectInput(
'animal',
'Select Animal',
selected = 'Cat',
choices = c('Dog', 'Cat')
)We will build a Shiny app that lets users visualize the top 10 most popular names by sex by adding an input to let them choose the sex.
ui <- fluidPage(
titlePanel("What's in a Name?"),
# CODE BELOW: Add select input named "sex" to choose between "M" and "F"
selectInput('sex', 'Select Sex', choices = c("F", "M")),
# Add plot output to display top 10 most popular names
plotOutput('plot_top_10_names')
)
server <- function(input, output, session){
# Render plot of top 10 most popular names
output$plot_top_10_names <- renderPlot({
# Get top 10 names by sex and year
top_10_names <- babynames %>%
# MODIFY CODE BELOW: Filter for the selected sex
filter(sex == input$sex) %>%
filter(year == 1900) %>%
top_n(10, prop)
# Plot top 10 names by sex and year
ggplot(top_10_names, aes(x = name, y = prop)) +
geom_col(fill = "#263e63")
})
}
shinyApp(ui = ui, server = server)– Many of the provided Shiny inputs, like this one, are named very aptly (selectInput() will hopefully help you remember you have to select one choice) and are easy to use to adjust your outputs in the server.
Slider inputs are great for numeric inputs, both when you’d like users to choose from a range of values and also when they should choose a static value from a set of options, but you want to be more creative than using a selectInput().
ui <- fluidPage(
titlePanel("What's in a Name?"),
# Add select input named "sex" to choose between "M" and "F"
selectInput('sex', 'Select Sex', choices = c("F", "M")),
# CODE BELOW: Add slider input named 'year' to select years (1900 - 2010)
sliderInput("year", "Select year", value = 1900, min = 1900, max = 2010),
# Add plot output to display top 10 most popular names
plotOutput('plot_top_10_names')
)
server <- function(input, output, session){
# Render plot of top 10 most popular names
output$plot_top_10_names <- renderPlot({
# Get top 10 names by sex and year
top_10_names <- babynames %>%
filter(sex == input$sex) %>%
# MODIFY CODE BELOW: Filter for the selected year
filter(year == input$year) %>%
top_n(10, prop)
# Plot top 10 names by sex and year
ggplot(top_10_names, aes(x = name, y = prop)) +
geom_col(fill = "#263e63")
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3371NAHaving users select a specific year with the sliderInput() is much cooler than selecting years from a drop down (and in this case, 100 years in a drop down would be a lot for them to scroll through.)
In order to add any output to a Shiny app, you need to:
We will add a table output to the baby names explorer app ereated earlier. The code inside a render___ function needs to be wrapped inside curly braces (e.g. renderPlot({…})).
ui <- fluidPage(
titlePanel("What's in a Name?"),
# Add select input named "sex" to choose between "M" and "F"
selectInput('sex', 'Select Sex', choices = c("F", "M")),
# Add slider input named "year" to select year between 1900 and 2010
sliderInput('year', 'Select Year', min = 1900, max = 2010, value = 1900),
# CODE BELOW: Add table output named "table_top_10_names"
tableOutput("table_top_10_names")
)
server <- function(input, output, session){
# Function to create a data frame of top 10 names by sex and year
top_10_names <- function(){
top_10_names <- babynames %>%
filter(sex == input$sex) %>%
filter(year == input$year) %>%
top_n(10, prop)
}
# CODE BELOW: Render a table output named "table_top_10_names"
output$table_top_10_names <- renderTable({
top_10_names()
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAThis static table output creates a new way of looking at our top babynames, and you are now starting to get the hang of the process of building an output in the server using a render function and then displaying it in the UI with an output function.
There are multiple htmlwidgets packages like DT, leaflet, plotly, etc. that provide highly interactive outputs and can be easily integrated into Shiny apps using almost the same pattern. For example, you can turn a static table in a Shiny app into an interactive table using the DT package:
We will update the app created previously, replacing the static table with an interactive table.
ui <- fluidPage(
titlePanel("What's in a Name?"),
# Add select input named "sex" to choose between "M" and "F"
selectInput('sex', 'Select Sex', choices = c("M", "F")),
# Add slider input named "year" to select year between 1900 and 2010
sliderInput('year', 'Select Year', min = 1900, max = 2010, value = 1900),
# MODIFY CODE BELOW: Add a DT output named "table_top_10_names"
DT::DTOutput('table_top_10_names')
)Registered S3 method overwritten by 'htmlwidgets':
method from
print.htmlwidget tools:rstudioserver <- function(input, output, session){
top_10_names <- function(){
babynames %>%
filter(sex == input$sex) %>%
filter(year == input$year) %>%
top_n(10, prop)
}
# MODIFY CODE BELOW: Render a DT output named "table_top_10_names"
output$table_top_10_names <- DT::renderDT({
DT::datatable(top_10_names())
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAJust by adjusting the functions you used to render and display the table, you made it interactive. Your users can now filter and adjust the data and gain even more insights into the top baby names.
Similar to creating interactive tables, you can easily turn a static plot created using ggplot2 into an interactive plot using the plotly package. To render an interactive plot, use plotly::renderPlotly(), and display it using plotly::plotlyOutput().
top_trendy_names <- readRDS("top_trendy_names.rds")ui <- fluidPage(
selectInput('name', 'Select Name', top_trendy_names$name),
# CODE BELOW: Add a plotly output named 'plot_trendy_names'
plotly::plotlyOutput("plot_trendy_names")
)
server <- function(input, output, session){
# Function to plot trends in a name
plot_trends <- function(){
babynames %>%
filter(name == input$name) %>%
ggplot(aes(x = year, y = n)) +
geom_col()
}
# CODE BELOW: Render a plotly output named 'plot_trendy_names'
output$plot_trendy_names <- plotly::renderPlotly({
plot_trends()
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAYou can zoom in on certain areas, zoom back out, and hover over the bars to see the values. This makes plots in your app far more interesting, and allows users to gain insights without having to see any code or data.
Displaying several tables and plots on the same page can lead to visual clutter and distract users of the app. In such cases, the tab layout comes in handy, as it allows different outputs to be displayed as tabs.
We will start with the Shiny app using the sidebar layout from the last example and modify it to use tabs. This example should also make it very clear that Shiny makes it really easy to switch app layouts with only a few modifications to the code.
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('name', 'Select Name', top_trendy_names$name)
),
mainPanel(
# MODIFY CODE BLOCK BELOW: Wrap in a tabsetPanel
tabsetPanel(
# MODIFY CODE BELOW: Wrap in a tabPanel providing an appropriate label
tabPanel("Plot",
plotly::plotlyOutput('plot_trendy_names')),
# MODIFY CODE BELOW: Wrap in a tabPanel providing an appropriate label
tabPanel("Table", DT::DTOutput('table_trendy_names'))
)
)
)
)
server <- function(input, output, session){
# Function to plot trends in a name
plot_trends <- function(){
babynames %>%
filter(name == input$name) %>%
ggplot(aes(x = year, y = n)) +
geom_col()
}
output$plot_trendy_names <- plotly::renderPlotly({
plot_trends()
})
output$table_trendy_names <- DT::renderDT({
babynames %>%
filter(name == input$name)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAAs you can see, a tab panel is a much cleaner way to extend a sidebar layout and display multiple pieces of information in one app. Tab layouts become especially helpful if you begin to build dashboards in Shiny.
Shiny makes it easy to customize the theme of an app. The UI functions in Shiny make use of Twitter Bootstrap, a popular framework for building web applications. Bootswatch extends Bootstrap by making it really easy to skin an application with minimal code changes.
We will add a title panel to your app, use the theme selector to explore different themes, and apply then a theme of your choice.
ui <- fluidPage(
# CODE BELOW: Add a titlePanel with an appropriate title
# REPLACE CODE BELOW: with theme = shinythemes::shinytheme("<your theme>")
shinythemes::themeSelector(),
sidebarLayout(
sidebarPanel(
selectInput('name', 'Select Name', top_trendy_names$name)
),
mainPanel(
tabsetPanel(
tabPanel('Plot', plotly::plotlyOutput('plot_trendy_names')),
tabPanel('Table', DT::DTOutput('table_trendy_names'))
)
)
)
)
server <- function(input, output, session){
# Function to plot trends in a name
plot_trends <- function(){
babynames %>%
filter(name == input$name) %>%
ggplot(aes(x = year, y = n)) +
geom_col()
}
output$plot_trendy_names <- plotly::renderPlotly({
plot_trends()
})
output$table_trendy_names <- DT::renderDT({
babynames %>%
filter(name == input$name)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAui <- fluidPage(
# CODE BELOW: Add a titlePanel with an appropriate title
titlePanel("Trendy Names"),
# REPLACE CODE BELOW: with theme = shinythemes::shinytheme("<your theme>")
theme = shinythemes::shinytheme("spacelab"),
sidebarLayout(
sidebarPanel(
selectInput('name', 'Select Name', top_trendy_names$name)
),
mainPanel(
tabsetPanel(
tabPanel('Plot', plotly::plotlyOutput('plot_trendy_names')),
tabPanel('Table', DT::DTOutput('table_trendy_names'))
)
)
)
)
server <- function(input, output, session){
# Function to plot trends in a name
plot_trends <- function(){
babynames %>%
filter(name == input$name) %>%
ggplot(aes(x = year, y = n)) +
geom_col()
}
output$plot_trendy_names <- plotly::renderPlotly({
plot_trends()
})
output$table_trendy_names <- DT::renderDT({
babynames %>%
filter(name == input$name)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7993NAThere are a lot of cool built-in themes in shinythemes, and if none of them suit your fancy, you can learn how to further customize your app with custom CSS.
The best way to learn Shiny is by deconstructing an existing app and rebuilding it from scratch.
We are going to build a Shiny app that allows you to enter your name and select a greeting (Hello/Bonjour), and returns “Hello, Kaelen”, when the user is Kaelen. Admittedly, it is a really simple app, but the challenge is we are going to have to code it from scratch!
Four steps to building a Shiny app are:
ui <- fluidPage(
selectInput("select", "Select greeting", choices = c("Hello", "Bonjour")),
textInput("name", "Enter your name"),
textOutput("greeting")
)
server <- function(input, output, session) {
output$greeting <- renderText({
paste(input$select, input$name)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:4667NABuilding a Shiny app is a modular process. You start with the UI, then you work on the server code, building outputs based on the user inputs. The more you practice this approach deliberately, the easier it will become to build good apps.
You will now build a Shiny app that lets a user choose sex and year, and will display the top 10 most popular names in that year as a column plot of proportion of births (prop) by name (name).
We have provided a function get_top_names() to extract the top 10 names for a given year and sex. For example, you can get the top 10 male names for the year 2000 using get_top_names(2000, “M”).
get_top_names <- function(.year, .sex) {
babynames %>%
filter(year == .year) %>%
filter(sex == .sex) %>%
top_n(10) %>%
mutate(name = forcats::fct_inorder(name))
}We can create a column plot from a data frame d with columns x and y using:
ggplot(d, aes(x = x, y = y)) +
geom_col()ui <- fluidPage(
titlePanel("Most Popular Names"),
sidebarLayout(
sidebarPanel(
selectInput("sex", "Select Sex", choices = c("M", "F")),
sliderInput("year", "Select Year", min = 1880, max = 2017, value = 1900)),
mainPanel(
plotOutput("plot_popular_names")
)
)
)
server <- function(input, output, session) {
output$plot_popular_names <- renderPlot({
ggplot(get_top_names(input$year, input$sex), aes(x = name, y = prop)) +
geom_col()
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7215NALet us wrap this chapter up by enhancing the app we built earlier by adding a table showing the top 10 baby names as a tab.
ui <- fluidPage(
titlePanel("Most Popular Names"),
sidebarLayout(
sidebarPanel(
selectInput("sex", "Select Sex", choices = c("M", "F")),
sliderInput("year", "Select Year", min = 1880, max = 2017, value = 1900)
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plot_popular_names")),
tabPanel("Table", tableOutput("table_poplar_names"))
)
)
)
)
server <- function(input, output, session) {
output$plot_popular_names <- renderPlot({
ggplot(get_top_names(input$year, input$sex), aes(x = name, y = prop)) +
geom_col()
})
output$table_poplar_names <- renderTable({
get_top_names(input$year, input$sex)
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7215NAThe magic behind Shiny is driven by reactivity. As you learned in this lesson, there are three types of reactive components in a Shiny app.
Reactive source: User input that comes through a browser interface, typically.
Reactive conductor: Reactive component between a source and an endpoint, typically used to encapsulate slow computations.
Reactive endpoint: Something that appears in the user’s browser window, such as a plot or a table of values.
ui <- fluidPage( titlePanel(‘BMI Calculator’), theme = shinythemes::shinytheme(‘cosmo’), sidebarLayout( sidebarPanel( numericInput(‘height’, ‘Enter your height in meters’, 1.5, 1, 2), numeriInput(‘weight’, ‘Enter your weight in Kilograms’, 60, 45, 120) ), mainPanel( textOutput(“bmi”), textOutput(“bmi_range”) ) ) ) server <- function(input, output, session) { rval_bmi <- reactive({ input\(weight/(input\)height^2) }) output\(bmi <- renderText({ bmi <- rval_bmi() paste("Your BMI is", round(bmi, 1)) }) output\)bmi_range <- renderText({ bmi <- rval_bmi() health_status <- cut(bmi, breaks = c(0, 18.5, 24.9, 29.9, 40), labels = c(‘underweight’, ‘healthy’, ‘overweight’, ‘obese’) ) paste(“You are”, health_status) }) } shinyApp(ui, server)
A reactive expression is an R expression that uses widget input and returns a value. The reactive expression will update this value whenever the original widget changes. Reactive expressions are lazy and cached.
In this exercise, you will encapsulate a repeated computation as a reactive expression.
server <- function(input, output, session) {
# CODE BELOW: Add a reactive expression rval_bmi to calculate BMI
rval_bmi <- reactive({
input$weight/(input$height^2)
})
output$bmi <- renderText({
# MODIFY CODE BELOW: Replace right-hand-side with reactive expression
bmi <- rval_bmi()
paste("Your BMI is", round(bmi, 1))
})
output$bmi_range <- renderText({
# MODIFY CODE BELOW: Replace right-hand-side with reactive expression
bmi <- rval_bmi()
bmi_status <- cut(bmi,
breaks = c(0, 18.5, 24.9, 29.9, 40),
labels = c('underweight', 'healthy', 'overweight', 'obese')
)
paste("You are", bmi_status)
})
}
ui <- fluidPage(
titlePanel('BMI Calculator'),
sidebarLayout(
sidebarPanel(
numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120)
),
mainPanel(
textOutput("bmi"),
textOutput("bmi_range")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:6934NAEncapsulating computations as reactive expressions is key to building modular and performant Shiny apps.
One of the central tenets of reactivity is that reactive expressions are executed lazily, and their values are cached.
A reactive expression can call other reactive expressions. This allows you to modularize computations and ensure that they are NOT executed repeatedly. Mastering the use of reactive expressions is key to building performant Shiny applications.
In this exercise, you will use a reactive expression to calculate the health status based on the BMI.
server <- function(input, output, session) {
rval_bmi <- reactive({
input$weight/(input$height^2)
})
# CODE BELOW: Add a reactive expression rval_bmi_status to
# return health status as underweight etc. based on inputs
rval_bmi_status <- reactive({
cut(rval_bmi(),
breaks = c(0, 18.5, 24.9, 29.9, 40),
labels = c('underweight', 'healthy', 'overweight', 'obese')
)
})
output$bmi <- renderText({
bmi <- rval_bmi()
paste("Your BMI is", round(bmi, 1))
})
output$bmi_status <- renderText({
# MODIFY CODE BELOW: Replace right-hand-side with
# reactive expression rval_bmi_status
bmi_status <- rval_bmi_status()
paste("You are", bmi_status)
})
}
ui <- fluidPage(
titlePanel('BMI Calculator'),
sidebarLayout(
sidebarPanel(
numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120)
),
mainPanel(
textOutput("bmi"),
textOutput("bmi_status")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:6934NAModularity is really important while building complex, performant Shiny apps. Reactive expressions enable you to achieve this modularity.
Recall that an observer is used for side effects, like displaying a plot, table, or text in the browser. By default an observer triggers an action, whenever one of its underlying dependencies change.
In this exercise, you will use an observer to display a notification in the browser, using observe() and showNotification(). As we are triggering an action using an observer, we do NOT need to use a render***() function or assign the results to an output.
ui <- fluidPage(
textInput('name', 'Enter your name')
)
server <- function(input, output, session) {
# CODE BELOW: Add an observer to display a notification
# 'You have entered the name xxxx' where xxxx is the name
observe({
showNotification(
paste('You have entered the name', input$name)
)
})
}
shinyApp(ui = ui, server = server)Ordinarily, the simple act of reading a reactive value is sufficient to set up a relationship, where a change to the reactive value will cause the calling expression to re-execute. The isolate() function allows an expression to read a reactive value without triggering re-execution when its value changes.
In this exercise, you will use the isolate() function to stop reactive flow.
server <- function(input, output, session) {
rval_bmi <- reactive({
input$weight/(input$height^2)
})
output$bmi <- renderText({
bmi <- rval_bmi()
# MODIFY CODE BELOW:
# Use isolate to stop output from updating when name changes.
paste("Hi", isolate({input$name}), ". Your BMI is", round(bmi, 1))
})
}
ui <- fluidPage(
titlePanel('BMI Calculator'),
sidebarLayout(
sidebarPanel(
textInput('name', 'Enter your name'),
numericInput('height', 'Enter your height (in m)', 1.5, 1, 2, step = 0.1),
numericInput('weight', 'Enter your weight (in Kg)', 60, 45, 120)
),
mainPanel(
textOutput("bmi")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:5271NAThere are situations where you don’t want Shiny’s reactive framework to automatically trigger an update. The isolate() function will be very handy in these scenarios.
Shiny’s reactive programming framework is designed such that any changes to inputs automatically updates the outputs that depend on it. In some situations, we might want more explicitly control the trigger that causes the update.
The function eventReactive() is used to compute a reactive value that only updates in response to a specific event.
rval_x <- eventReactive(input$event, {
# calculations
})server <- function(input, output, session) {
# MODIFY CODE BELOW: Use eventReactive to delay the execution of the
# calculation until the user clicks on the show_bmi button (Show BMI)
rval_bmi <- eventReactive(input$muestra_bmi,{
input$weight/(input$height^2)
})
output$bmi <- renderText({
bmi <- rval_bmi()
paste("Hi", input$name, ". Your BMI is", round(bmi, 1))
})
}
ui <- fluidPage(
titlePanel('BMI Calculator'),
sidebarLayout(
sidebarPanel(
textInput('name', 'Enter your name'),
numericInput('height', 'Enter height (in m)', 1.5, 1, 2, step = 0.1),
numericInput('weight', 'Enter weight (in Kg)', 60, 45, 120),
actionButton("show_bmi", "Show BMI")
),
mainPanel(
textOutput("bmi")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:5271NAThere are situations where you want to delay the computation of a reactive expression until a specific event is triggered. The eventReactive() function will prove very handy in these scenarios.
There are times when you want to perform an action in response to an event. For example, you might want to let the app user download a table as a CSV file, when they click on a “Download” button. Or, you might want to display a notification or modal dialog, in response to a click.
The observeEvent() function allows you to achieve this. It accepts two arguments:
In this exercise, you will use observeEvent() to display a modal dialog with help text, when the user clicks on a button labelled “Help”. The help text has already been assigned to the variable bmi_help_text.
bmi_help_text <- "Body Mass Index is a simple calculation using a person's height and weight. The formula is BMI = kg/m2 where kg is a person's weight in kilograms and m2 is their height in metres squared. A BMI of 25.0 or more is overweight, while the healthy range is 18.5 to 24.9."server <- function(input, output, session) {
# MODIFY CODE BELOW: Wrap in observeEvent() so the help text
# is displayed when a user clicks on the Help button.
# Display a modal dialog with bmi_help_text
# MODIFY CODE BELOW: Uncomment code
observeEvent(input$show_help,{
showModal(modalDialog(bmi_help_text))
})
rv_bmi <- eventReactive(input$show_bmi, {
input$weight/(input$height^2)
})
output$bmi <- renderText({
bmi <- rv_bmi()
paste("Hi", input$name, ". Your BMI is", round(bmi, 1))
})
}
ui <- fluidPage(
titlePanel('BMI Calculator'),
sidebarLayout(
sidebarPanel(
textInput('name', 'Enter your name'),
numericInput('height', 'Enter your height in meters', 1.5, 1, 2),
numericInput('weight', 'Enter your weight in Kilograms', 60, 45, 120),
actionButton("show_bmi", "Show BMI"),
# CODE BELOW: Add an action button named "show_help"
actionButton("show_help", "Help")
),
mainPanel(
textOutput("bmi")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:5271NAThe observeEvent() function is very useful when you want to explicitly trigger an action in response to an event in the user-interface.
Earlier in the chapter, we practiced stopping, delaying, and triggering apps. This is a very common pattern of programming in Shiny that enables your apps to be optimized for speed (and only re-run when something is updated and your user would like to re-run the app.)
In this exercise, you’ll practice some of those concepts again, just to make sure you truly understand them. Instead of calculating BMI, this app converts height in inches to centimeters.
server <- function(input, output, session) {
# MODIFY CODE BELOW: Delay the height calculation until
# the show button is pressed
rval_height_cm <- eventReactive(input$show_height_cm,{
input$height * 2.54
})
output$height_cm <- renderText({
height_cm <- rval_height_cm()
paste("Your height in centimeters is", height_cm, "cm")
})
}
ui <- fluidPage(
titlePanel("Inches to Centimeters Conversion"),
sidebarLayout(
sidebarPanel(
numericInput("height", "Height (in)", 60),
actionButton("show_height_cm", "Show height in cm")
),
mainPanel(
textOutput("height_cm")
)
)
)
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:5271NAUsing eventReactive(), you recalculate the height only when the ‘Show height in cm’ button is pressed, which makes sense. Remember that your app doesn’t need to do everything all the time!
library(readr)
usa_ufo_sightings <- read_csv("usa_ufo_sightings.csv")Parsed with column specification:
cols(
date_sighted = col_date(format = ""),
latitude = col_double(),
longitude = col_double(),
city = col_character(),
state = col_character(),
shape = col_character(),
duration_sec = col_double(),
comments = col_character()
)The National UFO Reporting Center (NUFORC) has collected sightings data throughout the last century. This app is going to allow users to select a U.S. state and a time period in which the sightings occurred.
ui <- fluidPage(
# CODE BELOW: Add a title
titlePanel("UFO Sightings"),
sidebarLayout(
sidebarPanel(
# CODE BELOW: One input to select a U.S. state
# And one input to select a range of dates
selectInput("state", "Choose a U.S. state:", choices = unique(usa_ufo_sightings$state)),
dateRangeInput("date", "Choose a date range:", start = "1920-01-01", end = "2020-01-01")
),
mainPanel()
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Listening on http://127.0.0.1:4934NAThese two inputs are a great start to the app, but if we don’t build anything in the server, they don’t do anything. Let’s get our outputs built.
Now that the dashboard has inputs, you should build your outputs to actually see information about the reported UFO sightings.
Recall there will be two, a plot and a table. The plot should show the number sighted, by shape, for the selected state and time period. The table should show, for the selected state and time period, the number sighted, plus the average, median, minimum, and maximum duration (duration_sec) of the sightings. This will require using dplyr, or a method of your choosing, to manipulate the usa_ufo_sightings data.
library(dplyr)
library(ggplot2)server <- function(input, output) {
# CODE BELOW: Create a plot output name 'shapes', of sightings by shape,
# For the selected inputs
output$shapes <- renderPlot({
usa_ufo_sightings %>%
filter(state == input$state,
date_sighted >= input$dates[1],
date_sighted <= input$dates[2]) %>%
ggplot(aes(shape)) +
geom_bar() +
labs(x = "Shape", y = "# Sighted")
})
# CODE BELOW: Create a table output named 'duration_table', by shape,
# of # sighted, plus mean, median, max, and min duration of sightings
# for the selected inputs
output$duration_table <- renderTable({
usa_ufo_sightings %>%
filter(
state == input$state,
date_sighted >= input$dates[1],
date_sighted <= input$dates[2]
) %>%
group_by(shape) %>%
summarize(
nb_sighted = n(),
avg_duration = mean(duration_sec),
median_duration = median(duration_sec),
min_duration = min(duration_sec),
max_duration = max(duration_sec)
)
})
}
ui <- fluidPage(
titlePanel("UFO Sightings"),
sidebarLayout(
sidebarPanel(
selectInput("state", "Choose a U.S. state:", choices = unique(usa_ufo_sightings$state)),
dateRangeInput("dates", "Choose a date range:",
start = "1920-01-01",
end = "1950-01-01")
),
mainPanel(
# Add plot output named 'shapes'
plotOutput("shapes"),
# Add table output named 'duration_table'
tableOutput("duration_table")
)
)
)
shinyApp(ui, server)
Listening on http://127.0.0.1:4565NAThis app is sort of cluttered, given that the plot and table output are just sitting on top of one another, but you’ve started to get some concrete information about the aliens sighted. Let’s clean it up by adding the tab layout.
As-is, the app is sort of busy with the graph on top of the table. Given that this is a dashboard, it might be nice to instead separate the two outputs.
The last step in building your dashboard is to take the plotOutput() and tableOutput() you’ve built and add the tab layout.
ui <- fluidPage(
titlePanel("UFO Sightings"),
sidebarLayout(
sidebarPanel(
selectInput("state", "Choose a U.S. state:", choices = unique(usa_ufo_sightings$state)),
dateRangeInput("dates", "Choose a date range:",
start = "1920-01-01",
end = "1950-01-01"
)
),
# MODIFY CODE BELOW: Create a tab layout for the dashboard
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput("shapes")),
tabPanel("Table",
tableOutput("duration_table"))
)
)
)
)
server <- function(input, output) {
output$shapes <- renderPlot({
usa_ufo_sightings %>%
filter(
state == input$state,
date_sighted >= input$dates[1],
date_sighted <= input$dates[2]
) %>%
ggplot(aes(shape)) +
geom_bar() +
labs(
x = "Shape",
y = "# Sighted"
)
})
output$duration_table <- renderTable({
usa_ufo_sightings %>%
filter(
state == input$state,
date_sighted >= input$dates[1],
date_sighted <= input$dates[2]
) %>%
group_by(shape) %>%
summarize(
nb_sighted = n(),
avg_duration_min = mean(duration_sec) / 60,
median_duration_min = median(duration_sec) / 60,
min_duration_min = min(duration_sec) / 60,
max_duration_min = max(duration_sec) / 60
)
})
}
shinyApp(ui, server)You could add a theme, write a custom CSS stylesheet to add pictures of aliens, and use the data to add even more information about alien sightings the world over.
Let’s look at all the different input options that are already built for you by exploring the shinyWidgets package. It comes with a neat built-in function, shinyWidgetsGallery() that opens a pre-built Shiny app that allows you to explore these pre-built inputs and gives you the code for implementing them.
Navigate to the radioButtons section. What argument do you use in radioGroupButtons() to display the buttons vertically instead of horizontally?
direction = “vertical”
Don’t be intimidated, but in this exercise, you’re going to build the entirety of this app (minus the custom error message) in one go!
For this app, you’ll be using the questions “Do you think that discussing a mental health issue with your employer would have negative consequences?” (the mental_health_consequence variable) and “Do you feel that your employer takes mental health as seriously as physical health?” (mental_vs_physical) as multi-selector inputs, then displaying a histogram of the Age of respondents. To see the choices for these variables, count() them in the console.
mental_health_survey <- read_csv("mental_health_survey_edited.csv")Parsed with column specification:
cols(
.default = col_character(),
Timestamp = col_datetime(format = ""),
Age = col_double()
)
See spec(...) for full column specifications.ui <- fluidPage(
# CODE BELOW: Add an appropriate title
titlePanel("2014 Mental Health in Tech Survey"),
sidebarPanel(
# CODE BELOW: Add a checkboxGroupInput
checkboxGroupInput(
inputId = "mental_health_consequence",
label = "Do you think that discussing a mental health issue with your employer would have negative consequences?",
choices = unique(mental_health_survey$mental_health_consequence),
selected = "Maybe"
),
# CODE BELOW: Add a pickerInput
pickerInput(
inputId = "mental_vs_physical",
label = "Do you feel that your employer takes mental health as seriously as physical health?",
choices = unique(mental_health_survey$mental_vs_physical),
multiple = TRUE
)
),
mainPanel(
# CODE BELOW: Display the output
plotOutput("age")
)
)
server <- function(input, output, session) {
# CODE BELOW: Build a histogram of the age of respondents
# Filtered by the two inputs
output$age <- renderPlot({
mental_health_survey %>%
filter(
mental_health_consequence %in% input$mental_health_consequence,
mental_vs_physical %in% input$mental_vs_physical
) %>%
ggplot(aes(Age)) +
geom_histogram()
})
}
shinyApp(ui, server)
Listening on http://127.0.0.1:6496NAThis was a real challenge, building an app in one go, but you’ve learned so much in the course and hopefully it wasn’t too bad. Now, let’s get rid of the blank plot and throw a custom error message to users.
It is often good practice to select a default value for your selector inputs, if one should be excluded, you can throw a custom error message to your users that clues them in on what they need to do for the app to run successfully.
We saw in the last exercise that, without a default value for the pickerInput(), the plot is simply blank. Instead of a blank plot, in this exercise you’ll show users a custom error message telling them to make the correct selection needed to get the app working.
server <- function(input, output, session) {
output$age <- renderPlot({
# MODIFY CODE BELOW: Add validation that user selected a 3rd input
validate(
need(input$mental_vs_physical != "", "Be sure to select an option")
)
mental_health_survey %>%
filter(
work_interfere == input$work_interfere,
mental_health_consequence %in% input$mental_health_consequence,
mental_vs_physical %in% input$mental_vs_physical
) %>%
ggplot(aes(Age)) +
geom_histogram()
})
}
ui <- fluidPage(
titlePanel("2014 Mental Health in Tech Survey"),
sidebarPanel(
sliderTextInput(
inputId = "work_interfere",
label = "If you have a mental health condition, do you feel that it interferes with your work?",
grid = TRUE,
force_edges = TRUE,
choices = c("Never", "Rarely", "Sometimes", "Often")
),
checkboxGroupInput(
inputId = "mental_health_consequence",
label = "Do you think that discussing a mental health issue with your employer would have negative consequences?",
choices = c("Maybe", "Yes", "No"),
selected = "Maybe"
),
pickerInput(
inputId = "mental_vs_physical",
label = "Do you feel that your employer takes mental health as seriously as physical health?",
choices = c("Don't Know", "No", "Yes"),
multiple = TRUE
)
),
mainPanel(
plotOutput("age")
)
)
shinyApp(ui, server)
Listening on http://127.0.0.1:6496NAThough this could have been avoided by setting a default value for our pickerInput(), this was a great demonstration of how to throw a custom error message for your users should you need it in future apps.
Food has universal appeal, and the amazing array of dishes one can concoct with the multitude of ingredients leads to near infinite variety! In this exercise, you will use a dataset named recipes that contains recipes, the cuisine it belongs to, and the ingredients it uses, to build a Shiny app that lets the user explore the most used ingredients by cuisine.
recipes <- read_rds("recipes.rds")Here is a handy snippet of code that gets you the top 10 ingredients used in Greek cuisine. You will find this useful to create the interactive data table in the app based on the cuisine and number of ingredients selected by the user.
library(tidyr)
recipes <- recipes %>%
unnest(ingredients)recipes %>%
filter(cuisine == 'greek') %>%
count(ingredients, name = 'nb_recipes') %>%
arrange(desc(nb_recipes)) %>%
head(10)ui <- fluidPage(
titlePanel('Explore Cuisines'),
sidebarLayout(
sidebarPanel(
# CODE BELOW: Add an input named "cuisine" to select a cuisine
selectInput("cuisine",
label = "Select Cuisine",
choices = unique(recipes$cuisine)),
# CODE BELOW: Add an input named "nb_ingredients" to select # of ingredients
sliderInput("nb_ingredients",
"Select No. of Ingredients",
value = 5,
min = 1,
max = 100)
),
mainPanel(
# CODE BELOW: Add a DT output named "dt_top_ingredients"
DT::DTOutput("dt_top_ingredients")
)
)
)
server <- function(input, output, session) {
# CODE BELOW: Render the top ingredients in a chosen cuisine as
# an interactive data table and assign it to output object `dt_top_ingredients`
output$dt_top_ingredients <- DT::renderDT({
recipes %>%
filter(cuisine == input$cuisine) %>%
count(ingredients, name = "nb_recipes") %>%
arrange(desc(nb_recipes)) %>%
head(input$nb_ingredients)
})
}
shinyApp(ui, server)
Listening on http://127.0.0.1:4447NAInteractive data tables are a great way to showcase raw data in your apps to let your users explore. The datatable package makes it easy to create highly interactive data tables, and is definitely worth exploring in detail.
Each cuisine is distinct because of a small set of distinct ingredients. We can’t surface these by looking at the most popular ingredients, since they’re the bread-and-butter ingredients of cooking like salt or sugar.
Another metric that can aid us in this quest is the term frequency–inverse document frequency (TFIDF), a numerical statistic that is intended to reflect how important a word (ingredient) is to a document (cuisine) in a collection or corpus (recipes).
library(tidytext)
recipes_enriched <- recipes %>%
count(cuisine, ingredients, name ='nb_recipes') %>%
tidytext::bind_tf_idf(ingredients, cuisine, nb_recipes)We already precomputed the tf_idf for you and created an enriched dataset named recipes_enriched. Your goal is to create a Shiny app that displays a horizontal bar plot of the top distinctive ingredients in a cuisine, as measured by tf_idf.
You will use a reactive expression to encapsulate the computations and let the plotting code focus only on creating the plot. This is good programming practice and helps create modular and performant Shiny apps.
We have loaded the packages shiny, dplyr, ggplot2 and plotly. Here are two handy snippets to filter for the top recipes by cuisine and create a horizontal bar plot. You can modify it appropriately.
top_ingredients <- recipes_enriched %>%
filter(cuisine == 'greek') %>%
arrange(desc(tf_idf)) %>%
head(5)
ggplot(top_ingredients, aes(x = ingredient, y = tf_idf)) +
geom_col() +
coord_flip()
library(forcats)ui <- fluidPage(
titlePanel('Explore Cuisines'),
sidebarLayout(
sidebarPanel(
selectInput('cuisine', 'Select Cuisine', unique(recipes$cuisine)),
sliderInput('nb_ingredients', 'Select No. of Ingredients', 5, 100, 10),
),
mainPanel(
tabsetPanel(
# CODE BELOW: Add a plotly output named "plot_top_ingredients"
tabPanel("Plot", plotly::plotlyOutput("plot_top_ingredients")),
tabPanel('Table', DT::DTOutput('dt_top_ingredients'))
)
)
)
)
server <- function(input, output, session) {
# CODE BELOW: Add a reactive expression named `rval_top_ingredients` that
# filters `recipes_enriched` for the selected cuisine and top ingredients
# based on the tf_idf value.
rval_top_ingredients <- reactive({
recipes_enriched %>%
filter(cuisine == input$cuisine) %>%
arrange(desc(tf_idf)) %>%
head(input$nb_ingredients) %>%
mutate(ingredients = forcats::fct_reorder(ingredients, tf_idf))
})
# CODE BELOW: Render a horizontal bar plot of top ingredients and
# the tf_idf of recipes they get used in, and assign it to an output named
# `plot_top_ingredients`
output$plot_top_ingredients <- plotly::renderPlotly({
rval_top_ingredients() %>%
ggplot( aes(x = ingredients, y = tf_idf)) +
geom_col() +
coord_flip()
})
output$dt_top_ingredients <- DT::renderDT({
recipes %>%
filter(cuisine == input$cuisine) %>%
count(ingredients, name = 'nb_recipes') %>%
arrange(desc(nb_recipes)) %>%
head(input$nb_ingredients)
})
}
shinyApp(ui, server)
Listening on http://127.0.0.1:4447NAA handy way to visualize a lot of data is wordclouds. In this exercise, you will extend the Shiny app we built previously and add a new tab that displays the top distinctive ingredients as an interactive wordcloud.
Here is a handy snippet to create a wordcloud.
d3wordcloud(
words = c('hello', 'world', 'good'),
freqs = c(20, 40, 30),
tooltip = TRUE
)library(wordcloud)
library(RColorBrewer)ui <- fluidPage(
titlePanel('Explore Cuisines'),
sidebarLayout(
sidebarPanel(
selectInput('cuisine', 'Select Cuisine', unique(recipes$cuisine)),
sliderInput('nb_ingredients', 'Select No. of Ingredients', 5, 100, 20),
),
mainPanel(
tabsetPanel(
# CODE BELOW: Add `d3wordcloudOutput` named `wc_ingredients` in a `tabPanel`
tabPanel('Word Cloud', plotOutput('wc_ingredients')),
tabPanel('Plot', plotly::plotlyOutput('plot_top_ingredients')),
tabPanel('Table', DT::DTOutput('dt_top_ingredients'))
)
)
)
)
server <- function(input, output, session){
# CODE BELOW: Render an interactive wordcloud of top distinctive ingredients
# and the number of recipes they get used in, using
# `d3wordcloud::renderD3wordcloud`, and assign it to an output named
# `wc_ingredients`
wordcloud_rep <- repeatable(wordcloud)
output$wc_ingredients <- renderPlot({
ingredients_df <- rval_top_ingredients()
wordcloud_rep(words = ingredients_df$ingredients,
freq = ingredients_df$nb_recipes,
scale = c(4, 0.5),
colors=brewer.pal(8, "Dark2"))
})
rval_top_ingredients <- reactive({
recipes_enriched %>%
filter(cuisine == input$cuisine) %>%
arrange(desc(tf_idf)) %>%
head(input$nb_ingredients) %>%
mutate(ingredients = forcats::fct_reorder(ingredients, tf_idf))
})
output$plot_top_ingredients <- plotly::renderPlotly({
rval_top_ingredients() %>%
ggplot(aes(x = ingredients, y = tf_idf)) +
geom_col() +
coord_flip()
})
output$dt_top_ingredients <- DT::renderDT({
recipes %>%
filter(cuisine == input$cuisine) %>%
count(ingredients, name = 'nb_recipes') %>%
arrange(desc(nb_recipes)) %>%
head(input$nb_ingredients)
})
}
shinyApp(ui = ui, server= server)
Listening on http://127.0.0.1:4447Below not working in R 4:
ui <- fluidPage(
titlePanel('Explore Cuisines'),
sidebarLayout(
sidebarPanel(
selectInput('cuisine', 'Select Cuisine', unique(recipes$cuisine)),
sliderInput('nb_ingredients', 'Select No. of Ingredients', 5, 100, 20),
),
mainPanel(
tabsetPanel(
# CODE BELOW: Add `d3wordcloudOutput` named `wc_ingredients` in a `tabPanel`
tabPanel('Word Cloud', d3wordcloud::d3wordcloudOutput('wc_ingredients', height = '400')),
tabPanel('Plot', plotly::plotlyOutput('plot_top_ingredients')),
tabPanel('Table', DT::DTOutput('dt_top_ingredients'))
)
)
)
)
server <- function(input, output, session){
# CODE BELOW: Render an interactive wordcloud of top distinctive ingredients
# and the number of recipes they get used in, using
# `d3wordcloud::renderD3wordcloud`, and assign it to an output named
# `wc_ingredients`.
output$wc_ingredients <- d3wordcloud::renderD3wordcloud({
ingredients_df <- rval_top_ingredients()
d3wordcloud(ingredients_df$ingredient, ingredients_df$nb_recipes, tooltip = TRUE)
})
rval_top_ingredients <- reactive({
recipes_enriched %>%
filter(cuisine == input$cuisine) %>%
arrange(desc(tf_idf)) %>%
head(input$nb_ingredients) %>%
mutate(ingredient = forcats::fct_reorder(ingredient, tf_idf))
})
output$plot_top_ingredients <- plotly::renderPlotly({
rval_top_ingredients() %>%
ggplot(aes(x = ingredient, y = tf_idf)) +
geom_col() +
coord_flip()
})
output$dt_top_ingredients <- DT::renderDT({
recipes %>%
filter(cuisine == input$cuisine) %>%
count(ingredient, name = 'nb_recipes') %>%
arrange(desc(nb_recipes)) %>%
head(input$nb_ingredients)
})
}
shinyApp(ui = ui, server= server)There is a rich ecosystem of interactive widgets like d3wordcloud, that make it easy to add interactivity to your Shiny app. Look up the gallery of htmlwidgets at http://gallery.htmlwidgets.org/.
Mass Shootings have been a topic of intense discussion in the United States. A public database of mass shootings since 1982 has been made available by the Mother Jones, a non-profit organization. Over the next three exercises, you will build a Shiny app to explore these shootings on an interactive map.
In this exercise, you will add a slider input to filter on fatalities and a date range input to filter on a range of dates.
library(shiny)
library(dplyr)
library(leaflet)
library(readr)
library(lubridate)
mass_shootings <- read_csv("mass-shootings.csv")Duplicated column names deduplicated: 'location' => 'location_1' [8]Parsed with column specification:
cols(
.default = col_character(),
fatalities = col_double(),
injured = col_double(),
total_victims = col_double(),
age_of_shooter = col_double(),
latitude = col_double(),
longitude = col_double(),
year = col_double()
)
See spec(...) for full column specifications.)Error: unexpected ')' in ")"mass_shootings <- mass_shootings %>%
mutate(date = parse_date_time(mass_shootings$date, "mdy"))ui <- bootstrapPage(
theme = shinythemes::shinytheme('simplex'),
leaflet::leafletOutput('map', height = '100%', width = '100%'),
absolutePanel(top = 10, right = 10, id = 'controls',
# CODE BELOW: Add slider input named nb_fatalities
sliderInput("nb_fatalities", "Minimum Fatalities", value = 10, min = 1, max = 40),
# CODE BELOW: Add date range input named date_range
dateRangeInput("date_range", "Select Date", start = "1982-01-01", end = 2020-01-01)
),
tags$style(type = "text/css", "
html, body {width:100%;height:100%}
#controls{background-color:white;padding:20px;}
")
)Couldn't coerce the `end` argument to a date string with format yyyy-mm-ddserver <- function(input, output, session) {
output$map <- leaflet::renderLeaflet({
leaflet() %>%
addTiles() %>%
setView( -98.58, 39.82, zoom = 5) %>%
addTiles()
})
}
shinyApp(ui, server)
Listening on http://127.0.0.1:4906Note how we made use of an alternate layout to display a full screen interactive map, and a sticky input panel on the top right. Shiny has many such layouts that you should definitely explore.
Wou will extend the Shiny app you built previously so that red circles sized based on the number of fatalities appear on the interactive map, along with a summary of the case when the circle is clicked.
server <- function(input, output, session) {
rval_mass_shootings <- reactive({
# MODIFY CODE BELOW: Filter mass_shootings on nb_fatalities and
# selected date_range.
mass_shootings %>%
filter(
date >= input$date_range[1],
date <= input$date_range[2],
fatalities >= input$nb_fatalities
)
})
output$map <- leaflet::renderLeaflet({
rval_mass_shootings() %>%
leaflet() %>%
addTiles() %>%
setView( -98.58, 39.82, zoom = 5) %>%
addTiles() %>%
addCircleMarkers(
# CODE BELOW: Add parameters popup and radius and map them
# to the summary and fatalities columns
popup = ~ summary, radius = ~ fatalities,
fillColor = 'red', color = 'red', weight = 1
)
})
}
ui <- bootstrapPage(
theme = shinythemes::shinytheme('simplex'),
leaflet::leafletOutput('map', height = '100%', width = '100%'),
absolutePanel(top = 10, right = 10, id = 'controls',
sliderInput('nb_fatalities', 'Minimum Fatalities', 1, 40, 10),
dateRangeInput('date_range', 'Select Date', "2010-01-01", "2019-12-01")
),
tags$style(type = "text/css", "
html, body {width:100%;height:100%}
#controls{background-color:white;padding:20px;}
")
)
shinyApp(ui, server)
Listening on http://127.0.0.1:5879
Assuming "longitude" and "latitude" are longitude and latitude, respectively
Assuming "longitude" and "latitude" are longitude and latitude, respectively
Assuming "longitude" and "latitude" are longitude and latitude, respectivelyNAUse reactive expressions generously in your app. They are executed only when required, and their values are cached, leading to highly performant apps. It also leads to more modular code that is easier to maintain.
It is always useful to provide users with more context about your app. One way to do this is by adding an About button to the app and display the context as a modal dialog.
This is exactly what we will be doing in this exercise.
text_about <- "This data was compiled by Mother Jones, nonprofit founded in 1976. Originally covering cases from 1982-2012, this database has since been expanded numerous times to remain current."ui <- bootstrapPage(
theme = shinythemes::shinytheme('simplex'),
leaflet::leafletOutput('map', width = '100%', height = '100%'),
absolutePanel(top = 10, right = 10, id = 'controls',
sliderInput('nb_fatalities', 'Minimum Fatalities', 1, 40, 10),
dateRangeInput(
'date_range', 'Select Date', "2010-01-01", "2019-12-01"
),
# CODE BELOW: Add an action button named show_about
actionButton('show_about', 'About')
),
tags$style(type = "text/css", "
html, body {width:100%;height:100%}
#controls{background-color:white;padding:20px;}
")
)
server <- function(input, output, session) {
# CODE BELOW: Use observeEvent to display a modal dialog
# with the help text stored in text_about.
observeEvent(input$show_about, {
showModal(modalDialog(text_about, title = 'About'))
})
output$map <- leaflet::renderLeaflet({
mass_shootings %>%
filter(
date >= input$date_range[1],
date <= input$date_range[2],
fatalities >= input$nb_fatalities
) %>%
leaflet() %>%
setView( -98.58, 39.82, zoom = 5) %>%
addTiles() %>%
addCircleMarkers(
popup = ~ summary, radius = ~ sqrt(fatalities)*3,
fillColor = 'red', color = 'red', weight = 1
)
})
}
shinyApp(ui, server)
Listening on http://127.0.0.1:5879
Assuming "longitude" and "latitude" are longitude and latitude, respectivelyNAModal dialogs are a great way to provide users with more context and information about your app, without cluttering the user interface.