Packages

library(tidyverse)
library(httr)
library(jsonlite)
library(usmap)
library(cowplot)
library(magick)
library(openxlsx)
library(fpp3)

Introduction

On May 11th, 2023 Burger King announced to its franchisees a national promotion, $5 Whopper Jr. Duo, which would include two Whopper Jr. sandwiches for $5 that was set to begin on May 18th. In their announcement, they provided the following forecast of various versions of the sandwich that were included within the promotion.

Menu Item	Baseline	Media	Post Media
Whopper Jr.	37.4	61.7	55.5
Whopper Jr. with cheese	18.6	34.3	30.0
Whopper Jr. with bacon & cheese	0.6	7.9	6.2
BBQ Bacon Whopper Jr.	0	4.7	3.6
BBQ Bacon & Cheese Whopper Jr.	0	4.7	3.6
Bacon & Swiss Whopper Jr.	0	4.5	3.0
Total	56.6	117.8	101.9

A national media advertising campaign would begin at the start of the promotion and last for 6 weeks. The promotion would continue for an additional 7 weeks for a total of 13 weeks, May 18 through Aug 14. The Baseline was taken from a 3-week period in February, and the Media and Post Media forecast was generated from a market test of this promotion which occurred in the Scranton - Wilkes-Barre Designated Market Area (DMA) in December 2022.

Based on the forecast, sales of Whopper Jr. are expected to increase by 108% during the media campaign, then soften in the weeks following. In August when the promotion was set to expire, it was extended due to its success.

The Whopper Jr. sandwich is a smaller version of Burger King’s signature sandwich the Whopper. Below is a table of the ingredients that make the Whopper and Whopper Jr. which shows that the Jr is about half the size of the Whopper.

Component	Whopper	Whopper Jr.
Mayonnaise	3/4 Ounces	3/8 Ounces
Lettuce	3/4 Ounces	3/8 Ounces
Tomato	2 Slices	1 Slice
Onions	3 Slices	2 Slices
Ketchup	1/2 Ounce	1/3 Ounce
Patty (precooked)	4.4 Ounces	2.0 Ounces
Cheese	2 Slices	1 Slice
Bacon	1 Slice	1/2 Slice

I wanted to determine the success, or failure, of this promotion by evaluating the following factors.

Are the increases in sales of the Whopper Jr. offset by decreases in sales of the Whopper?

Since the component costs of the Whopper Jr. is about half the Whopper and the $5 price of the promotion is less than the price of the Whopper, offsets in sales may not have a positive overall impact. Additionally, since the promotion price includes cheese & bacon which normally have an additional charge, the difference in revenue lost in item offsets may be significant.

Did restaurants see increases in same store sales and average guest check total?

Same store sales and average guest check are common measures in the Quick Service Restaurant (QSR) industry. If we evaluate these statistics for orders that included the promotion, and those that didn’t, we can determine if the promotion is successful.

Carrols Corporation

I work for the Carrols Corporation which is the largest Burger King franchisee in the United States. I used the Burger King API to load details about Carrols’ Restaurants.

if (!file.exists("./data/BKStores.csv")) {
    # API Call to retrieve a list of all Burger King Restaurants
    BKStores <- httr::GET("https://mdm.whopper.com/bk-locations-service/locationsFieldSet4?&brand=BK") |>
        content(as = "text") |>
        fromJSON() |>
        filter(country == "US", status != "Closed") |>
        mutate(postalCode = substring(postalCode, 0, 5), state = stateProvince, Remodel = (status !=
            "Open"), Carrols = (!is.na(reportingUnit) & reportingUnit == "Carrols")) |>
        select(id, city, state, postalCode, dmaName, latitude, longitude, Carrols,
            Remodel)

    BKStores |>
        write.csv("./data/BKStores.csv", row.names = FALSE)
} else {
    BKStores <- read.csv("./data/BKStores.csv")
}

BKStores <- BKStores |>
    usmap_transform(input_names = c("longitude", "latitude"), output_names = c("lon",
        "lat"))

CarrolsStores <- BKStores |>
    filter(Carrols == TRUE)

We operate 1019 restaurants, which is approximately 15% of all Burger King restaurants in the US. Carrols operates primarily on the east coast with restaurants in 23 states.

