Last Updated: November 05, 2024
(The data in this report indicates a ‘current’ date in November 2024)
This report presents the number of predicted leads for the remainder of 2024 and the year 2025. The top five lead sources are included in this report. Three of the sources are paid and two sources are not paid. The sources are as follows:
The lead sources that produce very few leads were grouped into a sixth source called ‘Other’ and the associated spend with those sources is added. Pseudo data was used for the historic leads and spend as this report is meant to demonstrate predictive capabilities without exploiting private company data from a specific organization.
# Libraries ####
library(DBI)
library(odbc)
library(tidyverse)
library(gam)
library(knitr)
library(kableExtra)
library(htmltools)
library(scales)
library(plotly)
library(gridExtra)
library(RColorBrewer)
# Data Creation ####
Source <- c(rep("Google Ads", 22), rep("Amazon", 22), rep("Ad Roll", 22), # GoogleAds, WGL, PestNet
rep("Google Organic", 22), rep("Website", 22), rep("Other", 22)) # Google Organic, Website, LSA
Year <- c(rep(c(rep(2023, 12), rep(2024, 10)), 6))
Month <- c(rep(c(1:12, 1:10), 6))
Leads <- c(421, 359, 572, 842, 784, 1017, 1569, 2604, 2625, 1830, 1233, 618, #Google Ads
870, 969, 1253, 1993, 2045, 2316, 3878, 3189, 2642, 1757,
271, 226, 480, 830, 693, 412, 654, 1333, 1185, 923, 572, 473, 263, #Amazon
132, 198, 283, 534, 785, 1471, 3120, 3063, 2626,
361, 283, 358, 350, 359, 341, 306, 339, 261, 260, 236, 284, 244, #Ad Roll
190, 242, 246, 299, 229, 268, 516, 546, 354,
133, 121, 323, 481, 471, 646, 700, 968, 731, 567, 396, 255, 241, #Google Organic
215, 363, 528, 845, 457, 201, 104, 89, 54,
578, 245, 218, 288, 450, 343, 374, 458, 424, 312, 211, 138, 133, #Website
128, 250, 414, 559, 684, 1054, 1269, 1036, 768,
289, 242, 391, 543, 476, 355, 449, 383, 317, 513, 454, 332, 328, #Other
275, 444, 617, 541, 403, 510, 632, 628, 521)
Spend <- c(44183.76, 27719.03, 27059.51, 39011.21, 58959.49, 67666.80, #Google Ads
107148.30, 118626.73, 144129.97, 115760.19, 61364.76, 52937.51,
94194.04, 113836.33, 134156.88, 217948.70, 203913.45, 211967.19,
272917.85, 409348.38, 514944.72, 275324.01,
17685, 14935, 31276, 54051, 45416, 26942, #Amazon
42818, 87214, 77650, 60558, 37531, 30957,
19740, 9912, 14868, 21252, 40068, 58884,
110292, 240391, 275688, 262640,
29640, 29640, 30780, 35340, 39520, 41040, #Ad Roll
41800, 41800, 45220, 45220, 45980, 45980,
45980, 45980, 45980, 49020, 49020, 49020,
49020, 49020, 49020, 49020,
rep(0, 44), #Google Organic & Website
3394.53, 3040.99, 4061.37, 4877.53, 4497.83, 3406.48, #Other
4111.14, 268.17, 1180.00, 2463.94, 3926.54, 3663.95,
3857.43, 3455.68, 4615.20, 5542.65, 5111.17, 3871.01,
4671.76, 5166.68, 6118.61, 5675.58)
sourceorder <- c("Google Ads", "Amazon", "Ad Roll", "Website", "Google Organic", "Other")
HistoricLeads <- cbind(Source, Month, Year, Spend, Leads) %>% as.data.frame() %>%
mutate(Month = as.numeric(Month),
Year = as.numeric(Year),
Leads = as.numeric(Leads),
Spend = as.numeric(Spend),
SpendType = ifelse(Source %in% c('Google Organic', 'Website'), 'NoSpend', 'Spend'),
YearCat = as.character(Year),
MonthAbb = month.abb[Month],
Date = as.Date(paste(Year, Month, '01', sep = "-"), "%Y-%m-%d"),
Source = factor(Source, levels = sourceorder))
rm(Leads, Month, Source, Spend)
Source <- c(rep("Google Ads", 14), rep("Amazon", 14), rep("Ad Roll", 14), # GoogleAds, WGL, PestNet
rep("Google Organic", 14), rep("Website", 14), rep("Other", 14)) # Google Organic, Website, LSA
Year <- c(rep(c(2024, 2024, rep(2025, 12)), 6))
Month <- c(rep(c(11:12, 1:12), 6))
Spend <- c(185144.57, 137819.09, # Google Ads
105497.32, 127496.69, 150255.71, 244102.54, 228383.06, 237403.25, # 12% more than last 12 months
305667.99, 458470.19, 576738.09, 308362.89, 207361.92, 154357.38,
139552, 51856, # Amazon
22109, 11101, 16652, 23802, 44876, 65950,
123527, 269238, 308771, 294157, 156298, 58079,
49020, 41587, # Ad Roll
51498, 51498, 51498, 54902, 54902, 54902,
54902, 54902, 54902, 54902, 54902, 46577,
rep(0, 28), # Google Organic & Website
4386.69, 3031.15, # Other
4320.32, 3870.36, 5169.02, 6207.77, 5724.51, 4335.53,
5232.37, 5786.68, 6852.84, 6356.65, 4913.09, 3394.89)
FutureSpend <- cbind(Source, Month, Year, Spend) %>% as.data.frame() %>%
mutate(Month = as.numeric(Month),
Year = as.numeric(Year),
Spend = as.numeric(Spend),
SpendType = ifelse(Source %in% c('Google Organic', 'Website'), 'NoSpend', 'Spend'),
YearCat = as.character(Year),
MonthAbb = month.abb[Month],
Date = as.Date(paste(Year, Month, '01', sep = "-"), "%Y-%m-%d"),
Source = factor(Source, levels = sourceorder))
rm(Month, Source, Spend, Year)
# Machine Learning ####
# Set up data
LStrain <- HistoricLeads %>%
filter(!(Date > today %m-% months(7))) %>%
arrange(Year, Month) # Train with all but previous 6 months
LStest <- HistoricLeads %>%
filter(Date > today %m-% months(7)) %>%
arrange(Year, Month) # Test most recent 6 months
PFSpend <- rbind(HistoricLeads %>% dplyr::select(-Leads), FutureSpend) %>% # Classifies past/future spend
mutate(Time = ifelse(Date > today %m-% months(1), 'Future', 'Past')) # Where current month is 'Future'
# Run GAM future predictions
# GAM
gams <- gam(data = HistoricLeads, Leads ~ (SpendType*Spend) + Source + Month)
pred <- predict(gams, newdata = FutureSpend, type = 'response', se.fit = TRUE)
Predictions <- round(as.numeric(pred$fit))
Upper95 <- round(as.numeric(pred$fit + (2*pred$se.fit))) # 95% confidence interval
Lower95 <- round(as.numeric(pred$fit - (2*pred$se.fit)))
Pleads <- cbind(FutureSpend, Predictions, Upper95, Lower95) %>%
mutate(Lower95 = ifelse(Lower95 < 0 , 0, Lower95),
Predictions = ifelse(Predictions < 0, 0, Predictions))
rm(pred, Predictions, Upper95, Lower95)
# Machine Learning GAM testing accuracy
gamt <- gam(data = LStrain, Leads ~ (SpendType*Spend) + Source + Month)
predt <- predict(gams, newdata = LStest, type = 'response', se.fit = TRUE)
Predictionst <- round(as.numeric(predt$fit))
Upper95t <- round(as.numeric(predt$fit + (2*predt$se.fit))) # 95% confidence interval
Lower95t <- round(as.numeric(predt$fit - (2*predt$se.fit)))
LStesto <- LStest %>% mutate(Pred = 'Observed', Upper95t = 0, Lower95t = 0)
LStestp <- LStest %>% mutate(Pred = 'Predicted') %>% cbind(Upper95t, Lower95t)
LStestp$Leads <- Predictionst
Pleadst <- rbind(LStesto, LStestp) %>%
mutate(Lower95t = ifelse(Lower95t < 0 , 0, Lower95t))
rm(predt, Predictionst, Upper95t, Lower95t, LStesto, LStestp, gams, gamt)
# ML Tables ####
ptest1 <- Pleadst %>% filter(Pred == 'Observed') %>%
dplyr::select(Source, Year, Month, Spend, Leads) %>%
rename(ObservedLeads = Leads)
ptest2 <- Pleadst %>% filter(Pred == 'Predicted') %>%
dplyr::select(Source, Year, Month, Spend, Leads, Upper95t, Lower95t) %>%
rename(PredictedLeads = Leads)
PredML <- inner_join(ptest1, ptest2, # ML Predictions numeric
by = c("Source" = "Source",
"Year" = "Year",
"Month" = "Month",
"Spend" = "Spend")) %>%
arrange(Source, Month)
rm(ptest1, ptest2)
SumsSourceML <- PredML %>% group_by(Source) %>% # ML Grouped Source Predictions numeric
summarize(Spend = sum(Spend),
ObservedSum = sum(ObservedLeads),
PredictedSum = sum(PredictedLeads),
UpperSum = sum(Upper95t),
LowerSum = sum(Lower95t)) %>%
remove_rownames %>% column_to_rownames(var = "Source")
SumsSourceML["Total", ] <- colSums(SumsSourceML)
SumsSourceML <- SumsSourceML %>% rownames_to_column(var = "Source")
MLSourceClean <- SumsSourceML %>%
mutate(ObservedLeads = format(ObservedSum, big.mark = ",", scientific = FALSE),
PredictedLeads = format(PredictedSum, big.mark = ",", scientific = FALSE),
UpperSum = format(UpperSum, big.mark = ",", scientific = FALSE),
LowerSum = format(LowerSum, big.mark = ",", scientific = FALSE),
Spend = scales::dollar(Spend)) %>%
mutate(CI = paste0(LowerSum, " - ", UpperSum)) %>%
dplyr::select(Source, Spend, ObservedLeads, PredictedLeads, CI)
SumsMonthML <- PredML %>% # ML Grouped Month Predictions numeric
mutate(Date = as.Date(paste0(Year, "-",
Month, "-01"))) %>%
group_by(Date) %>%
summarize(Spend = sum(Spend),
ObservedSum = sum(ObservedLeads),
PredictedSum = sum(PredictedLeads),
UpperSum = sum(Upper95t),
LowerSum = sum(Lower95t)) %>%
remove_rownames %>% column_to_rownames(var = "Date")
SumsMonthML["Total", ] <- colSums(SumsMonthML)
SumsMonthML <- SumsMonthML %>% rownames_to_column(var = "Date")
MLMonthClean <- SumsMonthML %>% mutate(ObservedLeads = format(ObservedSum, big.mark = ",", scientific = FALSE),
PredictedLeads = format(PredictedSum, big.mark = ",", scientific = FALSE),
UpperSum = format(UpperSum, big.mark = ",", scientific = FALSE),
LowerSum = format(LowerSum, big.mark = ",", scientific = FALSE),
Spend = scales::dollar(Spend),
Date = as.Date(Date)) %>%
mutate(CI = paste0(LowerSum, " - ", UpperSum),
Date = format(Date, "%b %Y")) %>%
mutate(Date = ifelse(is.na(Date), "Total", Date)) %>%
dplyr::select(Date, Spend, ObservedLeads, PredictedLeads, CI)
# Future Source Tables ####
PredFuture <- Pleads %>% # Future Predictions numeric
dplyr::select(Source, Month, Year, Spend, Predictions,
Upper95, Lower95)
SSP <- function(month){
SSPastFilt <- HistoricLeads %>% # Past Grouped Source Predictions numeric CY
filter(Year == year(today),
Month %in% c(month)) %>%
group_by(Source) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Leads)),
UpperSum = NA,
LowerSum = NA) %>%
remove_rownames %>% arrange(Source) %>%
column_to_rownames(var = "Source")
SSPastFilt[paste0("Total Observed ", year(today)), ] <- colSums(SSPastFilt)
SSPastFilt <- SSPastFilt %>% rownames_to_column(var = "Source")
}
SSPast <- SSP(month = 1:12)
SSF_CY <- function(month){
SSF_CYFilt <- Pleads %>% # Future Grouped Source Predictions numeric CY
filter(Year == year(today),
Month %in% c(month)) %>%
group_by(Source) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Predictions)),
UpperSum = sum(as.numeric(Upper95)),
LowerSum = sum(as.numeric(Lower95))) %>%
remove_rownames %>% arrange(Source) %>%
column_to_rownames(var = "Source")
SSF_CYFilt[paste0("Total Predicted ", year(today)), ] <- colSums(SSF_CYFilt)
SSF_CYFilt <- SSF_CYFilt %>% rownames_to_column(var = "Source")
}
SSFutureCY <- SSF_CY(month = c(1:12))
SSF_NY <- function(month){
SSF_NYFilt <- Pleads %>% # Future Grouped Source Predictions numeric NY
filter(Year == year(today) + 1,
Month %in% c(month)) %>%
group_by(Source) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Predictions)),
UpperSum = sum(as.numeric(Upper95)),
LowerSum = sum(as.numeric(Lower95))) %>%
remove_rownames %>% arrange(Source) %>%
column_to_rownames(var = "Source")
SSF_NYFilt[paste0("Total Predicted ", (year(today) + 1)), ] <- colSums(SSF_NYFilt)
SSF_NYFilt <- SSF_NYFilt %>% rownames_to_column(var = "Source")
}
SSFutureNY <- SSF_NY(month = c(1:12))
SS <- function(SS_A, SS_B, SS_C){
SumsSource <- rbind(SS_A, SS_B) %>%
add_row(Source = paste0("Total ", year(today)),
Spend = SS_A[nrow(SS_A), 'Spend'] +
SS_B[nrow(SS_B), 'Spend'],
LeadSum = SS_A[nrow(SS_A), 'LeadSum'] +
SS_B[nrow(SS_B), 'LeadSum'],
UpperSum = SS_A[nrow(SS_A), 'LeadSum'] +
SS_B[nrow(SS_B), 'UpperSum'],
LowerSum = SS_A[nrow(SS_A), 'LeadSum'] +
SS_B[nrow(SS_B), 'LowerSum']) %>%
rbind(SS_C)
}
SumsSource <- SS(SSPast, SSFutureCY, SSFutureNY)
rm(SSPast, SSFutureCY, SSFutureNY)
SSC <- function(SumS, SumS2 = T){
SSCFilt <- SumS %>% # Future Grouped Source Predictions formatted
mutate(LeadSum = format(LeadSum, big.mark = ",", scientific = FALSE),
UpperSum = format(UpperSum, big.mark = ",", scientific = FALSE),
LowerSum = format(LowerSum, big.mark = ",", scientific = FALSE),
Spend = scales::dollar(Spend)) %>%
rename(Predictions = LeadSum, Upper = UpperSum, Lower = LowerSum) %>%
mutate(CI = paste0(Lower, " - ", Upper)) %>%
dplyr::select(Source, Spend, Predictions, CI) %>%
mutate(CI = ifelse(Source == paste0("Total ", year(today)), paste0("*", CI), CI))
ifelse(SumS2 == T, SSCFilt[1:(length(sourceorder) + 1), "CI"] <- "",
SSCFilt[1:(length(sourceorder) + 1), "CI"] <- SSCFilt[1:(length(sourceorder) + 1), "CI"])
return(SSCFilt)
}
SumsSourceClean <- SSC(SumsSource)
# Future Month Tables ####
SMP <- function(source){
SMPastFilt <- HistoricLeads %>% # Past Grouped Month Predictions numeric CY
filter(Year == year(today),
Source %in% c(source)) %>%
group_by(Month) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Leads)),
UpperSum = NA,
LowerSum = NA) %>%
remove_rownames %>% arrange(Month) %>% mutate(Month = month.abb[Month]) %>%
column_to_rownames(var = "Month")
SMPastFilt[paste0("Total Observed ", year(today)), ] <- colSums(SMPastFilt)
SMPastFilt <- SMPastFilt %>% rownames_to_column(var = "Month")
}
SMPast <- SMP(sourceorder)
SMF_CY <- function(source){
SMF_CYFilt <- Pleads %>% # Future Grouped Month Predictions numeric CY
filter(Year == year(today),
Source %in% c(source)) %>%
group_by(Month) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Predictions)),
UpperSum = sum(as.numeric(Upper95)),
LowerSum = sum(as.numeric(Lower95))) %>%
remove_rownames %>% arrange(Month) %>% mutate(Month = month.abb[Month]) %>%
column_to_rownames(var = "Month")
SMF_CYFilt[paste0("Total Predicted ", year(today)), ] <- colSums(SMF_CYFilt)
SMF_CYFilt <- SMF_CYFilt %>% rownames_to_column(var = "Month")
}
SMFutureCY <- SMF_CY(sourceorder)
SMF_NY <- function(source){
SMF_NYFilt <- Pleads %>% # Future Grouped Month Predictions numeric NY
filter(Year == year(today) + 1,
Source %in% c(source)) %>%
group_by(Month) %>%
summarize(Spend = sum(as.numeric(Spend)),
LeadSum = sum(as.numeric(Predictions)),
UpperSum = sum(as.numeric(Upper95)),
LowerSum = sum(as.numeric(Lower95))) %>%
remove_rownames %>% arrange(Month) %>% mutate(Month = month.abb[Month]) %>%
column_to_rownames(var = "Month")
SMF_NYFilt[paste0("Total Predicted ", (year(today) + 1)), ] <- colSums(SMF_NYFilt)
SMF_NYFilt <- SMF_NYFilt %>% rownames_to_column(var = "Month")
}
SMFutureNY <- SMF_NY(sourceorder)
SM <- function(SM_A, SM_B, SM_C){
SumsMonthFilt <- rbind(SM_A, SM_B) %>%
add_row(Month = paste0("Total ", year(today)),
Spend = SM_A[nrow(SM_A), 'Spend'] +
SM_B[nrow(SM_B), 'Spend'],
LeadSum = SM_A[nrow(SM_A), 'LeadSum'] +
SM_B[nrow(SM_B), 'LeadSum'],
UpperSum = SM_A[nrow(SM_A), 'LeadSum'] +
SM_B[nrow(SM_B), 'UpperSum'],
LowerSum = SM_A[nrow(SM_A), 'LeadSum'] +
SM_B[nrow(SM_B), 'LowerSum']) %>%
rbind(SM_C)
}
SumsMonth <- SM(SMPast, SMFutureCY, SMFutureNY)
rm(SMPast, SMFutureCY, SMFutureNY)
SMC <- function(SumM){
SMCFilt <- SumM %>% # Future Grouped Month Predictions formatted
mutate(LeadSum = format(LeadSum, big.mark = ",", scientific = FALSE),
UpperSum = format(UpperSum, big.mark = ",", scientific = FALSE),
LowerSum = format(LowerSum, big.mark = ",", scientific = FALSE),
Spend = scales::dollar(Spend)) %>%
rename(Predictions = LeadSum, Upper = UpperSum, Lower = LowerSum) %>%
mutate(CI = paste0(Lower, " - ", Upper)) %>%
dplyr::select(Month, Spend, Predictions, CI) %>%
mutate(CI = ifelse(Month == paste0("Total ", year(today)), paste0("*", CI), CI))
SMCFilt[1:month(today), "CI"] <- ""
return(SMCFilt)
}
SumsMonthClean <- SMC(SumsMonth)
htmltools::tags$style(HTML("
table caption {
caption-side: top;
text-align: center;
font-weight: bold;
color: #666;
font-size: 14px;
}
"))Table 1 gives the predicted number of leads and spend for 2024 and 2025 based on the predictions made in this report.
SumsSourceClean[c(7, 14, 15, 22),] %>% knitr::kable(SumsSourceClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("", "Spend", "Leads", "95% Confidence Interval (CI)"),
padding = 0,
caption = '<div style="text-align: center; font-weight: bold; color: #666;
font-size: 14">Observed and Predicted Leads Summary</div>',
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "condensed", full_width = F, font_size = 12) %>%
row_spec(0, bold = TRUE, color = "#666") %>%
row_spec(1:4, extra_css = "color: #666;") %>%
pack_rows(paste0(year(today)), 1, 3,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0(year(today) + 1), 4, 4,
label_row_css = "background-color: #666; color: #fff;") %>%
row_spec(c(3, 4), bold = TRUE) %>%
footnote(general = paste0("<span style='color: #666;'>* Total Predicted Confidence Interval ",
year(today), " + Total Observed Leads.</span>"), escape = FALSE)| Spend | Leads | 95% Confidence Interval (CI) | |
|---|---|---|---|
| 2024 | |||
| Total Observed 2024 | $4,031,452 | 50,812 | |
| Total Predicted 2024 | $612,396 | 10,446 | 8,291 - 12,606 |
| Total 2024 | $4,643,849 | 61,258 | *59,103 - 63,418 |
| 2025 | |||
| Total Predicted 2025 | $5,201,108 | 64,449 | 51,899 - 76,995 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
Figure 1 below shows the total number of leads obtained and the predicted leads with 95% confidence intervals for the remainder of 2024 and 2025. The predictions were obtained based on a Generalized Additive Model which accounts for spend for the three spend sources as well as the grouped ‘Other’ sources and omits spend as a predictor for the two sources with no spend with a 95% confidence interval.
SumsMonthNoTotals <- SumsMonth %>%
filter(!str_starts(Month, "Total")) %>%
mutate(Type = ifelse(is.na(UpperSum), "Observed", "Predicted"))
SumsMonthNoTotals$Year <- c(rep(year(today), 12), rep(year(today)+1, 12))
SumsMonthNoTotals <- SumsMonthNoTotals %>%
mutate(Date = as.Date(paste0(Year, '-', match(Month, month.abb), '-01')))
SumsMonthNoTotals <- SumsMonthNoTotals %>%
mutate(Tooltip = ifelse(Type == "Observed",
paste0("<b>", format(SumsMonthNoTotals$Date, "%B %Y"),
"</b><br>Observed Leads: ",
format(SumsMonthNoTotals$LeadSum, big.mark = ",", scientific = FALSE)),
paste0("<b>", format(SumsMonthNoTotals$Date, "%B %Y"),
"</b><br>Upper Limit: ",
format(SumsMonthNoTotals$UpperSum, big.mark = ",", scientific = FALSE),
"<br>Predicted Leads: ",
format(SumsMonthNoTotals$LeadSum, big.mark = ",", scientific = FALSE),
"<br>Lower Limit: ",
format(SumsMonthNoTotals$LowerSum, big.mark = ",", scientific = FALSE))))
p1c <- ggplot(SumsMonthNoTotals,
aes(x = Date, y = LeadSum, linetype = Type,
text = Tooltip, group = Type)) +
geom_line(color = "#77BC1F") +
scale_linetype_manual(values = c('Observed' = 'solid', 'Predicted' = 'dashed')) +
geom_point(color = "#77BC1F") +
geom_ribbon(aes(ymin = LowerSum, ymax = UpperSum),
alpha = 0.2, color = "#77BC1F", fill = "#77BC1F") +
scale_x_date(date_labels = "%b-%y",
breaks = seq(from = min(SumsMonthNoTotals$Date),
to = max(SumsMonthNoTotals$Date), by = "2 months"),
limits = c(min(SumsMonthNoTotals$Date), max(SumsMonthNoTotals$Date)),
name = '') +
scale_y_continuous(name = 'Number of Leads',
breaks = seq(0, 12000, 2000),
labels = c('0', '2k', '4k', '6k', '8k', '10k', '12k'),
limits = c(0, 12000)) +
labs(linetype = NULL) +
ggtitle(paste0('Observed and Predicted Leads for ', year(today), ' and ', year(today) + 1)) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 15),
legend.position = "right",
panel.grid.minor = element_blank()) +
guides(linetype = guide_legend(override.aes = list(size = 0.15)))
p1c <- ggplotly(p1c, tooltip = "text") %>%
# style(legendgroup = "Type",
# line = list(dash = "solid", width = 2),
# mode = "lines") %>%
layout(legend = list(orientation = "r",
x = 1.15,
y = 0.5,
xanchor = "center", yanchor = "top",
font = list(size = 14),
bgcolor = "white",
bordercolor = "#FFFFFF",
borderwidth = 1,
traceorder = "normal",
itemsizing = "trace",
margin = list(l = 0, r = 0, b = 0, t = 0, pad = 0),
itemwidth = 40,
itemheight = 40,
tracegroupgap = 40))
p1cFigure 1: Lead Summary
To understand how the observed and predicted leads are categorized, overview tables showing predictions by source (Table 2) and predictions by month (Table 9) are found in the Predictions by Source and Predictions by Month tabs respectively. These leads can be further dissected by a specific source or month using the buttons nested inside their respective tabs.
rm(pc1)
SumsSourceClean %>% knitr::kable(SumsSourceClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Source", "Spend", "Leads", "95% Confidence Interval (CI)"),
padding = 0,
caption = '<div style="text-align: center; font-weight: bold; color: #666;
font-size: 14">Observed and Predicted Leads by Source</div>',
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "condensed", full_width = F, font_size = 12) %>%
row_spec(0, bold = TRUE, color = "#666") %>%
row_spec(1:nrow(SumsSourceClean), extra_css = "color: #666;") %>%
pack_rows(paste0("Observed (Jan - ", month.abb[month(today)-1], ") ", year(today)), 1, 7,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted (", month.abb[month(today)], " - Dec) ", year(today)), 8, 14,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Observed + Predicted ", year(today)), 15, 15,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted ", year(today) + 1), 16, 21,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Predicted ", year(today) + 1), 22, 22,
label_row_css = "background-color: #666; color: #fff;") %>%
row_spec(c(7, 14, 15, 22), bold = TRUE) %>%
footnote(general = paste0("<span style='color: #666;'>* Total Predicted Confidence Interval ",
year(today), " + Total Observed Leads.</span>"), escape = FALSE)| Source | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed (Jan - Oct) 2024 | |||
| Google Ads | $2,448,552 | 20,912 | |
| Amazon | $1,053,735 | 12,475 | |
| Ad Roll | $481,080 | 3,134 | |
| Website | $0 | 6,295 | |
| Google Organic | $0 | 3,097 | |
| Other | $48,086 | 4,899 | |
| Total Observed 2024 | $4,031,452 | 50,812 | |
| Predicted (Nov - Dec) 2024 | |||
| Google Ads | $322,964 | 3,636 | 3,277 - 3,996 |
| Amazon | $191,408 | 2,465 | 2,099 - 2,833 |
| Ad Roll | $90,607 | 921 | 563 - 1,278 |
| Website | $0 | 1,207 | 850 - 1,565 |
| Google Organic | $0 | 1,076 | 718 - 1,434 |
| Other | $7,418 | 1,141 | 784 - 1,500 |
| Total Predicted 2024 | $612,396 | 10,446 | 8,291 - 12,606 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $4,643,849 | 61,258 | *59,103 - 63,418 |
| Predicted 2025 | |||
| Google Ads | $3,104,097 | 28,450 | 25,845 - 31,053 |
| Amazon | $1,394,560 | 15,031 | 12,759 - 17,304 |
| Ad Roll | $640,287 | 4,719 | 2,798 - 6,638 |
| Website | $0 | 5,770 | 3,854 - 7,687 |
| Google Organic | $0 | 4,982 | 3,065 - 6,901 |
| Other | $62,164 | 5,497 | 3,578 - 7,412 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $5,201,108 | 64,449 | 51,899 - 76,995 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
SourceCleanTable <- function(sc){
SMPt <- SMP(sc)
SMFtCY <- SMF_CY(sc)
SMFtNY <- SMF_NY(sc)
SumsMo <- SM(SMPt, SMFtCY, SMFtNY)
SumsMoClean <- SMC(SumsMo)
caption_text <- paste0('<div style="text-align: center; font-weight: bold; color: #666; font-size: 14">',
sc, ' Lead Breakdown</div>')
SMCTable <- SumsMoClean %>%
knitr::kable(SumsMoClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Month", "Spend", "Leads", "95% Confidence Interval (CI)"),
padding = 0,
caption = caption_text,
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "condensed", full_width = F, font_size = 12) %>%
row_spec(0, bold = TRUE, color = "#666") %>%
row_spec(1:nrow(SumsMoClean), extra_css = "color: #666;") %>%
pack_rows(paste0("Observed ", year(today)), 1, month(today),
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted ", year(today)), month(today) + 1, 14,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Observed + Predicted ", year(today)), 15, 15,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted ", year(today) + 1), 16, 27,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Predicted ", year(today) + 1), 28, 28,
label_row_css = "background-color: #666; color: #fff;") %>%
row_spec(c(month(today), 14, 15, 28), bold = TRUE) %>%
row_spec(1:nrow(SumsMoClean), extra_css = "height: 15px;") %>%
footnote(general = paste0("<span style='color: #666;'>* Total Predicted Confidence Interval ",
year(today), " + Total Observed Leads.</span>"), escape = FALSE)
return(SMCTable)
}
SourceCleanTable(sourceorder[1])| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $94,194 | 870 | |
| Feb | $113,836 | 969 | |
| Mar | $134,157 | 1,253 | |
| Apr | $217,949 | 1,993 | |
| May | $203,913 | 2,045 | |
| Jun | $211,967 | 2,316 | |
| Jul | $272,918 | 3,878 | |
| Aug | $409,348 | 3,189 | |
| Sep | $514,945 | 2,642 | |
| Oct | $275,324 | 1,757 | |
| Total Observed 2024 | $2,448,552 | 20,912 | |
| Predicted 2024 | |||
| Nov | $185,145 | 1,970 | 1,798 - 2,143 |
| Dec | $137,819 | 1,666 | 1,479 - 1,853 |
| Total Predicted 2024 | $322,964 | 3,636 | 3,277 - 3,996 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $2,771,515 | 24,548 | *24,189 - 24,908 |
| Predicted 2025 | |||
| Jan | $105,497 | 1,171 | 996 - 1,346 |
| Feb | $127,497 | 1,349 | 1,184 - 1,513 |
| Mar | $150,256 | 1,531 | 1,374 - 1,688 |
| Apr | $244,103 | 2,208 | 2,024 - 2,392 |
| May | $228,383 | 2,123 | 1,954 - 2,293 |
| Jun | $237,403 | 2,211 | 2,040 - 2,382 |
| Jul | $305,668 | 2,710 | 2,496 - 2,923 |
| Aug | $458,470 | 3,796 | 3,455 - 4,137 |
| Sep | $576,738 | 4,643 | 4,192 - 5,093 |
| Oct | $308,363 | 2,802 | 2,584 - 3,020 |
| Nov | $207,362 | 2,125 | 1,949 - 2,301 |
| Dec | $154,357 | 1,781 | 1,597 - 1,965 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $3,104,097 | 28,450 | 25,845 - 31,053 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $19,740 | 263 | |
| Feb | $9,912 | 132 | |
| Mar | $14,868 | 198 | |
| Apr | $21,252 | 283 | |
| May | $40,068 | 534 | |
| Jun | $58,884 | 785 | |
| Jul | $110,292 | 1,471 | |
| Aug | $240,391 | 3,120 | |
| Sep | $275,688 | 3,063 | |
| Oct | $262,640 | 2,626 | |
| Total Observed 2024 | $1,053,735 | 12,475 | |
| Predicted 2024 | |||
| Nov | $139,552 | 1,525 | 1,347 - 1,704 |
| Dec | $51,856 | 940 | 752 - 1,129 |
| Total Predicted 2024 | $191,408 | 2,465 | 2,099 - 2,833 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $1,245,143 | 14,940 | *14,574 - 15,308 |
| Predicted 2025 | |||
| Jan | $22,109 | 463 | 288 - 639 |
| Feb | $11,101 | 411 | 242 - 581 |
| Mar | $16,652 | 475 | 312 - 637 |
| Apr | $23,802 | 549 | 393 - 705 |
| May | $44,876 | 720 | 571 - 869 |
| Jun | $65,950 | 891 | 745 - 1,037 |
| Jul | $123,527 | 1,316 | 1,161 - 1,471 |
| Aug | $269,238 | 2,353 | 2,108 - 2,598 |
| Sep | $308,771 | 2,652 | 2,375 - 2,929 |
| Oct | $294,157 | 2,575 | 2,309 - 2,841 |
| Nov | $156,298 | 1,642 | 1,458 - 1,826 |
| Dec | $58,079 | 984 | 797 - 1,171 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $1,394,560 | 15,031 | 12,759 - 17,304 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $45,980 | 244 | |
| Feb | $45,980 | 190 | |
| Mar | $45,980 | 242 | |
| Apr | $49,020 | 246 | |
| May | $49,020 | 299 | |
| Jun | $49,020 | 229 | |
| Jul | $49,020 | 268 | |
| Aug | $49,020 | 516 | |
| Sep | $49,020 | 546 | |
| Oct | $49,020 | 354 | |
| Total Observed 2024 | $481,080 | 3,134 | |
| Predicted 2024 | |||
| Nov | $49,020 | 474 | 301 - 647 |
| Dec | $41,587 | 447 | 262 - 631 |
| Total Predicted 2024 | $90,607 | 921 | 563 - 1,278 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $571,687 | 4,055 | *3,697 - 4,412 |
| Predicted 2025 | |||
| Jan | $51,498 | 245 | 69 - 421 |
| Feb | $51,498 | 270 | 104 - 436 |
| Mar | $51,498 | 294 | 136 - 452 |
| Apr | $54,902 | 343 | 190 - 495 |
| May | $54,902 | 367 | 219 - 515 |
| Jun | $54,902 | 392 | 245 - 538 |
| Jul | $54,902 | 416 | 269 - 564 |
| Aug | $54,902 | 441 | 290 - 591 |
| Sep | $54,902 | 465 | 310 - 621 |
| Oct | $54,902 | 490 | 327 - 653 |
| Nov | $54,902 | 515 | 342 - 687 |
| Dec | $46,577 | 481 | 297 - 665 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $640,287 | 4,719 | 2,798 - 6,638 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $0 | 133 | |
| Feb | $0 | 128 | |
| Mar | $0 | 250 | |
| Apr | $0 | 414 | |
| May | $0 | 559 | |
| Jun | $0 | 684 | |
| Jul | $0 | 1,054 | |
| Aug | $0 | 1,269 | |
| Sep | $0 | 1,036 | |
| Oct | $0 | 768 | |
| Total Observed 2024 | $0 | 6,295 | |
| Predicted 2024 | |||
| Nov | $0 | 591 | 418 - 765 |
| Dec | $0 | 616 | 432 - 800 |
| Total Predicted 2024 | $0 | 1,207 | 850 - 1,565 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $0 | 7,502 | *7,145 - 7,860 |
| Predicted 2025 | |||
| Jan | $0 | 346 | 171 - 520 |
| Feb | $0 | 370 | 205 - 535 |
| Mar | $0 | 395 | 238 - 552 |
| Apr | $0 | 419 | 268 - 571 |
| May | $0 | 444 | 297 - 591 |
| Jun | $0 | 469 | 323 - 615 |
| Jul | $0 | 493 | 346 - 640 |
| Aug | $0 | 518 | 367 - 668 |
| Sep | $0 | 542 | 386 - 699 |
| Oct | $0 | 567 | 403 - 731 |
| Nov | $0 | 591 | 418 - 765 |
| Dec | $0 | 616 | 432 - 800 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $0 | 5,770 | 3,854 - 7,687 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $0 | 241 | |
| Feb | $0 | 215 | |
| Mar | $0 | 363 | |
| Apr | $0 | 528 | |
| May | $0 | 845 | |
| Jun | $0 | 457 | |
| Jul | $0 | 201 | |
| Aug | $0 | 104 | |
| Sep | $0 | 89 | |
| Oct | $0 | 54 | |
| Total Observed 2024 | $0 | 3,097 | |
| Predicted 2024 | |||
| Nov | $0 | 526 | 352 - 699 |
| Dec | $0 | 550 | 366 - 735 |
| Total Predicted 2024 | $0 | 1,076 | 718 - 1,434 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $0 | 4,173 | *3,815 - 4,531 |
| Predicted 2025 | |||
| Jan | $0 | 280 | 106 - 455 |
| Feb | $0 | 305 | 140 - 470 |
| Mar | $0 | 329 | 172 - 486 |
| Apr | $0 | 354 | 203 - 505 |
| May | $0 | 378 | 231 - 526 |
| Jun | $0 | 403 | 257 - 549 |
| Jul | $0 | 427 | 280 - 575 |
| Aug | $0 | 452 | 301 - 603 |
| Sep | $0 | 477 | 320 - 633 |
| Oct | $0 | 501 | 337 - 665 |
| Nov | $0 | 526 | 352 - 699 |
| Dec | $0 | 550 | 366 - 735 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $0 | 4,982 | 3,065 - 6,901 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed 2024 | |||
| Jan | $3,857.43 | 328 | |
| Feb | $3,455.68 | 275 | |
| Mar | $4,615.20 | 444 | |
| Apr | $5,542.65 | 617 | |
| May | $5,111.17 | 541 | |
| Jun | $3,871.01 | 403 | |
| Jul | $4,671.76 | 510 | |
| Aug | $5,166.68 | 632 | |
| Sep | $6,118.61 | 628 | |
| Oct | $5,675.58 | 521 | |
| Total Observed 2024 | $48,085.77 | 4,899 | |
| Predicted 2024 | |||
| Nov | $4,386.69 | 563 | 390 - 737 |
| Dec | $3,031.15 | 578 | 394 - 763 |
| Total Predicted 2024 | $7,417.84 | 1,141 | 784 - 1,500 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $55,503.61 | 6,040 | *5,683 - 6,399 |
| Predicted 2025 | |||
| Jan | $4,320.32 | 317 | 142 - 491 |
| Feb | $3,870.36 | 338 | 173 - 503 |
| Mar | $5,169.02 | 372 | 215 - 529 |
| Apr | $6,207.77 | 404 | 252 - 555 |
| May | $5,724.51 | 425 | 277 - 572 |
| Jun | $4,335.53 | 440 | 294 - 586 |
| Jul | $5,232.37 | 471 | 324 - 618 |
| Aug | $5,786.68 | 499 | 349 - 650 |
| Sep | $6,852.84 | 531 | 375 - 687 |
| Oct | $6,356.65 | 552 | 388 - 716 |
| Nov | $4,913.09 | 567 | 393 - 740 |
| Dec | $3,394.89 | 581 | 396 - 765 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $62,164.03 | 5,497 | 3,578 - 7,412 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
SumsMonthClean %>% knitr::kable(SumsMonthClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Month", "Spend", "Leads", "95% Confidence Interval (CI)"),
caption = '<div style="text-align: center; font-weight: bold; color: #666;
font-size: 14">Observed and Predicted Leads by Month</div>',
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "condensed", full_width = F, font_size = 12) %>%
row_spec(0, bold = TRUE, color = "#666") %>%
row_spec(1:nrow(SumsMonthClean), extra_css = "color: #666;") %>%
pack_rows(paste0("Observed (Jan - ", month.abb[month(today)-1], ") ", year(today)),
1, month(today),
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted (", month.abb[month(today)], " - Dec) ", year(today)),
month(today) + 1, 14,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Observed + Predicted ", year(today)),
15, 15,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Predicted ", year(today) + 1), 16, 27,
label_row_css = "background-color: #666; color: #fff;") %>%
pack_rows(paste0("Total Predicted ", year(today) + 1), 28, 28,
label_row_css = "background-color: #666; color: #fff;") %>%
row_spec(c(month(today), 14, 15, 28), bold = TRUE) %>%
footnote(general = paste0("<span style='color: #666;'>* Total Predicted Confidence Interval ",
year(today), " + Total Observed Leads.</span>"), escape = FALSE)| Month | Spend | Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Observed (Jan - Oct) 2024 | |||
| Jan | $163,771 | 2,079 | |
| Feb | $173,184 | 1,909 | |
| Mar | $199,620 | 2,750 | |
| Apr | $293,763 | 4,081 | |
| May | $298,113 | 4,823 | |
| Jun | $323,742 | 4,874 | |
| Jul | $436,902 | 7,382 | |
| Aug | $703,926 | 8,830 | |
| Sep | $845,771 | 8,004 | |
| Oct | $592,660 | 6,080 | |
| Total Observed 2024 | $4,031,452 | 50,812 | |
| Predicted (Nov - Dec) 2024 | |||
| Nov | $378,103 | 5,649 | 4,606 - 6,695 |
| Dec | $234,293 | 4,797 | 3,685 - 5,911 |
| Total Predicted 2024 | $612,396 | 10,446 | 8,291 - 12,606 |
| Total Observed + Predicted 2024 | |||
| Total 2024 | $4,643,849 | 61,258 | *59,103 - 63,418 |
| Predicted 2025 | |||
| Jan | $183,425 | 2,822 | 1,772 - 3,872 |
| Feb | $193,966 | 3,043 | 2,048 - 4,038 |
| Mar | $223,575 | 3,396 | 2,447 - 4,344 |
| Apr | $329,014 | 4,277 | 3,330 - 5,223 |
| May | $333,886 | 4,457 | 3,549 - 5,366 |
| Jun | $362,591 | 4,806 | 3,904 - 5,707 |
| Jul | $489,329 | 5,833 | 4,876 - 6,791 |
| Aug | $788,397 | 8,059 | 6,870 - 9,247 |
| Sep | $947,264 | 9,310 | 7,958 - 10,662 |
| Oct | $663,779 | 7,487 | 6,348 - 8,626 |
| Nov | $423,475 | 5,966 | 4,912 - 7,018 |
| Dec | $262,408 | 4,993 | 3,885 - 6,101 |
| Total Predicted 2025 | |||
| Total Predicted 2025 | $5,201,108 | 64,449 | 51,899 - 76,995 |
| Note: | |||
| * Total Predicted Confidence Interval 2024 + Total Observed Leads. | |||
MonthCleanTable <- function(mo, yr){
SSFtCY <- SSF_CY(mo)
SSFtNY <- SSF_NY(mo)
SumsMonthCleanCY <- SSC(SSFtCY, F) %>% mutate(Source = ifelse(str_starts(Source, "Total"), "Total", Source))
SumsMonthCleanNY <- SSC(SSFtNY, F) %>% mutate(Source = ifelse(str_starts(Source, "Total"), "Total", Source))
SMCTable <- if (yr == year(today)){
SumsMonthCleanCY
} else if (yr == (year(today) + 1)){
SumsMonthCleanNY
} else {"Error"}
caption_text <- paste0('<div style="text-align: center; font-weight: bold; color: #666; font-size: 14">',
month.name[mo], " ", yr, ' Predicted Leads</div>')
SMCTable <- SMCTable %>%
knitr::kable(SSFtCY, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Source", "Spend", "Predicted Leads", "95% Confidence Interval (CI)"),
padding = 0,
caption = caption_text,
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "condensed", full_width = F, font_size = 12) %>%
row_spec(1:nrow(SMCTable), extra_css = "color: #666;") %>%
row_spec(7, bold = TRUE)
return(SMCTable)
}
MonthCleanTable(month(today), year(today))| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $185,145 | 1,970 | 1,798 - 2,143 |
| Amazon | $139,552 | 1,525 | 1,347 - 1,704 |
| Ad Roll | $49,020 | 474 | 301 - 647 |
| Website | $0 | 591 | 418 - 765 |
| Google Organic | $0 | 526 | 352 - 699 |
| Other | $4,387 | 563 | 390 - 737 |
| Total | $378,103 | 5,649 | 4,606 - 6,695 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $137,819 | 1,666 | 1,479 - 1,853 |
| Amazon | $51,856 | 940 | 752 - 1,129 |
| Ad Roll | $41,587 | 447 | 262 - 631 |
| Website | $0 | 616 | 432 - 800 |
| Google Organic | $0 | 550 | 366 - 735 |
| Other | $3,031 | 578 | 394 - 763 |
| Total | $234,293 | 4,797 | 3,685 - 5,911 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $105,497 | 1,171 | 996 - 1,346 |
| Amazon | $22,109 | 463 | 288 - 639 |
| Ad Roll | $51,498 | 245 | 69 - 421 |
| Website | $0 | 346 | 171 - 520 |
| Google Organic | $0 | 280 | 106 - 455 |
| Other | $4,320 | 317 | 142 - 491 |
| Total | $183,425 | 2,822 | 1,772 - 3,872 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $127,497 | 1,349 | 1,184 - 1,513 |
| Amazon | $11,101 | 411 | 242 - 581 |
| Ad Roll | $51,498 | 270 | 104 - 436 |
| Website | $0 | 370 | 205 - 535 |
| Google Organic | $0 | 305 | 140 - 470 |
| Other | $3,870 | 338 | 173 - 503 |
| Total | $193,966 | 3,043 | 2,048 - 4,038 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $150,256 | 1,531 | 1,374 - 1,688 |
| Amazon | $16,652 | 475 | 312 - 637 |
| Ad Roll | $51,498 | 294 | 136 - 452 |
| Website | $0 | 395 | 238 - 552 |
| Google Organic | $0 | 329 | 172 - 486 |
| Other | $5,169 | 372 | 215 - 529 |
| Total | $223,575 | 3,396 | 2,447 - 4,344 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $244,103 | 2,208 | 2,024 - 2,392 |
| Amazon | $23,802 | 549 | 393 - 705 |
| Ad Roll | $54,902 | 343 | 190 - 495 |
| Website | $0 | 419 | 268 - 571 |
| Google Organic | $0 | 354 | 203 - 505 |
| Other | $6,208 | 404 | 252 - 555 |
| Total | $329,014 | 4,277 | 3,330 - 5,223 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $228,383 | 2,123 | 1,954 - 2,293 |
| Amazon | $44,876 | 720 | 571 - 869 |
| Ad Roll | $54,902 | 367 | 219 - 515 |
| Website | $0 | 444 | 297 - 591 |
| Google Organic | $0 | 378 | 231 - 526 |
| Other | $5,725 | 425 | 277 - 572 |
| Total | $333,886 | 4,457 | 3,549 - 5,366 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $237,403 | 2,211 | 2,040 - 2,382 |
| Amazon | $65,950 | 891 | 745 - 1,037 |
| Ad Roll | $54,902 | 392 | 245 - 538 |
| Website | $0 | 469 | 323 - 615 |
| Google Organic | $0 | 403 | 257 - 549 |
| Other | $4,336 | 440 | 294 - 586 |
| Total | $362,591 | 4,806 | 3,904 - 5,707 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $305,668 | 2,710 | 2,496 - 2,923 |
| Amazon | $123,527 | 1,316 | 1,161 - 1,471 |
| Ad Roll | $54,902 | 416 | 269 - 564 |
| Website | $0 | 493 | 346 - 640 |
| Google Organic | $0 | 427 | 280 - 575 |
| Other | $5,232 | 471 | 324 - 618 |
| Total | $489,329 | 5,833 | 4,876 - 6,791 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $458,470 | 3,796 | 3,455 - 4,137 |
| Amazon | $269,238 | 2,353 | 2,108 - 2,598 |
| Ad Roll | $54,902 | 441 | 290 - 591 |
| Website | $0 | 518 | 367 - 668 |
| Google Organic | $0 | 452 | 301 - 603 |
| Other | $5,787 | 499 | 349 - 650 |
| Total | $788,397 | 8,059 | 6,870 - 9,247 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $576,738 | 4,643 | 4,192 - 5,093 |
| Amazon | $308,771 | 2,652 | 2,375 - 2,929 |
| Ad Roll | $54,902 | 465 | 310 - 621 |
| Website | $0 | 542 | 386 - 699 |
| Google Organic | $0 | 477 | 320 - 633 |
| Other | $6,853 | 531 | 375 - 687 |
| Total | $947,264 | 9,310 | 7,958 - 10,662 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $308,363 | 2,802 | 2,584 - 3,020 |
| Amazon | $294,157 | 2,575 | 2,309 - 2,841 |
| Ad Roll | $54,902 | 490 | 327 - 653 |
| Website | $0 | 567 | 403 - 731 |
| Google Organic | $0 | 501 | 337 - 665 |
| Other | $6,357 | 552 | 388 - 716 |
| Total | $663,779 | 7,487 | 6,348 - 8,626 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $207,362 | 2,125 | 1,949 - 2,301 |
| Amazon | $156,298 | 1,642 | 1,458 - 1,826 |
| Ad Roll | $54,902 | 515 | 342 - 687 |
| Website | $0 | 591 | 418 - 765 |
| Google Organic | $0 | 526 | 352 - 699 |
| Other | $4,913 | 567 | 393 - 740 |
| Total | $423,475 | 5,966 | 4,912 - 7,018 |
| Source | Spend | Predicted Leads | 95% Confidence Interval (CI) |
|---|---|---|---|
| Google Ads | $154,357 | 1,781 | 1,597 - 1,965 |
| Amazon | $58,079 | 984 | 797 - 1,171 |
| Ad Roll | $46,577 | 481 | 297 - 665 |
| Website | $0 | 616 | 432 - 800 |
| Google Organic | $0 | 550 | 366 - 735 |
| Other | $3,395 | 581 | 396 - 765 |
| Total | $262,408 | 4,993 | 3,885 - 6,101 |
To understand how the model works, a machine learning model was used to show how well the model predicted the most recent 6 months. This is described in the Prediction Accuracy tab. To get a visual of the historic leads and spend by source, graphs were added to the Historic Data tab for reference.
To visualize how well this model performs, the historic lead and spend data prior to May 2024 was used to predict the leads for May through Oct 2024. Figure 2 helps us visualize how well the model performed because we have the observed leads for May through Oct to use as a comparison.
SumsMonthMLNoTotal <- SumsMonthML %>%
filter(!str_starts(Date, "Total")) %>%
rename(Observed = ObservedSum, Predicted = PredictedSum) %>%
pivot_longer(cols = c(Observed, Predicted), names_to = "Type", values_to = "Leads") %>%
mutate(UpperSum = ifelse(Type == "Observed", NA, UpperSum),
LowerSum = ifelse(Type == "Observed", NA, LowerSum),
Date = as.Date(Date))
SumsMonthMLNoTotal <- SumsMonthMLNoTotal %>%
mutate(Tooltip = ifelse(Type == "Observed",
paste0("<b>", format(SumsMonthMLNoTotal$Date, "%B %Y"),
"</b><br>Observed Leads: ",
format(SumsMonthMLNoTotal$Leads, big.mark = ",", scientific = FALSE)),
paste0("<b>", format(SumsMonthMLNoTotal$Date, "%B %Y"),
"</b><br>Upper Limit: ",
format(SumsMonthMLNoTotal$UpperSum, big.mark = ",", scientific = FALSE),
"<br>Predicted Leads: ",
format(SumsMonthMLNoTotal$Leads, big.mark = ",", scientific = FALSE),
"<br>Lower Limit: ",
format(SumsMonthMLNoTotal$LowerSum, big.mark = ",", scientific = FALSE))))
### Colors for Conservice Navy: #263746, Green: #77BC1F, Blue: #396EB6, Light Gray: #D2D3D3, Dark Gray: #555759
p2c <- ggplot(SumsMonthMLNoTotal,
aes(x = Date, y = Leads, linetype = Type,
text = Tooltip,
group = Type)) +
# geom_line(aes(color = Type)) + # Mapping color to Type (Observed/Predicted)
# scale_linetype_manual(values = c('Observed' = 'solid', 'Predicted' = 'dashed')) +
# scale_color_manual(values = c('Observed' = '#396EB6', 'Predicted' = '#396EB6')) + # Set colors for lines
# geom_point(aes(color = Type)) +
geom_line(color = "#396EB6") +
scale_linetype_manual(values = c('Observed' = 'solid', 'Predicted' = 'dashed')) +
geom_point(color = "#396EB6") +
geom_ribbon(aes(ymin = LowerSum, ymax = UpperSum),
alpha = 0.2, color = "#396EB6", fill = "#396EB6") +
scale_x_date(date_labels = "%b-%y",
name = '') +
scale_y_continuous(name = 'Number of Leads',
breaks = seq(0, 10000, 2000),
labels = c('0', '2k', '4k', '6k', '8k', '10k'),
limits = c(0, 11000)) +
labs(linetype = NULL) +
ggtitle('Observed and Predicted Leads') +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 15),
legend.position = "right",
panel.grid.minor = element_blank()) +
guides(linetype = guide_legend(override.aes = list(size = 0.15)))
p2c <- ggplotly(p2c, tooltip = "text") %>%
layout(legend = list(orientation = "r",
x = 1.15,
y = 0.5,
xanchor = "center", yanchor = "top",
font = list(size = 14),
bgcolor = "white",
bordercolor = "#FFFFFF",
borderwidth = 1,
traceorder = "normal",
itemsizing = "trace",
margin = list(l = 0, r = 0, b = 0, t = 0, pad = 0),
itemwidth = 40,
itemheight = 40,
tracegroupgap = 40))
p2cFigure 2: Lead Comparison
The tables below show the observed and predicted leads by source and month. The observed leads nearly always fall within the confidence interval for a specific source or month, but it is interesting to note that the total number of predicted leads is so close to the total number of observed leads and that there were more leads observed than predicted overall. We want to avoid overfitting the model to give attainable targets.
MLMonthClean %>% knitr::kable(MLMonthClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Month", "Spend", "Observed",
"Predicted", "95% CI"),
padding = 0,
caption = '<div style="text-align: center; font-weight: bold; color: #666;
font-size: 12">Lead Comparison by Month</div>',
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "striped", full_width = F, font_size = 10.5) %>%
row_spec(nrow(MLMonthClean), bold = TRUE)| Month | Spend | Observed | Predicted | 95% CI |
|---|---|---|---|---|
| May 2024 | $298,113 | 4,823 | 4,208 | 3,312 - 5,107 |
| Jun 2024 | $323,742 | 4,874 | 4,536 | 3,646 - 5,425 |
| Jul 2024 | $436,902 | 7,382 | 5,468 | 4,538 - 6,399 |
| Aug 2024 | $703,926 | 8,830 | 7,472 | 6,350 - 8,593 |
| Sep 2024 | $845,771 | 8,004 | 8,605 | 7,338 - 9,872 |
| Oct 2024 | $592,660 | 6,080 | 6,992 | 5,901 - 8,086 |
| Total | $3,201,113 | 39,993 | 37,281 | 31,085 - 43,482 |
MLSourceClean %>% knitr::kable(MLSourceClean, format = "html", align = c("r", "r", "r", "c"),
col.names = c("Source", "Spend", "Observed",
"Predicted", "95% CI"),
padding = 0,
caption = '<div style="text-align: center; font-weight: bold; color: #666;
font-size: 12">Lead Comparison by Source</div>',
row.names = FALSE, escape = FALSE) %>%
kable_styling(bootstrap_options = "striped", full_width = F, font_size = 10.5) %>%
row_spec(nrow(MLMonthClean), bold = TRUE)| Source | Spend | Observed | Predicted | 95% CI |
|---|---|---|---|---|
| Google Ads | $1,888,416 | 15,827 | 16,709 | 15,317 - 18,103 |
| Amazon | $987,963 | 11,599 | 9,682 | 8,521 - 10,843 |
| Ad Roll | $294,120 | 2,212 | 2,326 | 1,417 - 3,238 |
| Website | $0 | 5,370 | 3,033 | 2,122 - 3,944 |
| Google Organic | $0 | 1,750 | 2,638 | 1,726 - 3,551 |
| Other | $30,615 | 3,235 | 2,893 | 1,982 - 3,803 |
| Total | $3,201,113 | 39,993 | 37,281 | 31,085 - 43,482 |
Another important consideration is the predicted spend (budget) variation from the actual spend. The budget for all sources throughout the year can change if a source is underproducing, overproducing, or if the lead source uses only a portion of the alloted budget. As such, the model accuracy may overinflate the confidence in this model to predict the number of leads because the “budget” and actual spend for the accuracy model above are the exact same which is not always possible to predict for the budget for future months.
Figure 3 shows the number of leads per month by source as well as the spend per month by source.
cols <- c("#a6cee3", "#b2df8a", "#fb9a99", "#fdbf6f", "#cab2d6", "#ffff99")
cols <- brewer.pal(12, "Paired") %>% .[seq(2, 12, 2)]
cols <- rev(cols)
visible_list <- list()
revsource <- rev(sourceorder)
p <- plot_ly(data = HistoricLeads, type = "bar",
hovertemplate = ~paste("Source: ", Source, "<br>Lead Count: ",
format(Leads, big.mark = ",",
scientific = FALSE),
"<br>Month: ", MonthAbb, Year,
"<extra></extra>"))
year_dates <- unique(HistoricLeads$Date[format(HistoricLeads$Date, "%m-%d") == "01-01"])
for (i in 1:length(revsource)) {
source <- revsource[i]
filtered_data <- subset(HistoricLeads, Source == source)
p <- add_trace(p, data = filtered_data, x = ~Date, y = ~Leads,
legendgroup = ~Source, name = source, stackgroup = "one",
marker = list(color = cols[i]), visible = visible_list[i])
}
p <- layout(p, title = "",
xaxis = list(title = "", tickangle = -45, tickformat = "%b-%y",
tickmode = "linear", dtick = "M2", title = none),
yaxis = list(title = "Number of Leads", tickformat = "$,.0s",
range = c(0, 15000), tickmode = "linear", dtick = 2000),
showlegend = TRUE, barmode = "stack",
legend = list(title = list(text = "Sources"),
itemsizing = "constant", traceorder = "reversed",
clickmode = "event+select"), margin = list(t = 100))
p <- layout(p, title = "",
xaxis = list(title = "", tickangle = -45, tickformat = "%b-%y",
tickmode = "linear", dtick = "M2", title = none),
yaxis = list(title = "Number of Leads", tickformat = "$,.0s",
range = c(0, 11000), tickmode = "array",
tickvals = c(0, 2000, 4000, 6000, 8000, 10000),
ticktext = c("0", "2k", "4k", "6k", "8k", "10k")),
showlegend = TRUE, barmode = "stack",
legend = list(title = list(text = "Sources"),
itemsizing = "constant", traceorder = "reversed",
clickmode = "event+select"), margin = list(t = 100))
p1 <- plot_ly(data = HistoricLeads, type = "bar",
hovertemplate = ~paste("Source: ", Source,
"<br>Spend: ",
paste0("$",
format(Spend, big.mark = ",",
nsmall = 2, scientific = FALSE)),
"<br>Month: ", MonthAbb, Year,
"<extra></extra>"))
visible_list <- list()
year_dates <- unique(HistoricLeads$Date[format(HistoricLeads$Date, "%m-%d") == "01-01"])
for (i in 1:length(revsource)) {
source <- revsource[i]
filtered_data <- subset(HistoricLeads, Source == source)
p1 <- add_trace(p1, data = filtered_data, x = ~Date, y = ~Spend,
legendgroup = ~Source, name = source, stackgroup = "one",
marker = list(color = cols[i]), showlegend = FALSE,
visible = visible_list[i])
}
p1 <- layout(p1, title = "Historic Leads and Spend",
xaxis = list(title = "",
tickangle = -45,
tickformat = "%b-%y",
tickmode = "linear",
dtick = "M2",
title = "none"),
yaxis = list(title = "Spend",
tickformat = "$,.0s",
range = c(0, 1050000),
tickmode = "array",
tickvals = c(0, 200000, 400000, 600000, 800000, 1000000),
ticktext = c("$0", "$200k", "$400k", "$600k", "$800k", "$1M")),
showlegend = TRUE, barmode = "stack",
legend = list(title = list(text = "Sources"), itemsizing = "constant",
traceorder = "reversed",
clickmode = "event+select"),
margin = list(t = 100))
subplot(p, p1, nrows = 2, margin = 0.05,
heights = c(0.45, 0.45),
widths = 1,
shareY = TRUE)Figure 3: Historic Leads (top) and Spend (bottom) since January 2023
Important: Please note that the predicted number of leads for paid sources presented in this report are estimates based on the GAM model and will not perfectly reflect the actual number of leads that will be obtained in 2024 or 2025. If you have any questions about this report, please email Joanna at jcoltrin@conservice.com.