Client Contact Program: Uneven Success Demands Strategic Response

Overall program succeeded, but stark performance gaps require immediate resource reallocation

SWDchallenge
SWD Exercise
2025
A strategic data visualization exercise demonstrating how to select and combine chart types for maximum business impact. Using client contact program data, this analysis shows how diverging bar charts paired with slope charts can drive executive decision-making by highlighting performance gaps that demand immediate resource reallocation and accountability discussions.
Author

Steven Ponce

Published

May 23, 2025

Original

The goal of this exercise is to learn how to select and combine the most effective chart types that drive specific business decisions rather than just displaying data.

In essence, it’s about becoming a strategic data storyteller who can:

  • Evaluate multiple visualization options critically
  • Choose charts that support clear business actions
  • Combine visualizations to tell a complete, compelling story
  • Transform raw data into executive-ready insights that drive immediate decisions

The exercise teaches you that chart selection is a strategic business skill, not just a technical one!

Figure 1: Original chart

Additional information can be found HERE

Makeover

Figure 2: Combined chart showing client contact program results. Top panel: horizontal bar chart with Executive Services showing +20 percentage point improvement (blue), Travel & Experiences +8pp (dark gray), Elite Access +2pp (light gray), and Lifestyle Services -3pp decline (red). Bottom panel: slope chart showing performance trends from before to after the program, with Executive Services rising steeply from 69% to 89% (blue line), while Lifestyle Services declined from 75% to 72% (red line). Gray lines show Travel & Experiences and Elite Access with modest improvements. A 90% target line is marked.

Steps to Create this Graphic

1. Load Packages & Setup

Show code
```{r}
#| label: load

if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse,         # Easily Install and Load the 'Tidyverse'
  ggtext,            # Improved Text Rendering Support for 'ggplot2'
  showtext,          # Using Fonts More Easily in R Graphs
  scales,            # Scale Functions for Visualization
  glue,              # Interpreted String Literals
  patchwork          # The Composer of Plots 
) 

### |- figure size ---- 
camcorder::gg_record( 
  dir    = here::here("temp_plots"), 
  device = "png",
  width  = 8,
  height = 8,
  units  = "in",
  dpi    = 320)

# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```

2. Read in the Data

Show code
```{r}
#| label: read

raw_data <- readxl::read_excel(
  here::here("data", "SWDchallenge", "2025", "swdexercise058 DATA.xlsx"),
  sheet   = "MAIN",
  range   = "B4:D9",
  trim_ws = TRUE
) |>
  janitor::clean_names()
```

3. Examine the Data

Show code
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false

glimpse(raw_data)
```

4. Tidy Data

Show code
```{r}
#| label: tidy

tidy_data <- raw_data |>
  filter(category != "Total") |>
  pivot_longer(cols = c(last_quarter, this_quarter), 
               names_to = "period", 
               values_to = "contact_rate") |>
  mutate(
    period = case_when(
      period == "last_quarter" ~ "Before Program",
      period == "this_quarter" ~ "After Program"
    ),
    period = factor(period, levels = c("Before Program", "After Program"))
  ) |> 
  mutate(
    category_short = case_when(
      category == "Elite access & bespoke requests" ~ "Elite Access",
      category == "Travel & experiences" ~ "Travel & Experiences", 
      category == "Executive services" ~ "Executive Services",
      category == "Lifestyle services" ~ "Lifestyle Services",
      TRUE ~ category
    )
  )

change_data <- raw_data |>  
  filter(category != "Total") |>
  mutate(
    change = this_quarter - last_quarter,
    # Shorter category names for better display
    category_short = case_when(
      category == "Elite access & bespoke requests" ~ "Elite Access",
      category == "Travel & experiences" ~ "Travel & Experiences", 
      category == "Executive services" ~ "Executive Services",
      category == "Lifestyle services" ~ "Lifestyle Services",
      TRUE ~ category
    ),
    strategic_color = case_when(
      change >= 0.15 ~ "exceptional",     
      change >= 0.05 ~ "strong",        
      change >= -0.01 ~ "stable",       
      TRUE ~ "concerning"               
    ),
    action_needed = case_when(
      change >= 0.15 ~ "Recognize & Scale",
      change >= 0.05 ~ "Reinforce Success", 
      change >= -0.01 ~ "Monitor Closely",
      TRUE ~ "Immediate Intervention"
    )
  )
```

5. Visualization Parameters

Show code
```{r}
#| label: params