myplot <- plot_usmap(regions = "states", labels = TRUE, include = (CarrolsStores |>
    distinct(state))$state) + geom_point(data = CarrolsStores, aes(x = lon, y = lat,
    colour = "Carrols"), show.legend = FALSE) + scale_color_manual(values = c(Carrols = "#F58426"))

ggdraw() + draw_image("./images/CarrolsBK.jpg", scale = 0.25, halign = 0, valign = 1) +
    draw_plot(myplot)

Data Collection

We maintain transactional sales data in a Microsoft SQL server. I wanted to generate a data set that would include the number of Whoppers and Whopper Jrs. sold, the number of promotional Duos sold, and the total revenue of orders, and the total revenue of orders that included the promotion by day. I included delivery data as a baseline during the promotion since the offer was only available for in-store orders.

I used the following query to generate the data set used in this project. The results of the query were loaded into an Excel workbook which could be read and evaluated.

SELECT A.WeekDate, A.Store, A.OrderSource, SUM(A.Orders) Orders
  , SUM(A.SubTotal) SubTotal, SUM(A.Whoppers) Whoppers, SUM(A.Jrs) Jrs
  , SUM(A.Duos) Duos, SUM(A.DuoOrders) DuoOrders, SUM(A.DuoSubTotal) DuoSubTotal
FROM (
    SELECT DATEADD(DAY,-((DATEPART(WEEKDAY,o.BusinessDate)+2) % 7),o.BusinessDate) WeekDate
      , o.Store, o.OrderNum, CASE WHEN o.OrderPoint IN ('2','3','4','5','6') THEN 'Delivery' ELSE 'Store' END OrderSource
        , 1 Orders, o.SubTotal, CASE WHEN w.Whoppers IS NULL THEN 0 ELSE w.Whoppers END Whoppers
        , CASE WHEN j.Jrs IS NULL THEN 0 ELSE j.Jrs END Jrs
        , CASE WHEN d.Duos IS NULL THEN 0 ELSE d.Duos END Duos
        , CASE WHEN d.Duos IS NULL THEN 0 ELSE 1 END DuoOrders
        , CASE WHEN d.Duos IS NULL THEN 0 ELSE o.SubTotal END DuoSubTotal
    FROM dbo.tblEJOrder o
    LEFT JOIN (
        SELECT BusinessDate, Store, OrderNum, SUM(Qty) Whoppers
        FROM dbo.tblEJOrderItem
        WHERE ItemNum IN (1002,1402,1452,1552,63101,63201) AND Status = 1
        GROUP BY BusinessDate, Store, OrderNum
    ) w ON o.BusinessDate = w.BusinessDate AND o.Store = w.Store AND o.OrderNum = w.OrderNum
    LEFT JOIN (
        SELECT BusinessDate, Store, OrderNum, SUM(Qty) Jrs
        FROM dbo.tblEJOrderItem
        WHERE ItemNum IN (1082,1406,1456,1556,63137,63150,63237,63250) AND Status = 1
        GROUP BY BusinessDate, Store, OrderNum
    ) j ON o.BusinessDate = j.BusinessDate AND o.Store = j.Store AND o.OrderNum = j.OrderNum
    LEFT JOIN (
        SELECT BusinessDate, Store, OrderNum, SUM(Qty) Duos
        FROM dbo.tblEJOrderItem
        WHERE ItemNum = 61555 AND Status = 1
        GROUP BY BusinessDate, Store, OrderNum
    ) d ON o.BusinessDate = d.BusinessDate AND o.Store = d.Store AND o.OrderNum = d.OrderNum
    WHERE o.Status = 1 AND o.Company = 'CAR' AND o.BusinessDate BETWEEN '2023-04-20' AND '2023-08-16'
) A
GROUP BY A.WeekDate, A.Store, A.OrderSource
ORDER BY A.Store, A.WeekDate, A.OrderSource

Market Test

A market test was conducted in the Scranton DMA during a 5-week period from 12/01/2022 through 01/04/2023. Carrols has 14 stores in the DMA that participated in the market test and I collected weekly sales data for these stores to evaluate the promotion during the test. Additionally, I collected the 5-week period prior to the test and the 5-week period after the test to determine if the test had a lasting impact.

Load Data

Data is loaded from an Excel spreadsheet.

