Promotions

Suppliers and manufacturers often offer promotions that are “on the backend.” That is to say they aren’t reflected on the invoice from the supplier but rather paid at some later date based on some conditions.

It is also possible for them to give promotions that extend retroactivly. In the future they will be on the invoice but they were not on the invoice in previous times when they should have been.

If we want to nail down our the cost of a product at any point in time both of these types of promotions need to be taken into account.

library(DomoR)
library(tidyverse)
library(lubridate)

load("domoAccessToken")
load("domoCustomer")
DomoR::init(domoCustomer, domoAccessToken)

#Product Promos - Magic ETL
promos <- fetch("fdab5361-3b57-45f8-9480-0a4e30d89051")

manuPromos <- promos %>%
  filter(source_type_name == 'Manufacturer',
         date_end > ymd_hms("2018-10-16 18:59:44")) %>%
  spread(key = promo_type_name, value = amount)

manuPromosSpreadDates <- manuPromos %>%
  filter(is.null(product_promos_id)) %>%
  select(-date_start) %>%
  rename(date = date_end)

i = 1
for (i in 1:nrow(manuPromos)) {
  promoDates = seq(from = manuPromos$date_start[i],
                   to = manuPromos$date_end[i],
                   by = 1)
  df = tibble(
    products_id = manuPromos$products_id[i],
    date = promoDates,
    mp_name = manuPromos$name[i],
    mp_backend = manuPromos$`Backend Rebate`[i],
    mp_pos = manuPromos$`POS Promotion`[i],
    mp_x_value = manuPromos$x_value[i],
    mp_y_value = manuPromos$y_value[i],
    mp_tier_type_name = manuPromos$tier_type_name[i]
  )
  
  manuPromosSpreadDates <- rbind(manuPromosSpreadDates, df)
  i = i + 1
}

manuFixedOffPerUnit <- manuPromosSpreadDates %>%
  filter(mp_tier_type_name == '$ Off Per Unit') %>%
  select(-mp_tier_type_name, -mp_x_value, -mp_y_value)

# Table of skus with more than one manufactuer POS promo
doubleTrouble <- manuFixedOffPerUnit %>%
  select(-mp_backend) %>%
  filter(mp_pos != 0) %>%
  group_by(products_id, date) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  unique()

# Table of skus with more than one manufacturer backend promo
doubleTrouble2 <- manuFixedOffPerUnit %>%
  select(-mp_pos) %>%
  filter(mp_backend != 0) %>%
  group_by(products_id, date) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  unique()

# Group multiple fixed price off manufacturer promos
manuFixedOffPerUnitGrouped <- manuFixedOffPerUnit %>%
  group_by(products_id, date) %>%
  summarise(mp_pos = sum(mp_pos),
            mp_backend = sum(mp_backend))

manuPctOffPerUnit <- manuPromosSpreadDates %>%
  filter(mp_tier_type_name == '% Off Per Unit') %>%
  select(-mp_tier_type_name, -mp_x_value, -mp_y_value, -mp_name) %>%
  rename(mp_pctOffInvoice = mp_pos,
         mp_pctOffBackend = mp_backend)

# Table of skus with more than one manufacturer % off promo
doubleTrouble3 <- manuPctOffPerUnit %>%
  group_by(products_id, date) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  unique()

manuBuyXGetY <- manuPromosSpreadDates %>%
  filter(mp_tier_type_name == 'Buy X Get Y') %>%
  select(-mp_backend,-mp_pos,-mp_tier_type_name,-mp_name)

# Table of skus with more than one manufacturer buy x get y
doubleTrouble4 <- manuBuyXGetY %>%
  group_by(products_id, date) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  unique()



### Supplier Promos
supPromos <- promos %>%
  filter(source_type_name == 'Supplier',
         date_end > ymd_hms("2018-10-16 18:59:44")) %>%
  spread(key = promo_type_name, value = amount)

# The specific_quantites by sku for BWI-Expo_2018
bwi18 <- read_csv("BWI_Expo_2018_quantities.csv") %>%
  rename(products_id = `Our SKU`,
         specific_quantity = `UNITS ON ORDER`)

# Filter for just BWI 2018 and add on the specific_quantities
justBWI18 <- supPromos %>%
  filter(grepl("BWI EXPO 2018", name)) %>%
  select(-specific_quantity) %>%
  merge(bwi18, by = "products_id")

# Filter for not BWI 2018
notBWI18 <- supPromos %>%
  filter(!grepl("BWI EXPO 2018", name))

# Row bind them back together
supPromos <- rbind(justBWI18, notBWI18)

supPromosSpreadDates <- supPromos %>%
  filter(is.null(product_promos_id)) %>%
  select(-date_start) %>%
  mutate(date = date_end)

i = 1
for (i in 1:nrow(supPromos)) {
  promoDates = seq(from = supPromos$date_start[i],
                   to = supPromos$date_end[i],
                   by = 1)
  df = tibble(
    products_id = supPromos$products_id[i],
    date = promoDates,
    sp_name = supPromos$name[i],
    suppliers_id = supPromos$source_id[i],
    sp_pos = supPromos$`POS Promotion`[i],
    sp_x_value = supPromos$x_value[i],
    sp_y_value = supPromos$y_value[i],
    sp_tier_type_name = supPromos$tier_type_name[i],
    sp_specific_quantity = supPromos$specific_quantity[i],
    sp_date_end = supPromos$date_end[i]
  )
  
  supPromosSpreadDates <- rbind(supPromosSpreadDates, df)
  i = i + 1
}