### |-  plot aesthetics ----
colors <- get_theme_colors(
  palette = c(
    "exceptional"= "#1f77b4", "strong"= "#969696", "stable" = "#bdbdbd", "concerning" = "#d62728",
    "Executive services"= "#1f77b4", "Travel & experiences"= "#969696", 
    "Elite access & bespoke requests" = "#bdbdbd", "Lifestyle services" = "#d62728"
  )
)

### |-  titles and caption ----
title_text <- str_glue("Client Contact Program: Uneven Success Demands Strategic Response")
subtitle_text <- str_glue("Overall program succeeded, but stark performance gaps require immediate\nresource reallocation")

# Create caption
caption_text <- create_swd_exe_caption(
  year = 2025,
  month = "May",
  source_text =  "Let's Practice! Exercise 5.8"
)

### |-  fonts ----
setup_fonts()
fonts <- get_font_families()

### |-  plot theme ----

# Start with base theme
base_theme <- create_base_theme(colors)

# Add weekly-specific theme elements
weekly_theme <- extend_weekly_theme(
  base_theme,
  theme(
    # Text styling 
    plot.title = element_text(face = "bold", family = fonts$title, color = colors$title, size = rel(1.14), margin = margin(b = 10)),
    plot.subtitle = element_text(family = fonts$subtitle, color = colors$text, size = rel(0.78), margin = margin(b = 20)),
    
    # Axis elements
    axis.title = element_text(color = colors$text, size = rel(0.8)),
    axis.text = element_text(color = colors$text, size = rel(0.7)),
    
    # Grid elements
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(color = "grey95", linewidth = 0.1),
    
    # Legend elements
    legend.position = "plot",
    legend.title = element_text(family = fonts$text, size = rel(0.8)),
    legend.text = element_text(family = fonts$text, size = rel(0.7)),
    
    # Plot margins 
    plot.margin = margin(t = 10, r = 15, b = 10, l = 15),
  )
)

# Set theme
theme_set(weekly_theme)
```

6. Plot

Show code
```{r}
#| label: plot

# P1. Diverging Chart ----
p1 <- ggplot(change_data, aes(
  x = reorder(category_short, change),
  y = change, fill = strategic_color
)) +
  geom_hline(yintercept = 0, color = "gray40", linewidth = 0.5, alpha = 0.8) +
  geom_col(width = 0.7, alpha = 0.9) +
  geom_text(aes(label = paste0(ifelse(change > 0, "+", ""), round(change * 100, 1), "pp")),
    hjust = ifelse(change_data$change > 0, -0.1, 1.1),
    size = 4.2, fontface = "bold", color = "black"
  ) +
  # Scales
  scale_y_continuous(
    labels = function(x) paste0(ifelse(x > 0, "+", ""), x * 100, "pp"),
    breaks = seq(-0.1, 0.20, 0.05),
    expand = expansion(mult = c(0.15, 0.15))
  ) +
  scale_fill_manual(values = colors$palette) +
  coord_flip() +
  # Labs
  labs(
    title = "Executive Services Soars (+20pp), Lifestyle Services Stumbles (-3pp)",
    subtitle = "Performance gaps this wide demand immediate strategic intervention",
    x = "",
    y = "Change in Contact Rate"
  ) +
  # Theme
  theme(
    plot.title = element_text(size = rel(1), face = "bold", color = colors$title, family = fonts$title),
    plot.subtitle = element_text(size = rel(0.71), color = colors$subtitle, family = fonts$subtitle),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
  )

# P2. Slope Chart ----
p2 <- ggplot(tidy_data, aes(x = period, y = contact_rate, group = category_short, color = category)) +
  # Geoms
  geom_hline(yintercept = 0.90, linetype = "dashed", color = "gray40", alpha = 0.6, size = 0.5) +
  geom_line(
    aes(size = ifelse(category_short == "Executive Services", 3,
      ifelse(category_short == "Lifestyle Services", 2.0, 1.0)
    )),
    alpha = 0.9
  ) +
  geom_point(aes(size = ifelse(category_short %in% c("Executive Services", "Lifestyle Services"), 3, 2))) +
  geom_text(
    data = tidy_data |>
      filter(
        period == "After Program",
        category_short %in% c("Executive Services", "Lifestyle Services")
      ),
    aes(label = category_short),
    hjust = -0.1, vjust = 0.5, size = 3.2, color = "black"
  ) +
  # Annotate
  annotate("text",
    x = 1.5, y = 0.92, label = "90% Target",
    size = 3, color = "gray40", fontface = "italic"
  ) +
  # Scales
  scale_y_continuous(
    labels = percent_format(accuracy = 1),
    limits = c(0.65, 1.0),
    breaks = seq(0.70, 1.0, 0.10)
  ) +
  scale_x_discrete(expand = expansion(mult = c(0.1, 0.35))) +
  scale_color_manual(values = colors$palette) +
  scale_size_identity() +
  labs(
    title = "The Journey: Dramatic Trajectories Reveal Strategic Opportunities",
    subtitle = "Steepest slopes indicate departments to celebrate and investigate",
    x = "",
    y = "Client Contact Rate"
  ) +
  # Theme
  theme(
    legend.position = "none",
    plot.title = element_text(size = rel(1), face = "bold", color = colors$title, family = fonts$title),
    plot.subtitle = element_text(size = rel(0.71), color = colors$subtitle, family = fonts$subtitle),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(color = "gray60", linewidth = 0.25),
  )

