Building a Shiny App for Cycling in Ottawa

Create a new R script

We’ll start with the packages and data. We haven’t done anything with the UI or Server yet. We usually want to keep the data outside the UI. We’ll also transform our data as we did earlier to generate the total and average time plots.

library(tidyverse)
library(leaflet)
library(leafpop)
library(shiny)
library(shinythemes)
library(shinyWidgets)

bikes <- read_csv("https://raw.githubusercontent.com/whipson/Ottawa_Bicycles/master/bikes_app.csv", col_types = c("?nnnnnnnnnnnnnn"))

#For ease, I've put the coordinates in a separate file, but you could just as easily rerun the 'coords' object above

coords <- read_csv("https://raw.githubusercontent.com/whipson/Ottawa_Bicycles/master/coords.csv")

bikes_plot <- bikes %>%
  pivot_longer(names_to = "counter", values_to = "count", -date) %>%
  left_join(coords, by = "counter")

bikes_total <- bikes_plot %>%
  group_by(date) %>%
  summarize(count = sum(count, na.rm = TRUE))

bikes_mean <- bikes_plot %>%
  group_by(date) %>%
  summarize(count = mean(count, na.rm = TRUE))

Now, still in the same R script, we can build the UI. It’s going to look a bit strange with parentheses all over the place. It’s just customary Shiny scripting to use hanging parentheses.

Specifying the UI

ui <- fluidPage(theme = shinytheme("flatly"),

  sidebarLayout(  #Layout
    
    sidebarPanel(id = "Sidebar",  #Side panel
                 h2("Ottawa Bicycle Counters", align = "center", tags$style("#Sidebar{-family: Verdana;}")),
                 fluidRow(  # Row 1 of side panel
                   htmlOutput("caption"),  # Caption output, provides descriptive text
                   tags$style("#caption{-size: 16px; height: 200px; -family: Verdana;}")
                 ),
                 fluidRow(  # Row 2 of side panel
                   htmlOutput("stats"),  # Statistics output, provides descriptive statistics 
                   tags$style("#stats{-size: 16px; height: 125px; -family: Verdana;}")
                 ),
                 fluidRow(  # Row 3 of side panel
                   switchInput("average",  # User input, allows the user to turn a switch to display the average
                               "Display Average",
                               value = FALSE)
                 ),
                 fluidRow(  # Row 4 of side panel
                   htmlOutput("caption2"),  # More caption output
                   tags$style("#caption2{-size: 12px; height: 80px; -family: Verdana;}")
                   ),
                 fluidRow(  # Row 5 of side panel 
                   downloadButton("download", "Download Data")  # A button so that users can download the data
                   )
                 ),
    mainPanel(id = "Main",  # Main panel (this is where the plots and map go)
              fluidRow(  # Row 1 of main panel
                leafletOutput("map", height = 400)  # Here's the output for the map
                ),
              fluidRow(  # Row 2 of main panel
                plotOutput("timeplot", height = 300)  # Here's the output for the time plots
                )
              )
    )
)

There’s the code for the UI. Starting from the top, we use the FluidPage function and here I’m using the theme flatly. Then I say that I want to use a sidebarLayout. From here, I split the code into a sidebarPanel and a mainPanel. I further split things into fluidRows which just helps to organize the layout. All of the #s are notes, of course, and will not actually be run.

The big thing to notice is that there are inputs and outputs. The only input is a switchInput which lets the user choose whether to display totals or averages. Everything else is an output. Each of these gets a name, for example, I’m calling the leafletOutput map. These names are important, as they will correspond with what we provide in the server part.

Specifying the Server