supFixedOffPerUnit <- supPromosSpreadDates %>%
  filter(sp_tier_type_name == '$ Off Per Unit') %>%
  select(
    -sp_tier_type_name,
    -sp_x_value,
    -sp_y_value,
    -sp_name,
    -sp_specific_quantity,
    -sp_date_end
  )

# Table of skus with more than one supplier POS promo
doubleTrouble5 <- supFixedOffPerUnit %>%
  filter(sp_pos != 0) %>%
  group_by(products_id, date) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  unique()

supFixedPrice <- supPromosSpreadDates %>%
  filter(sp_tier_type_name == 'Fixed Price') %>%
  select(products_id,
         date,
         suppliers_id,
         sp_pos,
         sp_specific_quantity,
         sp_name,
         sp_date_end) %>%
  rename(sp_fixed_price = sp_pos)

skusToGetEndDates <- unique(supFixedPrice$products_id)
suppliersCodes <- unique(supFixedPrice$suppliers_id)

#PO Items Lite
purchases <-
  DomoR::fetch("b8d4c659-5735-41b7-adb7-b6a42be1aed7")

purchasesOfTrackedSkus <- purchases %>%
  filter(products_id %in% skusToGetEndDates,
         suppliers_id %in% suppliersCodes) %>%
  mutate(date = date(date_received),
         products_quantity = qty_received * lot_qty) %>%
  group_by(products_id, suppliers_id, date) %>%
  summarise(products_quantity = sum(products_quantity))

supFixedPrice <- merge(
  supFixedPrice,
  purchasesOfTrackedSkus,
  by = c('products_id', 'date', 'suppliers_id'),
  all.x = TRUE
)

runningTtl <- function(df) {
  cumsum(df$products_quantity)
}

supFPbyName <- supFixedPrice %>%
  select(sp_name,
         products_id,
         date,
         sp_specific_quantity,
         products_quantity,
         sp_date_end) %>%
  mutate(products_quantity = ifelse(is.na(products_quantity),
                                    0,
                                    products_quantity)) %>%
  group_by(products_id, date, sp_name, sp_specific_quantity, sp_date_end) %>%
  summarise(products_quantity = sum(products_quantity)) %>%
  ungroup() %>%
  group_by(sp_name) %>%
  nest() %>%
  mutate(cusum = map(data, runningTtl)) %>%
  unnest() %>%
  mutate(active = cusum < sp_specific_quantity)

endDates <- supFPbyName %>%
  filter(active == TRUE) %>%
  group_by(sp_name, products_id) %>%
  summarise(endDate = max(date))

supFixedPriceActive <- supFixedPrice %>%
  merge(
    supFPbyName %>%
      select(-sp_specific_quantity,-products_quantity,-sp_date_end),
    by = c('sp_name', 'date', 'products_id')
  ) %>%
  filter(active == TRUE)

# Table of skus with more than one supplier fixed price promo (overlap of 2018 and 2019 BWI)
doubleTrouble6 <- supFixedPriceActive %>%
  group_by(products_id, date, suppliers_id) %>%
  summarise(count = n()) %>%
  ungroup() %>%
  select(-date) %>%
  filter(count > 1) %>%
  select(products_id, count) %>%
  unique()

# Newer promos for the same sku for same supplier overwrite old ones of same if old one is still active
skusToOverride <- supFixedPriceActive %>%
  group_by(products_id, date, suppliers_id) %>%
  summarise(number = n(),
            sp_date_end = min(sp_date_end)) %>%
  ungroup()


supFixedPriceNumber2AreDups <- supFixedPriceActive %>%
  merge(
    skusToOverride,
    by = c('products_id', 'date', 'suppliers_id', 'sp_date_end'),
    all.x = TRUE
  )

supFixedPriceClean <- supFixedPriceNumber2AreDups %>%
  filter(number != 2) %>%
  select(products_id, date, suppliers_id, sp_fixed_price)

# Put them all together

purchasesWithPromos <- purchases %>%
  mutate(
    date = date(date_received),
    products_quantity = qty_received * lot_qty,
    po_unit_cost = round(unit_cost / lot_qty, 2),
    base_unit_cost = base_unit_cost / lot_qty,
    promo_discount = promo_discount / lot_qty,
    calc_unit_cost = round(base_unit_cost - promo_discount, 2),
    diff_costs = po_unit_cost != calc_unit_cost
  ) %>%
  merge(
    manuFixedOffPerUnitGrouped,
    by = c('products_id', 'date'),
    all.x = TRUE
  ) %>%
  merge(manuPctOffPerUnit,
        by = c('products_id', 'date'),
        all.x = TRUE) %>%
  merge(manuBuyXGetY,
        by = c('products_id', 'date'),
        all.x = TRUE) %>%
  merge(
    supFixedOffPerUnit,
    by = c('products_id', 'date', 'suppliers_id'),
    all.x = TRUE
  ) %>%
  merge(
    supFixedPriceClean,
    by = c('products_id', 'date', 'suppliers_id'),
    all.x = TRUE
  ) %>%
  select(
    -supplier_sku,
    -admin_id,
    -date_expected,
    -reason_description,
    -invoices_id,
    -lot_types_id,
    -order_by,
    -exclude_from_fill_rate,
    -received_location,
    -original_qty_ordered
  ) %>%
  mutate(
    notes = ifelse(is.na(notes), '', notes),
    mp_pos = ifelse(is.na(mp_pos), 0, mp_pos),
    mp_backend = ifelse(is.na(mp_backend), 0, mp_backend),
    mp_pctOffBackend = ifelse(is.na(mp_pctOffBackend), 0, mp_pctOffBackend),
    mp_pctOffInvoice = ifelse(is.na(mp_pctOffInvoice), 0, mp_pctOffInvoice),
    mp_x_value = ifelse(is.na(mp_x_value), 0, mp_x_value),
    mp_y_value = ifelse(is.na(mp_y_value), 0, mp_y_value),
    sp_pos = ifelse(is.na(sp_pos), 0, sp_pos),
    sp_fixed_price = ifelse(is.na(sp_fixed_price), 0, sp_fixed_price)
  )

