Build Shiny Apps
2022-08-14
1 Chapter 4: Build Shiny Apps
1.1 Alien sightings
1.1.1 Alien sightings: add inputs
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.
Remember that when they’re added, the inputs should look as they do here, though they won’t yet be in the sidebar:
The usa_ufo_sightings dataset, plus the shiny, ggplot2, and dplyr packages have all been loaded for you.
Instructions
Add a title to your app.
Add an input to the sidebar that allows users to select one of the 50 U.S. states.
Add an input to the sidebar that allows users to select a range of dates. Feel free to use any start or end dates you’d like.
ui <- fluidPage(
# CODE BELOW: Add a title
sidebarLayout(
sidebarPanel(
# CODE BELOW: One input to select a U.S. state
# And one input to select a range of dates
),
mainPanel()
)
)
server <- function(input, output) {
}
shinyApp(ui, server)1.1.2 Solution
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("dates", "Choose a date range:",
start = "1920-01-01",
end = "1950-01-01"
)
),
mainPanel()
)
)
server <- function(input, output) {
}
shinyApp(ui, server)1.1.3 Alien sightings: add outputs
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.
Instructions
Add a bar plot output named
'shapes', showing the number of UFOs sighted, by shape, for the selected state and time period. Make sure to create the output in the server, and also display it in the UI.Add a table output showing named
'duration_table', by shape, the number of UFOs sighted, plus the average, median, minimum, and maximum duration of the sightings. Note that the table should only show data for the selected state and time period.
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'
# Add table output named 'duration_table'
)
)
)
server <- function(input, output) {
# CODE BELOW: Create a plot output of sightings by shape,
# For the selected inputs
# 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
}
shinyApp(ui, server)1.1.4 Solution
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")
)
)
)
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)
)
})
}
shinyApp(ui, server)1.1.5 Alien sightings: 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.
Instructions
- Add the tab panel layout and the two tabs. The first one should contain the plot, and the second one should contain the table. Feel free to name them whatever makes sense to you!
ui <- fluidPage(
titlePanel("UFO Sightings"),
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(
plotOutput("shapes"),
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)1.1.6 Solution
ui <- fluidPage(
titlePanel("UFO Sightings"),
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("Number sighted", plotOutput("shapes")),
tabPanel("Duration 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)