Introduction

GlobalShala’s Superhero U is a week-long virtual leadership event designed for students and educators/principals, aiming for global reach and impact through workshops and mentoring. A total of 11 Ad campaigns were run for this event on facebook. The dataset for this analysis was exported from Facebook, capturing metrics from ad campaigns targeting two key audiences: “students” and “educators and principals.” Thorough evaluation was conducted to assess campaign performance and provide actionable recommendations. The primary goal was to identify underperforming campaigns, optimize budget allocation, and enhance overall campaign efficiency, with findings visualized using tools like R and Tableau.

Objectives

  • The analysis focused on several key objectives to ensure a comprehensive evaluation:

    • Performance Evaluation:
      Assess campaigns using critical KPIs such as:

      • Cost Per Click (CPC)
      • Click-Through Rate (CTR)
      • Unique Link Clicks (ULC)
      • Efficiency Score (ULC / Amount Spent)
      • Budget Impact

    • Identify Underperformers:
      Pinpoint the least effective campaigns

    • Optimization and Budget Reallocation:

      • Recommend dropping the least performing campaign to free up capital
      • Reallocate to high-performing campaigns
      • Optimize campaigns with promising performance

    • Visualization Support:
      Use tools such as R, Tableau, and Power BI to support the analysis:

      • Create bar charts, scatter plots, heatmaps, and pie charts
      • Create visuals to highlight trends in engagement and cost-efficiency across demographics and regions

Analysis Insights

Campaign Overview

The Superhero U campaigns achieved an Average Cost Per Click of $1.01 and an Average Cost Per Result of $2.30 Campaigns targeted various regions, including Australia, UK, USA, Nigeria, and a broader SHU3 group (students apart from India and US). The dataset included metrics like Reach, Impressions, Clicks, Unique Link Clicks (ULC), CTR, Unique CTR (uCTR), Frequency, Amount Spent, CPC, and CPR, providing a robust foundation for analysis.

Key Performance Metrics

  • Cost Per Click (CPC):
    • SHU Students (Australia) had the highest CPC at $7.15, 608% higher than the portfolio average of $1.01.
    • Nigeria recorded the lowest CPC at $0.34.
  • Click-Through Rate (CTR):
    • The portfolio average CTR was 4.15%.
    • The Nigerian campaign led with 9.5%, followed by USA at 6.1%, and SHU3 at 5.6%.
    • Australia and UK campaignslagged at 3.3% and 3.0%, respectively.
  • Unique Link Clicks (ULC):
    • SHU3 and Nigeria campaigns showed strong ULC numbers.
    • Australia and UK campaigns underperformed relative to their reach and budget.
  • Efficiency Scores (ULC/$):
    • Optimal efficiency was 0.43.
    • Australia scored poorly due to high spend and low ULC.
    • Nigeria and SHU3 excelled in efficiency.
  • Budget Impact:
    • Australia consumed $850.68, representing 7% of the total budget, despite poor performance, highlighting significant inefficiency.

Demographic Insights

  • Age Group Engagement:
    • The 18-24 age group showed the highest engagement (CTR) across most campaigns, followed by the 25-34 age group.
    • The Educators and Principals campaign uniquely reached older demographics (35-64), aligning with its target audience.
  • Geographical Performance:
    • Nigeria and SHU3 campaigns demonstrated high engagement and cost-efficiency.
    • Australia, UK, and UAE consistently underperformed in reach, CTR, and ULC.

Data Cleaning and Preparation

Load Packages & Functions

To efficiently clean, organize, and visualize datasets in R, it is essential to load the appropriate libraries and define custom functions that streamline the workflow and enhance productivity.

library(tidyverse)
library(readxl)
library(knitr)
library(scales)
library(kableExtra)
library(rmarkdown)
library(patchwork)
nicelimits <- function(x) {
  range(scales::extended_breaks(only.loose = TRUE)(x))
}
highlight = function(x, pat, color="black", family="") {
  ifelse(grepl(pat, x), glue("<b style='font-family:{family}; color:{color}'>{x}</b>"), x)
}

Data Cleaning

To begin the analysis, the raw dataset was first imported from a CSV file. The original column headers were lengthy and would have cluttered visual outputs and tables. As a result, the headers were systematically renamed to more concise, readable forms to ensure clarity throughout the report.

For transparency and ease of interpretation, a table footnote was included to explain all abbreviations used in the renamed columns.

Following the initial cleaning, key performance metrics such as Cost Per Click (CPC), Click-Through Rate (CTR), and Unique Link Clicks (ULC) were calculated or validated to support further analysis. These metrics formed the foundation for subsequent visualizations and campaign evaluations.

# Raw dataset
campaign_raw <- read_excel("EXCELERATE_main.xlsx", sheet = "marketing_team_data", range = "A1:P34")
 
campaign_raw <- campaign_raw |>
  mutate(Geography = recode(Geography, "Group 1 (Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States)"="Group 1",
                            "Group 2 (Australia, Canada, United Kingdom, Ghana, Niger, Nigeria, Nepal, Pakistan, Thailand, Taiwan)"="Group 2"))|>
  rename(campaign_id=`campaign ID`, 
         campaign_name=`Campaign Name`, 
         ULC = `Unique Link Clicks (ULC)`, 
         CTR = `Click-Through Rate (CTR in %)`, 
         uCTR = `Unique Click-Through Rate (Unique CTR in %)`,
         amount_spent = `Amount Spent in INR`,
         CPC = `Cost Per Click (CPC)`,
         CPR = `Cost per Result (CPR)`)
campaign_raw |>
  kable(caption = "Raw Marketting Campaign Dataset") |> 
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) |>
  scroll_box(width = "500", height = "100") |>
  footnote(general = "ULC = Unique Link Clicks (ULC),
         CTR = Click-Through Rate (CTR in %),
         uCTR = Unique Click-Through Rate (Unique CTR in %),
         amount_spent = Amount Spent in $,
         CPC = Cost Per Click (CPC),
         CPR = Cost per Result (CPR))
         Group 1 includes Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States.
         Group 2 includes Australia, Canada, United Kingdom, Ghana, Niger, Nigeria, Nepal, Pakistan, Thailand, Taiwan.")