if (nrow(purchasesWithPromos) != nrow(purchases)) {
  print("You've got double trouble")
  break
}

#create(purchasesWithPromos, "Purchases With Promos", "All PO items since 10/12/2017 with promos added")
replace_ds("4fc7104b-9bb1-4cc1-8f0f-2e5dbb31aad7", purchasesWithPromos)

Weighted Average Cost of Inventory

# Munge the purchases table
purchasesSel <- purchasesWithPromos %>%
  rename(date_time = date_received,) %>%
  mutate(
    backend_per_unit = (mp_pctOffBackend / 100) * po_unit_cost + mp_backend,
    po_unit_cost = po_unit_cost - backend_per_unit
  ) %>%
  filter(date_time > ymd_hms("2018-10-16 18:59:44")) %>%
  select(po_items_id,
         products_id,
         warehouses_id,
         date_time,
         products_quantity,
         po_unit_cost) %>%
  mutate(
    weightedAvgCost = NA,
    pick_products_id = rep_len(0, length(date_time)),
    products_history_id = rep_len(0, length(date_time)),
    starting_inventory_id = rep_len(0, length(date_time))
  )

# Munge the picks table
# Orders Products Pick Lite
picks <-
  DomoR::fetch("7540a427-9f55-4af4-8ca0-f5af807ec466")

picksSel <- picks %>%
  filter(products_picked == 1,
         products_picked_time > ymd_hms("2018-10-16 18:59:44")) %>%
  select(
    pick_products_id,
    products_id,
    products_quantity,
    warehouses_id,
    products_picked_time
  ) %>%
  rename(date_time = products_picked_time) %>%
  mutate(
    products_quantity = products_quantity * -1,
    po_unit_cost = rep_len(0, length(date_time)),
    weightedAvgCost = NA,
    po_items_id = rep_len(0, length(date_time)),
    products_history_id = rep_len(0, length(date_time)),
    starting_inventory_id = rep_len(0, length(date_time))
  )

# Munge the adjustments table
# Products History Lite
adjustments <-
  DomoR::fetch("7b561bef-e909-4c7b-8ec2-a6fca2bae723")

adjustmentsSel <- adjustments %>%
  filter(date_added > ymd_hms("2018-10-16 18:59:44")) %>%
  select(
    products_history_id,
    products_id,
    products_history_quantity,
    warehouses_id,
    date_added
  ) %>%
  rename(date_time = date_added,
         products_quantity = products_history_quantity) %>%
  mutate(
    po_unit_cost = rep_len(0, length(date_time)),
    weightedAvgCost = NA,
    pick_products_id = rep_len(0, length(date_time)),
    po_items_id = rep_len(0, length(date_time)),
    starting_inventory_id = rep_len(0, length(date_time))
  )

# Munge the starting inventory
# First Day of Tracked Inventory
startingInventory <-
  DomoR::fetch("86502dfd-0d7a-47e7-98ee-b9a11bffbdc3")

inventorySel <- startingInventory %>%
  filter(products_quantity > 0) %>%
  select(products_id,
         products_quantity,
         warehouses_id,
         inventory_date_time,
         products_cost) %>%
  rename(date_time = inventory_date_time,
         weightedAvgCost = products_cost) %>%
  mutate(
    po_unit_cost = rep_len(0, length(date_time)),
    pick_products_id = rep_len(0, length(date_time)),
    po_items_id = rep_len(0, length(date_time)),
    products_history_id = rep_len(0, length(date_time)),
    starting_inventory_id = seq(1, length(date_time))
  )

# Bind the tables together
flow <- inventorySel %>%
  rbind(purchasesSel) %>%
  rbind(picksSel) %>%
  rbind(adjustmentsSel) %>%
  arrange(date_time)

# Define the functions to calculate running totals and weighted average prices
runningTtl <- function(df) {
  cumsum(df$products_quantity)
}

wgtAvg <- function(df) {
  x = numeric(length = length(df$weightedAvgCost))
  x[1] = df$weightedAvgCost[1]
  if (is.na(df$weightedAvgCost[1])) {
    if (!is.na(df$po_unit_cost[1])) {
      x[1] = df$po_unit_cost[1]
    }
  }
  if (length(df$weightedAvgCost) > 1) {
    for (i in 2:length(df$weightedAvgCost)) {
      if (!is.na(df$weightedAvgCost[i])) {
        x[i] = df$weightedAvgCost[i]
      }
      if (is.na(df$weightedAvgCost[i]) &
          df$po_items_id[i] == 0) {
        x[i] = x[i - 1]
      }
      if (is.na(df$weightedAvgCost[i]) &
          df$po_items_id[i] != 0) {
        x[i] = (ifelse(is.na(df$n[i - 1] * x[i - 1]),
                       0,
                       df$n[i - 1] * x[i - 1]) + (
                         df$products_quantity[i] * df$po_unit_cost[i])) / sum(
                           df$n[i - 1],
                                                                                                                                         df$products_quantity[i],
                                                                                                                                         na.rm = TRUE)
      }
    }
  }
  return(x)
}