MarketTest.df <- read.xlsx("./data/Carrols.xlsx", sheet = 1, detectDates = TRUE) |>
    mutate(DMA = as.factor(DMA), CLS = as.factor(CLS), Orders = as.integer(Orders),
        SubTotal = as.integer(SubTotal), Whoppers = as.integer(Whoppers), Jrs = as.integer(Jrs),
        Duos = as.integer(Duos), DuoOrders = as.integer(DuoOrders), DuoSubTotal = as.integer(DuoSubTotal),
        DlvOrders = as.integer(DlvOrders), DlvSubTotal = as.integer(DlvSubTotal))

Data Examination

summary(MarketTest.df)

##     WeekDate               CLS                DMA          Orders    
##  Min.   :2022-10-27   285    : 15   Scranton/W-B:210   Min.   :1442  
##  1st Qu.:2022-11-17   295    : 15                      1st Qu.:2346  
##  Median :2022-12-15   1039   : 15                      Median :2688  
##  Mean   :2022-12-15   1040   : 15                      Mean   :2824  
##  3rd Qu.:2023-01-12   1041   : 15                      3rd Qu.:3207  
##  Max.   :2023-02-02   1042   : 15                      Max.   :5167  
##                       (Other):120                                    
##     SubTotal        Whoppers           Jrs              Duos       
##  Min.   :16968   Min.   : 303.0   Min.   : 183.0   Min.   :  0.00  
##  1st Qu.:26129   1st Qu.: 432.0   1st Qu.: 282.0   1st Qu.:  0.00  
##  Median :30043   Median : 506.0   Median : 383.0   Median :  0.00  
##  Mean   :32275   Mean   : 565.2   Mean   : 435.6   Mean   : 55.76  
##  3rd Qu.:37173   3rd Qu.: 621.8   3rd Qu.: 531.2   3rd Qu.:120.75  
##  Max.   :61186   Max.   :1394.0   Max.   :1104.0   Max.   :296.00  
##                                                                    
##    DuoOrders      DuoSubTotal       DlvOrders      DlvSubTotal  
##  Min.   :  0.0   Min.   :   0.0   Min.   :  7.0   Min.   : 107  
##  1st Qu.:  0.0   1st Qu.:   0.0   1st Qu.: 33.0   1st Qu.: 721  
##  Median :  0.0   Median :   0.0   Median : 73.5   Median :1537  
##  Mean   : 51.2   Mean   : 657.6   Mean   : 74.2   Mean   :1542  
##  3rd Qu.:112.0   3rd Qu.:1401.2   3rd Qu.:107.0   3rd Qu.:2236  
##  Max.   :266.0   Max.   :3348.0   Max.   :264.0   Max.   :5989  
##

Field	Description
WeekDate	Start date for the week which runs Thursday through Wednesday.
CLS	This is the internal Carrols store number.
DMA	Designated Market Area: Television Ad Markets.
Orders	Number of in-store orders for the week.
SubTotal	Total revenue for in-store orders.
Whoppers	Total number Whoppers sold in-store.
Jrs	Total number of Whopper Jrs. sold in-store, includes 2 for every Duo Promotion sold.
Duos	Total number of Duo Promotions sold in-store.
DuoOrders	Total number of in-store orders that contained the Duo Promotion.
DuoSubTotal	Total revenue for in-store orders that contained the Duo Promotion.
DlvOrders	Total number of delivery orders.
DlvSubTotal	Total revenue for delivery orders.

Burger Sales

One of the features of the promotion that I wanted to evaluate was the offset of Whoppers for Whopper Jr. sandwiches. Whoppers traditionally outsell Whopper Jrs. by 2:1, but as expected, when the promotion began, the sale of Whopper Jrs. increased, at the expense of Whopper sales.

MarketTest.df |>
    select(WeekDate, CLS, Whoppers, Jrs) |>
    pivot_longer(cols = c("Whoppers", "Jrs"), names_to = "Sandwich", values_to = "Count") |>
    ggplot(aes(x = WeekDate, y = Count)) + geom_line(aes(color = Sandwich)) + scale_color_manual(values = c("blue",
    "red")) + scale_y_continuous(expand = c(0, 0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2022-12-01"),
    as.Date("2022-12-29"))), linetype = 4, color = "black") + facet_wrap(CLS ~ .,
    scales = "fixed") + labs(title = "Weekly Sales of Whopper and Whopper Jr. Sandwiches",
    subtitle = "by Carrols Restaurant", x = "Date", y = "Burger Sales")

