Chapter 4 Project 2: Sales Performance Dashboard (Shiny + DBI)

Executive dashboards transform raw data into actionable intelligence. In this chapter, we build a production-grade sales performance dashboard using Shiny, shinydashboard, and plotly — connected directly to a data warehouse for real-time insights.

4.1 Business Context

Sales leadership needs visibility into:

• Total pipeline value and weighted pipeline
• Quota attainment by team and individual
• Win rates and average deal sizes
• At-risk deals requiring intervention
• Revenue bridge: how ARR moves from start to end of period

The dashboard must handle multiple concurrent users, refresh data efficiently, and provide interactive drill-downs.

4.2 Architecture Overview

Data Warehouse (Snowflake/BigQuery)
    │
    ▼
dbplyr lazy queries ──► Reactive data loading
    │
    ▼
Shiny Server ──► shinydashboard UI
    │
    ▼
plotly (interactive charts) + DT (data tables)

4.3 Data Model Functions

We encapsulate all database logic in reusable functions. This makes testing easier and allows the Shiny app to focus on presentation logic.

library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(dbplyr)
library(dplyr)
library(lubridate)

get_pipeline_data <- function(con, start_date, end_date) {
  tbl(con, "fact_pipeline") %>%
    inner_join(tbl(con, "dim_date"), by = "date_key") %>%
    inner_join(tbl(con, "dim_sales_rep"), by = "rep_key") %>%
    inner_join(tbl(con, "dim_account"), by = "account_key") %>%
    inner_join(tbl(con, "dim_stage"), by = "stage_key") %>%
    filter(date >= start_date, date <= end_date) %>%
    mutate(
      weighted_pipeline = opportunity_value * (probability_pct / 100),
      is_at_risk = ifelse(
        is_closed == FALSE & 
          as.numeric(Sys.Date() - last_activity_date) > 30 &
          opportunity_value > 50000,
        TRUE, FALSE
      )
    ) %>%
    collect()
}

Tip: The is_at_risk flag combines business rules (open deal, no activity in 30 days, high value) into a single boolean. This pushes complexity to the data layer, keeping the UI simple.

4.4 Dashboard UI Design

shinydashboard provides a professional layout with a sidebar, header, and tabbed body content.

ui <- dashboardPage(
  dashboardHeader(title = "Sales Performance"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("Executive Summary", tabName = "exec", icon = icon("dashboard")),
      menuItem("Pipeline Deep Dive", tabName = "pipeline", icon = icon("chart-line")),
      menuItem("Rep Performance", tabName = "reps", icon = icon("users"))
    ),

    dateRangeInput("date_range", "Date Range",
                   start = Sys.Date() - 90, end = Sys.Date()),
    selectInput("territory", "Territory", 
                choices = c("All", "NA", "EMEA", "APAC"))
  ),

  dashboardBody(
    tabItems(
      tabItem(tabName = "exec",
        fluidRow(
          valueBoxOutput("total_pipeline", width = 3),
          valueBoxOutput("quota_attainment", width = 3),
          valueBoxOutput("win_rate", width = 3),
          valueBoxOutput("avg_deal_size", width = 3)
        ),
        fluidRow(
          box(plotlyOutput("waterfall_chart"), width = 8),
          box(DTOutput("at_risk_deals"), width = 4, title = "At-Risk Deals")
        )
      ),

      tabItem(tabName = "pipeline",
        fluidRow(
          box(plotlyOutput("funnel_chart"), width = 6),
          box(plotlyOutput("scatter_chart"), width = 6)
        )
      )
    )
  )
)

4.5 Reactive Data Loading

Shiny’s reactivity system ensures data is loaded only when inputs change. We use reactive() to cache the pipeline data and eventReactive() for actions triggered by buttons.