# Apply the functions to the data set and munge for upload
inventoryCost <- flow %>%
  group_by(products_id, warehouses_id) %>%
  nest() %>%
  mutate(n = map(data, runningTtl)) %>%
  unnest() %>%
  ungroup() %>%
  mutate(n = ifelse(n > 0, n, 0)) %>%
  group_by(products_id, warehouses_id) %>%
  nest() %>%
  mutate(newWeightedAvgCost = map(data, wgtAvg)) %>%
  unnest() %>%
  mutate(weightedAvgCost = newWeightedAvgCost,
         inventoryValue = weightedAvgCost * n) %>%
  select(-newWeightedAvgCost) %>%
  rename(inventory = n) %>%
  arrange(products_id, warehouses_id, date_time) %>%
  mutate(
    products_id = as.integer(products_id),
    warehouses_id = as.integer(warehouses_id),
    inventory = as.integer(inventory),
    products_quantity = as.integer(products_quantity),
    pick_products_id = as.integer(pick_products_id),
    po_items_id = as.integer(po_items_id),
    products_history_id = as.integer(products_history_id),
    starting_inventory_id = as.integer(starting_inventory_id),
    movement = ifelse(
      pick_products_id > 0,
      "pick",
      ifelse(
        po_items_id > 0,
        "purchase",
        ifelse(
          products_history_id > 0,
          "adjustment",
          ifelse(starting_inventory_id > 0,
                 "starting_inventory", "error")
        )
      )
    )
  )

# Push to the cloud
# DomoR::create(inventoryCost, "InventoryCost")
DomoR::replace_ds("e3caee46-a3de-4406-b725-8109d818b219", inventoryCost)

Create Picks Table

Select the columns we want to use from the picks table. Group by orders_id and prodcuts_id. Summerise products_quantity as sum, products_weight by mean and weightedAvgCost by mean.

The weightedAvgCost here should probably be summerised by the weighted average instead of the mean but since the costs should be the same the mean should work.

# Make the picks table
picksSel <- picks %>%
  select(orders_id,
         products_id,
         products_quantity,
         products_weight,
         weightedAvgCost) %>%
  group_by(orders_id, products_id) %>%
  summarise(
    products_quantity = sum(products_quantity),
    products_weight = mean(products_weight),
    weightedAvgCost = mean(weightedAvgCost)
  ) %>%
  mutate(
    products_ttl_weight = products_weight * products_quantity,
    products_ttl_cost = products_quantity * weightedAvgCost
  ) %>%
  rename(qtyPicked = products_quantity) %>%
  ungroup()

Create Products Table

Next up is the orders_prodcuts table which will be called productsSel here. The first step will be to calculate the extended_products_price and extended_final_price for each sku.

After that we will replace the products_id of any product that has a products_parent_id with the products_parent_id.

If the sku has a products_parent_id and it has a case amount greater than 0 the products_quantity should be changed to equal the products_quantity * products_case_amount.

Once the new quantities are calculated the products_price and final_price should be changed so the price per unit is correct for the new number of units.

productsSel <- products %>%
  filter(products_quantity > 0) %>%
  mutate(
    extended_price = products_price * products_quantity,
    ext_fin_price = final_price * products_quantity
  ) %>%
  mutate(
    products_id = ifelse(products_parent_id > 0,
                         products_parent_id,
                         products_id),
    products_quantity = ifelse(
      products_case_amt > 0 & products_parent_id > 0,
      products_quantity * products_case_amt,
      products_quantity
    ),
    original_products_quantity = ifelse(
      products_case_amt > 0 & products_parent_id > 0,
      original_products_quantity * products_case_amt,
      original_products_quantity
    )
  ) %>%
  mutate(
    products_price = ifelse(
      products_case_amt > 0 &
        products_price != 0 &
        products_parent_id > 0,
      extended_price / products_quantity,
      products_price
    ),
    final_price = ifelse(
      products_case_amt > 0 & final_price != 0 & products_parent_id > 0,
      ext_fin_price / products_quantity,
      final_price
    )
  ) %>%
  select(-products_case_amt,
         -products_is_case,
         -extended_price,
         -ext_fin_price) %>%
  group_by(orders_id, products_id, kit, orders_status) %>%
  summarise(
    final_price = sum(final_price * products_quantity) / sum(products_quantity),
    products_price = sum(products_price * products_quantity) /
      sum(products_quantity),
    products_quantity = sum(products_quantity),
    mdy = max(mdy),
    original_products_quantity = sum(original_products_quantity)
  ) %>%
  ungroup()

# If everything is correct these two should match.
sum(products$final_price * products$products_quantity)
sum(productsSel$final_price * productsSel$products_quantity)

Kit Creation

Since kits are listed as their own sku in the products table but listed as the components of the kit in the picks table we need to transform the products table to take out the kit rows and replace them with the kit contents. In doing so we need to spread the price of the kit based on the costs of the items in the kit.

First we’ll make a list of all the orders that have a kit in them. Then create an empty data frame to hold the kits.

For each orders_id with a kit in it we’ll find the components of the kit in the bundles table. The bundles table can change over time so we’ll make sure we’re matching the date of the order with the date of the bundle unless the order is from a time before we started appending the bundles list by day.

I’ll flag the kit items as 2 and leave the kits flagged as 1 so we can filter out the kits skus later.

# List of all kits on orders
kitSales <- productsSel %>%
  filter(kit == 1)

# Empty dataframe to append kits to
kitProductsbyOrder <- data.frame()

listOfKitOrders <- unique(kitSales$orders_id)