Revenue

When looking at the revenue for each store before, during, and after the promotion, it seems as if revenue decreased during the promotion. I included delivery revenue as a comparison, since it did not participate in the promotion, but it’s such a small percentage of sales, it doesn’t register much change.

MarketTest.df |>
    select(WeekDate, CLS, SubTotal, DlvSubTotal) |>
    pivot_longer(cols = c("SubTotal", "DlvSubTotal"), names_to = "Source", values_to = "Revenue") |>
    ggplot(aes(x = WeekDate, y = Revenue)) + geom_line(aes(color = Source)) + scale_color_manual(values = c("blue",
    "red")) + scale_y_continuous(expand = c(0, 0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2022-12-01"),
    as.Date("2022-12-29"))), linetype = 4, color = "black") + facet_wrap(CLS ~ .,
    scales = "fixed") + labs(title = "Weekly Revenue of in-store and delivery sales",
    subtitle = "by Carrols Restaurant", x = "Date", y = "Weekly Revenue $")

Average Guest Check

This provided a very surprising result that the average guest check for orders that included the promotion is higher than the average guest check for orders that didn’t. This is likely caused by the fact that the promotion for two Jrs. cannot be combined with the standard combo that would include fries and a drink.

MarketTest.df |>
    mutate(Check = (SubTotal - DuoSubTotal)/(Orders - DuoOrders), DuoCheck = DuoSubTotal/DuoOrders) |>
    select(WeekDate, CLS, Check, DuoCheck) |>
    pivot_longer(cols = c("Check", "DuoCheck"), names_to = "CheckType", values_to = "Average") |>
    ggplot(aes(x = WeekDate, y = Average)) + geom_line(aes(color = CheckType)) +
    scale_color_manual(values = c("blue", "red")) + scale_y_continuous(expand = c(0,
    0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2022-12-01"),
    as.Date("2022-12-29"))), linetype = 4, color = "black") + facet_wrap(CLS ~ .,
    scales = "fixed") + labs(title = "Average Guest Check for orders with and without the Duo Promotion",
    subtitle = "by Carrols Restaurant", x = "Date", y = "Avg Guest Check $")

Summary

During the promotion market test we see a number of factors that indicate this is will be a successful promotion.

Whopper Jr. sales increased 71% over the 5-week period preceding the promotion.

While we did see a revenue decrease during the promotion, that trend continued into the 5-weeks after the promotion, which could indicate outside factors. However we did see an increase of $1.25 in average guest check price for those orders that included the promotion versus those that did not.

Initial concerns about this promotion just offsetting Whopper Jr. sales for Whopper sales are not founded. While we are seeing a decrease in Whopper sales of 74 sandwiches per week, we are saw the promotion used 167 times per week, which more than offsets the Whopper losses.

MarketTest.summary <- MarketTest.df |>
    mutate(Period = case_when(WeekDate < as.Date("2022-12-01") ~ "10/27 - 11/30",
        WeekDate < as.Date("2023-01-05") ~ "12/01 - 01/04", .default = "01/05 - 02/08")) |>
    summarise(Orders = as.integer(mean(Orders - DuoOrders)), SubTotal = as.integer(mean(SubTotal -
        DuoSubTotal)), Whoppers = as.integer(mean(Whoppers)), Jrs = as.integer(mean(Jrs)),
        Duos = as.integer(mean(Duos)), DuoOrders = as.integer(mean(DuoOrders)), DuoSubTotal = as.integer(mean(DuoSubTotal)),
        DlvOrders = as.integer(mean(DlvOrders)), DlvSubTotal = as.integer(mean(DlvSubTotal)),
        .by = c("DMA", "Period")) |>
    mutate(AvgCheck = round(SubTotal/Orders, 2), DuoAvgCheck = round(DuoSubTotal/DuoOrders,
        2))

knitr::kable(MarketTest.summary |>
    select(DMA, Period, Orders, SubTotal, AvgCheck, Whoppers, Jrs, Duos, DuoOrders,
        DuoSubTotal, DuoAvgCheck))