Raw Marketting Campaign Dataset
campaign_id campaign_name Audience Age Geography Reach Impressions Frequency Clicks Unique Clicks ULC CTR uCTR amount_spent CPC CPR
Campaign 1 SHU_6 (Educators and Principals) Educators and Principals 25-34 Group 1 11387 23283 2.044700 487 406 180 2.09 3.57 1092.24 2.24 6.07
Campaign 1 SHU_6 (Educators and Principals) Educators and Principals 35-44 Group 1 8761 15683 1.790093 484 376 154 3.09 4.29 835.46 1.73 5.43
Campaign 1 SHU_6 (Educators and Principals) Educators and Principals 45-54 Group 1 2867 6283 2.191489 198 145 65 3.15 5.06 319.38 1.61 4.91
Campaign 1 SHU_6 (Educators and Principals) Educators and Principals 55-64 Group 1 889 1890 2.125984 49 40 21 2.59 4.50 86.25 1.76 4.11
Campaign 2 SHU3_ (Students Apart from India and US) Students 18-24 Group 2 29675 39161 1.319663 2593 1994 1095 6.62 6.72 1193.94 0.46 1.09
Campaign 2 SHU3_ (Students Apart from India and US) Students 13-17 Group 2 14753 25705 1.742358 969 698 435 3.77 4.73 299.51 0.31 0.69
Campaign 2 SHU3_ (Students Apart from India and US) Students 25-34 Group 2 2066 2447 1.184414 181 141 65 7.40 6.82 85.57 0.47 1.32
Campaign 3 SHU_Students(Australia) Students 13-17 Australia 2271 2616 1.151916 61 55 28 2.33 2.42 475.85 7.80 16.99
Campaign 3 SHU_Students(Australia) Students 18-24 Australia 704 734 1.042614 49 46 13 6.68 6.53 283.17 5.78 21.78
Campaign 3 SHU_Students(Australia) Students 25-34 Australia 212 222 1.047170 9 8 3 4.05 3.77 91.66 10.18 30.55
Campaign 4 SHU_Students (Canada) Students 13-17 Canada 2330 3146 1.350215 101 84 63 3.21 3.61 528.08 5.23 8.38
Campaign 4 SHU_Students (Canada) Students 18-24 Canada 759 878 1.156785 52 44 34 5.92 5.80 294.82 5.67 8.67
Campaign 4 SHU_Students (Canada) Students 25-34 Canada 218 243 1.114679 18 18 15 7.41 8.26 101.06 5.61 6.74
Campaign 5 SHU_Students(Ghana) Students 18-24 Ghana 5952 6943 1.166499 284 238 98 4.09 4.00 378.10 1.33 3.86
Campaign 5 SHU_Students(Ghana) Students 25-34 Ghana 3717 4620 1.242938 184 160 46 3.98 4.30 282.22 1.53 6.14
Campaign 5 SHU_Students(Ghana) Students 13-17 Ghana 5355 8920 1.665733 180 154 93 2.02 2.88 177.46 0.99 1.91
Campaign 6 SHU_Students (India) Students 18-24 India 30110 35372 1.174759 1308 1162 934 3.70 3.86 894.00 0.68 0.96
Campaign 6 SHU_Students (India) Students 25-34 India 1721 1874 1.088902 92 76 53 4.91 4.42 61.21 0.67 1.15
Campaign 7 SHU_Students(Nepal) Students 18-24 Nepal 18900 36659 1.939630 849 688 306 2.32 3.64 634.64 0.75 2.07
Campaign 7 SHU_Students(Nepal) Students 13-17 Nepal 6145 19474 3.169081 325 246 129 1.67 4.00 211.76 0.65 1.64
Campaign 7 SHU_Students(Nepal) Students 25-34 Nepal 4623 9082 1.964525 246 212 83 2.71 4.59 188.84 0.77 2.28
Campaign 8 SHU_Students (Nigeria) Students 18-24 Nigeria 11027 13820 1.253287 1491 1132 548 10.79 10.27 542.67 0.36 0.99
Campaign 8 SHU_Students (Nigeria) Students 13-17 Nigeria 8516 12372 1.452795 970 696 408 7.84 8.17 282.21 0.29 0.69
Campaign 8 SHU_Students (Nigeria) Students 25-34 Nigeria 2386 2782 1.165968 304 230 117 10.93 9.64 117.90 0.39 1.01
Campaign 9 SHU_Students(UAE) Students 25-34 UAE 2892 3347 1.157331 135 102 41 4.03 3.53 455.49 3.37 11.11
Campaign 9 SHU_Students(UAE) Students 18-24 UAE 2862 3234 1.129979 72 60 27 2.23 2.10 316.14 4.39 11.71
Campaign 9 SHU_Students(UAE) Students 13-17 UAE 1579 2079 1.316656 35 32 20 1.68 2.03 104.63 2.99 5.23
Campaign 10 SHU_Students(UK) Students 13-17 UK 2557 2941 1.150176 69 60 33 2.35 2.35 487.52 7.07 14.77
Campaign 10 SHU_Students(UK) Students 18-24 UK 741 785 1.059379 39 34 20 4.97 4.59 255.57 6.55 12.78
Campaign 10 SHU_Students(UK) Students 25-34 UK 338 365 1.079882 13 11 4 3.56 3.25 113.58 8.74 28.40
Campaign 11 SHU_Students (USA) Students 13-17 USA 2159 2465 1.141732 126 111 95 5.11 5.14 691.28 5.49 7.28
Campaign 11 SHU_Students (USA) Students 18-24 USA 305 332 1.088525 43 37 28 12.95 12.13 159.14 3.70 5.68
Campaign 11 SHU_Students (USA) Students 25-34 USA 91 103 1.131868 9 8 3 8.74 8.79 47.26 5.25 15.75
Note:
ULC = Unique Link Clicks (ULC),
CTR = Click-Through Rate (CTR in %),
uCTR = Unique Click-Through Rate (Unique CTR in %),
amount_spent = Amount Spent in $,
CPC = Cost Per Click (CPC),
CPR = Cost per Result (CPR))
Group 1 includes Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States.
Group 2 includes Australia, Canada, United Kingdom, Ghana, Niger, Nigeria, Nepal, Pakistan, Thailand, Taiwan. 
# Cleaning dataset  
campaign_clean <- campaign_raw|>
  group_by(campaign_id,campaign_name,Audience,Geography)|>
  summarise(across(where(is.numeric), sum, na.rm = TRUE))|>
  mutate(Frequency = Impressions/Reach,
         CTR = Clicks/Impressions*100,
         uCTR = `Unique Clicks`/Reach*100,
         CPC= amount_spent/Clicks,
         CPR= amount_spent/ULC,
         Geography = recode(Geography, "Group 1 (Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States)"="Group 1",
                            "Group 2 (Australia, Canada, United Kingdom, Ghana, Niger, Nigeria, Nepal, Pakistan, Thailand, Taiwan)"="Group 2"))

campaign_clean |>
  kable(caption = "Cleaned Campaign Dataset") |> 
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) |>
  scroll_box(width = "500", height = "200")
Cleaned Campaign Dataset
campaign_id campaign_name Audience Geography Reach Impressions Frequency Clicks Unique Clicks ULC CTR uCTR amount_spent CPC CPR
Campaign 1 SHU_6 (Educators and Principals) Educators and Principals Group 1 23904 47139 1.972013 1218 967 420 2.583848 4.045348 2333.33 1.9157061 5.5555476
Campaign 10 SHU_Students(UK) Students UK 3636 4091 1.125137 121 105 57 2.957712 2.887789 856.67 7.0799174 15.0292982
Campaign 11 SHU_Students (USA) Students USA 2555 2900 1.135029 178 156 126 6.137931 6.105675 897.68 5.0431461 7.1244444
Campaign 2 SHU3_ (Students Apart from India and US) Students Group 2 46494 67313 1.447778 3743 2833 1595 5.560590 6.093259 1579.02 0.4218595 0.9899812
Campaign 3 SHU_Students(Australia) Students Australia 3187 3572 1.120803 119 109 44 3.331467 3.420144 850.68 7.1485714 19.3336364
Campaign 4 SHU_Students (Canada) Students Canada 3307 4267 1.290293 171 146 112 4.007499 4.414878 923.96 5.4032749 8.2496429
Campaign 5 SHU_Students(Ghana) Students Ghana 15024 20483 1.363352 648 552 237 3.163599 3.674121 837.78 1.2928704 3.5349367
Campaign 6 SHU_Students (India) Students India 31831 37246 1.170117 1400 1238 987 3.758793 3.889290 955.21 0.6822929 0.9677913
Campaign 7 SHU_Students(Nepal) Students Nepal 29668 65215 2.198160 1420 1146 518 2.177413 3.862748 1035.24 0.7290423 1.9985328
Campaign 8 SHU_Students (Nigeria) Students Nigeria 21929 28974 1.321264 2765 2058 1073 9.543039 9.384833 942.78 0.3409693 0.8786393
Campaign 9 SHU_Students(UAE) Students UAE 7333 8660 1.180963 242 194 88 2.794457 2.645575 876.26 3.6209091 9.9575000

Initial Analysis

Performing a preliminary analysis of the dataset first, to discover trends and relationships, and familiarize ourselves with the dataset using R.

Bar Charts

Looking at our dataset,specific ad campaigns are targeted towards specific audience. Let’s analyse individual campaigns to see how they are peforming.

amountspent_campaign <- campaign_clean

p1 <- amountspent_campaign |>
  ggplot(aes(x = reorder(campaign_id,-amount_spent), y = amount_spent))+
  geom_col(width = 0.9, fill = "#09979B")+
  geom_text(aes(label = paste0("$",scales::comma(amount_spent,accuracy = 0.01))),
            family = "Century Gothic", fontface = "bold", vjust  = -0.5, size = 5)+
  scale_y_continuous(expand = c(0,1),
                     limits = nicelimits)+
  scale_x_discrete(label = scales::wrap_format(width = 10))+
  labs(x = NULL, y = "Amount Spent", title = "Amount Spent on Campaigns")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14, color = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text = element_text(size = 11, colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p1)

From the above chart chart, we can determine that the Campaign 1 (Educators and Principals) campaign has been the most expensive, whereas the campaign targeting the students of Ghana (Campaign 5) has been the least expensive. But if we see a comparison of Campaign with Reach, we notice something peculiar:

reach_campaign <- campaign_clean

p2 <- reach_campaign |>
  ggplot(aes(x = reorder(campaign_id,-Reach), y = Reach))+
  geom_col(width = 0.9, fill = "#27A0CC")+
  geom_text(aes(label = scales::comma(Reach), vjust = -0.5), family = "Century Gothic", fontface = "bold", size = 5)+
  scale_y_continuous(expand = c(0,0), limits = nicelimits)+
  scale_x_discrete(label = scales::wrap_format(width = 10))+
  labs(x=NULL, title = "Reach Across Campaigns")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14, color = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text = element_text(size = 11, colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p2)

Campaign 1, The Educators and Principals campaign is not the campaign with the highest reach. It isn’t even the second-highest reach – it comes at the fourth position. Whereas the inexpensive Campaing 5 , The Ghana campaign is in the 6th position, showing more reach with low cost. Let’s explore this further;

geo_cpc <- campaign_clean