# Assemble the kits
for (i in seq(1:length(listOfKitOrders))) {
  id = listOfKitOrders[i]
  
  kitsOnOrder = kitSales %>%
    filter(orders_id == id) %>%
    select(
      products_id,
      products_quantity,
      mdy,
      products_price,
      final_price,
      orders_status,
      original_products_quantity
    ) %>%
    rename(bundle_id = products_id,
           date = mdy)
  
  kit = kits %>%
    filter(bundle_id %in% kitsOnOrder$bundle_id,
           #started appending 2/21/19 so this will be then or after
           mdy == max(kitsOnOrder$date[1],
                      ymd("2019-02-21"),
                      na.rm = T)) %>%
    merge(kitsOnOrder, by = 'bundle_id') %>%
    select(-mdy) %>%
    rename(kit = bundle_id,
           products_id = subproduct_id,
           mdy = date) %>%
    mutate(
      extended_price = products_price * subproduct_qty,
      ext_fin_price = final_price * subproduct_qty
    ) %>%
    mutate(
      products_id = ifelse(products_parent_id > 0, products_parent_id, products_id),
      subproduct_qty = ifelse(
        products_case_amt > 0 & products_parent_id > 0,
        subproduct_qty * products_case_amt,
        subproduct_qty
      )
    ) %>%
    mutate(
      products_price = ifelse(
        products_case_amt > 0 &
          products_price != 0 &
          products_parent_id > 0,
        extended_price / subproduct_qty,
        products_price
      ),
      final_price = ifelse(
        products_case_amt > 0 & final_price != 0 & products_parent_id > 0,
        ext_fin_price / subproduct_qty,
        final_price
      )
    ) %>%
    select(-products_case_amt,-extended_price,-ext_fin_price) %>%
    mutate(
      products_quantity = subproduct_qty * products_quantity,
      original_products_quantity = subproduct_qty * original_products_quantity,
      products_price = products_price * pct_of_kit,
      final_price = final_price * pct_of_kit
    ) %>%
    select(
      kit,
      products_id,
      products_quantity,
      products_price,
      final_price,
      mdy,
      orders_status,
      original_products_quantity
    ) %>%
    mutate(orders_id = id,
           kit = ifelse(kit > 1, 2, kit))
  
  kitProductsbyOrder = rbind(kitProductsbyOrder, kit)
}

All the kits we made get tacked onto the end of the productsSel dataframe.

kitProductsbyOrderGrouped <- kitProductsbyOrder %>%
  group_by(kit,
           products_id,
           mdy,
           orders_status,
           orders_id,
           products_price,
           final_price) %>%
  summarise(
    products_quantity = sum(products_quantity),
    original_products_quantity = sum(original_products_quantity)
  ) %>%
  ungroup() %>%
  group_by(kit, products_id, mdy, orders_status, orders_id) %>%
  summarise(
    products_price = sum(products_price * products_quantity) / sum(products_quantity),
    final_price = sum(final_price * products_quantity) / sum(products_quantity),
    products_quantity = sum(products_quantity),
    original_products_quantity = sum(original_products_quantity)
  ) %>%
  ungroup()


# Bind the kits onto the orders_products df
productsSel <- productsSel %>%
  filter(kit == 0) %>%
  rbind(kitProductsbyOrderGrouped) %>%
  filter(products_quantity > 0) %>%
  group_by(products_id,
           mdy,
           orders_status,
           orders_id,
           products_price,
           final_price) %>%
  summarise(
    products_quantity = sum(products_quantity),
    original_products_quantity = sum(original_products_quantity)
  ) %>%
  ungroup() %>%
  group_by(products_id, mdy, orders_status, orders_id) %>%
  summarise(
    products_price = sum(products_price * products_quantity) / sum(products_quantity),
    final_price = sum(final_price * products_quantity) / sum(products_quantity),
    products_quantity = sum(products_quantity),
    original_products_quantity = sum(original_products_quantity)
  ) %>%
  ungroup()


# Check to make sure the extended price is still close
sum(products$final_price * products$products_quantity)
sum(productsSel$final_price * productsSel$products_quantity,
    na.rm = T)

Full Join of Picks and Products

I’ll join the two tables now by orders_id and products_id.

picksWithProducts <- picksSel %>%
  full_join(productsSel, by = c("orders_id", "products_id")) %>%
  arrange(orders_id, products_id)

sum(picksWithProducts$final_price * picksWithProducts$products_quantity,
    na.rm = T)

Dealing with drop ships

Drop-ships apparently have no qty picked because of that we have a price but no cost. This will join on the cost of the drop ship items from the POs.

I’ll bind those onto a data frame which includes only the skus where the qtyPicked != NA.

costs1 <- costs %>%
  mutate(mdy = mdy(mdy)) %>%
  rename(products_cost = unit_cost,
         weight = products_weight)

dropships <- shipments %>%
  select(orders_id, is_drop_ship) %>%
  group_by(orders_id) %>%
  mutate(ds_items = sum(is_drop_ship)) %>%
  ungroup() %>%
  filter(ds_items > 0) %>%
  merge(picksWithProducts, by = 'orders_id') %>%
  merge(costs1, by = c("products_id", "mdy")) %>%
  mutate(
    products_weight = weight,
    weightedAvgCost = products_cost,
    products_ttl_weight = products_weight * products_quantity,
    products_ttl_cost = weightedAvgCost * products_quantity
  ) %>%
  select(-is_drop_ship,-products_cost,-weight,-ds_items)

withDropShips <- picksWithProducts %>%
  filter(!(orders_id %in% dropships$orders_id)) %>%
  rbind(dropships) %>%
  mutate(
    picks_equal_pquant = qtyPicked == products_quantity,
    picks_equal_opquant = qtyPicked == original_products_quantity
  ) %>%
  mutate(
    products_quantity = ifelse((picks_equal_pquant == FALSE &
                                  picks_equal_opquant == FALSE),
                               qtyPicked,
                               products_quantity
    ),
    qtyPicked = ifelse((picks_equal_pquant == FALSE &
                          picks_equal_opquant == TRUE),
                       products_quantity,
                       qtyPicked
    )
  ) %>%
  select(-original_products_quantity,
         -picks_equal_opquant,
         -picks_equal_pquant) %>%
  filter(!is.na(mdy),!is.na(qtyPicked))