DMA	Period	Orders	SubTotal	AvgCheck	Whoppers	Jrs	Duos	DuoOrders	DuoSubTotal	DuoAvgCheck
Scranton/W-B	10/27 - 11/30	2998	34307	11.44	638	367	0	0	0	NaN
Scranton/W-B	12/01 - 01/04	2577	29989	11.64	564	628	167	153	1972	12.89
Scranton/W-B	01/05 - 02/08	2741	30554	11.15	493	310	0	0	0	NaN

Nationwide Promotion

The $5 Whopper Jr. Duo nationwide promotion went live on May 18th, 2023. I’ve collected weekly sales data for all Carrols stores.

Load Data

Data is loaded from an Excel spreadsheet.

Promotion.df <- read.xlsx("./data/Carrols.xlsx", sheet = 2, detectDates = TRUE) |>
    mutate(DMA = as.factor(DMA), CLS = as.factor(CLS), Orders = as.integer(Orders),
        SubTotal = as.integer(SubTotal), Whoppers = as.integer(Whoppers), Jrs = as.integer(Jrs),
        Duos = as.integer(Duos), DuoOrders = as.integer(DuoOrders), DuoSubTotal = as.integer(DuoSubTotal),
        DlvOrders = as.integer(DlvOrders), DlvSubTotal = as.integer(DlvSubTotal))

Group the data by DMA to evaluate rather than individual restaurants.

Groups.df <- Promotion.df |>
    summarise(Orders = as.integer(mean(Orders)), SubTotal = as.integer(mean(SubTotal)),
        Whoppers = as.integer(mean(Whoppers)), Jrs = as.integer(mean(Jrs)), Duos = as.integer(mean(Duos)),
        DuoOrders = as.integer(mean(DuoOrders)), DuoSubTotal = as.integer(mean(DuoSubTotal)),
        DlvOrders = as.integer(mean(DlvOrders)), DlvSubTotal = as.integer(mean(DlvSubTotal)),
        .by = c("WeekDate", "DMA")) |>
    mutate(AvgCheck = round(SubTotal/Orders, 2), DuoAvgCheck = round(DuoSubTotal/DuoOrders,
        2))

summary(Groups.df)

##     WeekDate                  DMA           Orders        SubTotal    
##  Min.   :2023-04-20   Albany    :  17   Min.   :1580   Min.   :17556  
##  1st Qu.:2023-05-18   Baltimore :  17   1st Qu.:2637   1st Qu.:29943  
##  Median :2023-06-15   Bangor    :  17   Median :2892   Median :33106  
##  Mean   :2023-06-15   Binghamton:  17   Mean   :2983   Mean   :34459  
##  3rd Qu.:2023-07-13   Birmingham:  17   3rd Qu.:3399   3rd Qu.:39588  
##  Max.   :2023-08-10   (Other)   :1003   Max.   :4705   Max.   :55836  
##                       NA's      :  17                                 
##     Whoppers           Jrs              Duos       DuoOrders      DuoSubTotal  
##  Min.   : 405.0   Min.   : 147.0   Min.   :  0   Min.   :  0.0   Min.   :   0  
##  1st Qu.: 656.0   1st Qu.: 487.0   1st Qu.:116   1st Qu.:103.0   1st Qu.:1055  
##  Median : 741.0   Median : 694.0   Median :212   Median :188.0   Median :2043  
##  Mean   : 749.2   Mean   : 681.9   Mean   :189   Mean   :167.1   Mean   :1862  
##  3rd Qu.: 847.0   3rd Qu.: 833.0   3rd Qu.:270   3rd Qu.:239.0   3rd Qu.:2641  
##  Max.   :1144.0   Max.   :1345.0   Max.   :491   Max.   :430.0   Max.   :5009  
##                                                                                
##    DlvOrders      DlvSubTotal      AvgCheck      DuoAvgCheck   
##  Min.   :  4.0   Min.   :  87   Min.   :10.15   Min.   : 8.20  
##  1st Qu.: 62.0   1st Qu.:1202   1st Qu.:11.11   1st Qu.:10.59  
##  Median : 98.0   Median :1957   Median :11.49   Median :11.11  
##  Mean   :104.7   Mean   :2143   Mean   :11.52   Mean   :11.06  
##  3rd Qu.:137.0   3rd Qu.:2837   3rd Qu.:11.81   3rd Qu.:11.60  
##  Max.   :418.0   Max.   :9127   Max.   :13.77   Max.   :13.74  
##                                                 NA's   :260

DMAs

