Creating a Real-Time Politics Dashboard With Shiny Dashboards

Earlier this week I put together a series of graphics tracing Donald Trump’s approval rating by voter group and party affiliation, even throwing in the generic congressional ballot for good measure. While cool to have a point-in-time snapshot, I figured this could be a lot more useful if built into a live dashboard, with data updating automatically (as opposed to whenever I chose to save the charts).

To make that happen, I chose to create a Shiny Dashboard that integrates all of my existing charts and provides a nice structure for designing interactive web apps. Once I set up the scaffolding for how I wanted the page to look, it didn’t take too long to start filling in the boxes with different charts and scores.

Check it out below - note that the scoreboxes at the top are 10-day rolling averages!

Politics Dashboard

The app can be accessed directly at this link.

Notes and Code Snippets

• In the interests of decluttering my code as much as possible, I broke the core components of the Shiny app into separate ui.R and server.R files
• I re-used most of my code from my previous post about Donald Trump’s approval rating to build the charts. I placed this code within a global.R file so that it would be accessible across server.R and ui.R files and run everytime the app is loaded
• I used valueBox objects to create the scores going along the top row
• I created a tabBox to switch between voter subsets in the chart on the middle-left of the page

valueBox Details

# Define within the dashboardBody in ui.R
    
fluidRow(
  valueBoxOutput("kpi1"),
  valueBoxOutput("kpi2"),
  valueBoxOutput("kpi3")
),

# Calculate score and build valueBox in server.R
# Step 1: Calculate 10 day approval
approval_10_days <- trump.m %>% 
filter(variable == "Approve", 
       sample_subpopulation == "Adults", 
       as.Date(end_date) >= (Sys.Date() - 10)
       ) %>% 
select(value) %>%
summarize(mean = mean(value))

# Step 2: Output kpi1 - Trump Current Approval (last 10 days of polls)
output$kpi1 <- renderValueBox({
valueBox(
  paste(round(approval_10_days, 1), "%", "")
  ,'Approve of President Trump'
  ,icon = icon("thumbs-up",lib='glyphicon')
  ,color = "green")  
})

tabBox Details

# Create tabBox within the dashboardBody in ui.R
    fluidRow(
      tabBox(
        title = "Trump's Approval Rating",
        id = "tabset1", 
        height = "350px",
        width = 6,
        side = "right",
        tabPanel("All Adults", plotOutput("plot1", height = "350px")),
        tabPanel("Only Voters", plotOutput("plot2", height = "350px"))
      )
    ),

# In server.R, output the plots that were produced in global.R
output$plot1 <- renderPlot({
	trump_approval_adults
})

output$plot2 <- renderPlot({
	trump_approval_voters
})