sum(withDropShips$final_price * withDropShips$qtyPicked, na.rm = T)

Missing costs

Some costs are inexplicably missing. I’ll use the average cost of the product to account for those instances.

meanCosts <- picks %>%
  filter(products_cost > 0) %>%
  group_by(products_id) %>%
  summarise(
    products_cost = mean(products_cost),
    products_weight = mean(products_weight)
  )

missingCosts <- withDropShips %>%
  filter(is.na(weightedAvgCost) | weightedAvgCost == 0) %>%
  select(-products_weight,-weightedAvgCost) %>%
  merge(meanCosts, by = c('products_id'), all.x = T) %>%
  rename(weightedAvgCost = products_cost) %>%
  mutate(
    products_ttl_weight = qtyPicked * products_weight,
    products_ttl_cost = qtyPicked * weightedAvgCost
  )

notMissingCosts <- withDropShips %>%
  filter(!is.na(weightedAvgCost) & weightedAvgCost != 0) %>%
  ungroup()

removedMissingCosts <- rbind(notMissingCosts, missingCosts)

Make a table for orders_products with split kits

This orders products split kits table is needed to calculate SB45 so I’ll push it to Domo.

orders_products_split_kits <- removedMissingCosts %>%
  select(orders_id, products_id, products_quantity, mdy, orders_status)

#create(orders_products_split_kits, "orders_products_split_kits")
replace_ds("77827d48-71fb-4acd-b2a1-7b9c37afe529",
           orders_products_split_kits)

Get the total shipping cost and the box cost

shipmentCosts <- shipments %>%
  select(orders_id, shipments_id, box_cost, total_shipment_cost) %>%
  group_by(orders_id, shipments_id) %>%
  summarise(box_cost = max(box_cost),
            shipping_cost = max(total_shipment_cost)) %>%
  ungroup() %>%
  group_by(orders_id) %>%
  summarise(box_cost = sum(box_cost),
            shipping_cost = sum(shipping_cost)) %>%
  ungroup()

Join shipping and box costs to orders_total

totalsAndShipCosts <- totals %>%
  left_join(shipmentCosts, by = 'orders_id') %>%
  select(
    -date_purchased,
    -orders_total,
    -Subtotal,
    -Returned_Items,
    -Handling,
    -Handling_Fee,
    -Referral,
    -Refund,
    -Custom,
    -Custom2,-Custom3,
    -Custom4
  )

Use the fees table to join on fees

payment_methods <- products %>%
  select(orders_id, payment_method) %>%
  unique()

justTotals <- totals %>%
  select(orders_id, orders_total, Tax, website_name) %>%
  mutate(orders_total = orders_total - Tax) %>%
  select(-Tax)

feesSpread <- fees %>%
  filter(orders_id %in% justTotals$orders_id) %>%
  group_by(orders_id, fee_type) %>%
  summarise(amount = mean(amount)) %>%
  spread(fee_type, amount, fill = 0) %>%
  ungroup() %>%
  group_by(orders_id) %>%
  summarise(
    `Amazon Commission` = sum(`Amazon Commission`),
    Authorize.net = sum(Authorize.net),
    `eBay Commission` = sum(`eBay Commission`),
    PayPal = sum(PayPal)
  ) %>%
  ungroup()

totFees <-
  merge(justTotals, feesSpread, by = "orders_id", all.x = T) %>%
  mutate_all( ~ replace(., is.na(.), 0)) %>%
  filter(orders_total > 0) %>%
  mutate(
    `Amazon Commission` = ifelse(
      website_name != 'WeSellDirect.com',
      0,
      ifelse(`Amazon Commission` > 0, `Amazon Commission`,
             orders_total * .15)
    ),
    PayPal = ifelse(
      PayPal > 0,
      PayPal,
      ifelse(`eBay Commission` > 0, orders_total * .029, 0)
    )
  )

If it’s a credit card order without a fee estimate one

feesSel <- totFees %>%
  mutate(fees = select(.,-orders_id,-website_name,-orders_total) %>%
           rowSums()) %>%
  select(orders_id, fees, orders_total) %>%
  merge(payment_methods, by = "orders_id", all.x = TRUE) %>%
  mutate(fees = ifelse(
    fees > 0 & !is.na(fees),
    fees,
    ifelse(
      payment_method %in% c("Cash",
                            "Check/Money Order",
                            "No Charge",
                            "Store Credit",
                            "Net 30"),
      0,
      orders_total * .025 + .05
    )
  )) %>%
  select(-orders_total)

Join the totals to the product level

mergedProductsAndTotals <- removedMissingCosts %>%
  left_join(totalsAndShipCosts, by = 'orders_id') %>%
  ungroup() %>%
  left_join(feesSel, by = 'orders_id') %>%
  mutate(fees = as.numeric(ifelse(is.na(fees), 0, fees)))

Define all the functions to split the totals

# Functions to split by weight
ShippingChargeSplit <- function(df) {
  x = numeric(length = length(df$products_ttl_weight))
  for (i in 1:length(x)) {
    x[i] = (df$products_ttl_weight[i] / sum(df$products_ttl_weight)) * df$Shipping[i]
  }
  return(x)
}

BoxCostSplit <- function(df) {
  x = numeric(length = length(df$products_ttl_weight))
  for (i in 1:length(x)) {
    x[i] = (df$products_ttl_weight[i] / sum(df$products_ttl_weight)) * df$box_cost[i]
  }
  return(x)
}