p3 <- geo_cpc |>
  ggplot(aes(x=reorder(Geography,CPC), y=CPC, fill = CPC))+
  geom_col(width = 0.8)+
  scale_fill_gradient2(high = "#2ECC71",mid = "#F1C40F", low = "#E74C3C", midpoint = median(campaign_clean$CPC,na.rm = TRUE))+
  coord_flip(clip = "off")+
  labs(x=NULL, y = "Cost Per Click", title = "Cost Per Click Across Geographic locations")+
  geom_text(aes(label = paste0(round(CPC,2),"$")), hjust =-0.1, family = "Century Gothic", size = 5, fontface="bold")+
  scale_y_continuous(expand = c(0,0),limits = nicelimits)+
  theme(text = element_text(family = "Century Gothic", size = 15, face = "bold", colour = "black"),
    axis.text = element_text(family = "Century Gothic", size = 15, face = "bold", colour = "black"),
    panel.background = element_blank(),
    panel.grid.major.x = element_line(colour = "gray",size = 0.25),
    legend.position = "none",
    plot.title = element_text(hjust = 0.5, size = 15))
print(p3)

Nigeria has some of the lowest CPC, but India, which had a more successful ad campaign in terms of reach, also has a low CPC.

Scatter/Bubble plots

A bubble plot to explore the relationship between Reach and Impressions

reach_imp <- campaign_clean


p4 <- reach_imp|>
  ggplot(aes(x=Reach, y = Impressions, size = ULC, colour = campaign_id))+
  geom_point(alpha = 0.7, show.legend = c(colour = FALSE))+
  geom_text(aes(label = if_else(Reach > 5000, str_wrap(campaign_id,width = 15),"")),
            size = 4.5, colour = "black", vjust = -2.5,family = "Century Gothic", fontface = "bold")+
  scale_size_continuous(range = c(4,20))+
  scale_x_continuous(limits = nicelimits)+
  scale_y_continuous(limits = c(0,80000)) +
  labs(x = "Reach (Unique Users)", y = "Impressions (Total Views) ", size = "Unique Link Clicks", 
       title = "Reach vs. Impressions \n(Bubble Size = Unique Link Clicks)")+
  scale_colour_manual(values = c("Campaign 1"="#4B644B",
                                 "Campaign 2"="#7D96AF",
                                 "Campaign 3"="#F98B00",
                                 "Campaign 4"="#09979B",
                                 "Campaign 5"="#EA879C",
                                 "Campaign 6"="#FDD835",
                                 "Campaign 7"="#0070C0",
                                 "Campaign 8"="#AE2B47",
                                 "Campaign 9"="#EBA07E",
                                 "Campaign 10"="#E06666",
                                 "Campaign 11"="#002060"))+
  theme(text = element_text(family = "Century Gothic", face = "bold",size = 14),
        panel.background = element_blank(),
        axis.line = element_line(colour = "black", size = 1),
        axis.text = element_text(size = 15, colour = "black"),
        legend.text = element_text(size = 14, colour = "black"),
        plot.title = element_text(hjust = 0.5))
print(p4)

On the X-axis, we have Reach, which shows the number of unique users who saw each campaign. On the Y-axis, we have Impressions, which is the total number of times the ad was shown. Unique Link Clicks (ULC) was used for the bubble size, which shows how many individuals clicked on the ad. And, finally, each color represents a different campaign. Top-right corner means the best visibility. Campaigns in the top-right have high reach and high impressions, which implies strong visibility. We find that the Campaign 2 (SHU_3 (Students Apart from India and US)) campaign and Campaign 7 (SHU_ Students (Nepal)) both had high reach and impressions, making them stand out. Let’s analyze bubble size, which translates to engagement: larger bubbles mean more people clicked on the ad.

The Campaign 2 (SHU3 campaign) has a large bubble, suggesting high engagement. Campaigns 4 and 11 (Canada and USA) have tiny bubbles, indicating low click activity, even with modest reach. Campaigns positioned in the lower-left corner of the graph represent poor performers. These campaigns have low reach, low impressions, and small bubble sizes. Some of these campaigns are Campaign 9 (SHU Students (UAE)), Campaign 11 (SHU Students (USA)), and Campaign 4 (SHU Students (Canada)), reflecting low visibility and weak engagement. Campaign 10, the UK campaign is so insignificant in terms of Reach that it cannot even be displayed.

Heatmaps

Visualizing how reach varies across campaigns and Age Range using a heatmap.

campaign_age <- campaign_raw         

campaign_age <- campaign_age |>
  select(Age, campaign_id, Reach)
  
  
heatmap <- campaign_age |>
  pivot_wider(id_cols = c(campaign_id),
              names_from = "Age",
              values_from = "Reach") |>
  mutate(All_Ages= rowSums(across(c("13-17","18-24","25-34","35-44","45-54","55-64")), na.rm = TRUE))

heatmap <- heatmap |>
  add_row(campaign_id="All Campaigns",`13-17`=sum(heatmap$`13-17`, na.rm = TRUE),`18-24`=sum(heatmap$`18-24`, na.rm = TRUE), `25-34`= sum(heatmap$`25-34`, na.rm = TRUE),
          `35-44`=sum(heatmap$`35-44`, na.rm = TRUE), `45-54`=sum(heatmap$`45-54`, na.rm = TRUE), `55-64`=sum(heatmap$`55-64`, na.rm = TRUE), All_Ages=sum(heatmap$All_Ages, na.rm = TRUE))


heatmap_long <- heatmap |>
  pivot_longer(-c(`campaign_id`),
               names_to = "age",
               values_to = "number")

# Replace NA values in dataframe with 0
heatmap_long[is.na(heatmap_long)] <- 0

p5 <- heatmap_long |>
  mutate(campaign_id = factor(campaign_id, levels = rev(c("All Campaigns","Campaign 2","Campaign 6","Campaign 7","Campaign 1","Campaign 8",
                                                          "Campaign 5","Campaign 9","Campaign 10","Campaign 4","Campaign 3","Campaign 11"))))|>
  ggplot(aes(x = age, y = campaign_id, fill = ifelse(campaign_id == "All Campaigns" | age == "All_Ages", NA, number)))+
  geom_tile()+
  geom_text(aes(label = scales::comma(number)), family = "Century Gothic", size = 5)+
  scale_fill_gradientn(colours = c("#FFFFCC","#C7E9B4","#7FCDBB","#41B6C4","#2C7FB8"), na.value = "#F2F1F1")+
  labs(fill = "Reach", y = NULL, x = NULL, title = "Reach Across Campaigns by Age Group")+
  scale_y_discrete(expand = c(0,0))+
  scale_x_discrete(expand = c(0,0))+
  theme(
    text = element_text(family = "Century Gothic", face = "bold"),
    axis.text = element_text(size = 15, colour = "black"),
    axis.text.y = element_text(hjust = 1),
    panel.grid.major = element_blank(),
    plot.title = element_text(hjust = 0.5, size = 15))
print(p5)

According to this heatmap, across most campaigns, 18–24 is the strongest performing age group. This is most prominent in Campaign 6, SHU_Students (India) campaign, where we see a 30,110 reach. The second-strongest is Campaign 2 (SHU3_ Students Apart from India and US)). But the older age groups, ranging from 35 all the way to 64, show lighter shades, which implies that campaigns are less effective among older audiences. The only exception is Campaign 1 (SHU_6 (Educators and Principals)), which reached 8,761 people aged 35–44, but it makes sense due to the target audience. However, Campaign 10 (SHU_Students (UK)), Campaign 4 (SHU_Students (Canada)), and Campaign 3(SHU_Students (Australia)) have low reach across all age groups, which is an important insight.

Pie/Donught Charts

Lets visualise how Reach is distributed across the different Age groups using a donught

donut <- campaign_age |>
  select(Age, Reach)

donut <- donut |>
  group_by(Age)|>
  summarise(Reach = sum(Reach))

donut <- donut |>
  arrange(desc(Age)) |>
  mutate(percent = Reach/sum(Reach)*100,
         label = if_else(percent > 4, paste0(round(percent,1),"%"),""),
         ypos = cumsum(Reach)- 0.5 * Reach )
p6 <- donut |>
  ggplot()+
  geom_col(aes(x=2, y=Reach, fill = Age), width = 1)+
  geom_text(aes(x=2,y = ypos, label = label), family = "Century Gothic", fontface = "bold", colour = "white",size = 6 )+
  coord_polar(theta = "y")+
  xlim(0.5, 2.5)+
  scale_fill_manual(values = c("13-17"="#206095",
                               "18-24"="#F66068",
                               "25-34"="#22D0B6",
                               "35-44"="#871A5B",
                               "45-54"="#F98B00",
                               "55-64"="#002060"
  ))+
  theme_void()+
  labs(fill = "Age Group", title = "Campaign Reach Across Age groups")+
  theme(legend.text = element_text(size = 12, family = "Century Gothic", face = "bold"),
        text = element_text(family = "Century Gothic", face = "bold"),
        plot.title = element_text(hjust = 0.5, size = 15))