# Combined Plot -----
combined_plot <- (p1 / p2) +
  plot_layout(heights = c(1, 1.1))

combined_plot <- combined_plot +
  plot_annotation(
    title = title_text,
    subtitle = subtitle_text,
    caption = caption_text,
    theme = theme(
      plot.title = element_text(
        size = rel(1.25),
        family = fonts$title,
        face = "bold",
        color = colors$title,
        lineheight = 1.1,
        margin = margin(t = 5, b = 5)
      ),
      plot.subtitle = element_text(
        size = rel(0.9),
        family = fonts$subtitle,
        color = colors$subtitle,
        lineheight = 1.2,
        margin = margin(t = 5, b = 10)
      ),
      plot.caption = element_markdown(
        size   = rel(0.6),
        family = fonts$caption,
        color  = colors$caption,
        hjust  = 0.5,
        margin = margin(t = 10)
      ),
      plot.margin = margin(t = 20, r = 10, b = 20, l = 10),
    )
  )
```

7. Save

Show code
```{r}
#| label: save

### |-  plot image ----  
save_plot_patchwork(
  combined_plot, 
  type = 'swd', 
  year = 2025, 
  month = 05, 
  exercise = 058,
  width = 8, 
  height = 8
  )
```

8. Session Info

R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 22631)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/New_York
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
 [1] here_1.0.1      patchwork_1.3.0 glue_1.8.0      scales_1.3.0   
 [5] showtext_0.9-7  showtextdb_3.0  sysfonts_0.8.9  ggtext_0.1.2   
 [9] lubridate_1.9.3 forcats_1.0.0   stringr_1.5.1   dplyr_1.1.4    
[13] purrr_1.0.2     readr_2.1.5     tidyr_1.3.1     tibble_3.2.1   
[17] ggplot2_3.5.1   tidyverse_2.0.0 pacman_0.5.1   

loaded via a namespace (and not attached):
 [1] gtable_0.3.6       xfun_0.49          htmlwidgets_1.6.4  tzdb_0.5.0        
 [5] yulab.utils_0.1.8  vctrs_0.6.5        tools_4.4.0        generics_0.1.3    
 [9] curl_6.0.0         gifski_1.32.0-1    fansi_1.0.6        pkgconfig_2.0.3   
[13] ggplotify_0.1.2    readxl_1.4.3       rematch_2.0.0      lifecycle_1.0.4   
[17] compiler_4.4.0     farver_2.1.2       munsell_0.5.1      janitor_2.2.0     
[21] codetools_0.2-20   snakecase_0.11.1   htmltools_0.5.8.1  yaml_2.3.10       
[25] pillar_1.9.0       camcorder_0.1.0    magick_2.8.5       commonmark_1.9.2  
[29] tidyselect_1.2.1   digest_0.6.37      stringi_1.8.4      rsvg_2.6.1        
[33] rprojroot_2.0.4    fastmap_1.2.0      grid_4.4.0         colorspace_2.1-1  
[37] cli_3.6.4          magrittr_2.0.3     utf8_1.2.4         withr_3.0.2       
[41] timechange_0.3.0   rmarkdown_2.29     cellranger_1.1.0   hms_1.1.3         
[45] evaluate_1.0.1     knitr_1.49         markdown_1.13      gridGraphics_0.5-1
[49] rlang_1.1.6        gridtext_0.1.5     Rcpp_1.0.13-1      xml2_1.3.6        
[53] renv_1.0.3         svglite_2.1.3      rstudioapi_0.17.1  jsonlite_1.8.9    
[57] R6_2.5.1           fs_1.6.5           systemfonts_1.1.0

9. GitHub Repository

The complete code for this analysis is available in swd_2025_05 - Ex_058.qmd. For the full repository, click here.

10. References

Data Sources:

  1. Data Sources:

Back to top