server <- function(input, output, session) {

  # Reactive data source: refreshes when date_range or territory changes
  pipeline_data <- reactive({
    get_pipeline_data(con, input$date_range[1], input$date_range[2]) %>%
      {if (input$territory != "All") filter(., territory == input$territory) else .}
  }) %>%
    bindCache(input$date_range, input$territory) %>%
    bindEvent(input$date_range, input$territory)

  # Value boxes
  output$total_pipeline <- renderValueBox({
    val <- pipeline_data() %>%
      summarise(total = sum(opportunity_value, na.rm = TRUE)) %>%
      pull(total)

    valueBox(
      scales::dollar(val),
      "Total Pipeline",
      icon = icon("dollar-sign"),
      color = "blue"
    )
  })

  output$quota_attainment <- renderValueBox({
    total_won <- pipeline_data() %>%
      filter(is_closed_won) %>%
      summarise(won = sum(opportunity_value, na.rm = TRUE)) %>%
      pull(won)

    total_quota <- tbl(con, "dim_sales_rep") %>%
      {if (input$territory != "All") filter(., territory == input$territory) else .} %>%
      summarise(q = sum(quota, na.rm = TRUE)) %>% 
      pull(q)

    val <- total_won / total_quota

    valueBox(
      scales::percent(val),
      "Quota Attainment",
      icon = icon("trophy"),
      color = if (val >= 1) "green" else if (val >= 0.8) "yellow" else "red"
    )
  })

Note: bindCache() stores results in memory, reducing database load. bindEvent() ensures the reactive only executes when specified inputs change, not on every session start.

4.6 Interactive Visualizations with plotly

4.6.1 Revenue Bridge Chart

The revenue bridge shows how ARR changes through new business, expansion, and churn.

  output$waterfall_chart <- renderPlotly({
    bridge_data <- pipeline_data() %>%
      group_by(month = floor_date(date, "month")) %>%
      summarise(
        new_arr = sum(opportunity_value * (stage_name == "Closed Won" & deal_type == "New")),
        expansion = sum(opportunity_value * (stage_name == "Closed Won" & deal_type == "Expansion")),
        churn = sum(opportunity_value * (stage_name == "Closed Lost" & deal_type == "Churn")),
        .groups = "drop"
      )

    plot_ly(bridge_data, x = ~month) %>%
      add_bars(y = ~new_arr, name = "New ARR", 
               marker = list(color = "#2E7D32")) %>%
      add_bars(y = ~expansion, name = "Expansion", 
               marker = list(color = "#1976D2")) %>%
      add_bars(y = ~-churn, name = "Churn", 
               marker = list(color = "#C62828")) %>%
      layout(
        barmode = "relative",
        title = "Revenue Bridge",
        yaxis = list(title = "$ ARR", tickformat = "$,.0f"),
        hovermode = "x unified"
      )
  })

4.6.2 At-Risk Deals Table

  output$at_risk_deals <- renderDT({
    pipeline_data() %>%
      filter(is_at_risk) %>%
      select(account_name, rep_name, opportunity_value, days_stagnant) %>%
      arrange(desc(opportunity_value)) %>%
      datatable(
        options = list(pageLength = 5, scrollX = TRUE),
        rownames = FALSE
      ) %>%
      formatCurrency("opportunity_value", currency = "$", digits = 0)
  })

4.7 Performance Optimization

Production Shiny apps require careful performance tuning:

4.7.1 1. Database Optimization

• Add indexes on date_key, rep_key, and account_key
• Use materialized views for pre-aggregated metrics
• Consider read replicas for dashboard queries

4.7.2 2. Shiny Optimization

# Use promises for non-blocking operations
library(promises)
library(future)
plan(multisession)

pipeline_data <- reactive({
  future({ get_pipeline_data(con, ...) })
}) %>%
  bindCache(...)

4.7.3 3. Caching Strategies

# Cache at the app level
shinyOptions(cache = cache_mem(max_size = 200e6))

# Or use a disk cache for larger datasets
library(cachem)
app_cache <- cache_disk(dir = "shiny_cache", max_size = 1e9)

4.8 Deployment Options

4.8.1 RStudio Connect

rsconnect::deployApp("sales-dashboard/")

4.8.2 Shiny Server Open Source

Configure shiny-server.conf for load balancing and process limits.

4.8.3 Docker

FROM rocker/shiny-verse:4.3
COPY . /srv/shiny-server/sales-dashboard/
EXPOSE 3838

4.9 Exercises

1. Add a “Rep Performance” tab with a leaderboard showing win rate and average deal size by sales rep.
2. Implement a download button that exports the current view to Excel using openxlsx.
3. Add a forecast widget that projects quarter-end attainment based on current pipeline velocity.
4. Set up automated email alerts when quota attainment drops below 75% using blastula.

---

Next, we’ll explore marketing attribution — understanding which touchpoints drive conversions using Markov chains.