print(p6)

Lets similarly visulaise the Audience (Geography) by the Reach

pie <- campaign_clean 
pie <-  pie |>
  ungroup() |>
  mutate(Reach = as.numeric(Reach))|>
  arrange(desc(Geography))|>
  mutate(percent = Reach/sum(Reach)*100,
         label = if_else(percent > 3, paste0(scales::number(percent,accuracy = 0.1),"%"),""),
         ypos = cumsum(Reach)- 0.5 * Reach)

p7 <- pie |>
  ggplot()+
  geom_col(aes(x="",y = Reach, fill = Geography))+
  coord_polar(theta = "y")+
  geom_text(aes(x = "",y = ypos, label = label), family = "Century Gothic", size = 6, fontface = "bold",colour = "white")+
  theme_void()+
  labs(fill = "Geography", title = "Campaign Reach by Geographic Locations")+
  guides(fill = guide_legend(reverse = FALSE))+
  scale_fill_manual(values = c("Group 1"="#4B644B",
                                 "Group 2"="#7D96AF",
                                 "Australia"="#F98B00",
                                 "Canada"="#09979B",
                                 "Ghana"="#EA879C",
                                 "India"="#FDD835",
                                 "Nepal"="#0070C0",
                                 "Nigeria"="#AE2B47",
                                 "UAE"="#EBA07E",
                                 "UK"="#E06666",
                                 "USA"="#002060"))+
  theme(text = element_text(family = "Century Gothic", size = 15, face = "bold"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p7)

Group 1 (Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States) had the highest reach (24.6%) compared to the other geographical locations followed by India with 16.9% of the total reach of all campaigns.

Stacked Bar Chart

Let’s visualize how CTR is split among Age Ranges within each campaign.

ctrage <- campaign_raw |>
  select(campaign_id, Age, Impressions, Clicks)

ctrage <- ctrage |>
  group_by(Age, campaign_id)|>
  summarise(Impressions = sum(Impressions),
            Clicks = sum(Clicks))|>
  mutate(cltr = Clicks/Impressions*100)


ctrage_wide <- ctrage |>
  select(-Clicks, -Impressions) |>
  pivot_wider(campaign_id,
              names_from = Age,
              values_from = cltr)

ctrage_long <- ctrage_wide |>
  pivot_longer(-c(campaign_id),
               names_to = "Age",
               values_to = "ctr_rate")


p8 <- ctrage_long |>
  mutate(campaign_id = factor(campaign_id, levels = c("Campaign 8", "Campaign 11","Campaign 2","Campaign 4",
                                                      "Campaign 3","Campaign 1","Campaign 10","Campaign 5","Campaign 6","Campaign 9","Campaign 7")))|>
  ggplot(aes(x = campaign_id, y = ctr_rate, fill = Age))+
  geom_col(width = 0.8)+
  geom_text(aes(label = if_else(ctr_rate > 0 ,paste0(round(ctr_rate,1), "%"),"")),
            position = position_stack(vjust = 0.5), family = "Century Gothic", fontface = "bold", color = "white", size = 5)+
  scale_fill_manual(values = c("13-17"="#206095",
                               "18-24"="#F66068",
                               "25-34"="#22D0B6",
                               "35-44"="#871A5B",
                               "45-54"="#F98B00",
                               "55-64"="#002060"
  )) +
  labs(x="Campaign Name", title = "Click-Through Rate Among Age Group Across Campaigns",
       y = "Click Through Rate (CTR) ")+
  scale_y_continuous(expand = c(0,0))+
  scale_x_discrete(labels = scales::wrap_format(width = 5))+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.x = element_text(size = 12, colour = "black"),
        axis.text.y = element_text(size = 14, colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p8)

Campaign 8 (SHU_Students (Nigeria)) has the highest click-through rate (CTR), with the 18-24 and 25-34 age groups making up the majority. Campaign 11 (SHU_Students (USA)) comes second, also dominated by the 18-24 age group. Campaign 2 (SHU_3 (Students Apart from India and US)) follows, with a 17.8% CTR, again heavily targeting younger age groups. Once again, Campaign 1(SHU 6 (Educators and Principals))cstands out as the only campaign with a significant share from older age groups like 35-44, 45-54, and 55-64. Campaigns 5, 10, 9, 6 & 7 (*SHU_Students (Ghana), UK, UAE, India, and Nepal) have very low overall CTR. These campaigns aren’t contributing meaningfully to the total engagement and may need to be reevaluated or redesigned. Based on the color distributions, we can highlight that younger audiences (13–34) are the primary contributors to reach across nearly all student campaigns. The educator campaign is well-segmented, showing success in reaching an older demographic. We can keep or expand these based on the company’s goals.

KPI Analysis Build up

Let’s compare Click-Through Rate (CTR) across different geographies

geo_ctr <-  campaign_clean

p9 <- geo_ctr |>
  ggplot(aes(x = reorder(Geography,CTR), y = CTR))+
  geom_col(width = 0.9, fill = "#871A5B")+
  geom_text(aes(label = paste0(scales::number(CTR, accuracy = 0.1),"%"), vjust = -1),
            family="Century Gothic", fontface = "bold", size = 7)+
  scale_y_continuous(expand = c(0,0), 
                     labels = scales::number_format(accuracy = 1),
                     limits = nicelimits)+
  labs(x = NULL, y = "Click-Through Rate (%)", title = "Click-Through Rate Across Geographic locations")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.x = element_text(size = 15, colour = "black"),
        axis.text.y = element_text(size = 15, colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p9)

What we can infer from this chart is that Nigeria has the highest click-through rate (CTR) among all geographies. USA and Group 2(Australia, Canada, United Kingdom, Ghana, Niger, Nigeria, Nepal, Pakistan, Thailand, Taiwan) follow with a CTR of 6.1% and 5.6% respectively. Canada, India, Australia, Ghana and the UK contribute similar CTRs, each falling within the range of 3–4%. On the other hand UAE, Group 1(Australia, Canada, United Kingdom, Ghana, Nigeria, Pakistan, United States) and Nepal show lower CTRs, ranging from 2.2 - 2.8%.
Nigeria and USA appear to be the most cost-effective and efficient regions in terms of campaign engagement, achieving higher CTRs. These insights suggest that optimizing efforts in high CTR regions or reevaluating strategies in lower CTR geographies like UAE and Nepal might yield better results.

Let’s now shift our focus to assess the same distribution but using uCTR as the metric.

geo_uctr <- campaign_clean

p10 <- geo_uctr |>
  ggplot(aes(x = reorder(campaign_id,uCTR), y = uCTR))+
  geom_col(width = 0.9, fill = "#09979B")+
  geom_text(aes(label = paste0(scales::number(uCTR, accuracy = 0.1),"%"), vjust = -1),
            family="Century Gothic", fontface = "bold", size = 6)+
  scale_y_continuous(expand = c(0,0), 
                     labels = scales::number_format(accuracy = 1),
                     limits = nicelimits)+
  labs(x = NULL, y = "Unique Click-Through Rate (%)", title = "Unique Click-Through Rate Across Geographic Locations")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.x = element_text(size = 13, colour = "black"),
        axis.text.y = element_text(size = 14, colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p10)

The unique Click-Through Rate (uCTR), calculated as (Unique Clicks / Reach) * 100, indicates the percentage of individuals who engaged with the campaign out of the total audience reached. A lower uCTR reflects weaker engagement. Campaign 9 (The SHU Students (UAE)) campaign recorded the lowest uCTR, suggesting it had the least effective audience engagement among all campaigns.

cpc_campaign <- campaign_clean

p11 <- cpc_campaign |>
  ggplot(aes(x = reorder(campaign_id,CPC), y = CPC))+
  geom_col(width = 0.8, fill = "tan")+
  coord_flip(clip = "off")+
  geom_text(aes(label = paste0(round(CPC,2),"$")), hjust = -0.2,
            family= "Century Gothic", fontface = "bold", colour = "black", size = 6)+
  scale_y_continuous(expand = c(0,0),
                     limits = c(0,8.5))+
  scale_x_discrete(labels = scales::wrap_format(width = 20))+
  labs(x = NULL,
       y = "Cost Per Click ($)", title = "Cost Per Click Across Campaigns")+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.x = element_line(colour = "gray",size = 0.25),
        axis.text.y = element_text(size = 14, colour = "black"),
        axis.text.x = element_text(size = 13, colour = "black"),
        axis.title = element_text(size = 14, colour = "black", vjust = -2),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p11)