Carrols has restaurants in 65 DMAs, so we’ll select the top 15, by number of restaurants, to evaluate.

TopDMAs <- Promotion.df |>
    filter(WeekDate == as.Date("2023-04-20")) |>
    count(DMA) |>
    arrange(desc(n)) |>
    head(15)

TopDMAs

##                  DMA  n
## 1                GSA 53
## 2       Indianapolis 52
## 3            Memphis 49
## 4          Cleveland 48
## 5          Nashville 48
## 6          Charlotte 43
## 7            Buffalo 36
## 8            Detroit 36
## 9         Cincinnati 35
## 10    Greensboro/W-S 34
## 11    Raleigh/Durham 34
## 12        Louisville 31
## 13 Roanoke/Lynchburg 26
## 14         Knoxville 22
## 15              GNBW 21

Burger Sales

Examining burger sales for the top 15 DMAs shows similar increases in Whopper Jrs. at the start of the promotion. As we saw previous, Whopper sales have come down with the promotion, but by much less than the increase in Jrs.

The second vertical line indicates the end of the media ad campaign, which was expected to see a decline in Whopper Jr. sales, but sales remain strong without the campaign.

Groups.df |>
    inner_join(TopDMAs, by = join_by(DMA)) |>
    select(WeekDate, DMA, Whoppers, Jrs) |>
    pivot_longer(cols = c("Whoppers", "Jrs"), names_to = "Sandwich", values_to = "Count") |>
    ggplot(aes(x = WeekDate, y = Count)) + geom_line(aes(color = Sandwich)) + scale_color_manual(values = c("blue",
    "red")) + scale_y_continuous(expand = c(0, 0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2023-05-18"),
    as.Date("2023-06-29"))), linetype = 4, color = "black") + facet_wrap(DMA ~ .,
    scales = "fixed", ncol = 4) + labs(title = "Weekly Sales of Whopper and Whopper Jr. Sandwiches",
    subtitle = "by DMA", x = "Date", y = "Burger Sales")

Revenue

We are seeing similar declines in weekly revenue that were seen in the Market Test.

Groups.df |>
    inner_join(TopDMAs, by = join_by(DMA)) |>
    select(WeekDate, DMA, SubTotal, DlvSubTotal) |>
    pivot_longer(cols = c("SubTotal", "DlvSubTotal"), names_to = "Source", values_to = "Revenue") |>
    ggplot(aes(x = WeekDate, y = Revenue)) + geom_line(aes(color = Source)) + scale_color_manual(values = c("blue",
    "red")) + scale_y_continuous(expand = c(0, 0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2023-05-18"),
    as.Date("2023-06-29"))), linetype = 4, color = "black") + facet_wrap(DMA ~ .,
    scales = "fixed") + labs(title = "Weekly Revenue of in-store and delivery sales",
    subtitle = "by DMA", x = "Date", y = "Weekly Revenue $")

Average Guest Check

This is the result that I expected to see with the market test. Average guest check for these DMAs are consistently lower for orders that have the promotion versus those that do not.

Groups.df |>
    inner_join(TopDMAs, by = join_by(DMA)) |>
    mutate(Check = (SubTotal - DuoSubTotal)/(Orders - DuoOrders), DuoCheck = DuoSubTotal/DuoOrders) |>
    select(WeekDate, DMA, Check, DuoCheck) |>
    pivot_longer(cols = c("Check", "DuoCheck"), names_to = "CheckType", values_to = "Average") |>
    ggplot(aes(x = WeekDate, y = Average)) + geom_line(aes(color = CheckType)) +
    scale_color_manual(values = c("blue", "red")) + scale_y_continuous(expand = c(0,
    0), limits = c(0, NA)) + geom_vline(xintercept = as.numeric(c(as.Date("2023-05-18"),
    as.Date("2023-06-29"))), linetype = 4, color = "black") + facet_wrap(DMA ~ .,
    scales = "fixed") + labs(title = "Average Guest Check for orders with and without the Duo Promotion",
    subtitle = "by DMA", x = "Date", y = "Avg Guest Check $")

DMA Summary

Most of the top DMAs have seen a decrease in revenue and are also seeing lower guest check prices for those that have the promotion versus those that do not. While we are seeing increases in Whopper Jrs. that more than offset the losses in Whoppers, it doesn’t not appear that the national promotion is having the same success as the market test did in Scranton.

