Box Packing and Shipping Cost Estimation
Stephen Ewing
2022-09-16
Background
In a ‘free shipping’ e-commerce business model it is often desirable to bundle products together and offer a discount to a customer based on the reduced cost of shipping.
The following will walk through a method for calculating an estimated shipping cost for a group of products given:
- product dimensions (length, width (depth), height), in inches, as compact as you can make each product
- product weights in pounds
- boxes available in order of preference
- program prices and discounts from FedEx and USPS
Data and Libraries
Our datasets are hosted in Domo but the fetch calls could just be read_csv from the local drive or a call to a database. These are all static tables that are replaced annually. The only exception being the fuel surcharges which are updated weekly and require a web scrape like this one.
Documentation for the gbp box packing library can be
found here.
library(tidyverse)
library(lubridate)
library(DomoR)
library(gbp)
library(rgl)
library(knitr)
load("domoCustomer")
load("domoAccessToken")
init(domoCustomer, domoAccessToken)
products <-
fetch('e7dc62de-4abf-47e5-baa6-976883a3160a', show_col_types = FALSE)
boxes <-
fetch("51434740-ea01-43cf-92af-8a7f724e2c30", show_col_types = FALSE)
fedex_costs_ <-
fetch('0471fb9d-f3ca-4462-8ae7-5f468ad4412d', show_col_types = FALSE)
usps_costs_ <-
fetch('50809d99-b7e2-40e1-a2bc-2420965283d1', show_col_types = FALSE)
cubic_costs_ <-
fetch('0da841f4-869c-4194-b5f5-eb84ba13b2ea', show_col_types = FALSE)
smartpost_costs_under_1_lbs_ <-
fetch('efeeff88-b512-4ca1-a83b-884ddc985a57', show_col_types = FALSE)
smartpost_costs_over_1_lbs_ <-
fetch('b6fb718a-b590-4bcb-b306-f733f0b6d4fb', show_col_types = FALSE)
surcharges <-
fetch('b6a62703-bf1e-40f4-9590-eeb684c86849', show_col_types = FALSE)
fuel_surcharges_ <-
fetch('46737960-d5c2-4338-bb76-202301b0e3b8', show_col_types = FALSE)
dim_divisors <-
fetch('acebc034-362e-4211-bf80-a9b186eeca8d', show_col_types = FALSE)Example Order
Here I’ll create an example order with 3 skus of various quantities.
orders <- tibble(oid = 1337,
sku = c(14492, 19352, 106),
qty = c(3, 2, 4))
kable(orders)| oid | sku | qty |
|---|---|---|
| 1337 | 14492 | 3 |
| 1337 | 19352 | 2 |
| 1337 | 106 | 4 |
Munging
Products
Get weights, dims and shipping flags for selected products.
product_info <- products %>%
mutate(products_weight = ifelse(products_weight_new > 0,
products_weight_new,
products_weight)) %>%
select(
products_id,
name,
products_parent_id,
products_weight,
products_length,
products_width,
products_height,
products_hazmat,
force_ground_if_freeshipping,
products_aerosol,
un_id_number,
wm_boxes_id,
recommended_box_max_qty,
products_bundle
) %>%
rename(products_name = name)
product_dims <- product_info %>%
select(products_id,
products_weight,
products_length,
products_width,
products_height) %>%
rename(
sku = products_id)
product_flags <- product_info %>%
mutate(products_un_id = ifelse(is.na(un_id_number), 0, 1)) %>%
select(
products_id,
products_hazmat,
force_ground_if_freeshipping,
products_aerosol,
products_un_id
) %>%
rename(sku = products_id)
kable(product_dims %>% filter(sku %in% orders$sku))| sku | products_weight | products_length | products_width | products_height |
|---|---|---|---|---|
| 106 | 0.45 | 6.30 | 9.6 | 2.90 |
| 14492 | 0.63 | 3.20 | 3.2 | 10.10 |
| 19352 | 0.06 | 1.55 | 1.6 | 2.65 |
Boxes
Define the universe of boxes and the order in which to use them. This is potentially different for each service.
current_box_list_and_costs <-
tibble(box_alias = c('PLY1', 'C3', 'D4', 'E7', 'D1', 'G2', 'T2', 'H1', 'L1', 'U2', 'V1', 'B1', 'X1', 'Q1', 'B2', 'Y1', 'M1', 'S1', 'Z1'),
box_cost = c(0.13, 0.38, 0.54, 1.12, 0.65, 0.8, 1.8, 1.05, 1.17, 1.51, 2.52, 1.82, 1.4, 1.51, 2.22, 2.16, 2.24, 2.82, 4.89),
sort_order = 1:19)
boxes_active <- current_box_list_and_costs %>%
merge(boxes, all.x = T) %>%
rename(l = length,
d = width,
h = height) %>%
rowwise() %>%
mutate(ln = max(c(l, d, h)),
dn = median(c(l, d, h)),
hn = min(c(l, d, h))) %>%
select(-l,-d,-h) %>%
rename(l = ln,
d = dn,
h = hn) %>%
mutate(
id = paste0(box_alias, "-", wm_boxes_id),
w = ifelse(id == 'PLY1-37', 12, 55),
l = ifelse(id == 'PLY1-37', 9, l),
d = ifelse(id == 'PLY1-37', 6, d),
h = ifelse(id == 'PLY1-37', 2, h)) %>%
arrange(sort_order) %>%
select(id, l, d, h, w) %>%
filter(!id %in% c('H1-54', 'T2-75'))
kable(boxes_active)| id | l | d | h | w |
|---|---|---|---|---|
| PLY1-37 | 9 | 6 | 2 | 12 |
| C3-83 | 10 | 6 | 5 | 55 |
| D4-81 | 12 | 8 | 3 | 55 |
| E7-82 | 24 | 8 | 4 | 55 |
| D1-9 | 12 | 8 | 8 | 55 |
| G2-86 | 16 | 8 | 6 | 55 |
| T2-87 | 48 | 4 | 4 | 55 |
| H1-11 | 15 | 10 | 10 | 55 |
| L1-85 | 14 | 12 | 10 | 55 |
| U2-89 | 22 | 14 | 6 | 55 |
| V1-90 | 28 | 16 | 5 | 55 |
| B1-70 | 30 | 9 | 9 | 55 |
| X1-4 | 16 | 16 | 10 | 55 |
| Q1-8 | 18 | 12 | 12 | 55 |
| B2-71 | 36 | 10 | 10 | 55 |
| Y1-6 | 21 | 14 | 14 | 55 |
| M1-10 | 24 | 16 | 12 | 55 |
| S1-13 | 26 | 18 | 16 | 55 |
| Z1-5 | 28 | 24 | 20 | 55 |
Box Packer Formatting
The packer needs to have each item as its own row. So a sku with a qty of 4 needs to have 4 lines of 1.
expanded_products <- data.frame(oid = integer(),
sku = integer())
for (i in 1:length(orders)) {
if (orders$qty[i] == 1) {
newDF = data.frame(oid = as.integer(orders$oid[i]),
sku = as.integer(orders$sku[i]))
expanded_products = rbind(expanded_products, newDF)
}
else{
subTable = data.frame(oid = integer(),
sku = integer())
for (j in 1:orders$qty[i]) {
newDF = data.frame(
oid = as.integer(orders$oid[i]),
sku = as.integer(orders$sku[i])
)
subTable = rbind(subTable, newDF)
}
expanded_products = rbind(expanded_products, subTable)
}
}
it <- merge(expanded_products, product_dims, all.x = T) %>%
rename(l = products_length,
d = products_width,
h = products_height,
w = products_weight) %>%
rowwise() %>%
mutate(ln = max(c(l, d, h)),
dn = median(c(l, d, h)),
hn = min(c(l, d, h))) %>%
select(-l,-d,-h) %>%
rename(l = ln,
d = dn,
h = hn) %>%
ungroup()
kable(it)| sku | oid | w | l | d | h |
|---|---|---|---|---|---|
| 106 | 1337 | 0.45 | 9.60 | 6.3 | 2.90 |
| 106 | 1337 | 0.45 | 9.60 | 6.3 | 2.90 |
| 106 | 1337 | 0.45 | 9.60 | 6.3 | 2.90 |
| 106 | 1337 | 0.45 | 9.60 | 6.3 | 2.90 |
| 14492 | 1337 | 0.63 | 10.10 | 3.2 | 3.20 |
| 14492 | 1337 | 0.63 | 10.10 | 3.2 | 3.20 |
| 14492 | 1337 | 0.63 | 10.10 | 3.2 | 3.20 |
| 19352 | 1337 | 0.06 | 2.65 | 1.6 | 1.55 |
| 19352 | 1337 | 0.06 | 2.65 | 1.6 | 1.55 |
Box Packing
This will run the box packer, extract the result, then add back on the product level flags we need to determine how it can ship.
sn <- bpp_solver(it = it, bn = boxes_active)## bpp_solver_dpp: processing order id: 1337 on index: 0 - 8 ..bpp_viewer(sn)boxed_orders_w_sku <- sn[['it']] %>%
separate(bid, c('box_alias', 'wm_boxes_id'), '-') %>%
mutate(wm_boxes_id = as.numeric(wm_boxes_id),
sku = as.numeric(sku))
boxed_w_sku_and_product_flags <- boxed_orders_w_sku %>%
merge(product_flags, all.x = T)
kable(boxed_w_sku_and_product_flags)| sku | oid | tid | otid | box_alias | wm_boxes_id | x | y | z | l | d | h | w | products_hazmat | force_ground_if_freeshipping | products_aerosol | products_un_id |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 106 | 1337 | 1 | 1337X1 | H1 | 11 | 8.7 | 0.0 | 3.2 | 2.90 | 9.6 | 6.30 | 0.45 | 0 | 0 | 0 | 0 |
| 106 | 1337 | 1 | 1337X1 | H1 | 11 | 5.8 | 0.0 | 3.2 | 2.90 | 9.6 | 6.30 | 0.45 | 0 | 0 | 0 | 0 |
| 106 | 1337 | 1 | 1337X1 | H1 | 11 | 2.9 | 0.0 | 3.2 | 2.90 | 9.6 | 6.30 | 0.45 | 0 | 0 | 0 | 0 |
| 106 | 1337 | 1 | 1337X1 | H1 | 11 | 0.0 | 0.0 | 3.2 | 2.90 | 9.6 | 6.30 | 0.45 | 0 | 0 | 0 | 0 |
| 14492 | 1337 | 1 | 1337X1 | H1 | 11 | 0.0 | 6.4 | 0.0 | 10.10 | 3.2 | 3.20 | 0.63 | 0 | 0 | 1 | 0 |
| 14492 | 1337 | 1 | 1337X1 | H1 | 11 | 0.0 | 3.2 | 0.0 | 10.10 | 3.2 | 3.20 | 0.63 | 0 | 0 | 1 | 0 |
| 14492 | 1337 | 1 | 1337X1 | H1 | 11 | 0.0 | 0.0 | 0.0 | 10.10 | 3.2 | 3.20 | 0.63 | 0 | 0 | 1 | 0 |
| 19352 | 1337 | 1 | 1337X1 | H1 | 11 | 10.1 | 1.6 | 0.0 | 1.55 | 1.6 | 2.65 | 0.06 | 0 | 0 | 0 | 1 |
| 19352 | 1337 | 1 | 1337X1 | H1 | 11 | 10.1 | 0.0 | 0.0 | 1.55 | 1.6 | 2.65 | 0.06 | 0 | 0 | 0 | 1 |
Once we have boxed up the skus we can drop the sku level and look at the package level.
packages <- boxed_w_sku_and_product_flags %>%
group_by(oid, tid, otid, box_alias, wm_boxes_id) %>%
summarise(
products_weight = sum(w),
products_hazmat = sum(products_hazmat),
force_ground_if_freeshipping = sum(force_ground_if_freeshipping),
products_aerosol = sum(products_aerosol),
products_un_id = sum(products_un_id)
) %>%
merge(
boxes %>% select(
wm_boxes_id,
length_exterior,
width_exterior,
height_exterior,
box_weight
),
all.x = T
) %>%
rename(l = length_exterior,
d = width_exterior,
h = height_exterior) %>%
rowwise() %>%
mutate(
w = products_weight + box_weight,
ln = max(c(l, d, h)),
dn = median(c(l, d, h)),
hn = min(c(l, d, h)),
products_hazmat = ifelse(products_hazmat > 0, 1, 0),
force_ground_if_freeshipping = ifelse(force_ground_if_freeshipping > 0, 1, 0),
products_aerosol = ifelse(products_aerosol > 0, 1, 0),
products_un_id = ifelse(products_un_id > 0, 1, 0)
) %>%
select(-l, -d, -h) %>%
rename(l = ln,
d = dn,
h = hn) %>%
ungroup()
kable(packages)| wm_boxes_id | oid | tid | otid | box_alias | products_weight | products_hazmat | force_ground_if_freeshipping | products_aerosol | products_un_id | box_weight | w | l | d | h |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 11 | 1337 | 1 | 1337X1 | H1 | 3.81 | 0 | 0 | 1 | 1 | 0.88 | 4.69 | 15 | 10 | 10 |
Shipping Costs
Now that we have what we’re shipping we can figure out how much it will cost to ship with each service.
When looking at shipping prices you can look at the cost to ship to a specific zip-code or you can look at the cost to ship to all the zip-codes and take some kind of average from there.
This method will look at the cost to ship to zones 2-8, the continental US.
To estimate the shipping costs for each product we could use the weighted average zone and use the cost to that zone as the estimated shipping cost. However, in many instances we don’t have the history of which zone we shipped to, new products for example. In those cases it can be helpful to use certain heuristics in regards to warehousing. For example, if a company has 2 warehouses, one small one where only a few items are stocked on one side of the US and another, larger warehouse, on the other side of the US that stocks all skus one could assume the products that reside in both warehouses are more likely to ship to lower zones. This can be approximated by averaging the cost to ship to zones 2 and 5 for products in both warehouses and averaging the cost to ship to zones 2 and 8 for products stocked in only one warehouse.
When using this method of estimation it is important to remember that there can be outliers, for example, a zone 8 shipment to a zip-code which incurs an extended delivery area surcharge. For that reason it can be helpful to look at the zone 8 cost alone with the extended delivery area surcharge which is currently 2.6.
Lbs/Zone Munging
Standard list or retail price FedEx rate sheets as well as zone lists from any origin zip-code are available to download here.
The list price tables you can download need to have your companies discount rates applied to them, or you can use the retail rates for personal shipping.
I have cost tables in Domo which already have our volume discount applied, they were loaded in the Data and Libraries section.
fedex_costs <- fedex_costs_ %>%
select(lbs, X2, X3, X4, X5, X6, X7, X8) %>%
gather(key = zone,
value = cost,
X2,
X3,
X4,
X5,
X6,
X7,
X8) %>%
mutate(zone = as.integer(str_replace(zone, 'X', '')))
usps_costs <- usps_costs_ %>%
gather(
key = zone,
value = cost,
zone_2,
zone_3,
zone_4,
zone_5,
zone_6,
zone_7,
zone_8
) %>%
mutate(zone = as.integer(str_replace(zone, 'zone_', '')))
cubic_costs <-
cubic_costs_ %>%
gather(
key = zone,
value = cost,
zone_2,
zone_3,
zone_4,
zone_5,
zone_6,
zone_7,
zone_8
) %>%
mutate(zone = as.integer(str_replace(zone, 'zone_', '')))
smartpost_costs_under_1_lbs <-
smartpost_costs_under_1_lbs_ %>%
select(oz, X2, X3, X4, X5, X6, X7, X8) %>%
gather(key = zone,
value = cost,
X2,
X3,
X4,
X5,
X6,
X7,
X8) %>%
mutate(zone = as.integer(str_replace(zone, 'X', '')))
smartpost_costs_over_1_lbs <-
smartpost_costs_over_1_lbs_ %>%
select(lbs, X2, X3, X4, X5, X6, X7, X8) %>%
gather(key = zone,
value = cost,
X2,
X3,
X4,
X5,
X6,
X7,
X8) %>%
mutate(zone = as.integer(str_replace(zone, 'X', '')))Surcharges
Surcharges can often make up a large portion of the cost of shipping. Especially when shipping large but very light items or extremely heavy items. In general surcharges fall into 3 buckets:
package attributes like weight or dimensions,
location attributes based on where the package is going and
the fuel surcharge rate
#Package Attributes
#USPS
usps_oversize <- surcharges$USPS_OVERSIZE
usps_very_oversize <- surcharges$USPS_VERY_OVERSIZE
#FedEx
hazmat_fee <- surcharges$FX_HAZ
dim_surcharge_ground_and_home_z2 <- surcharges$FX_G_AHC_D_z2
dim_surcharge_ground_and_home_z3_4 <- surcharges$FX_G_AHC_W_z3_4
dim_surcharge_ground_and_home_z5_6 <- surcharges$FX_G_AHC_D_z5_6
dim_surcharge_ground_and_home_z7_8 <- surcharges$FX_G_AHC_D_z7_
weight_surcharge_ground_and_home_z2 <- surcharges$FX_G_AHC_W_z2
weight_surcharge_ground_and_home_z3_4 <- surcharges$FX_G_AHC_W_z3_4
weight_surcharge_ground_and_home_z5_6 <- surcharges$FX_G_AHC_W_z5_6
weight_surcharge_ground_and_home_z7_8 <- surcharges$FX_G_AHC_D_z7_
fx_peak_ahs_1 <- surcharges$FX_PEAK_AHS_1
fx_peak_ahs_2 <- surcharges$FX_PEAK_AHS_2
oversize_charge_r_z2 <- surcharges$FX_G_LPS_RZ2
oversize_charge_r_z3_4 <- surcharges$FX_G_LPS_RZ34
oversize_charge_r_z5_6 <- surcharges$FX_G_LPS_RZ5_6
oversize_charge_r_z7_8 <- surcharges$FX_G_LPS_RZ7_
oversize_charge_c_z2 <- surcharges$FX_G_LPS_CZ2
oversize_charge_c_z3_4 <- surcharges$FX_G_LPS_CZ34
oversize_charge_c_z5_6 <- surcharges$FX_G_LPS_CZ5_6
oversize_charge_c_z7_8 <- surcharges$FX_G_LPS_CZ7_
fx_peak_oversize_1 <- surcharges$FX_PEAK_LPS_1
fx_peak_oversize_2 <- surcharges$FX_PEAK_LPS_2
unauthorized_package_charge <- surcharges$FX_OM
fx_peak_unauthorized <- surcharges$FX_PEAK_UNAUTH
#SmartPost
smartpost_extra_fee <- surcharges$FX_SP_EXTRA_FEE
sp_peak_1 <- surcharges$SP_PEAK_1
sp_peak_2 <- surcharges$SP_PEAK_2
sp_peak_3 <- surcharges$SP_PEAK_3#Location Attributes
#FedEx
residential_surcharge_fedex <- surcharges$FX_G_RES
fx_das_res <- surcharges$FX_G_DAS_R
fx_das_com <- surcharges$FX_G_DAS_C
fx_ext_das_res <- surcharges$FX_G_EDAS_R
fx_ext_das_com <- surcharges$FX_G_EDAS_C
#SmartPost
sp_das <- surcharges$FX_SP_DAS
sp_ext_das <- surcharges$FX_SP_EDASThe fuel surcharges are subject to change every week.
fuel_surcharges <- fuel_surcharges_ %>%
arrange(desc(date))
fuel_surcharge_rate_fedex <- fuel_surcharges$fedex_Ground[1]
fuel_surcharge_discount <- dim_divisors$fuel_discount[1]
ggplot(data = fuel_surcharges,
aes(x = `date`, y = `fedex_Ground`)) +
geom_line() +
geom_point(aes(max(`date`), fuel_surcharge_rate_fedex),
size = 4,
colour = "red") +
geom_label(aes(max(date), fuel_surcharge_rate_fedex, label = fuel_surcharge_rate_fedex))
Dim Divisors
The dim divisors are how dimensional weight is calculated for each package. The total of the volume of the package in cubic inches is divided by the dim divisor. If the product is greater than the weight of the package the dimensional weight is used instead of the actual weight.
fedex_dim_divisor <- dim_divisors$fedex[1]
usps_dim_divisor <- dim_divisors$usps[1]Shipping Math and Logic
split each package into 7 rows for zones 2-8
calculate volumes and dimensional weights
split_zones <- packages %>%
uncount(8, .id = 'zone') %>%
filter(zone != 1) %>% #there is no zone 1
rename(orders_id = oid,
ttl_weight = w) %>%
mutate(
ttl_volume = l * d * h,
ttl_weight_oz = ttl_weight * 16,
ttl_volume_cu_ft = ttl_volume / 1728,
rounded_weight_lbs = ceiling(ttl_weight),
rounded_weight_oz = ceiling(ttl_weight_oz),
fedex_dim_weight = ceiling(ttl_volume / fedex_dim_divisor),
fedex_weight = ifelse(
rounded_weight_lbs > fedex_dim_weight,
rounded_weight_lbs,
fedex_dim_weight
),
usps_dim_weight = ceiling(ttl_volume / usps_dim_divisor),
usps_weight_lbs = ifelse(
ttl_volume < 1728,
rounded_weight_lbs,
ifelse(
rounded_weight_lbs > usps_dim_weight,
rounded_weight_lbs,
usps_dim_weight
)
),
usps_weight_oz = ifelse(
ttl_volume < 1728,
rounded_weight_oz,
ifelse(
rounded_weight_oz > (usps_dim_weight * 16),
rounded_weight_oz,
usps_dim_weight * 16
)
)
)Merging on the Costs
We need to look at shipments under 1 lbs separately from shipments over 1 lbs since under 1 lbs the dim weight isn’t used and we’ll join on ounces instead of lbs for the usps rates.
under1lbs <- filter(split_zones, ttl_weight < 1) %>%
merge(
usps_costs %>% select(-weight_lbs),
by.x = c('zone', 'usps_weight_oz'),
by.y = c('zone', 'weight_oz'),
all.x = T
) %>%
rename(usps_base_cost = cost) %>%
merge(
smartpost_costs_under_1_lbs,
by.x = c('zone', 'rounded_weight_oz'),
by.y = c('zone', 'oz'),
all.x = T
) %>%
rename(smartpost_base_cost = cost) %>%
merge(
fedex_costs,
by.x = c('zone', 'fedex_weight'),
by.y = c('zone', 'lbs'),
all.x = T
) %>%
rename(fedex_base_cost = cost)
over1lbs <-
filter(split_zones, ttl_weight >= 1) %>%
merge(
usps_costs %>% select(-weight_oz),
by.x = c('zone', 'usps_weight_lbs'),
by.y = c('zone', 'weight_lbs'),
all.x = T
) %>%
rename(usps_base_cost = cost) %>%
merge(
smartpost_costs_over_1_lbs,
by.x = c('zone', 'fedex_weight'),
by.y = c('zone', 'lbs'),
all.x = T
) %>%
rename(smartpost_base_cost = cost) %>%
merge(
fedex_costs,
by.x = c('zone', 'fedex_weight'),
by.y = c('zone', 'lbs'),
all.x = T
) %>%
rename(fedex_base_cost = cost)
addCubes <- rbind(under1lbs, over1lbs) %>%
mutate(usps_cubes_rounded = ceiling(ttl_volume_cu_ft * 10) / 10) %>%
merge(
cubic_costs,
by.x = c("zone", "usps_cubes_rounded"),
by.y = c("zone", "Cubic"),
all.x = T
) %>%
rename(cubic_base_cost = cost) %>%
mutate(cubic_base_cost = ifelse(is.na(cubic_base_cost), 99999, cubic_base_cost))
kable(addCubes %>% select(zone, fedex_base_cost, smartpost_base_cost, usps_base_cost, cubic_base_cost))| zone | fedex_base_cost | smartpost_base_cost | usps_base_cost | cubic_base_cost |
|---|---|---|---|---|
| 2 | 6.61000 | 5.670 | 8.45 | 99999 |
| 3 | 6.61000 | 6.270 | 8.89 | 99999 |
| 4 | 6.61000 | 6.855 | 9.82 | 99999 |
| 5 | 6.88200 | 7.400 | 12.71 | 99999 |
| 6 | 7.13775 | 7.675 | 17.03 | 99999 |
| 7 | 7.52370 | 8.090 | 20.81 | 99999 |
| 8 | 7.97010 | 8.570 | 24.01 | 99999 |
Surcharge Logic
with_surcharges <- addCubes %>%
mutate(sku = as.numeric(orders_id)) %>%
mutate(
ups_res_com = 'Y',
CLG = l + 2 * d + 2 * h,
cubic_feet = l / 12 * d / 12 * h / 12,
usps_priority_oversize = ifelse(
l <= 22 & cubic_feet <= 2,
0,
ifelse(
l > 30 | cubic_feet > 2,
usps_very_oversize,
usps_oversize)),
fx_residential_surcharge = ifelse(
ups_res_com != 'N',
residential_surcharge_fedex,
0),
fx_hazmat_fee = ifelse(
products_hazmat == 1,
hazmat_fee,
0),
fx_dim_surcharge = ifelse(
l > 48 | d > 30 | CLG > 105,
ifelse(
zone <= 2,
dim_surcharge_ground_and_home_z2,
ifelse(
zone == 3 | zone == 4,
dim_surcharge_ground_and_home_z3_4,
ifelse(
zone == 5 |zone == 6,
dim_surcharge_ground_and_home_z5_6,
dim_surcharge_ground_and_home_z7_8))),
0),
fx_weight_surcharge = ifelse(
fedex_weight > 60,
ifelse(
zone <= 2,
weight_surcharge_ground_and_home_z2,
ifelse(
zone == 3 | zone == 4,
weight_surcharge_ground_and_home_z3_4,
ifelse(
zone == 5 | zone == 6,
weight_surcharge_ground_and_home_z5_6,
weight_surcharge_ground_and_home_z7_8))),
0),
fx_oversize_charge = ifelse(
l > 96 | CLG > 130,
ifelse(
zone <= 2,
oversize_charge_z2,
ifelse(
zone == 3 | zone == 4,
oversize_charge_z3_4,
ifelse(zone == 5 | zone == 6,
oversize_charge_z5_6,
oversize_charge_z7_8))),
0),
fx_unauthorized_charge = ifelse(
l > 108 | CLG > 165 | fedex_weight > 150,
unauthorized_package_charge,
0),
fx_peak_ahs = ifelse(
fx_dim_surcharge + fx_weight_surcharge == 0,
0,
ifelse(
Sys.Date() >= ymd('2022-09-05') & Sys.Date() < ymd('2022-10-03'),
fx_peak_ahs_1,
ifelse(
Sys.Date() >= ymd('2022-10-03') & Sys.Date() < ymd('2023-01-16'),
fx_peak_ahs_2,
0))),
fx_peak_oversize = ifelse(
fx_oversize_charge == 0,
0,
ifelse(
Sys.Date() >= ymd('2022-09-05') & Sys.Date() < ymd('2022-10-03'),
fx_peak_oversize_1,
ifelse(
Sys.Date() >= ymd('2022-10-03') & Sys.Date() < ymd('2023-01-16'),
fx_peak_oversize_2,
0))),
fx_peak_unauthorized_surcharge = ifelse(
fx_unauthorized_charge == 0,
0,
ifelse(
Sys.Date() >= ymd('2022-10-03') & Sys.Date() < ymd('2023-01-16'),
fx_peak_unauthorized,
0)),
sp_peak_surcharge = ifelse(
Sys.Date() >= ymd('2022-10-31') & Sys.Date() < ymd('2022-11-28'),
sp_peak_1,
ifelse(
Sys.Date() >= ymd('2022-11-28') & Sys.Date() < ymd('2022-12-12'),
sp_peak_2,
ifelse(
Sys.Date() >= ymd('2022-12-12') & Sys.Date() < ymd('2023-01-16'),
sp_peak_3,
0))),
fx_edas = fx_ext_das_res,
sp_edas = sp_ext_das)
kable(with_surcharges %>% select(zone, usps_priority_oversize:sp_edas))| zone | usps_priority_oversize | fx_residential_surcharge | fx_hazmat_fee | fx_dim_surcharge | fx_weight_surcharge | fx_oversize_charge | fx_unauthorized_charge | fx_peak_ahs | fx_peak_oversize | fx_peak_unauthorized_surcharge | sp_peak_surcharge | fx_edas | sp_edas |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 3 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 4 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 5 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 6 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 7 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
| 8 | 0 | 1.9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 2.6 | 2.38 |
Total Costs
With the surcharges and zone based shipping costs calculated we can sum up the totals and multiply by the fuel surcharge rate to finally provide a cost for each service to each zone.
You’ll see adding on the extended delivery area surcharge will often make usps cheaper than fedex/smartpost in the closer zones.
costs_by_zone_by_service <- with_surcharges %>%
mutate(
fedex_cost_wo_fuel =
fedex_base_cost +
fx_residential_surcharge +
fx_hazmat_fee +
fx_dim_surcharge +
fx_weight_surcharge +
fx_oversize_charge +
fx_unauthorized_charge +
fx_peak_ahs +
fx_peak_oversize +
fx_peak_unauthorized_surcharge,
fx_fuel_surcharge = (fedex_cost_wo_fuel * fuel_surcharge_rate_fedex) * (1 - fuel_surcharge_discount),
fedex_cost = fedex_cost_wo_fuel + fx_fuel_surcharge,
fedex_max = fedex_cost_wo_fuel + fx_edas + ((fedex_cost_wo_fuel + fx_edas) * fuel_surcharge_rate_fedex) * (1 - fuel_surcharge_discount),
sp_cost_wo_fuel =
smartpost_base_cost +
smartpost_extra_fee +
sp_peak_surcharge,
sp_fuel_surcharge = (sp_cost_wo_fuel * fuel_surcharge_rate_fedex) * (1 - fuel_surcharge_discount),
smartpost_cost = sp_cost_wo_fuel + sp_fuel_surcharge,
sp_max = sp_cost_wo_fuel + sp_edas + ((sp_cost_wo_fuel + sp_edas) * fuel_surcharge_rate_fedex) * (1 - fuel_surcharge_discount),
usps_cost = ifelse(
usps_base_cost + usps_priority_oversize < cubic_base_cost + usps_priority_oversize,
usps_base_cost + usps_priority_oversize,
cubic_base_cost + usps_priority_oversize))
kable(costs_by_zone_by_service %>% select(zone, fedex_cost, smartpost_cost, usps_cost, fedex_max, sp_max), digits = 2)| zone | fedex_cost | smartpost_cost | usps_cost | fedex_max | sp_max |
|---|---|---|---|---|---|
| 2 | 9.57 | 6.66 | 8.45 | 12.49 | 9.33 |
| 3 | 9.57 | 7.33 | 8.89 | 12.49 | 10.01 |
| 4 | 9.57 | 7.99 | 9.82 | 12.49 | 10.66 |
| 5 | 9.87 | 8.60 | 12.71 | 12.80 | 11.28 |
| 6 | 10.16 | 8.91 | 17.03 | 13.08 | 11.59 |
| 7 | 10.59 | 9.38 | 20.81 | 13.52 | 12.05 |
| 8 | 11.10 | 9.92 | 24.01 | 14.02 | 12.59 |
Shipment Flags
There are rules like you can’t send hazmat through the mail. And you can’t end aerosols on planes, so we need to take those into account.
costs_with_flags <- costs_by_zone_by_service %>%
mutate(fedex_cost = ifelse(
is.na(fedex_base_cost),
9999,
fedex_cost),
fedex_max = ifelse(
is.na(fedex_base_cost),
9999,
fedex_max),
smartpost_cost = ifelse(
is.na(smartpost_base_cost) |
products_hazmat == 1,
9999,
smartpost_cost),
sp_max = ifelse(
is.na(smartpost_base_cost) |
products_hazmat == 1,
9999,
sp_max),
usps_cost = ifelse(
is.na(usps_cost) |
products_hazmat == 1 |
products_aerosol == 1 |
products_un_id == 1,
99999,
usps_cost))
kable(costs_with_flags %>% select(zone, fedex_cost, smartpost_cost, usps_cost, fedex_max, sp_max), digits = 2)| zone | fedex_cost | smartpost_cost | usps_cost | fedex_max | sp_max |
|---|---|---|---|---|---|
| 2 | 9.57 | 6.66 | 99999 | 12.49 | 9.33 |
| 3 | 9.57 | 7.33 | 99999 | 12.49 | 10.01 |
| 4 | 9.57 | 7.99 | 99999 | 12.49 | 10.66 |
| 5 | 9.87 | 8.60 | 99999 | 12.80 | 11.28 |
| 6 | 10.16 | 8.91 | 99999 | 13.08 | 11.59 |
| 7 | 10.59 | 9.38 | 99999 | 13.52 | 12.05 |
| 8 | 11.10 | 9.92 | 99999 | 14.02 | 12.59 |
Minimum Cost by Zone
with_min_costs <- costs_with_flags %>%
pivot_longer(c(usps_cost, fedex_cost, smartpost_cost),
names_to = 'column',
values_to = 'value',
) %>%
group_by(zone) %>%
mutate(lowest_cost = rank(value, ties.method = "first") == 1) %>%
ungroup() %>%
rename(service_type = column,
min_cost = value) %>%
pivot_wider(names_from = 'service_type', values_from = c('min_cost', 'lowest_cost')) %>%
rename(usps_cost = min_cost_usps_cost,
fedex_cost = min_cost_fedex_cost,
smartpost_cost = min_cost_smartpost_cost) %>%
mutate(service_type = ifelse(
lowest_cost_usps_cost == TRUE,
'USPS',
ifelse(
lowest_cost_fedex_cost == TRUE,
'FedEx',
ifelse(
lowest_cost_smartpost_cost == TRUE,
'SmartPost',
'Error'))),
min_cost = ifelse(
lowest_cost_usps_cost == TRUE,
usps_cost,
ifelse(
lowest_cost_fedex_cost == TRUE,
fedex_cost,
ifelse(
lowest_cost_smartpost_cost == TRUE,
smartpost_cost,
9999))))
kable(with_min_costs %>% select(zone, fedex_cost, smartpost_cost, usps_cost, fedex_max, sp_max, service_type, min_cost), digits = 2)| zone | fedex_cost | smartpost_cost | usps_cost | fedex_max | sp_max | service_type | min_cost |
|---|---|---|---|---|---|---|---|
| 2 | 9.57 | 6.66 | 99999 | 12.49 | 9.33 | SmartPost | 6.66 |
| 3 | 9.57 | 7.33 | 99999 | 12.49 | 10.01 | SmartPost | 7.33 |
| 4 | 9.57 | 7.99 | 99999 | 12.49 | 10.66 | SmartPost | 7.99 |
| 5 | 9.87 | 8.60 | 99999 | 12.80 | 11.28 | SmartPost | 8.60 |
| 6 | 10.16 | 8.91 | 99999 | 13.08 | 11.59 | SmartPost | 8.91 |
| 7 | 10.59 | 9.38 | 99999 | 13.52 | 12.05 | SmartPost | 9.38 |
| 8 | 11.10 | 9.92 | 99999 | 14.02 | 12.59 | SmartPost | 9.92 |