CPC is a metric that shows how much you pay for each click on your ad. It is calculated by dividing the total amount spent by the number of clicks received. CPC helps measure the efficiency of your ad spend. A lower CPC means you’re getting more clicks for less money, while a higher CPC may suggest your ad needs improvement.

ulc_amount <- campaign_clean

p12 <- ulc_amount |>
  ggplot(aes(x = ULC, y = amount_spent, fill = campaign_id))+
  geom_point(size = 8, shape = 21) +
  scale_fill_manual(values = c("Campaign 1"="#4B644B",
                               "Campaign 2"="#7D96AF",
                               "Campaign 3"="#EBA07E",
                               "Campaign 4"="#09979B",
                               "Campaign 5"="#EA879C",
                               "Campaign 6"="#FDD835",
                               "Campaign 7"="#0070C0",
                               "Campaign 8"="#AE2B47",
                               "Campaign 9"="#FFFFCC",
                               "Campaign 10"="#E06666",
                               "Campaign 11"="#002060"))+
  labs(x = "Unique Link Clicks (ULC)",
       y = "Total Amount SPent ($)", title = "Unique Link Clicks vs Amount Spent on Campaign",
       fill = NULL)+
  scale_y_continuous(
    limits = c(500,3000))+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black", size = 16),
        panel.background = element_blank(),
        axis.line = element_line(colour = "gray", size = 0.5),
        axis.text= element_text(size = 18),
        legend.background = element_rect(colour = "black"),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p12)

This metric highlights the cost-efficiency of each campaign by comparing total amount spent to the number of unique link clicks (ULC). Campaigns with high spend but relatively low ULC such as Campaign SHU 6 (Educators and Principals) indicate lower efficiency and may require strategic adjustments. In contrast, campaigns with high ULC and moderate spend reflect stronger performance and better return on investment.

ctr_reach <- campaign_clean 

ctr_reach <- ctr_reach |>
  mutate(vjust_pos = if_else(campaign_id == "Campaign 9",1.8,-0.9))

p13 <- ctr_reach |>
  ggplot(aes(x = Reach, y = CTR, colour = campaign_id))+
  geom_point(size = 4)+
  geom_text(aes(label = str_wrap(campaign_id, width = 34), vjust = vjust_pos), 
            family = "Century Gothic", fontface = "bold", size = 4)+
  scale_y_continuous(expand = c(0,1))+
  scale_x_continuous(limits = nicelimits,
                     labels = scales::comma)+
  scale_colour_manual(values = c("Campaign 1"="#4B644B",
                                 "Campaign 2"="#7D96AF",
                                 "Campaign 3"="#EBA07E",
                                 "Campaign 4"="#09979B",
                                 "Campaign 5"="#EA879C",
                                 "Campaign 6"="#FDD835",
                                 "Campaign 7"="#0070C0",
                                 "Campaign 8"="#AE2B47",
                                 "Campaign 9"="#F98B00",
                                 "Campaign 10"="#871A5B",
                                 "Campaign 11"="#002060"))+
  
  labs(x = "Reach", y = "CTR(%)", title = "Click-Through Rate vs Reach")+
  theme(text = element_text(family = "Century Gothic", face = "bold"),
        panel.background = element_blank(),
        axis.line = element_line(colour = "grey", size = 0.5),
        axis.text = element_text(size = 15),
        axis.title = element_text(size = 15),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 15))
print(p13)

Campaign 7 (SHU_Students(Nepal)) despite having more reach has the lowest CTR of all the campaigns.

cpc_ctr <- campaign_clean

cpc_ctr <- cpc_ctr|>
  mutate(vjust_pos = if_else(campaign_id == "Campaign 10",1.5,-0.6))

p14 <- cpc_ctr |>
  ggplot(aes(x=CTR, y=CPC, colour = campaign_id))+
  geom_point(size = 4)+
  geom_text(aes(label = str_wrap(campaign_id, width = 40), vjust = vjust_pos), 
            family = "Century Gothic", fontface = "bold", size = 6)+
  scale_y_continuous(expand = c(0,1))+
  scale_x_continuous(limits = nicelimits,
                     labels = scales::comma)+
  scale_colour_manual(values = c("Campaign 1"="#4B644B",
                                 "Campaign 2"="#7D96AF",
                                 "Campaign 3"="#EBA07E",
                                 "Campaign 4"="#09979B",
                                 "Campaign 5"="#EA879C",
                                 "Campaign 6"="#FDD835",
                                 "Campaign 7"="#0070C0",
                                 "Campaign 8"="#AE2B47",
                                 "Campaign 9"="#F98B00",
                                 "Campaign 10"="#871A5B",
                                 "Campaign 11"="#002060"))+
  
  labs(x = "Click Through Rate(%)", y = "Cost Per Click($)", title = "Cost Per Click vs Click-Through Rate")+
  theme(text = element_text(family = "Century Gothic", face = "bold"),
        panel.background = element_blank(),
        axis.line = element_line(colour = "grey", size = 1),
        axis.text = element_text(size = 20),
        axis.title = element_text(size = 20),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 15))
print(p14)

The most efficient campaigns with high CTR and Low CPC are Campaing 8 (SHU_Students (Nigeria)) and Campaign 2 (SHU3_ (Students Apart from India and US)). Both of them show a very high CTR, and extremely low CPC, around 1 INR. Thus, these campaigns are high-performing and cost-effective. Similarly, the least efficient campaigns, with low CTR and high CPC are Campaign 3 (SHU_Students (Australia)) and Campaign 10 (SHU_Students (UK)). These have low to moderate CTR and an extremely high CPC. These are costly and less engaging campaigns, and possibly not worth the investment.

Conclusion - KPI Initial Analysis

Based on a thorough performance analysis, dropping the SHU_Students (Australia) campaign is recommended. It has the highest Cost Per Click (CPC) at 7.15$ and its Click-Through Rate (CTR) is low at 3.3%. Given its high CPC and high spend (850$), the campaign may not be delivering proportional value and should be dropped.

Supporting Evidence:

  1. Highest Cost Per Click (CPC): At $7.15, Australia’s CPC is:
    • 608% higher than the average campaign CPC ($1.01)
    • 21x higher than the top-performing Nigeria campaign ($0.34)
    • Second-worst efficiency score in our multi-factor analysis
  2. Suboptimal Engagement:
    • 3.3% CTR (below the 4.2% campaign average)
    • Despite significant reach (14,492), conversion metrics remain poor
    • Underperforms compared to similar markets (UK, USA)
  3. Budget Impact:
    • Immediate cost savings: $850
    • Represents 14% of total marketing budget
    • High reallocation potential to better-performing campaigns
  4. Financial Impact:
    Discontinuing the Australia campaign will:
    • Eliminate the highest CPC in the portfolio
    • Free up $850 for reallocation
    • Improve overall campaign efficiency by approximately 18%
    • Allow expansion of high-performing campaigns (Campaign 8 and 2)

Recommendation - KPI Initial Analysis

Campaign 10, the SHU_Students (UK) has a high CPC of 7.08$ and a slightly better CTR of 3.0%. While it’s not as inefficient as Campaign 3, it still lacks strong cost-effectiveness and should be considered for optimization trials.

On the other hand, several campaigns clearly stand out and should definitely be retained:

  1. SHU_Students (Nigeria): With a CTR of 9.5% and CPC of just $0.34, it’s the top performer in both engagement and cost-efficiency.
  2. SHU3_ (Students Apart from India and US): Features an excellent balance with a CTR of 5.6% and a CPC of only $0.42, which means it is a very efficient spend.
  3. SHU_Students (USA): With a CTR of 6.1% and a moderate CPC of $5.04 this campaign shows strong engagement despite a slightly higher cost.

KPI Analysis

This analysis builds on the initial KPI analysis carried out previously

Our analysis identified Campaign 3 [SHU_Students (Australia)] as the least effective campaign, with Campaign 10 [SHU_Students (UK)] as the second worst performer. While both underperform, we suggested optimizing the UK campaign due to its slightly better click-through rate (CTR).
This section will support our recommendation by exploring the dataset and making visualizations to depict how the data validates our criteria. We will go through each of the supporting evidence listed in the previous section, and represent it visually.

high_cost <- campaign_clean

high_cost <- high_cost |>
  mutate(highlight = campaign_id == "Campaign 3")        #highlight defined in libraries and functions section