Groups.summary <- Groups.df |>
    mutate(Period = case_when(WeekDate < as.Date("2023-05-18") ~ "04/20 - 05/17",
        WeekDate < as.Date("2023-06-29") ~ "05/18 - 06/28", .default = "06/29 - 08/16")) |>
    summarise(Orders = as.integer(mean(Orders - DuoOrders)), SubTotal = as.integer(mean(SubTotal -
        DuoSubTotal)), Whoppers = as.integer(mean(Whoppers)), Jrs = as.integer(mean(Jrs)),
        Duos = as.integer(mean(Duos)), DuoOrders = as.integer(mean(DuoOrders)), DuoSubTotal = as.integer(mean(DuoSubTotal)),
        DlvOrders = as.integer(mean(DlvOrders)), DlvSubTotal = as.integer(mean(DlvSubTotal)),
        .by = c("DMA", "Period")) |>
    mutate(AvgCheck = round(SubTotal/Orders, 2), DuoAvgCheck = round(DuoSubTotal/DuoOrders,
        2))

knitr::kable(Groups.summary |>
    inner_join(TopDMAs, by = join_by(DMA)) |>
    select(DMA, Period, Orders, SubTotal, AvgCheck, Whoppers, Jrs, Duos, DuoOrders,
        DuoSubTotal, DuoAvgCheck))

DMA	Period	Orders	SubTotal	AvgCheck	Whoppers	Jrs	Duos	DuoOrders	DuoSubTotal	DuoAvgCheck
Indianapolis	04/20 - 05/17	2928	33529	11.45	722	279	0	0	0	NaN
Indianapolis	05/18 - 06/28	2684	31163	11.61	731	605	196	173	1925	11.13
Indianapolis	06/29 - 08/16	2641	30163	11.42	695	666	232	204	2267	11.11
Nashville	04/20 - 05/17	2878	32283	11.22	742	327	0	0	0	NaN
Nashville	05/18 - 06/28	2648	30146	11.38	742	604	168	150	1598	10.65
Nashville	06/29 - 08/16	2561	28790	11.24	708	623	186	165	1765	10.70
GNBW	04/20 - 05/17	3213	32888	10.24	630	364	0	0	0	NaN
GNBW	05/18 - 06/28	2968	30771	10.37	652	677	190	173	1735	10.03
GNBW	06/29 - 08/16	2922	30220	10.34	641	728	217	195	1973	10.12
GSA	04/20 - 05/17	3204	35548	11.09	827	414	0	0	0	NaN
GSA	05/18 - 06/28	2938	33041	11.25	843	785	227	201	2166	10.78
GSA	06/29 - 08/16	2864	31902	11.14	808	835	259	228	2467	10.82
Charlotte	04/20 - 05/17	3159	36530	11.56	938	430	0	0	0	NaN
Charlotte	05/18 - 06/28	2884	33919	11.76	947	811	237	209	2274	10.88
Charlotte	06/29 - 08/16	2783	32540	11.69	905	853	267	235	2567	10.92
Raleigh/Durham	04/20 - 05/17	2935	31856	10.85	727	350	0	0	0	NaN
Raleigh/Durham	05/18 - 06/28	2718	30151	11.09	766	714	212	190	1954	10.28
Raleigh/Durham	06/29 - 08/16	2632	29055	11.04	745	760	239	213	2195	10.31
Buffalo	04/20 - 05/17	4080	44935	11.01	803	520	0	0	0	NaN
Buffalo	05/18 - 06/28	3767	41409	10.99	802	1111	377	336	3734	11.11
Buffalo	06/29 - 08/16	3674	39979	10.88	760	1218	443	390	4381	11.23
Detroit	04/20 - 05/17	2777	32914	11.85	834	391	0	0	0	NaN
Detroit	05/18 - 06/28	2594	31208	12.03	845	779	242	216	2385	11.04
Detroit	06/29 - 08/16	2464	29364	11.92	797	822	274	241	2685	11.14
Cleveland	04/20 - 05/17	3238	35814	11.06	747	446	0	0	0	NaN
Cleveland	05/18 - 06/28	2934	32559	11.10	732	919	301	269	2891	10.75
Cleveland	06/29 - 08/16	2878	31596	10.98	707	961	329	292	3160	10.82
Louisville	04/20 - 05/17	2682	31624	11.79	799	325	0	0	0	NaN
Louisville	05/18 - 06/28	2495	29782	11.94	799	649	194	172	1914	11.13
Louisville	06/29 - 08/16	2442	28815	11.80	765	679	218	193	2124	11.01
Greensboro/W-S	04/20 - 05/17	2866	33246	11.60	909	392	0	0	0	NaN
Greensboro/W-S	05/18 - 06/28	2630	30937	11.76	926	774	235	208	2225	10.70
Greensboro/W-S	06/29 - 08/16	2553	29698	11.63	884	843	276	243	2610	10.74
Cincinnati	04/20 - 05/17	2663	30143	11.32	712	337	0	0	0	NaN
Cincinnati	05/18 - 06/28	2379	27297	11.47	707	710	235	205	2240	10.93
Cincinnati	06/29 - 08/16	2311	26201	11.34	670	759	270	234	2580	11.03
Roanoke/Lynchburg	04/20 - 05/17	2630	29443	11.20	833	400	0	0	0	NaN
Roanoke/Lynchburg	05/18 - 06/28	2430	27954	11.50	860	742	204	183	1889	10.32
Roanoke/Lynchburg	06/29 - 08/16	2336	26667	11.42	812	782	235	207	2177	10.52
Knoxville	04/20 - 05/17	3255	37012	11.37	957	414	0	0	0	NaN
Knoxville	05/18 - 06/28	3080	36042	11.70	987	741	197	174	2030	11.67
Knoxville	06/29 - 08/16	3011	35126	11.67	951	775	223	195	2293	11.76
Memphis	04/20 - 05/17	2452	26870	10.96	660	200	0	0	0	NaN
Memphis	05/18 - 06/28	2216	24807	11.19	667	455	148	133	1306	9.82
Memphis	06/29 - 08/16	2152	23848	11.08	639	499	169	150	1480	9.87