ShippingCostSplit <- function(df) {
  x = numeric(length = length(df$products_ttl_weight))
  for (i in 1:length(x)) {
    x[i] = (df$products_ttl_weight[i] / sum(df$products_ttl_weight)) * df$shipping_cost[i]
  }
  return(x)
}

# Functions to split by extended price
TaxSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Tax[i]
  }
  return(x)
}

CouponSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Coupon[i]
  }
  return(x)
}

DiscountSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Discount[i]
  }
  return(x)
}

Misc_RefundSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Misc_Refund[i]
  }
  return(x)
}

AddonSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Addon_Charge[i]
  }
  return(x)
}

CharitySplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$Charity[i]
  }
  return(x)
}

feesSplit <- function(df) {
  x = numeric(length = length(df$extended_price))
  for (i in 1:length(x)) {
    x[i] = (df$extended_price[i] / sum(df$extended_price)) * df$fees[i]
  }
  return(x)
}

Split the totals by the products in each order and calculate profit

Calculate product parent level revenue and cost
* revenue = extended_price + ShippingChargeSplit + AddonSplit
- CouponSplit - DiscountSplit - Misc_RefundSplit - feesSplit
* cost = products_ttl_cost + ShippingCostSplit + BoxCostSplit

#Shipping charges and costs should be split on weight, all other charges should be split by price.

costsAssigned <- mergedProductsAndTotals %>%
  mutate(extended_price = final_price * qtyPicked,
         products_quantity = qtyPicked) %>%
  group_by(orders_id) %>%
  nest() %>%
  mutate(
    ShippingChargeSplit = map(data, ShippingChargeSplit),
    BoxCostSplit = map(data, BoxCostSplit),
    ShippingCostSplit = map(data, ShippingCostSplit),
    TaxSplit = map(data, TaxSplit),
    CouponSplit = map(data, CouponSplit),
    DiscountSplit = map(data, DiscountSplit),
    Misc_RefundSplit = map(data, Misc_RefundSplit),
    AddonSplit = map(data, AddonSplit),
    CharitySplit = map(data, CharitySplit),
    feesSplit = map(data, feesSplit)
  ) %>%
  unnest() %>%
  select(
    -Shipping,-Tax,-Coupon,-Discount,-Misc_Refund,-Addon_Charge,
    -Charity,-box_cost,-shipping_cost,-fees
  ) %>%
  mutate(
    products_ttl_cost = weightedAvgCost * qtyPicked,
    ShippingChargeSplit = if_else(is.na(ShippingChargeSplit), 0, as.numeric(round(
      ShippingChargeSplit, 2
    ))),
    BoxCostSplit = if_else(is.na(BoxCostSplit), 0, as.numeric(round(BoxCostSplit, 2))),
    ShippingCostSplit = if_else(is.na(ShippingCostSplit), 0, as.numeric(round(
      ShippingCostSplit, 2
    ))),
    TaxSplit = if_else(is.na(TaxSplit), 0, as.numeric(round(TaxSplit, 2))),
    CouponSplit = if_else(is.na(CouponSplit), 0, as.numeric(round(CouponSplit, 2))),
    DiscountSplit = if_else(is.na(DiscountSplit), 0, as.numeric(round(DiscountSplit, 2))),
    Misc_RefundSplit = if_else(is.na(Misc_RefundSplit), 0, as.numeric(round(Misc_RefundSplit, 2))),
    AddonSplit = if_else(is.na(AddonSplit), 0, as.numeric(round(AddonSplit, 2))),
    CharitySplit = if_else(is.na(CharitySplit), 0, as.numeric(round(CharitySplit, 2))),
    feesSplit = if_else(is.na(feesSplit), 0, as.numeric(round(feesSplit, 2))),
    revenue = extended_price + ShippingChargeSplit - CouponSplit - 
      DiscountSplit - Misc_RefundSplit + AddonSplit - feesSplit,
    revenue = if_else(is.na(revenue), 0, as.numeric(round(revenue, 2))),
    cost = products_ttl_cost + ShippingCostSplit + BoxCostSplit,
    cost = if_else(is.na(cost), 0, as.numeric(round(cost, 2)))
  )

sum(costsAssigned$extended_price)
sum(costsAssigned$final_price * costsAssigned$products_quantity)
sum(costsAssigned$final_price * costsAssigned$qtyPicked)

Push to the cloud and write to script file

#DomoR::create(costsAssigned, "Costs Assigned")
DomoR::replace_ds("6899c90c-1fa7-41ba-8271-7b18067f8f10", costsAssigned)
#knitr::purl('costAssignment.rmd')

Merge Results on products

products_or_parents <- products %>%
  select(-payment_method,-original_products_quantity) %>%
  filter(kit == 0) %>%
  mutate(products_or_parents_id = ifelse(products_parent_id > 0,
                                         products_parent_id,
                                         products_id)) %>%
  merge(
    costsAssigned %>% select(
      -mdy,
      -products_price,
      -final_price,
      -orders_status,
      -payment_method,
      -products_quantity
    ),
    by.x = c("orders_id", "products_or_parents_id"),
    by.y = c("orders_id", "products_id"),
    all.x = TRUE
  ) %>%
  select(-products_or_parents_id)

Split the kits but keep kit products_id

kitProductsbyOrder2 <- data.frame()