p15 <- high_cost|>
  ggplot(aes(x = reorder(campaign_id, CPC), y= CPC, fill = highlight))+
  geom_col(width = 0.8)+
  coord_flip(clip = "off")+
  geom_text(aes(label = paste0(round(CPC,2),"$")), hjust=-0.1,
            family = "Century Gothic", fontface = "bold",colour = "black", size = 5)+
  scale_y_continuous(expand = c(0,0))+
  scale_x_discrete(labels = scales::wrap_format(width = 20))+
  scale_fill_manual(labels = c("FALSE"="Other", "TRUE"="Highest"),
                    values = c("TRUE" = "#8B5E3C", "FALSE" = "#D2B48C"))+
  guides(fill = guide_legend(reverse = TRUE))+
  labs(x=NULL, fill = NULL, y = "Cost Per Click", title = "Cost Per Click Across Campaigns")+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.x = element_line(colour = "gray",size = 0.25),
        axis.text.y = element_text(size = 14, colour = "black"),
        axis.text.x = element_text(size = 12, colour = "black"),
        axis.title = element_text(size = 12, colour = "black", vjust = -2),
        legend.text = element_text(size = 12),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p15)

The deeper shaded bar shows the campaign with the highest CPC out of all.
Key Insight: The Australian campaign, thus Campaign 3’s CPC is approximately 608% higher than the average campaign CPC, demonstrating severe cost inefficiency. Let’s visualize this;

avg <- campaign_clean 

Average_CPC = sum(campaign_clean$amount_spent)/sum(campaign_clean$Clicks)

avg_cpc <- tribble(~ind, ~value,
                   "Average Campaign CPC", Average_CPC,
                   "Campaign 3", as.numeric(campaign_clean[campaign_clean$campaign_id=="Campaign 3","CPC"]))

p16 <- avg_cpc |>
  ggplot(aes(x = ind, y = value, fill = ind))+
  geom_col(width = 0.8)+
  geom_text(aes(label = paste0(scales::number(value, accuracy = 0.01),"$")),
            family = "Times New Roman", fontface = "bold", size = 6, vjust = -0.5)+
  geom_text(aes(label = ifelse(value > 5, paste0("608% higher ▲ \n"),"")), vjust = -0.1, 
            family = "Times New Roman", fontface = "bold",size = 6.5, colour = "#871A5B")+
  scale_y_continuous(expand = c(0,0), limits = c(0,8))+
  scale_fill_manual(values = c("Average Campaign CPC"= "#22D0B6",
                               "Campaign 3"= "#871A5B")) +
  labs(fill = NULL, x = NULL, y = "Cost Per Click", title = "Cost Per Click Comparison: Campaign Average vs Campaign 3")+
  theme(text = element_text(family = "Century Gothic", colour = "black", face = "bold", size = 13),
        axis.text = element_text(size = 18, colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(size = 0.25, colour = "gray"),
        plot.title = element_text(hjust = 0.5),
        legend.position = "none")
print(p16)

This graph compares the average campaign CPC with Campaign 3 (Australian campaign)’s CPC. The difference is clearly visible in this graph. When bench marked against the most cost-efficient campaign (Campaign 8) which had a CPC of 0.34$ 

avg_1 <- campaign_clean

avg1_cpc <- tribble(~ind, ~value,
                    "Campaign 3", as.numeric(campaign_clean[campaign_clean$campaign_id =="Campaign 3" , "CPC"]),
                    "Campaign 8", as.numeric(campaign_clean[campaign_clean$campaign_id =="Campaign 8","CPC"]))
p17 <- avg1_cpc |>
  ggplot(aes(x = reorder(ind,value), y = value, fill = ind))+
  geom_col(width = 0.8)+
  geom_text(aes(label = paste0(scales::number(value, accuracy = 0.01),"$")),
            family = "Times New Roman", fontface = "bold", size = 7, vjust = -0.5)+
  geom_text(aes(label = ifelse(value > 5, paste0("23.3x higher ▲ \n"),"")), vjust = -0.1, 
            family = "Times New Roman", fontface = "bold",size = 7, colour = "#871A5B")+
  scale_y_continuous(expand = c(0,0), limits = c(0,8))+
  scale_fill_manual(values = c("Campaign 8"= "#F98B00",
                               "Campaign 3"= "#871A5B")) +
  labs(fill = NULL, x = NULL, y = "Cost Per Click", title = "Cost Per Click Comparison: Campaign 3 vs Campaign 8")+
  theme(text = element_text(family = "Century Gothic", colour = "black", face = "bold", size = 13),
        axis.text = element_text(size = 18, colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(size = 0.25, colour = "gray"),
        plot.title = element_text(hjust = 0.5),
        legend.position = "none")
print(p17)

Critical Finding:
Campaign 3 requires $7.58 more per click than Campaign 8, making it 23 times more expensive to achieve the same basic engagement metric.
We can also do a campaign efficiency score to see which is the second worst performing campaign, which we had earlier explained to be Campaign 10.
This Efficiency scored was calculated using this formula;

Efficiency Score = Unique Link Clicks (ULC)/ Amount Spent

We can visually confirm that Campaign 3 has one of the lowest efficiency scores 

efficiency_score <- campaign_clean

avg_eff <- sum(campaign_clean$ULC)/sum(campaign_clean$amount_spent)

efficiency_score <- efficiency_score |>
  mutate(effi_score = ULC/amount_spent,
         highlight = campaign_id == "Campaign 3",)        #highlight defined in libraries and functions section

p18 <- efficiency_score |>
  ggplot(aes(x = reorder(campaign_id,effi_score), y = effi_score, fill = highlight))+
  geom_col(width = 0.8)+
  geom_text(aes(label = ifelse(campaign_clean$campaign_id == "Campaign 3", paste0("Worst"),"")),
            vjust = -1,family = "Century Gothic", fontface = "bold", size = 5)+
  scale_y_continuous(expand = c(0,0), limits = nicelimits)+
  geom_hline(yintercept = avg_eff, linetype = "dashed", size = 1, colour = "#990000")+
  annotate("text", x = 1, y = avg_eff, label = paste0("Optimal Efficiency: ", round(avg_eff,1)),
           vjust = -1, family = "Century Gothic", fontface="bold", size = 6, hjust = 0.2, colour = "#990000")+
  scale_x_discrete(labels = scales::wrap_format(width = 10))+
  scale_fill_manual(values = c("TRUE"="#990000", "FALSE"="grey"))+
  labs(fill = NULL, x = NULL, y = "Efficiency Score", title = "Campaign Efficiency Scores (ULC/Amount Spent)")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.x = element_text(size = 12, colour = "black"),
        axis.text.y = element_text(size = 14, colour = "black"),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5))
print(p18)

Suboptimal Engagement Metrics

Despite commanding premiunm placement costs, the Australian campaign consistently underdelivers on critical engagement metrics that drive campaign success. Lets visualize this; 

ctr_avg_optimal <- campaign_clean


ctr_avg_optimal <- ctr_avg_optimal |>
  mutate(highlight = campaign_id == "Campaign 3")

avg_ctr = mean(campaign_clean$CTR, na.rm = TRUE)

p19 <- ctr_avg_optimal |>
  ggplot(aes(x = reorder(campaign_id,CTR), y = CTR, fill = highlight))+
  geom_col(width = 0.8)+
  geom_text(aes(label = ifelse(campaign_clean$campaign_id == "Campaign 3", paste0("Suboptimal"),"")),
            vjust = -1,family = "Century Gothic", fontface = "bold", size = 4, colour = "#F98B00")+
  geom_hline(yintercept = avg_ctr,
             linetype = "dashed",
             color = "blue", size = 0.7)+
  annotate("text",x = 1, y = avg_ctr + 0.5,
           label = paste0("Average CTR = ", round(avg_ctr,1),"%"), colour = "blue",
           family = "Century Gothic", fontface = "bold", hjust = -4.5, vjust = 2, size = 5)+
  scale_y_continuous(expand = c(0,0), limits = nicelimits)+
  scale_x_discrete(labels = scales::wrap_format(width = 10))+
  scale_fill_manual(values = c("TRUE"="#F98B00", "FALSE"="grey"))+
  labs(x = NULL, y = "Click Through Rate (%)", title = "Click Through Rate(CTR) by Campaign with Average CTR line")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 14),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.x = element_text(size = 12, colour = "black"),
        axis.text.y = element_text(size = 14, colour = "black"),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5))
print(p19)

Key Insight: Campaign 3 achieves only a 3.3% CTR, which is 21.4% below our portfolio average of 4.2%. This underperformance is particularly problematic considering its position as our highest-cost campaign on a per-click basis. The campaign’s reach (14,492 users) also doesn’t translate to meaningful engagement. Let’s visualize this: 

ulc_reach <- campaign_clean

ulc_reach <- ulc_reach |>
  mutate(highlight = campaign_id == "Campaign 3")