Overall Summary

Across all of our restaurants we are seeing average guest checks about $0.50 less on orders that include the promotion versus orders that do not. We are also seeing reductions in the weekly number of orders and total revenue which indicates that the promotion is also not driving traffic into the restaurants.

Sales of Whopper Jrs. have remained high since the beginning of the promotion, even though the media campaign ended, but we are not seeing increased check sizes or revenue, which would cause me to recommend that the promotion be ended.

Promotion.summary <- Promotion.df |>
    mutate(Period = case_when(WeekDate < as.Date("2023-05-18") ~ "04/20 - 05/17",
        WeekDate < as.Date("2023-06-29") ~ "05/18 - 06/28", .default = "06/29 - 08/16")) |>
    summarise(Orders = as.integer(mean(Orders - DuoOrders)), SubTotal = as.integer(mean(SubTotal -
        DuoSubTotal)), Whoppers = as.integer(mean(Whoppers)), Jrs = as.integer(mean(Jrs)),
        Duos = as.integer(mean(Duos)), DuoOrders = as.integer(mean(DuoOrders)), DuoSubTotal = as.integer(mean(DuoSubTotal)),
        DlvOrders = as.integer(mean(DlvOrders)), DlvSubTotal = as.integer(mean(DlvSubTotal)),
        .by = c("Period")) |>
    mutate(AvgCheck = round(SubTotal/Orders, 2), DuoAvgCheck = round(DuoSubTotal/DuoOrders,
        2))

knitr::kable(Promotion.summary |>
    select(Period, Orders, SubTotal, AvgCheck, Whoppers, Jrs, Duos, DuoOrders, DuoSubTotal,
        DuoAvgCheck))

Period	Orders	SubTotal	AvgCheck	Whoppers	Jrs	Duos	DuoOrders	DuoSubTotal	DuoAvgCheck
04/20 - 05/17	3061	34987	11.43	781	381	0	0	0	NaN
05/18 - 06/28	2810	32519	11.57	789	757	233	207	2274	10.99
06/29 - 08/16	2732	31360	11.48	757	810	267	235	2600	11.06

DATA698: Capstone

Marketing Promotional Analysis

Donald Butler

2023-12-10

Packages

Introduction

Carrols Corporation

Data Collection

Market Test

Load Data

Data Examination

Burger Sales

Revenue

Average Guest Check

Summary

Nationwide Promotion

Load Data

DMAs

Burger Sales

Revenue

Average Guest Check

DMA Summary

Overall Summary