server <- function(input, output) {
  
  output$map <- renderLeaflet({  # Map output
      leaflet(data = coords) %>%
         addTiles() %>%
         addMarkers(~long, ~lat, label = ~name) %>%
         setMaxBounds(-75.65, 45.38, -75.75, 45.46) %>%
         addProviderTiles(providers$CartoDB.Positron)
    })
  
  output$caption2 <- renderUI({  # Lower caption output
    str1 <- paste("Created by ", a("Will Hipson.", href = "https://willhipson.netlify.com/"))
    str2 <- paste("Data courtesy of ", a("Open Data Ottawa.", href = "https://open.ottawa.ca/datasets/bicycle-trip-counters"))
    str3 <- "2010-01-01 - 2019-09-30"
    str4 <- "Updated on 2019-10-24"
    HTML(paste(str1, str2, str3, str4, sep = '<br/>'))
  })
  
  observeEvent(input$map_marker_click, { # If the user clicks a marker, this line is run.
    output$timeplot <- renderPlot({
      if(input$average == TRUE) { # if average is selected we get average overlayed
        ggplot() +
          geom_line(data = bikes_plot[bikes_plot$lat == input$map_marker_click$lat, ], 
                    aes(x = date, y = count), size = .5, alpha = .70, color = "#36648B") +
          geom_line(data = bikes_mean, aes(x = date, y = count), alpha = .50, color = "#9F79EE") +
          scale_x_datetime(date_breaks = "2 years", date_labels = "%Y") +
          scale_y_continuous(limits = c(0, 6000)) +
          labs(x = NULL,
               y = "Count",
               title = paste(bikes_plot[bikes_plot$lat == input$map_marker_click$lat,]$name)) +
          theme_minimal(base_size = 16) +
          theme(plot.title = element_text(hjust = .5),
                axis.text.x = element_text(size = 16),
                text = element_text(family = "Verdana"))
      } else { # if average is not selected, then it's just the total
        ggplot() +
          geom_line(data = bikes_plot[bikes_plot$lat == input$map_marker_click$lat, ], 
                    aes(x = date, y = count), size = .5, alpha = .70, color = "#36648B") +
          scale_x_datetime(date_breaks = "2 years", date_labels = "%Y") +
          scale_y_continuous(limits = c(0, 6000)) +
          labs(x = NULL,
               y = "Count",
               title = paste(bikes_plot[bikes_plot$lat == input$map_marker_click$lat,]$name)) +
          theme_minimal(base_size = 16) +
          theme(plot.title = element_text(hjust = .5),
                axis.text.x = element_text(size = 16),
                text = element_text(family = "Verdana"))
      }
    })
    
    output$caption <- renderUI({ # counter specific description
      str1 <- coords[coords$lat == input$map_marker_click$lat, ]$desc
      HTML(str1)
    })
    
    output$stats <- renderUI({ # counter specific statistics
      str1 <- "<b>Statistics</b>"
      str2 <- paste("Total count: ", format(round(sum(bikes_plot[bikes_plot$lat == input$map_marker_click$lat,]$count, na.rm = TRUE)), big.mark = ","))
      str3 <- paste("Average count: ", format(round(mean(bikes_plot[bikes_plot$lat == input$map_marker_click$lat,]$count, na.rm = TRUE), 1), big.mark = ","))
      str4 <- paste("Busiest day: ", bikes_plot[which.max(bikes_plot[bikes_plot$lat == input$map_marker_click$lat,]$count),]$date)
      HTML(paste(str1, str2, str3, str4, sep = '<br/>'))
      })
  })
    
  observeEvent(input$map_click, ignoreNULL = FALSE, {  # If the user clicks on the map it goes back to the cumulative data
    output$timeplot <- renderPlot({
      if(input$average == TRUE) {  # if the average is selected, it displays average
      ggplot(data = bikes_mean, aes(x = date, y = count)) +
          geom_line(size = .5, alpha = .70, color = "#36648B") +
          scale_x_datetime(date_breaks = "2 years", date_labels = "%Y") +
          labs(x = NULL,
               y = "Count") +
          theme_minimal(base_size = 16) +
          theme(plot.title = element_text(hjust = .5),
                axis.text.x = element_text(size = 16),
                text = element_text(family = "Verdana"))
      } else { # if average is not selected it is the total
        ggplot(data = bikes_total, aes(x = date, y = count)) +
          geom_line(size = .5, alpha = .70, color = "#36648B") +
          scale_x_datetime(date_breaks = "2 years", date_labels = "%Y") +
          labs(x = NULL,
               y = "Count") +
          theme_minimal(base_size = 16) +
          theme(plot.title = element_text(hjust = .5),
                axis.text.x = element_text(size = 16),
                text = element_text(family = "Verdana"))
      }
    })
    
    output$caption <- renderUI({  # the default caption
      str1 <- "Presenting data from bicycle counters across Ottawa. There are 14 counters spread across the city. The graph below displays how daily counts change over time. Click on a map marker to select a specific counter."
      HTML(str1)
    })
    
    output$stats <- renderUI({  # Statistics output
      str1 <- "<b>Statistics</b>"
      str2 <- paste("Total count: ", format(round(sum(bikes_total$count, na.rm = TRUE)), big.mark = ","))
      str3 <- paste("Average count: ", format(round(mean(bikes_total$count, na.rm = TRUE), 1), big.mark = ","))
      str4 <- paste("Busiest day: ", bikes_total[which.max(bikes_total$count),]$date)
      HTML(paste(str1, str2, str3, str4, sep = '<br/>'))
    })
  })
  
  output$download <- downloadHandler( # download button. Will turn 'bikes' object into a csv file.
    filename = function() {
      paste("ottawa_bikes", ".csv", sep = "")
    },
    
    content = function(file) {
      write.csv(bikes, file)
    }
  )
}

The code for the server is much busier and it can be overwhelming. Essentially we’re just saying what we want to do with the inputs and outputs. We generate a little code chunk for each output. Look at the first one for map. This is where we generate the map. We say we want to renderLeaflet and then we just copy the code that we made earlier into this block.

Where things get a bit more complicated is when we want our output to change based on user input. If the user selects the switch that converts the data to averages, for example. I used if and else statements to modulate the output based on whether ‘average’ is selected. What happens, is when the user clicks on the switch, the value of input$average changes to TRUE. Using if and else functions, I just say what I want to happen when ‘average’ is TRUE and what happens if it’s FALSE.

Finally, we want the user to be able to click on specific markers and have the output change to that specific marker. We use the observeEvent function and specify the input, ‘map_marker_click’. We also want the user to be able to click off the marker to go back to the default output. Again, we use observeEvent but now with ‘click_map’.

Once we have all the other outputs in place for the downloads and the captions, we put it all together using the shinyApp function.

shinyApp(ui, server)

And there it is, a user-friendly app for exploring bicycling data in Ottawa. Future avenues include building in some time-series forecasting. It would be cool to show the user how the trend is expected to change over time.

One last shout out to Open Data Ottawa for sharing this data!