p20 <- ulc_reach |>
  ggplot(aes(x = Reach, y = ULC, colour = highlight))+
  geom_point(size = 6)+
  geom_text(data = subset(ulc_reach, campaign_id == "Campaign 3"),
                  aes(x = Reach, y = ULC),
                      label = "Suboptimal", show.legend = FALSE, size = 5,
            vjust = 1.5,hjust = -0.1, family = "Century Gothic", fontface = "bold")+
  geom_smooth(method = lm, se = FALSE, color = "blue", linetype = "dashed")+
  scale_color_manual(
    values = c("TRUE" = "#E74C3C", "FALSE" = "#BDC3C7"),
    labels = c("TRUE" = "Campaign 3", "FALSE" = "Other Campaigns"))+
  scale_y_continuous(limits = c(0, 1600*1.1),
                     expand = c(0,100),
                     breaks = pretty(c(0,max(campaign_clean$ULC)*1.1), n = 5)[-1])+
  scale_x_continuous(limits = c(0,50000*1.05), 
                     labels = scales::comma,
                     expand = c(0,0))+
  labs(x = "Reach", y="Unique Link Clicks (ULC)", colour = NULL, title = "Reach vs Conversion Performance (ULC)")+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black", size = 14),
        panel.background = element_blank(),
        axis.line = element_line(colour = "black", size = 0.7),
        axis.text = element_text(size = 14),
        plot.title = element_text(hjust = 0.5),
        legend.background = element_rect(colour = "grey"))
print(p20)

This graph shows the ULC of all other campaigns compared to Campaign 3 (Australian campaign), which is one of the lowest. When compared to similar markets, Campaign 10(UK) and Campaign 11(USA), Campaign 3 consistently underperforms. Let’s visualize this; 

campaign_performance <- campaign_clean 

campaign_performance <- campaign_performance |>
  ungroup() |>
  filter(campaign_id %in% c("Campaign 3","Campaign 10","Campaign 11")) |>
  select(campaign_id,CPC,CTR,ULC)

campaign_performance_long <- campaign_performance |>
  pivot_longer(-c(campaign_id),
               names_to = "metrics",
               values_to = "values")

campaign_performance_long <- campaign_performance_long |>
  mutate(label = case_when(metrics=="CPC" ~ paste0("$", scales::number(values, accuracy = 0.01)),
                           metrics=="CTR" ~ paste0(scales::number(values,accuracy = 0.1), "%"),
                           TRUE ~ as.character(values)))
  

p21 <- campaign_performance_long |>
  mutate(campaign_id = factor(campaign_id, levels = c("Campaign 3","Campaign 10","Campaign 11"))) |>
  ggplot(aes(x = metrics, y = values, fill = factor(campaign_id)))+
  geom_col(width = 0.8, position = "dodge")+
  geom_text(aes(label = label), position = position_dodge(width = 0.8), family = "Century Gothic", fontface = "bold",
            vjust = -0.5, size = 6) +
  scale_y_continuous(expand = c(0,0), limits = nicelimits) +
  scale_fill_manual(values = c("Campaign 3" = "#871A5B",
                               "Campaign 10" = "#E06666",
                               "Campaign 11" = "#002060"))+
  labs(x = NULL, y=NULL, fill=NULL, title = "Performance of Campaign 3 , Campaign 10 & Campaign 11 Across Key Metrics") +
  theme(text = element_text(family = "Century Gothic",face = "bold"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(size = 0.25, colour = "gray"),
        axis.text = element_text(size = 15),
        plot.title = element_text(hjust = 0.5))
print(p21)

We can see clearly that Campaign 3 (Australian campaign) has been a financial burden on the client.

Budget Impact

The primary basis on which we evaluated Campaign 3, the Australian campaign was budget efficiency. Despite consuming a substantial share of the marketing budget, the campaign delivered a low conversion rate while incurring the highest cost per click. The following visual highlights these key metrics; 

budget_share <- campaign_clean 

budget_share <- budget_share |>
  ungroup() |>
  select(campaign_id,amount_spent)

budget_share <- budget_share |>
  mutate(is_highlight = campaign_id == "Campaign 3") |>
  arrange(desc(is_highlight)) |>
  mutate(percent = amount_spent/sum(amount_spent)*100,
         ypos = cumsum(amount_spent)- 0.5 * amount_spent)


p22 <- budget_share |>
  ggplot(aes(x=2, y=amount_spent, fill = is_highlight))+
  geom_col(colour = "white", size = 0.1)+
  coord_polar(theta = "y")+
  xlim(0.5, 2.5)+
  geom_text(aes(x = 2, y = ypos, label = paste0(scales::number(percent,accuracy = 0.1),"%")), 
            family = "Century Gothic", fontface = "bold", size = 5, colour = "white")+
  geom_text(aes(x = 2, y = 50, label = paste0("Total Amount Spent \n on Campaigns: \n", "$",
                                               scales::comma(sum(amount_spent), accuracy = 1)),vjust = 3.5, hjust = 0.5),
            family = "Century Gothic", fontface = "bold", size = 5)+
  scale_fill_manual(values = c("TRUE"="#E74C3C", "FALSE"="grey"),
                    labels = c("TRUE"="Campaign 3", "FALSE"="Other Campaigns"))+
  guides(fill = guide_legend(reverse = TRUE))+
  labs(x=NULL, y=NULL, title = "Marketing Budget Share Across Campaigns", fill = NULL)+
  theme(panel.background = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        text = element_text(family = "Century Gothic", face = "bold", size = 15),
        plot.title = element_text(hjust = 0.5))
print(p22)

This campaign accounts for a significant portion of the marketing budget. Discontinuing it would remove the highest cost-per-click campaign from the portfolio. The following visualization illustrates this impact; 

reg <- campaign_clean |>
  ggplot(aes(x = reorder(campaign_id,-CPC), y = CPC))+
  geom_col(width = 0.8, fill = "tan")+
  geom_text(aes(label = ifelse(CPC > 7.1, paste0("Max: \n", round(CPC,2),"$ \n ▼"), "")), vjust = -0.2,
            family= "Arial Narrow", fontface = "bold", colour = "black", size = 6)+
  scale_y_continuous(expand = c(0,0),
                     limits = c(0,8.5))+
  scale_x_discrete(labels = scales::wrap_format(width = 10))+
  labs(x = "Campaign Name", title = "Current Portfolio (with Campaign 3)",
       y = "Cost Per Click ($)")+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.y = element_text(size = 14, colour = "black"),
        axis.text.x = element_text(size = 10, colour = "black"),
        axis.title = element_text(size = 12, colour = "black", vjust = -2),
        panel.border = element_rect(colour = "black", size = 1, fill = NA),
        plot.title = element_text(hjust = 0.5))

reg2 <- campaign_clean |>
  filter(campaign_id != "Campaign 3")|>
  ggplot(aes(x = reorder(campaign_id,-CPC), y = CPC))+
  geom_col(width = 0.8, fill = "turquoise")+
  geom_text(aes(label = ifelse(CPC > 7, paste0("Max:  \n", round(CPC,2),"$ \n ▼"), "")), vjust = -0.2,
            family= "Arial Narrow", fontface = "bold", colour = "black", size = 6)+
  scale_y_continuous(expand = c(0,0),
                     limits = c(0,8.5))+
  scale_x_discrete(labels = scales::wrap_format(width = 10))+
  labs(x = "Campaign Name", title = "Proposed Portfolio (without Campaign 3)",
       y = "Cost Per Click ($)")+
  theme(text = element_text(family = "Century Gothic", face = "bold", colour = "black"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text.y = element_text(size = 14, colour = "black"),
        axis.text.x = element_text(size = 10, colour = "black"),
        axis.title = element_text(size = 12, colour = "black", vjust = -2),
        panel.border = element_rect(colour = "black", size = 1, fill = NA),
        plot.title = element_text(hjust = 0.5))

print(reg + reg2)

The UK campaign, which can be optimized for better results, becomes the next highest CPC campaign in the portfolio.

Resource Allocation

This strategic decision will free up $850.68 for redistribution: 

reallocation <- tribble(~name, ~value,
                  "Campaign 3", as.numeric(campaign_clean[campaign_clean$campaign_id=="Campaign 3","amount_spent"]),
                  "Other Campaigns", sum(campaign_clean$amount_spent)-as.numeric(campaign_clean[campaign_clean$campaign_id=="Campaign 3","amount_spent"]))

p23 <- reallocation |>
  ggplot(aes(x = name, y = value, fill = name))+
  geom_col(width = 0.8)+
  geom_text(aes(label = paste0("$", scales::comma(value,accuracy = 0.01))), 
            family="Century Gothic", fontface = "bold", size = 6, vjust = -1)+
  scale_y_continuous(expand = c(0,0), limits = nicelimits)+
  scale_fill_manual(values = c("Campaign 3"="#871A5B",
                               "Other Campaigns"="#04BCFC"))+
  labs(x=NULL, y="Budget ($)", title = "Reallocation Potential: Dropping Campaign 3")+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 13),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(size = 0.25, color = "gray"),
        axis.text.x = element_text(size = 15, colour = "black"),
        legend.position = "none",
        plot.title = element_text(hjust = 0.5))