# Assemble the kits
for (i in seq(1:length(listOfKitOrders))) {
  id = listOfKitOrders[i]
  
  kitsOnOrder = kitSales %>%
    filter(orders_id == id) %>%
    select(
      products_id,
      products_quantity,
      mdy,
      products_price,
      final_price,
      orders_status,
      original_products_quantity
    ) %>%
    rename(bundle_id = products_id,
           date = mdy)
  
  kit = kits %>%
    filter(bundle_id %in% kitsOnOrder$bundle_id,
           #started appending 2/21/19 so this will be then or after
           mdy == max(kitsOnOrder$date[1],
                      ymd("2019-02-21"),
                      na.rm = T)) %>%
    merge(kitsOnOrder, by = 'bundle_id') %>%
    select(-mdy) %>%
    rename(kit = bundle_id,
           products_id = subproduct_id,
           mdy = date) %>%
    mutate(
      extended_price = products_price * subproduct_qty,
      ext_fin_price = final_price * subproduct_qty
    ) %>%
    mutate(
      products_id = ifelse(products_parent_id > 0,
                           products_parent_id, products_id),
      subproduct_qty = ifelse(
        products_case_amt > 0 & products_parent_id > 0,
        subproduct_qty * products_case_amt,
        subproduct_qty
      )
    ) %>%
    mutate(
      products_price = ifelse(
        products_case_amt > 0 &
          products_price != 0 &
          products_parent_id > 0,
        extended_price / subproduct_qty,
        products_price
      ),
      final_price = ifelse(
        products_case_amt > 0 & final_price != 0 & products_parent_id > 0,
        ext_fin_price / subproduct_qty,
        final_price
      )
    ) %>%
    select(-products_case_amt,-extended_price,-ext_fin_price) %>%
    rename(kit_quantity = products_quantity) %>%
    mutate(
      products_quantity = subproduct_qty * kit_quantity,
      original_products_quantity = subproduct_qty * original_products_quantity,
      products_price = products_price * pct_of_kit,
      final_price = final_price * pct_of_kit
    ) %>%
    select(
      kit,
      products_id,
      products_quantity,
      products_price,
      final_price,
      mdy,
      orders_status,
      original_products_quantity,
      kit_quantity
    ) %>%
    mutate(orders_id = id)
  
  kitProductsbyOrder2 = rbind(kitProductsbyOrder2, kit)
}

Merge on the calculated costs onto the kits table and calculate profit

orders_kit_items <- select(kitProductsbyOrder2,
                           products_id,
                           orders_id,
                           kit,
                           kit_quantity,
                           products_quantity) %>%
  merge(
    costsAssigned,
    by.x = c("orders_id", "products_id"),
    by.y = c("orders_id", "products_id"),
    all.x = TRUE
  ) %>%
  mutate(
    ShippingChargeSplit = ((ShippingChargeSplit / products_quantity.y) * products_quantity.x
    ),
    BoxCostSplit = ((BoxCostSplit / products_quantity.y) * products_quantity.x),
    ShippingCostSplit = ((ShippingCostSplit / products_quantity.y) * products_quantity.x
    ),
    TaxSplit = ((TaxSplit / products_quantity.y) * products_quantity.x),
    CouponSplit = ((CouponSplit / products_quantity.y) * products_quantity.x),
    DiscountSplit = ((DiscountSplit / products_quantity.y) * products_quantity.x),
    Misc_RefundSplit = ((Misc_RefundSplit / products_quantity.y) * products_quantity.x),
    AddonSplit = ((AddonSplit / products_quantity.y) * products_quantity.x),
    CharitySplit = ((CharitySplit / products_quantity.y) * products_quantity.x),
    feesSplit = ((feesSplit / products_quantity.y) * products_quantity.x),
    products_ttl_weight = ((products_ttl_weight / products_quantity.y) * products_quantity.x
    ),
    products_ttl_cost = ((products_ttl_cost / products_quantity.y) * products_quantity.x
    ),
    extended_price = ((extended_price / products_quantity.y) * products_quantity.x),
    revenue = ((revenue / products_quantity.y) * products_quantity.x),
    cost = ((cost / products_quantity.y) * products_quantity.x)
  ) %>%
  select(-products_quantity.y,-kit_quantity) %>%
  rename(products_quantity = products_quantity.x) %>%
  group_by(orders_id, kit, website_name) %>%
  summarise(
    ShippingChargeSplit = sum(ShippingChargeSplit),
    BoxCostSplit = sum(BoxCostSplit),
    ShippingCostSplit = sum(ShippingCostSplit),
    TaxSplit = sum(TaxSplit),
    CouponSplit = sum(CouponSplit),
    DiscountSplit = sum(DiscountSplit),
    Misc_RefundSplit = sum(Misc_RefundSplit),
    AddonSplit = sum(AddonSplit),
    CharitySplit = sum(CharitySplit),
    feesSplit = sum(feesSplit),
    qtyPicked = sum(qtyPicked),
    products_weight = sum(products_weight),
    weightedAvgCost = sum(weightedAvgCost),
    products_ttl_weight = sum(products_ttl_weight),
    products_ttl_cost = sum(products_ttl_cost),
    extended_price = sum(extended_price),
    revenue = sum(revenue),
    cost = sum(cost)
  ) %>%
  ungroup() %>%
  rename(products_id = kit)

kits_on_products_table <- products %>%
  filter(kit == 1) %>%
  select(-payment_method,-original_products_quantity) %>%
  merge(orders_kit_items,
        by = c("orders_id", "products_id"),
        all.x = T)

costsAssigned_orders_products <- rbind(products_or_parents,
                                       kits_on_products_table)

Push to the cloud

#create(costsAssigned_orders_products, "costsAssigned_orders_products")
replace_ds("ea4c23d0-f76c-4a07-b581-fce1705fd500",
           costsAssigned_orders_products)