print(p23)

Efficiency Projection

eff_projection <- campaign_clean

current_cpc <- sum(eff_projection$amount_spent)/sum(eff_projection$Clicks)

eff_projection_2 <- eff_projection |>
  filter(campaign_id != "Campaign 3")

improved_cpc <- sum(eff_projection_2$amount_spent)/sum(eff_projection_2$Clicks)

eff_proj <- tribble(~name,~value,
                    "Current Portfolio CPC", current_cpc,
                    "Improved Portfolio CPC", improved_cpc)

p24 <- eff_proj |>
  ggplot(aes(x = name, y = value, fill = name))+
  geom_col(width = 0.8)+
  geom_segment(aes(x = "Current Portfolio CPC", xend = "Improved Portfolio CPC", y = current_cpc, yend = improved_cpc),
               arrow = arrow(length = unit(0.3, "cm")),
               size = 1,
               colour = "purple", linetype = "solid")+
  annotate("text", x= 1, y = 1, label = "6% Improvement", hjust = -1, family = "Century Gothic", fontface = "bold", colour = "purple", size = 4.5)+
  geom_text(aes(label = paste0("$", round(value,2)), vjust = -1),
            family = "Century Gothic", fontface = "bold", size = 6)+
  scale_fill_manual(values = c("Current Portfolio CPC"="lightblue", "Improved Portfolio CPC"="lightgreen"))+
  scale_y_continuous(expand = c(0,0), limits = nicelimits)+
  labs(x=NULL, y="Cost Per Click", title = "Overall Campaign Efficiency Improvement")+
  theme(panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray",size = 0.25),
        axis.text = element_text(colour = "black", size = 15, family = "Century Gothic", face = "bold"),
        axis.title = element_text(colour = "black", size = 15, family = "Century Gothic", face = "bold"),
        legend.position = "none",
        plot.title = element_text(colour = "black", size = 15, family = "Century Gothic", face = "bold", hjust = 0.5))
print(p24)

Recommendations

Dropping the Campaign 3 allows the client to focus their attention on more profitable campaigns. While the Campaign 10 is also a financial burden, we believe that it can be optimized. However, we see that Campaign 8, with a CTR of 9.5% and CPC of just $0.34, comes up as the top performer in both engagement and cost-efficiency. Let’s visualize these metrics. 

#campaign performance 1: cpc vs ctr

cp1 <- campaign_clean

cp1 <- cp1 |>
  mutate(highlight = campaign_id == "Campaign 8")

p25 <- cp1|>
  ggplot(aes(x = CTR, y = CPC, colour = highlight))+
  geom_point(size = 4)+
  geom_text(data = subset(cp1, campaign_id == "Campaign 8"),
            aes(x = CTR, y = CPC), label = "Top Performer", show.legend = FALSE,
            family = "Century Gothic", vjust = -1, hjust = 0.69, size = 5, fontface = "bold")+
  scale_color_manual(values = c("FALSE"="grey", "TRUE"= "#E74C3C"),
                      labels = c("FALSE"="Other Campaigns", "TRUE"="Campaign 8"))+
  scale_x_continuous(expand = c(0,0),
                     limits = nicelimits)+
  scale_y_continuous(expand = c(0,0),
                     limits = nicelimits)+
  labs(x = "Click Through Rate(%)", y = "Cost Per Click($)", title = "Campaign Performance: CTR vs CPC", colour = NULL)+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 13),
        panel.background = element_blank(),
        axis.line = element_line(colour = "grey", size = 1),
        axis.text = element_text(size = 15),
        axis.title = element_text(size = 15),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p25)

Campaign 8 stands ahead of all the other campaigns. However, the campaign with an excellent balance is Campaign 2 with a CTR of 5.6% and a CPC of only $0.42. This implies it is a very efficient spend. Let’s also visualize this; 

#campaign performance 2: cpc vs ctr
cp2 <- campaign_clean

cp2 <- cp2 |>
  mutate(highlight = campaign_id == "Campaign 2")

p26 <- cp2|>
  ggplot(aes(x = CTR, y = CPC, colour = highlight))+
  geom_point(size = 4)+
  geom_text(data = subset(cp2, campaign_id == "Campaign 2"),
            aes(x = CTR, y = CPC), label = "Efficient Spend", show.legend = FALSE,
            family = "Century Gothic", vjust = -1, hjust = 0.69, size = 5, fontface = "bold")+
  scale_color_manual(values = c("FALSE"="grey", "TRUE"= "#22D0B6"),
                      labels = c("FALSE"="Other Campaigns", "TRUE"="Campaign 2"))+
  scale_x_continuous(expand = c(0,0),
                     limits = nicelimits)+
  scale_y_continuous(expand = c(0,0),
                     limits = nicelimits)+
  labs(x = "Click Through Rate(%)", y = "Cost Per Click($)", title = "Campaign Performance: CTR vs CPC", colour = NULL)+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 13),
        panel.background = element_blank(),
        axis.line = element_line(colour = "grey", size = 1),
        axis.text = element_text(size = 15),
        axis.title = element_text(size = 15),
        plot.title = element_text(hjust = 0.5, size = 15))
print(p26)

Campaign 2 sits perfectly in the lower middle part of the chart, which makes it not only an efficient spend, but ready for future optimizations. There’s another campaign that, despite having a larger CPC, has a higher CTR and, thus, stronger engagement. It’s Campaign 11, with a CTR of 6.1% and a moderate CPC of $5.04. Strong engagement despite a slightly higher cost per click. Let’s visualize this; 

#campaign performance 3: cpc vs ctr
cp3 <- campaign_clean

cp3 <- cp3 |>
  mutate(highlight = campaign_id == "Campaign 11")

p27 <- cp3|>
  ggplot(aes(x = CTR, y = CPC, colour = highlight))+
  geom_point(size = 4)+
  geom_text(data = subset(cp2, campaign_id == "Campaign 11"),
            aes(x = CTR, y = CPC), label = "Strong Engagement", show.legend = FALSE,
            family = "Century Gothic", vjust = -1, hjust = 0.69, size = 5, fontface = "bold", colour ="blue")+
  scale_color_manual(values = c("FALSE"="grey", "TRUE"= "blue"),
                      labels = c("FALSE"="Other Campaigns", "TRUE"="Campaign 11"))+
  scale_x_continuous(expand = c(0,0),
                     limits = nicelimits)+
  scale_y_continuous(expand = c(0,0),
                     limits = nicelimits)+
  labs(x = "Click Through Rate(%)", y = "Cost Per Click($)", title = "Campaign Performance: CTR vs CPC", colour = NULL)+
  theme(text = element_text(family = "Century Gothic", face = "bold", size = 13),
        panel.background = element_blank(),
        axis.line = element_line(colour = "grey", size = 1),
        axis.text = element_text(size = 15),
        axis.title = element_text(size = 15),
        plot.title = element_text(hjust = 0.5, size = 15))

print(p27)

Actions & Next Steps

Based on the analysis, the following actions were recommended:

  • Discontinue SHU Students (Australia):
    Its high CPC ($7.15), low CTR (3.3%), and significant budget consumption ($850.68) make it the least efficient campaign.
    Dropping it will free up funds and improve overall efficiency by 18%.

  • Optimize SHU Students (UK):
    Despite a slightly better CTR (3.0%) than Australia, its high CPC ($7.08) warrants optimization through:

    • Refined audience targeting
    • Bid adjustments

  • Scale High Performers:

    • SHU Students (Nigeria): With a CTR of 9.5% and CPC of $0.34, it’s the top performer in engagement and cost-efficiency.
    • SHU3 (Students Apart from India and USA): Offers a balanced CTR of 5.6% and CPC of $0.42, making it an efficient spend.
    • SHU Students (USA): Shows strong engagement with a CTR of 6.1% and a moderate CPC of $5.04.

  • Budget Reallocation:
    Redirect the $850.68 from the Australian campaign to Nigeria, SHU3, and USA campaigns to maximize ROI.

  • Next Steps:

    • Implement A/B testing and continuous performance monitoring to refine strategies and ensure sustained improvements.

Conclusion

The Superhero U campaign analysis revealed significant disparities in performance across regions and demographics.

  • Discontinuing the SHU Students (Australia) campaign will eliminate the portfolio’s highest CPC and free up $850.68 for reallocation, improving overall efficiency by 18%.
  • Optimizing the UK campaign and scaling high performers like Nigeria, SHU3, and USA will enhance engagement and cost-effectiveness.
  • Ongoing A/B testing and monitoring are essential to refine strategies further.

Team 15A thanks GlobalShala for the opportunity to contribute to this analysis.