Data Ingestion/EDA

Continuing Data Investigation

First, I have to get every library that I will use for this Data Investigation/EDA.

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggplot2)
library(plotly)

## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

library(zoo)

## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

library(stringr)

I have to put the three datasets now on my global envrionment to work with them.

# Loading the datasets
High_Volume_Weekly_DS <- read.csv("/Users/emilio/Downloads/DATA 205/Montgomery-College-Data-Set-1(High-Volume-Weekly)-csv.csv")
Medium_Volume_Weekly_DS <- read.csv("/Users/emilio/Downloads/DATA 205/Montgomery-College-Data-Set-1(Medium-Volume-Weekly)-csv.csv")
Low_Volume_Weekly_DS <- read.csv("/Users/emilio/Downloads/DATA 205/Montgomery-College-Data-Set-1(Low-Volume-Weekly)-csv.csv")

I noticed that the variables on the top of my data set have X1, X2, X3, etc. I will remove the X and replace it with “Week”.

# Renaming the columns
colnames(High_Volume_Weekly_DS) <- gsub("X", "Week", colnames(High_Volume_Weekly_DS))
colnames(Medium_Volume_Weekly_DS) <- gsub("X", "Week", colnames(Medium_Volume_Weekly_DS))
colnames(Low_Volume_Weekly_DS) <- gsub("X", "Week", colnames(Low_Volume_Weekly_DS))

Finally, I will do my last step with this data set, which is to multiply to “Bottles_Per_Case” varibale with “Cost_Amount_Per_Bottle” variable to get the “Total_Cost” variable for all the bottles in a case. I will do this for all three data sets.

# Creating the Total_Cost variable
High_Volume_Weekly_DS <- High_Volume_Weekly_DS |>
  mutate(Total_Cost = Bottles_Per_Case * Cost_Amount_Per_Bottle)

Medium_Volume_Weekly_DS <- Medium_Volume_Weekly_DS |>
  mutate(Total_Cost = Bottles_Per_Case * Cost_Amount_Per_Bottle)

Low_Volume_Weekly_DS <- Low_Volume_Weekly_DS |>
  mutate(Total_Cost = Bottles_Per_Case * Cost_Amount_Per_Bottle)

I want to move the last column “Total_Cost” right after the “Cost_Amount_Per_Bottle” column. I will do this for all three data sets.

# Moving the Total_Cost column
High_Volume_Weekly_DS <- High_Volume_Weekly_DS |>
  select(ItemID, Description, Bottles_Per_Case, Cost_Amount_Per_Bottle, Total_Cost, everything())
Medium_Volume_Weekly_DS <- Medium_Volume_Weekly_DS |>
  select(ItemID, Description, Bottles_Per_Case, Cost_Amount_Per_Bottle, Total_Cost, everything())
Low_Volume_Weekly_DS <- Low_Volume_Weekly_DS |>
  select(ItemID, Description, Bottles_Per_Case, Cost_Amount_Per_Bottle, Total_Cost, everything())

Finished! I will do my last step, which is to check the structure of the data sets to see if everything is in order. I will do this by using the str() function.

# Checking the structure of the datasets
str(High_Volume_Weekly_DS)

## 'data.frame':    500 obs. of  59 variables:
##  $ ItemID                : int  18467 96741 70417 249230 35211 53929 71009 359430 98744 71983 ...
##  $ Description           : chr  "SCOTTY'S VODKA 50ML" "CORONA EXTRA 4/6 NR - 12OZ" "FIREBALL CINN WHISKY 50ML/10PK LOOSE" "FIREBALL WHISKY 10PK SLV - 50ML" ...
##  $ Bottles_Per_Case      : int  96 24 120 120 120 6 24 120 24 24 ...
##  $ Cost_Amount_Per_Bottle: num  0.99 1.83 1.09 1.09 0.99 ...
##  $ Total_Cost            : num  95 44 131 131 119 ...
##  $ Week1                 : int  60 162 62 230 142 92 48 96 120 40 ...
##  $ Week2                 : int  93 0 170 100 181 127 60 72 84 56 ...
##  $ Week3                 : int  93 0 170 100 181 127 60 72 84 56 ...
##  $ Week4                 : int  94 144 108 280 154 90 84 102 108 56 ...
##  $ Week5                 : int  89 144 166 210 167 153 96 132 0 88 ...
##  $ Week6                 : int  114 132 141 240 224 151 108 120 102 80 ...
##  $ Week7                 : int  145 252 203 170 152 129 24 54 132 56 ...
##  $ Week8                 : int  94 66 185 80 189 131 24 78 42 48 ...
##  $ Week9                 : int  63 6 153 20 260 134 48 138 36 72 ...
##  $ Week10                : int  130 0 145 70 215 127 120 78 0 72 ...
##  $ Week11                : int  68 66 133 120 191 111 132 114 84 88 ...
##  $ Week12                : int  153 126 160 200 200 129 72 78 84 48 ...
##  $ Week13                : int  90 168 143 200 197 131 48 174 138 56 ...
##  $ Week14                : int  85 84 141 150 147 135 132 120 72 32 ...
##  $ Week15                : int  71 156 192 150 205 134 84 120 90 152 ...
##  $ Week16                : int  132 162 158 110 231 99 60 84 138 120 ...
##  $ Week17                : int  127 108 241 0 151 132 0 156 102 72 ...
##  $ Week18                : int  172 138 157 0 139 117 0 114 78 72 ...
##  $ Week19                : int  94 150 219 0 154 106 0 168 120 200 ...
##  $ Week20                : int  137 144 245 0 5 114 0 90 126 88 ...
##  $ Week21                : int  117 120 246 90 0 152 132 72 18 200 ...
##  $ Week22                : int  121 210 200 210 0 119 120 102 168 160 ...
##  $ Week23                : int  96 150 167 150 92 140 252 114 120 192 ...
##  $ Week24                : int  142 264 192 160 125 149 108 126 186 184 ...
##  $ Week25                : int  114 24 127 220 84 120 240 78 30 224 ...
##  $ Week26                : int  167 132 155 170 107 138 120 96 108 224 ...
##  $ Week27                : int  159 180 140 200 51 144 252 132 198 184 ...
##  $ Week28                : int  125 186 121 130 252 122 120 162 138 136 ...
##  $ Week29                : int  142 186 95 180 123 142 180 108 126 80 ...
##  $ Week30                : int  203 90 144 170 141 106 300 66 60 112 ...
##  $ Week31                : int  165 144 141 120 172 119 240 78 96 72 ...
##  $ Week32                : int  174 186 123 170 140 127 216 78 126 64 ...
##  $ Week33                : int  249 84 129 140 24 105 120 72 108 120 ...
##  $ Week34                : int  183 90 210 50 8 115 204 78 78 112 ...
##  $ Week35                : int  205 168 97 160 48 132 276 84 102 176 ...
##  $ Week36                : int  255 162 124 130 97 146 192 162 162 112 ...
##  $ Week37                : int  225 174 127 240 142 138 120 90 96 96 ...
##  $ Week38                : int  235 222 103 150 102 120 264 108 162 144 ...
##  $ Week39                : int  233 150 142 140 131 109 84 60 126 72 ...
##  $ Week40                : int  240 138 184 130 126 132 120 96 156 40 ...
##  $ Week41                : int  233 144 221 160 97 126 36 96 78 56 ...
##  $ Week42                : int  183 126 148 160 143 111 132 180 120 64 ...
##  $ Week43                : int  168 222 20 140 163 134 324 186 114 104 ...
##  $ Week44                : int  167 120 131 80 143 152 204 162 108 56 ...
##  $ Week45                : int  164 180 152 210 160 144 204 114 150 128 ...
##  $ Week46                : int  170 174 0 140 174 153 144 204 198 136 ...
##  $ Week47                : int  159 216 0 120 113 140 84 216 54 48 ...
##  $ Week48                : int  137 294 147 280 155 187 132 150 252 168 ...
##  $ Week49                : int  99 102 81 150 165 128 60 162 84 184 ...
##  $ Week50                : int  118 114 0 290 219 150 180 288 114 160 ...
##  $ Week51                : int  163 126 71 0 157 143 168 420 144 104 ...
##  $ Week52                : int  102 252 169 0 99 158 144 60 264 184 ...
##  $ Week53                : int  76 114 0 0 45 94 156 0 66 168 ...
##  $ Grand_Total           : int  7690 7478 7520 7391 7404 6901 6855 6481 5876 5842 ...

str(Medium_Volume_Weekly_DS)

## 'data.frame':    500 obs. of  59 variables:
##  $ ItemID                : int  70417 96741 96067 96083 98744 69086 249230 5932 53929 70058 ...
##  $ Description           : chr  "FIREBALL CINN WHISKY 50ML/10PK LOOSE" "CORONA EXTRA 4/6 NR - 12OZ" "GUINNESS STOUT 4/6 NR - 11.2OZ" "HEINEKEN 4/6 NR - 12OZ" ...
##  $ Bottles_Per_Case      : int  120 24 24 24 24 24 120 24 6 120 ...
##  $ Cost_Amount_Per_Bottle: num  1.09 1.83 1.83 1.83 2 ...
##  $ Total_Cost            : num  131 44 44 44 48 ...
##  $ Week1                 : int  76 60 12 96 18 48 20 24 24 17 ...
##  $ Week2                 : int  60 60 132 52 48 60 80 60 42 35 ...
##  $ Week3                 : int  137 78 24 0 0 12 10 6 47 31 ...
##  $ Week4                 : int  136 24 72 54 49 24 110 48 46 31 ...
##  $ Week5                 : int  115 48 96 85 0 48 100 12 35 36 ...
##  $ Week6                 : int  127 90 72 79 90 60 80 24 54 36 ...
##  $ Week7                 : int  81 78 60 102 72 36 130 60 56 39 ...
##  $ Week8                 : int  113 0 72 36 6 0 40 0 40 27 ...
##  $ Week9                 : int  118 48 54 18 24 24 30 24 42 18 ...
##  $ Week10                : int  158 24 54 30 36 24 20 42 40 30 ...
##  $ Week11                : int  101 36 138 41 36 24 60 30 46 35 ...
##  $ Week12                : int  128 72 66 26 30 84 100 72 36 14 ...
##  $ Week13                : int  160 84 180 79 90 0 50 66 38 18 ...
##  $ Week14                : int  102 48 60 36 36 0 80 12 30 29 ...
##  $ Week15                : int  86 54 72 43 37 84 0 30 44 47 ...
##  $ Week16                : int  117 114 48 61 24 24 70 54 35 27 ...
##  $ Week17                : int  91 48 168 62 42 48 50 42 46 35 ...
##  $ Week18                : int  121 96 132 90 103 84 70 60 34 40 ...
##  $ Week19                : int  109 108 54 134 72 36 60 72 32 50 ...
##  $ Week20                : int  102 54 54 87 50 108 60 54 47 41 ...
##  $ Week21                : int  110 168 138 102 72 156 60 90 55 39 ...
##  $ Week22                : int  100 192 90 127 72 84 90 66 26 56 ...
##  $ Week23                : int  110 138 150 72 54 96 90 54 39 15 ...
##  $ Week24                : int  84 180 48 240 137 96 50 48 57 21 ...
##  $ Week25                : int  55 90 210 66 78 72 60 42 34 25 ...
##  $ Week26                : int  72 66 138 90 24 120 50 60 42 34 ...
##  $ Week27                : int  73 150 150 162 144 132 90 78 56 18 ...
##  $ Week28                : int  76 90 72 78 63 108 120 48 33 1 ...
##  $ Week29                : int  80 84 48 96 66 36 40 84 36 48 ...
##  $ Week30                : int  57 114 72 54 72 72 80 24 44 26 ...
##  $ Week31                : int  79 84 90 72 45 72 60 36 47 55 ...
##  $ Week32                : int  61 120 162 108 36 36 20 66 45 37 ...
##  $ Week33                : int  82 120 66 84 96 60 60 48 38 24 ...
##  $ Week34                : int  131 126 84 66 99 60 20 48 31 50 ...
##  $ Week35                : int  87 84 84 138 80 84 50 18 34 35 ...
##  $ Week36                : int  103 60 24 84 73 96 70 90 35 27 ...
##  $ Week37                : int  97 102 36 78 114 24 40 36 27 64 ...
##  $ Week38                : int  113 102 24 78 54 12 30 18 36 34 ...
##  $ Week39                : int  97 42 42 78 78 48 50 36 37 76 ...
##  $ Week40                : int  138 72 18 96 62 48 50 12 36 65 ...
##  $ Week41                : int  126 108 72 72 96 48 80 60 41 73 ...
##  $ Week42                : int  90 42 78 72 61 48 30 18 48 48 ...
##  $ Week43                : int  112 90 18 96 63 96 20 30 47 81 ...
##  $ Week44                : int  154 36 12 60 36 24 20 30 46 99 ...
##  $ Week45                : int  119 54 18 84 36 48 40 36 52 66 ...
##  $ Week46                : int  135 54 84 84 144 84 40 42 41 72 ...
##  $ Week47                : int  109 144 48 60 66 48 40 54 47 33 ...
##  $ Week48                : int  105 144 78 126 108 108 40 48 71 43 ...
##  $ Week49                : int  155 30 36 12 72 36 0 6 39 63 ...
##  $ Week50                : int  131 54 66 36 42 96 0 12 36 77 ...
##  $ Week51                : int  137 54 120 78 168 108 0 42 52 66 ...
##  $ Week52                : int  124 222 108 60 156 108 0 0 45 36 ...
##  $ Week53                : int  26 24 42 36 42 12 0 48 24 9 ...
##  $ Grand_Total           : int  5687 4490 4172 4082 3498 3230 2831 2246 2228 2273 ...

str(Low_Volume_Weekly_DS)

## 'data.frame':    500 obs. of  59 variables:
##  $ ItemID                : int  70417 96741 96083 98744 251042 96067 35211 38067 12944 23193 ...
##  $ Description           : chr  "FIREBALL CINN WHISKY 50ML/10PK LOOSE" "CORONA EXTRA 4/6 NR - 12OZ" "HEINEKEN 4/6 NR - 12OZ" "STELLA ARTOIS 4/6 NR - 11.2OZ" ...
##  $ Bottles_Per_Case      : int  120 24 24 24 120 24 120 120 24 24 ...
##  $ Cost_Amount_Per_Bottle: num  1.09 1.83 1.83 2 1.09 ...
##  $ Total_Cost            : num  131 44 44 48 131 ...
##  $ Week1                 : int  141 66 48 60 0 60 64 18 36 12 ...
##  $ Week2                 : int  88 78 90 78 11 90 82 12 54 72 ...
##  $ Week3                 : int  82 84 84 78 16 30 130 0 156 108 ...
##  $ Week4                 : int  141 66 48 48 11 36 83 0 66 12 ...
##  $ Week5                 : int  200 114 30 210 13 66 97 0 102 48 ...
##  $ Week6                 : int  189 78 78 6 15 30 125 40 72 84 ...
##  $ Week7                 : int  242 48 72 36 23 36 36 37 12 24 ...
##  $ Week8                 : int  235 48 60 18 30 42 38 43 60 84 ...
##  $ Week9                 : int  2 54 54 78 3 48 0 0 12 24 ...
##  $ Week10                : int  200 54 84 54 31 60 78 33 24 36 ...
##  $ Week11                : int  263 66 42 36 41 102 49 47 132 36 ...
##  $ Week12                : int  183 30 48 18 51 60 87 58 18 0 ...
##  $ Week13                : int  260 48 42 30 51 24 84 74 19 48 ...
##  $ Week14                : int  238 30 54 36 50 24 82 28 13 24 ...
##  $ Week15                : int  251 72 78 60 68 43 98 36 96 72 ...
##  $ Week16                : int  204 36 72 60 39 54 91 25 90 36 ...
##  $ Week17                : int  147 66 24 72 31 18 54 32 7 60 ...
##  $ Week18                : int  74 66 102 114 25 84 61 34 67 24 ...
##  $ Week19                : int  129 126 138 84 40 36 73 43 102 24 ...
##  $ Week20                : int  69 132 108 108 78 144 53 33 60 60 ...
##  $ Week21                : int  91 162 114 120 72 60 27 61 85 84 ...
##  $ Week22                : int  155 108 30 48 54 72 0 44 96 120 ...
##  $ Week23                : int  131 96 54 24 56 48 21 34 61 132 ...
##  $ Week24                : int  82 144 84 90 60 66 38 78 62 24 ...
##  $ Week25                : int  84 96 102 54 59 96 21 26 90 36 ...
##  $ Week26                : int  129 30 42 54 56 42 25 45 24 0 ...
##  $ Week27                : int  66 90 72 66 49 30 16 49 36 12 ...
##  $ Week28                : int  93 66 78 114 73 66 33 25 54 0 ...
##  $ Week29                : int  44 60 60 120 79 36 22 45 68 60 ...
##  $ Week30                : int  56 66 84 60 104 36 41 51 79 24 ...
##  $ Week31                : int  73 66 72 36 41 78 43 50 54 48 ...
##  $ Week32                : int  88 96 66 54 80 36 48 65 62 84 ...
##  $ Week33                : int  121 84 42 192 86 120 27 65 24 144 ...
##  $ Week34                : int  105 150 72 108 61 66 51 102 6 0 ...
##  $ Week35                : int  154 108 54 78 77 96 58 130 19 144 ...
##  $ Week36                : int  144 60 96 30 43 96 37 64 60 48 ...
##  $ Week37                : int  155 84 114 78 79 90 74 143 169 276 ...
##  $ Week38                : int  150 114 60 36 41 30 39 129 48 12 ...
##  $ Week39                : int  134 72 48 84 66 54 47 104 36 36 ...
##  $ Week40                : int  200 54 42 24 58 36 82 93 108 60 ...
##  $ Week41                : int  185 78 66 78 97 60 39 73 12 12 ...
##  $ Week42                : int  98 54 30 36 72 30 58 22 6 24 ...
##  $ Week43                : int  160 90 60 54 71 54 35 49 18 36 ...
##  $ Week44                : int  129 52 78 48 97 24 46 58 18 72 ...
##  $ Week45                : int  129 54 72 84 81 66 47 41 12 108 ...
##  $ Week46                : int  113 30 60 42 63 72 30 46 43 12 ...
##  $ Week47                : int  134 61 78 54 81 32 27 100 66 60 ...
##  $ Week48                : int  221 72 90 36 82 32 61 72 6 36 ...
##  $ Week49                : int  216 36 42 24 79 42 48 69 90 48 ...
##  $ Week50                : int  202 48 42 24 115 42 48 68 12 24 ...
##  $ Week51                : int  281 54 67 18 52 36 68 68 1 12 ...
##  $ Week52                : int  120 66 38 84 73 66 67 93 26 24 ...
##  $ Week53                : int  121 24 18 54 33 18 12 4 6 24 ...
##  $ Grand_Total           : int  7823 3913 3509 3416 3038 2941 2922 2880 2782 2750 ...

Time to export the data sets to CSV files so I can use them in my analysis.

# Exporting the datasets to CSV files
write.csv(High_Volume_Weekly_DS, "/Users/emilio/Downloads/High_Volume_Weekly_DS.csv", row.names = FALSE)
write.csv(Medium_Volume_Weekly_DS, "/Users/emilio/Downloads/Medium_Volume_Weekly_DS.csv", row.names = FALSE)
write.csv(Low_Volume_Weekly_DS, "/Users/emilio/Downloads/Low_Volume_Weekly_DS.csv", row.names = FALSE)

Now time to work on the EDA!

My next goal for this project is to discover patterns with the data, and what I can find to help others know to understand. Particullarly, if I were able to find Moving Average Sales trends from any product or products, especially a top selling product, I can understand the basis of how my algorithm could work. My first goal will try to uncover…

- Moving Average Salaes Trends for a Top-Selling Product

Working with Weekly data especially will help look at trends better.

I will choose the most sold amount of products across all stores, for ALL of 2024.

Since we have the “Grand_Total” Variable, all I have to do is look at the highest grand total for all the products and see which is the highst.

# Finding the top-selling product for 2024
top_selling_product_high_vol_store <- High_Volume_Weekly_DS |>
  arrange(desc(Grand_Total)) |>
  slice(1)

top_selling_product_medium_vol_store <- Medium_Volume_Weekly_DS |>
  arrange(desc(Grand_Total)) |>
  slice(1)

top_selling_product_low_vol_store <- Low_Volume_Weekly_DS |>
  arrange(desc(Grand_Total)) |>
  slice(1)

top_selling_product_high_vol_store

##   ItemID         Description Bottles_Per_Case Cost_Amount_Per_Bottle Total_Cost
## 1  18467 SCOTTY'S VODKA 50ML               96                   0.99      95.04
##   Week1 Week2 Week3 Week4 Week5 Week6 Week7 Week8 Week9 Week10 Week11 Week12
## 1    60    93    93    94    89   114   145    94    63    130     68    153
##   Week13 Week14 Week15 Week16 Week17 Week18 Week19 Week20 Week21 Week22 Week23
## 1     90     85     71    132    127    172     94    137    117    121     96
##   Week24 Week25 Week26 Week27 Week28 Week29 Week30 Week31 Week32 Week33 Week34
## 1    142    114    167    159    125    142    203    165    174    249    183
##   Week35 Week36 Week37 Week38 Week39 Week40 Week41 Week42 Week43 Week44 Week45
## 1    205    255    225    235    233    240    233    183    168    167    164
##   Week46 Week47 Week48 Week49 Week50 Week51 Week52 Week53 Grand_Total
## 1    170    159    137     99    118    163    102     76        7690

top_selling_product_medium_vol_store

##   ItemID                          Description Bottles_Per_Case
## 1  70417 FIREBALL CINN WHISKY 50ML/10PK LOOSE              120
##   Cost_Amount_Per_Bottle Total_Cost Week1 Week2 Week3 Week4 Week5 Week6 Week7
## 1                   1.09      130.8    76    60   137   136   115   127    81
##   Week8 Week9 Week10 Week11 Week12 Week13 Week14 Week15 Week16 Week17 Week18
## 1   113   118    158    101    128    160    102     86    117     91    121
##   Week19 Week20 Week21 Week22 Week23 Week24 Week25 Week26 Week27 Week28 Week29
## 1    109    102    110    100    110     84     55     72     73     76     80
##   Week30 Week31 Week32 Week33 Week34 Week35 Week36 Week37 Week38 Week39 Week40
## 1     57     79     61     82    131     87    103     97    113     97    138
##   Week41 Week42 Week43 Week44 Week45 Week46 Week47 Week48 Week49 Week50 Week51
## 1    126     90    112    154    119    135    109    105    155    131    137
##   Week52 Week53 Grand_Total
## 1    124     26        5687

top_selling_product_low_vol_store

##   ItemID                          Description Bottles_Per_Case
## 1  70417 FIREBALL CINN WHISKY 50ML/10PK LOOSE              120
##   Cost_Amount_Per_Bottle Total_Cost Week1 Week2 Week3 Week4 Week5 Week6 Week7
## 1                   1.09      130.8   141    88    82   141   200   189   242
##   Week8 Week9 Week10 Week11 Week12 Week13 Week14 Week15 Week16 Week17 Week18
## 1   235     2    200    263    183    260    238    251    204    147     74
##   Week19 Week20 Week21 Week22 Week23 Week24 Week25 Week26 Week27 Week28 Week29
## 1    129     69     91    155    131     82     84    129     66     93     44
##   Week30 Week31 Week32 Week33 Week34 Week35 Week36 Week37 Week38 Week39 Week40
## 1     56     73     88    121    105    154    144    155    150    134    200
##   Week41 Week42 Week43 Week44 Week45 Week46 Week47 Week48 Week49 Week50 Week51
## 1    185     98    160    129    129    113    134    221    216    202    281
##   Week52 Week53 Grand_Total
## 1    120    121        7823

As we see above, the top selling product for the.. High Volume store = “SCOTTY’S VODKA 50ML” Medium Volume store = “FIREBALL CINN WHISKEY 50ML/10PK LOOSE” Low Volume store = “FIREBALL CINN WHISKEY 50ML/10PK LOOSE”.

Now for curiosity, I want to use the moving average across a set of weeks to see if I can find trends. I will have to use the zoo package for this.

WIll use library zoo for this

# Sales for 53 weeks in a vector
weekly_sales_high <- as.numeric(High_Volume_Weekly_DS[1, paste0("Week", 1:53)])
weekly_sales_medium <- as.numeric(Medium_Volume_Weekly_DS[1, paste0("Week", 1:53)])
weekly_sales_low <- as.numeric(Low_Volume_Weekly_DS[1, paste0("Week", 1:53)])

# Will use a 4-week moving average
moving_avg_high <- rollmean(weekly_sales_high, k = 3, fill = NA, align = "right")
moving_avg_medium <- rollmean(weekly_sales_medium, k = 3, fill = NA, align = "right")
moving_avg_low <- rollmean(weekly_sales_low, k = 3, fill = NA, align = "right")

# Below I will put approximate starting week for each month to show when the months start
month_weeks <- c(1, 5, 9, 14, 18, 22, 27, 31, 36, 40, 45, 49)
month_labels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

# Creating a data frame for plotting
moving_avg_df_high <- data.frame(
  Week = 1:53,
  Sales = moving_avg_high,
  Store = "High Volume"
)

moving_avg_df_medium <- data.frame(
  Week = 1:53,
  Sales = moving_avg_medium,
  Store = "Medium Volume"
)

moving_avg_df_low <- data.frame(
  Week = 1:53,
  Sales = moving_avg_low,
  Store = "Low Volume"
)

# Combining all data frames
moving_avg_df <- bind_rows(moving_avg_df_high, moving_avg_df_medium, moving_avg_df_low)

ggplot(moving_avg_df, aes(x = Week, y = Sales, color = Store)) +
  geom_line(size = 1.2, na.rm = TRUE) +
  scale_x_continuous(breaks = month_weeks, labels = month_labels) +
  scale_color_manual(values = c("High Volume" = "darkblue",
                                "Medium Volume" = "darkgreen",
                                "Low Volume" = "darkred")) +
  labs(
    title = "3-Week Moving Average of Sales by Store Type \n - HIGHEST sold product $$$ (2024)",
    x = "Month",
    y = "Sales",
    color = "Store"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "top"
  )

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Oh wow.. as you can see from the above, the 4-week Moving Averages for different volume of stores for the HIGHEST selling product all year long has been different for different weeks. Towards the end of the year, the sales for the high volume store have been increasing, while the sales for the medium and low volume stores have been decreasing in the middle of the weeks (as you can see… around July and August). This is very interesting to see. I will have to look at this more closely later on.

#Me playing around with making the algorithm.

# Example weekly sales for the highest product (SCOTTY'S VODKA 50ML) as an example
## period1 <- c(60, 93, 93, 94, 89)
## period2 <- c(114, 145, 94, 63, 130)
## period3 <- c(90, 95, 100, 98, 97)

# Calculating average sales for each period
## avg1 <- mean(period1)
## avg2 <- mean(period2)
## avg3 <- mean(period3)

WEIGHTED AVERAGES: for later use: (Skip this step)

# Apply weights: P1 = 15%, P2 = 25%, P3 = 60%
## weighted_avg <- (0.15 * avg1) + (0.25 * avg2) + (0.60 * avg3)
## weighted_avg

# Step 2: Combined average (no weights)
##  combined_avg <- mean(c(avg1, avg2, avg3))
  
# Step 3: Standard deviation of averages
##  stdev_val <- sd(c(avg1, avg2, avg3))
  
# Step 4: Check if Period 1 is consistent
##  if (abs(avg1 - combined_avg) > (3 * stdev_val)) {
##    chosen_avg <- combined_avg
##  } else {
##    chosen_avg <- avg1
##  }
  
# Step 5: Convert to daily average
##  daily_avg <- chosen_avg / 7

# Step 6: Constants (can customize later)
##  reorder_threshold_days <- 10
##  lead_time_days <- 10
  
##  MSS <- daily_avg * reorder_threshold_days
##  reorder_qty <- (daily_avg * lead_time_days) + MSS

Okay simple. I split the first 3 periods (Each period if 5 weeks) from the first 15 weeks of the dataset (the start of january) and I calculated the average for each. Then I put calculated using weighted average.

## EXAMPLE OF REORDER QTY CALCULATION


## reorder_threshold_days <- 10 # The number of days of sales you want to always have in stock before ordering more. # "If I have 10 days of this alcohol in stock, I will need to re-order more!"
## lead_time_days <- 10

# Minimum Shelf Stock
## MSS <- (weighted_avg/7) * reorder_threshold_days #The lowest amount of product the ABS stores should keep on hand at all times to stay stocked and ready.
# MSS = (Average daily sales) × (Reorder Threshold)
# Exp: I need atleast # alcohol stores at all times. That’s the backup stash, just in case demand suddenly goes up.

#NOTE: Lead time is 10 days, so I will need to order more alcohol 10 days before I run out of stock.


# Reorder Quantity
## reorder_qty <- (weighted_avg * lead_time_days) + MSS
# Reorder Quantity = (Average daily sales) × (Lead time) + MSS

## reorder_qty

Cool! The reorder_qty is 1995.4. That means that I will need to order 1117.371 bottles of SCOTTY’S VODKA 50ML every time you reorder (which is every 10 days — the lead time).

In the future, I wil try to implement this algorithm to the rest of the products in the data set. I will also try to implement this algorithm to the other two data sets (Medium and Low Volume stores) to see if I can find any patterns or trends, and make possible visualizations with this. For now, I will keep how everything is.

Labeling products with a category: Beer and Other

I have to ensure that products that have a reorder tres hold of 14 days (beer) are calcualted correctly in the algorithm. I will do this by creating a new column called “Category” and putting the category of the product in there.

# First, I want to see which beer brands there are. I am going to start of with a basic search for different beer products.

beer_brands <- c("CORONA","STELLA", "HEINEKEN", "MODELO","BLUE MOON", "GUINNESS", "SAPPORO", "MICHELOB", "SAM ADAMS", "NEGRA MODELO", "PERONI", "PILSNER URQUELL", "FLYING DOG", "LEFFE", "ASAHI", "DC BRAU", "DOS EQUIS", "SIERRA NEVADA", "TSINGTAO", "RED STRIPE", "ALLAGASH", "DENIZENS", "SINGHA", "BEER FARM", "DOGFISH HEAD SLIGHTLY MIGHTY LO-CAL IPA 4/6PK", "DOGFISH HEAD SEAQUENCH ALE 4/6 CAN", "DOGFISH HEAD PUNKIN ALE 4/6 CAN", "DOGFISH HEAD IPA 2/12 VP CANS", "DOGFISH HEAD HAZY SQUALL 4/6 CAN", "DOGFISH HEAD FESTINA PECHE 4/6 CN", "DOGFISH HEAD 90 MINUTE IMPERIAL IPA 4/6 NR", "DOGFISH HEAD 60 MIN IPA 4/6 NR - 12OZ", "DOGFISH HEAD (SUMMER) VP 2/12PK CAN", "DOGFISH HEAD (FALL) VP 2/12", "NEW BELGIUM")

High_Volume_Weekly_DS$Category <- ifelse(grepl(paste(beer_brands, collapse = "|"), High_Volume_Weekly_DS$Description, ignore.case = TRUE), "Beer", "Other")
Medium_Volume_Weekly_DS$Category <- ifelse(grepl(paste(beer_brands, collapse = "|"), Medium_Volume_Weekly_DS$Description, ignore.case = TRUE), "Beer", "Other")
Low_Volume_Weekly_DS$Category <- ifelse(grepl(paste(beer_brands, collapse = "|"), Low_Volume_Weekly_DS$Description, ignore.case = TRUE), "Beer", "Other")

# Making a copy of the original datasets (for my function I will create)
High_Volume_Weekly_DS_copy <- High_Volume_Weekly_DS
Medium_Volume_Weekly_DS_copy <- Medium_Volume_Weekly_DS
Low_Volume_Weekly_DS_copy <- Low_Volume_Weekly_DS

# Making a copy of the original datasets (for Weighted averages just to test that alone)
High_Volume_Weekly_DS_weighted_averages <- High_Volume_Weekly_DS
Medium_Volume_Weekly_DS_weighted_averages <- Medium_Volume_Weekly_DS
Low_Volume_Weekly_DS_weighted_averages <- Low_Volume_Weekly_DS

Below I will try to implement the algorithm to the data set to see if I can get Reorder_Qty for all the products in the data set.

I WILL only test to see if it works here, I will not run this code on my final output since I will make an algorothm that works for all periods of the week and make more columns (Getting reorder quantities starting rfrom week 16 to 53)

# Function to calculate reorder quantity

## calculate_reorder_simple <- function(row) {
  
  # Step 1: Get period averages
##  period1 <- as.numeric(row[paste0("Week", 1:5)])
##  period2 <- as.numeric(row[paste0("Week", 6:10)])
##  period3 <- as.numeric(row[paste0("Week", 11:15)])
  
##  total_sales <- sum(period1) + sum(period2) + sum(period3)

##  if (total_sales < as.numeric(row["Bottles_Per_Case"])) {
##    return(0)  # If less than a case sold over 15 weeks, don't reorder
##  }
  
##  avg1 <- mean(period1)
##  avg2 <- mean(period2)
##  avg3 <- mean(period3)
  
  # Step 2: Combined average (no weights)
##  combined_avg <- mean(c(avg1, avg2, avg3))
  
  # Step 3: Absolute difference between avg1 and combined_avg
##  stdev_val <- abs(avg1 - combined_avg)

  # Step 4: Check if Period 1 is consistent
##  if (stdev_val > 3) {
#    chosen_avg <- combined_avg
##  } else {
##    chosen_avg <- avg1
##  }
  
  # Step 5: Convert to daily average
##  daily_avg <- chosen_avg / 7
  
  # Step 6: Constants (customized based on Beer or Other)
##  reorder_threshold_days <- 10
##  if (row["Category"] == "Beer") {
##    reorder_threshold_days <- 14
##  }
  
##  lead_time_days <- 10
  
##  MSS <- daily_avg * reorder_threshold_days
##  reorder_qty <- (daily_avg * lead_time_days) + MSS
  
##  return(round(reorder_qty, 2))
##}

Apply the function to each row of the dataset

## High_Volume_Weekly_DS$Reorder_Qty <- apply(High_Volume_Weekly_DS, 1, calculate_reorder_simple)
## Medium_Volume_Weekly_DS$Reorder_Qty <- apply(Medium_Volume_Weekly_DS, 1, calculate_reorder_simple)
## Low_Volume_Weekly_DS$Reorder_Qty <- apply(Low_Volume_Weekly_DS, 1, calculate_reorder_simple)

Below is calculation to ROUND to the NEAREST Case! (Bottles_Per_Case) (VERY IMPORTANT, Will have to use for later)

# High_Volume_Weekly_DS$Reorder_Cases <- ceiling(High_Volume_Weekly_DS$Reorder_Qty / as.numeric(High_Volume_Weekly_DS$Bottles_Per_Case))

# Medium_Volume_Weekly_DS$Reorder_Cases <- ceiling(Medium_Volume_Weekly_DS$Reorder_Qty / as.numeric(Medium_Volume_Weekly_DS$Bottles_Per_Case))

# Low_Volume_Weekly_DS$Reorder_Cases <- ceiling(Low_Volume_Weekly_DS$Reorder_Qty / as.numeric(Low_Volume_Weekly_DS$Bottles_Per_Case))

We got the originial algorithm to work!!! So happy about this, now that it works, we can calculate the exact number of bottles AND MOST IMPORTANTLY as well the number of cases needed to be order of that product usng the algorithm and knowig how much we would keep in stock. NOW i want to try to recreate the algorithm and continue on the Master Planning.

Master Planning

I will recalculate reorder quantities using a new set of 3 five-week periods, say every month or quarter.

First plan was 1 - 15 weeks Next plan: 2 - 16 weeks And so on (till I reach 53).

I will plan by batch of 3 periods (15 weeks) and then I will move the window by 3 periods (15 weeks) to get the next batch of 3 periods. I will do this for all the products in the data set (since ABS plans by month)

Functions

———

Working for the first 3 periods (15 weeks) and then moving the window by 3 periods (15 weeks) to get the next batch of 3 periods.

# Modified function: Now returns the Reorder quantities of bottles
calculate_reorder_sliding <- function(row, start_week) {
  
  # Define the week ranges based on start_week
  weeks <- paste0("Week", start_week:(start_week + 14))  # 15 weeks
  week_nums <- start_week:(start_week + 14)
  
  # Make 3 periods of 5 weeks each
  period1 <- as.numeric(row[paste0("Week", week_nums[1:5])])
  period2 <- as.numeric(row[paste0("Week", week_nums[6:10])])
  period3 <- as.numeric(row[paste0("Week", week_nums[11:15])])
  
  total_sales <- sum(period1) + sum(period2) + sum(period3)
  
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) {
    return(0)  # If less than a case sold, don't reorder
  }
  
  avg1 <- mean(period1)
  avg2 <- mean(period2)
  avg3 <- mean(period3)
  
  combined_avg <- mean(c(avg1, avg2, avg3))
  stdev_val <- abs(avg1 - combined_avg)
  
  chosen_avg <- if (stdev_val > 3) combined_avg else avg1
  
  daily_avg <- chosen_avg / 7
  
  reorder_threshold_days <- if (row["Category"] == "Beer") 14 else 10
  lead_time_days <- 10
  
  MSS <- daily_avg * reorder_threshold_days
  reorder_qty <- (daily_avg * lead_time_days) + MSS
  
  return(round(reorder_qty, 2))
}

I will make ANOTHER function to also return only MSS values per sliding window.

# New function: ONLY returns the MSS
calculate_mss_sliding <- function(row, start_week) {
  
  # Define the week ranges based on start_week
  week_nums <- start_week:(start_week + 14)
  
  # Create 3 periods of 5 weeks each
  period1 <- as.numeric(row[paste0("Week", week_nums[1:5])])
  period2 <- as.numeric(row[paste0("Week", week_nums[6:10])])
  period3 <- as.numeric(row[paste0("Week", week_nums[11:15])])
  
  total_sales <- sum(period1) + sum(period2) + sum(period3)
  
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) {
    return(0)  # If less than a case sold, MSS is zero
  }
  
  avg1 <- mean(period1)
  avg2 <- mean(period2)
  avg3 <- mean(period3)
  
  combined_avg <- mean(c(avg1, avg2, avg3))
  stdev_val <- abs(avg1 - combined_avg)
  
  chosen_avg <- if (stdev_val > 3) combined_avg else avg1
  
  daily_avg <- chosen_avg / 7
  
  reorder_threshold_days <- if (row["Category"] == "Beer") 14 else 10
  
  MSS <- daily_avg * reorder_threshold_days
  
  return(round(MSS, 2))
}

`

And lastly, I will create one more function to get Reorder Cases for each sliding window.

# Function to calculate reorder cases
convert_reorder_to_cases <- function(dataset) {
  for (start_week in 1:39) {
    reorder_col <- paste0("Reorder_Weeks_", start_week, "_", start_week + 14)
    case_col <- paste0("Reorder_Cases_Weeks_", start_week, "_", start_week + 14)
    
    dataset[[case_col]] <- ceiling(dataset[[reorder_col]] / as.numeric(dataset$Bottles_Per_Case))
  }
  return(dataset)
}

Applying Functions

——————

Now, I will Loop Through Weeks 1 to 39

Because I need 15 weeks, the last valid starting week is Week 39 (39 + 14 = 53).

Here’s the code to…

Add a new Reorder column for each sliding window:

# Create reorder columns for sliding windows
for (start_week in 1:39) {  
  reorder_col_name <- paste0("Reorder_Weeks_", start_week, "_", start_week + 14)
  
  High_Volume_Weekly_DS[[reorder_col_name]] <- apply(High_Volume_Weekly_DS, 1, function(row) {
    calculate_reorder_sliding(row, start_week)
  })
  Medium_Volume_Weekly_DS[[reorder_col_name]] <- apply(Medium_Volume_Weekly_DS, 1, function(row) {
    calculate_reorder_sliding(row, start_week)
  })
  Low_Volume_Weekly_DS[[reorder_col_name]] <- apply(Low_Volume_Weekly_DS, 1, function(row) {
    calculate_reorder_sliding(row, start_week)
  })
}

Getting the MSS

# Create MSS columns for sliding windows
for (start_week in 1:39) {  
  mss_col_name <- paste0("MSS_Weeks_", start_week, "_", start_week + 14)
  
  High_Volume_Weekly_DS[[mss_col_name]] <- apply(High_Volume_Weekly_DS, 1, function(row) {
    calculate_mss_sliding(row, start_week)
  })
  
  Medium_Volume_Weekly_DS[[mss_col_name]] <- apply(Medium_Volume_Weekly_DS, 1, function(row) {
    calculate_mss_sliding(row, start_week)
  })
  
  Low_Volume_Weekly_DS[[mss_col_name]] <- apply(Low_Volume_Weekly_DS, 1, function(row) {
    calculate_mss_sliding(row, start_week)
  })
}

Convert Reorder quantities to Cases

# Applying the conversion to each store type
High_Volume_Weekly_DS <- convert_reorder_to_cases(High_Volume_Weekly_DS)
Medium_Volume_Weekly_DS <- convert_reorder_to_cases(Medium_Volume_Weekly_DS)
Low_Volume_Weekly_DS <- convert_reorder_to_cases(Low_Volume_Weekly_DS)

Now the orginial algorithm is calcualted with all it’s sliding windows. I will try to visualize this below

#Visualization

# Step 1: Filter the item
## VISUAL EXAMPLE OF MAKING A item_data table for visualization
## item_data <- "dataset" %>% filter(ItemID == "ID") # <-- WHERE ITEM ID I enter!


item_data <- High_Volume_Weekly_DS %>% filter(ItemID == "18467") # <-- WHICH ITEM ID I enter AND DATA SET!

# Step 2: Get the reorder data (Weeks 16–53)
reorder_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# Step 3: Get the MSS data
mss_long <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Step 4: Get weekly sales from Week16 to Week53
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Step 5: Get the Reorder in Cases data
reorder_cases_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# Step 6: Combine all three
combined_plot_data_abs <- sales_long %>%
  left_join(reorder_long, by = "Reorder_Week") %>%
  left_join(mss_long, by = "Reorder_Week") %>%
  left_join(reorder_cases_long, by = "Reorder_Week") %>%
  pivot_longer(cols = c("Sales", "Reorder_Qty", "MSS", "Reorder_Cases"),
               names_to = "Metric", values_to = "Value")

# Step 7: Plot
algorithm_vis <- ggplot(combined_plot_data_abs, aes(x = Reorder_Week, y = Value, color = Metric)) +
  geom_line(size = 1) +
  geom_point() +
  labs(
    title = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)",
    x = "Week Number",
    y = "Units",
    subtitle = "Item: DISARONNO AMARETTO - 750ML (ItemID 42838)" # <-- NAME of Item!
  ) +
  scale_color_manual(values = c(
    "Sales" = "black", 
    "Reorder_Qty" = "blue", 
    "MSS" = "red",
    "Reorder_Cases" = "purple")) +
  theme_minimal()

ggplotly(algorithm_vis, tooltip = c("Reorder_Week", "Metric", "Value")) %>%
  layout(
    title = list(text = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)"),
    xaxis = list(title = "Week Number"),
    yaxis = list(title = "Units")
  )

## Code to skip ggplot entirely and show EXACTLY where reorder cases are.

NOTE *MAIN FUNCTION/VIS**

---

I did the cose below to simplify things by skipping ggplot entirely and using plot_ly() directly. That gives me full control over what’s shown in the tooltip vs. what’s actually plotted, to show reorder cases!

item_data <- High_Volume_Weekly_DS %>% filter(ItemID == "18467") # <-- WHERE ITEM ID I enter!

# Step 2: Get the reorder data (Weeks 16–53)
reorder_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# Step 3: Get the MSS data
mss_long <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Step 4: Get weekly sales from Week16 to Week53
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Step 5: Get the Reorder in Cases data
reorder_cases_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# -----------------------
# Where the magic happens
# -----------------------

# Step 6: Prepare combined data with all metrics
combined_plot_data_abs <- sales_long %>%
  left_join(reorder_long, by = "Reorder_Week") %>%
  left_join(mss_long, by = "Reorder_Week") %>%
  left_join(reorder_cases_long, by = "Reorder_Week")

# Step 7: Making the plotly object directly

plot_ly() %>%
  # Sales
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~Sales,
    type = "scatter", mode = "lines+markers",
    name = "Sales",
    line = list(color = "black"),
    marker = list(color = "black"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Sales:", Sales)
  ) %>%
  # Reorder_Qty (with Reorder_Cases in tooltip)
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~Reorder_Qty,
    type = "scatter", mode = "lines+markers",
    name = "Reorder Quantity",
    line = list(color = "blue"),
    marker = list(color = "blue"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Reorder Qty:", Reorder_Qty,
                  "<br>Reorder Cases:", Reorder_Cases)
  ) %>%
  # MSS
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~MSS,
    type = "scatter", mode = "lines+markers",
    name = "MSS",
    line = list(color = "red"),
    marker = list(color = "red"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>MSS:", MSS)
  ) %>%
  layout(
  title = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)<br><sub>Item: SCOTTY'S VODKA 50ML (ItemID 18467)</sub>",
  xaxis = list(
    title = "Week Number",
    tickmode = "linear",     # Linear spacing
    tick0 = 16,              # Starting at week 16
    dtick = 2                # Show every week (adjust to 2 or 5 if too crowded)
  ),
  yaxis = list(
    title = "Value"         # Changing this based on data scale (e.g., 5, 10, 20, etc.)
  ),
  hovermode = "closest"
)

   # tickmode = "linear", # Changing this based on data scale
   # tick0 = 0,           # Add the thing to the elft if needed for clearlification on y axis
   # dtick = 50       

Yay! Now we can see reorder cases.

As you can see, I used SCOTTY’S VODKA 50ML as an example. I will breifly explain what my visualizaiton above means.

PRODUCT: SCOTTY’S VODKA 50ML (ItemID: 18467)

Time Frame: Weeks 16–53

Plotted: - Sales (black line) - MSS (Minimum Shelf Stock) (red line) - Reorder Quantity (blue line, ~2× MSS)

WHAT THE ALGORITHM IS DOING

The Master Planning Algorithm estimates how much stock a store should always have (MSS) and how much to reorder (Reorder Quantity) based on past sales (especially PD1) and standard deviation (to avoid overreacting to weird spikes or drops). - MSS = expected 10-day demand - Reorder Quantity = MSS + expected 10-day demand (so basically double of MSS for many items)

This is a forecast-based inventory model. It’s assuming that recent high sales trends will continue unless the data shows strong variability (std dev > 3).

SALES PATTERN SUMMARY (in this case the Scotty’s Vodka Example)

Weeks 16–36 (High Sales Period)

Sales regularly exceed MSS. Examples: - Week 18: Sales (172) > MSS (147.43) - Week 30: Sales (203) > MSS (182.48) - Week 36: Sales (255) > MSS (224.95)

What this means: The product is moving fast. - MSS is well-justified. - Reordering logic is working — it’s keeping up with demand. - No risking stockouts — maybe even underestimating demand slightly.

BUT HERES WHEN THERE IS A PROBLEM…

Weeks 42–53 (Sharp Sales Decline)

Sales drop significantly below MSS. Examples: - Week 42: Sales ~150 vs MSS ~288 - Week 53: Sales 76 vs MSS 244.86

What this means: - The algorithm is still using high previous sales (like from PD1 or the Combined Average) to calculate MSS. - However, recent sales have sharply declined. - The store is likely overstocked

The demand dropped but MSS and reorder quantities remained high. - The algorithm might not be reacting fast enough to recent drops — or PD1 was just so high that it’s still driving the numbers.

WHY THIS HAPPENED

The algorithm prioritizes past trends — especially PD1 (recent 5-week period) — but only switches to a combined average if sales variability is high.

In this case: - PD1 was likely very strong (weeks 31–35 or so) — so the MSS stayed high. - Sales crashed starting Week 41, but the algorithm didn’t adjust quickly because: - Standard deviation may not have triggered a switch to a lower average. - There is no “cool down” logic in the base algorithm — it doesn’t account for sudden market changes or seasonality

FINAL TAKEAWAY

This visualization is good because it shows me when and where the algorithm assumptions break down: - Early Weeks: Algorithm works well sales justify inventory levels. ️ - Later Weeks: Sales drop, but the algorithm doesn’t adjust fast enough — leading to excess inventory.

We may want to make MSS algorithm to adapt more quickly when recent sales drop significantly — perhaps by incorporating rolling averages, demand decay, or more dynamic STD thresholds.”

item_data <- High_Volume_Weekly_DS %>% filter(ItemID == "42838") # <-- WHERE ITEM ID I enter!

# Step 2: Get the reorder data (Weeks 16–53)
reorder_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# Step 3: Get the MSS data
mss_long <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Step 4: Get weekly sales from Week16 to Week53
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Step 5: Get the Reorder in Cases data
reorder_cases_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# -----------------------
# Where the magic happens
# -----------------------

# Step 6: Prepare combined data with all metrics
combined_plot_data_abs <- sales_long %>%
  left_join(reorder_long, by = "Reorder_Week") %>%
  left_join(mss_long, by = "Reorder_Week") %>%
  left_join(reorder_cases_long, by = "Reorder_Week")

# Step 7: Making the plotly object directly

plot_ly() %>%
  # Sales
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~Sales,
    type = "scatter", mode = "lines+markers",
    name = "Sales",
    line = list(color = "black"),
    marker = list(color = "black"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Sales:", Sales)
  ) %>%
  # Reorder_Qty (with Reorder_Cases in tooltip)
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~Reorder_Qty,
    type = "scatter", mode = "lines+markers",
    name = "Reorder Quantity",
    line = list(color = "blue"),
    marker = list(color = "blue"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Reorder Qty:", Reorder_Qty,
                  "<br>Reorder Cases:", Reorder_Cases)
  ) %>%
  # MSS
  add_trace(
    data = combined_plot_data_abs,
    x = ~Reorder_Week, y = ~MSS,
    type = "scatter", mode = "lines+markers",
    name = "MSS",
    line = list(color = "red"),
    marker = list(color = "red"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>MSS:", MSS)
  ) %>%
  layout(
  title = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)<br><sub>Item: DISARONNO AMARETTO - 750ML (ItemID 42838)</sub>",
  xaxis = list(
    title = "Week Number",
    tickmode = "linear",     # Linear spacing
    tick0 = 16,              # Starting at week 16
    dtick = 2                # Show every week (adjust to 2 or 5 if too crowded)
  ),
  yaxis = list(
    title = "Value"         # Changing this based on data scale
  ),
  hovermode = "closest"
)

   # tickmode = "linear", # Changing this based on data scale
   # tick0 = 0,           # Add the thing to the elft if needed for clearlification on y axis
   # dtick = 50      

# Get info of itemID 42838 from high volume data set
High_Volume_Weekly_DS %>% filter(ItemID == "42838") %>% select(everything())

##   ItemID                Description Bottles_Per_Case Cost_Amount_Per_Bottle
## 1  42838 DISARONNO AMARETTO - 750ML               12                  28.99
##   Total_Cost Week1 Week2 Week3 Week4 Week5 Week6 Week7 Week8 Week9 Week10
## 1     347.88     5    10    10    12     5     9    11     9    11     12
##   Week11 Week12 Week13 Week14 Week15 Week16 Week17 Week18 Week19 Week20 Week21
## 1      7      8      4      6      3      4      9      4      3     12      8
##   Week22 Week23 Week24 Week25 Week26 Week27 Week28 Week29 Week30 Week31 Week32
## 1     10     10      6      6      9      7      3      6      4      4      9
##   Week33 Week34 Week35 Week36 Week37 Week38 Week39 Week40 Week41 Week42 Week43
## 1      3      5      4      3      6      7      6      2      6      8     10
##   Week44 Week45 Week46 Week47 Week48 Week49 Week50 Week51 Week52 Week53
## 1      4     11      8     10     14     16     14     20     27      6
##   Grand_Total Category Reorder_Weeks_1_15 Reorder_Weeks_2_16 Reorder_Weeks_3_17
## 1         467    Other                 24              26.29              26.86
##   Reorder_Weeks_4_18 Reorder_Weeks_5_19 Reorder_Weeks_6_20 Reorder_Weeks_7_21
## 1              26.29              25.71              29.71              28.57
##   Reorder_Weeks_8_22 Reorder_Weeks_9_23 Reorder_Weeks_10_24 Reorder_Weeks_11_25
## 1              26.86                 24               21.14                  16
##   Reorder_Weeks_12_26 Reorder_Weeks_13_27 Reorder_Weeks_14_28
## 1               14.29               14.86               14.86
##   Reorder_Weeks_15_29 Reorder_Weeks_16_30 Reorder_Weeks_17_31
## 1               13.14               18.29               20.57
##   Reorder_Weeks_18_32 Reorder_Weeks_19_33 Reorder_Weeks_20_34
## 1               21.14               24.57               26.29
##   Reorder_Weeks_21_35 Reorder_Weeks_22_36 Reorder_Weeks_23_37
## 1               22.86               23.43               21.71
##   Reorder_Weeks_24_38 Reorder_Weeks_25_39 Reorder_Weeks_26_40
## 1               17.71               17.71               16.57
##   Reorder_Weeks_27_41 Reorder_Weeks_28_42 Reorder_Weeks_29_43
## 1               13.71               14.86               14.86
##   Reorder_Weeks_30_44 Reorder_Weeks_31_45 Reorder_Weeks_32_46
## 1               14.29               14.29               13.71
##   Reorder_Weeks_33_47 Reorder_Weeks_34_48 Reorder_Weeks_35_49
## 1                  12               14.29               14.86
##   Reorder_Weeks_36_50 Reorder_Weeks_37_51 Reorder_Weeks_38_52
## 1               23.81               27.05               31.05
##   Reorder_Weeks_39_53 MSS_Weeks_1_15 MSS_Weeks_2_16 MSS_Weeks_3_17
## 1               30.86             12          13.14          13.43
##   MSS_Weeks_4_18 MSS_Weeks_5_19 MSS_Weeks_6_20 MSS_Weeks_7_21 MSS_Weeks_8_22
## 1          13.14          12.86          14.86          14.29          13.43
##   MSS_Weeks_9_23 MSS_Weeks_10_24 MSS_Weeks_11_25 MSS_Weeks_12_26
## 1             12           10.57               8            7.14
##   MSS_Weeks_13_27 MSS_Weeks_14_28 MSS_Weeks_15_29 MSS_Weeks_16_30
## 1            7.43            7.43            6.57            9.14
##   MSS_Weeks_17_31 MSS_Weeks_18_32 MSS_Weeks_19_33 MSS_Weeks_20_34
## 1           10.29           10.57           12.29           13.14
##   MSS_Weeks_21_35 MSS_Weeks_22_36 MSS_Weeks_23_37 MSS_Weeks_24_38
## 1           11.43           11.71           10.86            8.86
##   MSS_Weeks_25_39 MSS_Weeks_26_40 MSS_Weeks_27_41 MSS_Weeks_28_42
## 1            8.86            8.29            6.86            7.43
##   MSS_Weeks_29_43 MSS_Weeks_30_44 MSS_Weeks_31_45 MSS_Weeks_32_46
## 1            7.43            7.14            7.14            6.86
##   MSS_Weeks_33_47 MSS_Weeks_34_48 MSS_Weeks_35_49 MSS_Weeks_36_50
## 1               6            7.14            7.43            11.9
##   MSS_Weeks_37_51 MSS_Weeks_38_52 MSS_Weeks_39_53 Reorder_Cases_Weeks_1_15
## 1           13.52           15.52           15.43                        2
##   Reorder_Cases_Weeks_2_16 Reorder_Cases_Weeks_3_17 Reorder_Cases_Weeks_4_18
## 1                        3                        3                        3
##   Reorder_Cases_Weeks_5_19 Reorder_Cases_Weeks_6_20 Reorder_Cases_Weeks_7_21
## 1                        3                        3                        3
##   Reorder_Cases_Weeks_8_22 Reorder_Cases_Weeks_9_23 Reorder_Cases_Weeks_10_24
## 1                        3                        2                         2
##   Reorder_Cases_Weeks_11_25 Reorder_Cases_Weeks_12_26 Reorder_Cases_Weeks_13_27
## 1                         2                         2                         2
##   Reorder_Cases_Weeks_14_28 Reorder_Cases_Weeks_15_29 Reorder_Cases_Weeks_16_30
## 1                         2                         2                         2
##   Reorder_Cases_Weeks_17_31 Reorder_Cases_Weeks_18_32 Reorder_Cases_Weeks_19_33
## 1                         2                         2                         3
##   Reorder_Cases_Weeks_20_34 Reorder_Cases_Weeks_21_35 Reorder_Cases_Weeks_22_36
## 1                         3                         2                         2
##   Reorder_Cases_Weeks_23_37 Reorder_Cases_Weeks_24_38 Reorder_Cases_Weeks_25_39
## 1                         2                         2                         2
##   Reorder_Cases_Weeks_26_40 Reorder_Cases_Weeks_27_41 Reorder_Cases_Weeks_28_42
## 1                         2                         2                         2
##   Reorder_Cases_Weeks_29_43 Reorder_Cases_Weeks_30_44 Reorder_Cases_Weeks_31_45
## 1                         2                         2                         2
##   Reorder_Cases_Weeks_32_46 Reorder_Cases_Weeks_33_47 Reorder_Cases_Weeks_34_48
## 1                         2                         1                         2
##   Reorder_Cases_Weeks_35_49 Reorder_Cases_Weeks_36_50 Reorder_Cases_Weeks_37_51
## 1                         2                         2                         3
##   Reorder_Cases_Weeks_38_52 Reorder_Cases_Weeks_39_53
## 1                         3                         3

WHAT’S HAPPENING WITH DISARONNO AMARETTO - 750ML?

Sales are up and down, not totally stable. Sales start low (Week 16: 4 bottles = ~1 case), then:

Spike randomly (e.g., Weeks 20, 21, 27) Dip sharply (Weeks 32–38: sales are very low) Climb strongly from Week 45 to 52 (up to 27 bottles in Week 52 — more than 2 full cases)

HOW TO INTERPRET THE BEHAVIOR: Weeks 16–21 - Sales are sometimes below the MSS (red line), meaning inventory probably remained stable. The algorithm doesn’t change MSS much here — it’s around 12–15, assuming recent sales stay modest. Interpretation: Demand is low to medium. No urgent changes needed yet.

Weeks 32–38: Drop in Sales - Sales stay well below MSS (sales as low as 2–4 bottles while MSS is still ~7–9). This is an example where the algorithm is slow to respond.

Result: holding more inventory than needed. The algorithm uses older sales in its averages (like 5-week blocks), so it takes a while to recognize a drop in demand.

POSSIBLE SOLUTIONS: This is a good time to suggest weighted averages or demand decay to speed up reaction.

Also: Weeks 45–52: Sales Explode Weekly sales go above the red line almost every week. MSS is too low, and even the reorder quantity (blue line) gets touched or exceeded. Week 52: Sales = 27 bottles (over 2 cases). MSS = ~15.4. Reorder Quantity = ~30.8

The store is likely running close to stockouts.

HAT THIS ALL MEANS: DISARONNO sales start slow, then fluctuate. Around mid-year, sales dip hard, but the algorithm doesn’t react fast enough — we keep too much stock. Later in the year, demand shoots up fast. The algorithm starts raising the reorder amounts and MSS, but it’s still a bit slow, so sales go over those thresholds. This means we risk running out. The algorithm works okay, but it reacts slowly to change — it needs better sensitivity to recent trends.

Next step

ROBLEM RECAP: - Sales drop fast (weeks 42–53) | MSS and reorder quantities stay high. - Sales spike in certain weeks (weeks 42 - 52) | System doesn’t respond fast enough.

GOAL: Making algorithm adapt quickly to changing sales trends! MSS and Sales closely align, but - MSS should be slightly above Sales (safety buffer). - MSS should not lag behind if Sales are increasing quickly. - MSS should drop fast when Sales go down (to prevent overstocking).

FIRST IDEA: Weight Averages! Giving MORE IMPORTANCE to Recent Trends My current algorithm treats each 5-week period equally. That’s simple and fair, but not responsive to recent demand. A weighted average solves this. It gives more importance to recent trends, which is key for products like DISARONNO AMARETTO - 750ML, where demand changed significantly from week 45 onward.

SECOND IDEA: 10-week, 15-week, 20-week Windows! This is about responsiveness vs stability: (All depends on the product variability of sales and patterns!)

How to Choose: Volatile product? Use shorter window (10 weeks). Stable product? Use longer window (20 weeks).

I will have to figure out how I will get volatily with my function, as I go along. I will first focus on the first idea.

Functions

WEIGHTED AVERAGES

I will create a function below to calculate the weighted average for the last 5 weeks, 10 weeks, and 15 weeks. I will then use this function to calculate the reorder quantities and MSS.

calculate_reorder_sliding_weighted <- function(row, start_week) {
  
  week_nums <- start_week:(start_week + 14)
  
  period1 <- as.numeric(row[paste0("Week", week_nums[1:5])])
  period2 <- as.numeric(row[paste0("Week", week_nums[6:10])])
  period3 <- as.numeric(row[paste0("Week", week_nums[11:15])])
  
  total_sales <- sum(period1) + sum(period2) + sum(period3)
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) return(0)

  # Period averages
  avg1 <- mean(period1)
  avg2 <- mean(period2)
  avg3 <- mean(period3)
  
  # Combined average with weights (Importance to get weighted average!) 
  combined_avg <- (0.2 * avg1) + (0.3 * avg2) + (0.5 * avg3) 
  stdev_val <- abs(avg1 - combined_avg)
  
  chosen_avg <- if (stdev_val > 3) combined_avg else avg1
  daily_avg <- chosen_avg / 7

  reorder_threshold_days <- if (row["Category"] == "Beer") 14 else 10
  lead_time_days <- 10

  MSS <- daily_avg * reorder_threshold_days
  reorder_qty <- (daily_avg * lead_time_days) + MSS

  return(round(reorder_qty, 2))
}

Function to calculate MSS

This mirrors my original calculate_mss_sliding() but uses the weighted averages like the new reorder function I made:

calculate_mss_sliding_weighted <- function(row, start_week) {
  
  week_nums <- start_week:(start_week + 14)
  
  period1 <- as.numeric(row[paste0("Week", week_nums[1:5])])
  period2 <- as.numeric(row[paste0("Week", week_nums[6:10])])
  period3 <- as.numeric(row[paste0("Week", week_nums[11:15])])
  
  total_sales <- sum(period1) + sum(period2) + sum(period3)
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) return(0)
  
  avg1 <- mean(period1)
  avg2 <- mean(period2)
  avg3 <- mean(period3)
  
  combined_avg <- (0.2 * avg1) + (0.3 * avg2) + (0.5 * avg3)
  stdev_val <- abs(avg1 - combined_avg)
  
  chosen_avg <- if (stdev_val > 3) combined_avg else avg1
  daily_avg <- chosen_avg / 7
  
  reorder_threshold_days <- if (row["Category"] == "Beer") 14 else 10
  MSS <- daily_avg * reorder_threshold_days
  
  return(round(MSS, 2))
}

Function to calculate reorder cases for WEIGHTED reorder columns

convert_weighted_reorder_to_cases <- function(dataset) {
  for (start_week in 1:39) {
    reorder_col <- paste0("Reorder_Weighted_Weeks_", start_week, "_", start_week + 14)
    case_col <- paste0("Reorder_Cases_Weighted_Weeks_", start_week, "_", start_week + 14)
    
    # Ensure the reorder column exists before calculation
    if (reorder_col %in% names(dataset)) {
      dataset[[case_col]] <- ceiling(dataset[[reorder_col]] / as.numeric(dataset$Bottles_Per_Case))
    }
  }
  return(dataset)
}

WILL USE THE SAME LOGIC AS THE ORIGINAL MSS FUNCTION, BUT WITH WEIGHTED AVERAGES.

Applying Functions

Here I will loop through weeks 1 to 39 again, but this time using the new function to calculate the reorder quantities and MSS.

Applying weighted reorder logic to copied datasets

for (start_week in 1:39) {  
  reorder_col_name <- paste0("Reorder_Weighted_Weeks_", start_week, "_", start_week + 14)
  
  High_Volume_Weekly_DS_weighted_averages[[reorder_col_name]] <- apply(High_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_reorder_sliding_weighted(row, start_week)
  })
  
  Medium_Volume_Weekly_DS_weighted_averages[[reorder_col_name]] <- apply(Medium_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_reorder_sliding_weighted(row, start_week)
  })
  
  Low_Volume_Weekly_DS_weighted_averages[[reorder_col_name]] <- apply(Low_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_reorder_sliding_weighted(row, start_week)
  })
}

Applying weighted MSS logic to copied datasets

for (start_week in 1:39) {  
  mss_col_name <- paste0("MSS_Weighted_Weeks_", start_week, "_", start_week + 14)
  
  High_Volume_Weekly_DS_weighted_averages[[mss_col_name]] <- apply(High_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_mss_sliding_weighted(row, start_week)
  })
  
  Medium_Volume_Weekly_DS_weighted_averages[[mss_col_name]] <- apply(Medium_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_mss_sliding_weighted(row, start_week)
  })
  
  Low_Volume_Weekly_DS_weighted_averages[[mss_col_name]] <- apply(Low_Volume_Weekly_DS_weighted_averages, 1, function(row) {
    calculate_mss_sliding_weighted(row, start_week)
  })
}

Applying the conversion to cases

High_Volume_Weekly_DS_weighted_averages <- convert_weighted_reorder_to_cases(High_Volume_Weekly_DS_weighted_averages)
Medium_Volume_Weekly_DS_weighted_averages <- convert_weighted_reorder_to_cases(Medium_Volume_Weekly_DS_weighted_averages)
Low_Volume_Weekly_DS_weighted_averages <- convert_weighted_reorder_to_cases(Low_Volume_Weekly_DS_weighted_averages)

Visualizing the new weighted algorithm

item_data <- High_Volume_Weekly_DS_weighted_averages %>% filter(ItemID == "18467")  # Adjust as needed

# Reorder Quantity (Weighted)
reorder_long_weighted <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weighted_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weighted_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# MSS (Weighted)
mss_long_weighted <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weighted_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weighted_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Sales
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Reorder in Cases (Weighted)
reorder_cases_long_weighted <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weighted_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weighted_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# Combine for plotting
combined_plot_data_weighted <- sales_long %>%
  left_join(reorder_long_weighted, by = "Reorder_Week") %>%
  left_join(mss_long_weighted, by = "Reorder_Week") %>%
  left_join(reorder_cases_long_weighted, by = "Reorder_Week")

# Create Plot
plot_ly() %>%
  # Sales
  add_trace(
    data = combined_plot_data_weighted,
    x = ~Reorder_Week, y = ~Sales,
    type = "scatter", mode = "lines+markers",
    name = "Sales", line = list(color = "black"),
    marker = list(color = "black"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week, "<br>Sales:", Sales)
  ) %>%
  # Reorder Qty
  add_trace(
    data = combined_plot_data_weighted,
    x = ~Reorder_Week, y = ~Reorder_Qty,
    type = "scatter", mode = "lines+markers",
    name = "Reorder Quantity (W)",
    line = list(color = "blue"),
    marker = list(color = "blue"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Reorder Qty:", Reorder_Qty,
                  "<br>Reorder Cases:", Reorder_Cases)
  ) %>%
  # MSS
  add_trace(
    data = combined_plot_data_weighted,
    x = ~Reorder_Week, y = ~MSS,
    type = "scatter", mode = "lines+markers",
    name = "MSS (W)",
    line = list(color = "red"),
    marker = list(color = "red"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week, "<br>MSS:", MSS)
  ) %>%
  layout(
    title = "Weighted Reorder & MSS vs Sales (Weeks 16–53)<br><sub>Item: DISARONNO AMARETTO - 750ML (ItemID 42838)</sub>",
    xaxis = list(title = "Week Number", tickmode = "linear", tick0 = 16, dtick = 2),
    yaxis = list(title = "Value"),
    hovermode = "closest"
  )

I see results… okay results thus far.

NOW…

I will apply my OWN LOGIC to the MSS and Reorder Quantity calculations.

MY OFFICAL ALGOIRHTM This will be a custom algorithm that I made based on logic and possible solutions for the project.

calculate_reorder_my_way <- function(row, start_week) {
  # Define full 15-week window
  week_nums <- start_week:(start_week + 14)
  week_labels <- paste0("Week", week_nums)

  # Pull weekly sales
  sales <- as.numeric(row[week_labels])

  # Default periods (5-5-5)
  p1 <- sales[1:5]
  p2 <- sales[6:10]
  p3 <- sales[11:15]

  # Compute averages
  avg1 <- mean(p1)
  avg2 <- mean(p2)
  avg3 <- mean(p3)

  combined_avg <- mean(c(avg1, avg2, avg3))
  stdev <- sd(c(avg1, avg2, avg3))
  cv <- if (combined_avg > 0) stdev / combined_avg else 0

  # Detect instability: high CV or trend reversal
  unstable <- (cv > 0.25) || ((avg1 < avg2 & avg2 > avg3) | (avg1 > avg2 & avg2 < avg3))

  # Re-define periods if unstable (5-4-3 instead of 5-5-5)
  if (unstable) {
    p1 <- sales[1:5]
    p2 <- sales[6:9]
    p3 <- sales[10:12]

    avg1 <- mean(p1)
    avg2 <- mean(p2)
    avg3 <- mean(p3)

    combined_avg <- mean(c(avg1, avg2, avg3))
  }

  # Weighted average (more weight on recent)
  weighted_avg <- (avg1 * 0.2) + (avg2 * 0.3) + (avg3 * 0.5)

  # If total sales < 1 case, don't reorder
  total_sales <- sum(p1, p2, p3)
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) {
    return(0)
  }

  # Choose base avg: fallback to combined if instability is extreme
  chosen_avg <- if (unstable) weighted_avg else avg1
  daily_avg <- chosen_avg / 7

  # Reorder threshold (days) and lead time (days)
  reorder_days <- if (row["Category"] == "Beer") 14 else 10
  lead_time <- 10

  # Minimum Shelf Stock and Reorder Quantity (in bottles)
  MSS <- daily_avg * reorder_days
  reorder_qty_bottles <- MSS + (daily_avg * lead_time)

  return(round(reorder_qty_bottles, 2))
}

Function to calculate MSS

calculate_mss_my_way <- function(row, start_week) {
  # Define full 15-week window
  week_nums <- start_week:(start_week + 14)
  week_labels <- paste0("Week", week_nums)

  # Pull weekly sales
  sales <- as.numeric(row[week_labels])

  # Default periods (5-5-5)
  p1 <- sales[1:5]
  p2 <- sales[6:10]
  p3 <- sales[11:15]

  # Compute averages
  avg1 <- mean(p1)
  avg2 <- mean(p2)
  avg3 <- mean(p3)

  combined_avg <- mean(c(avg1, avg2, avg3))
  stdev <- sd(c(avg1, avg2, avg3))
  cv <- if (combined_avg > 0) stdev / combined_avg else 0

  # Detect instability
  unstable <- (cv > 0.25) || ((avg1 < avg2 & avg2 > avg3) | (avg1 > avg2 & avg2 < avg3))

  # Re-define periods if unstable (5-4-3)
  if (unstable) {
    p1 <- sales[1:5]
    p2 <- sales[6:9]
    p3 <- sales[10:12]

    avg1 <- mean(p1)
    avg2 <- mean(p2)
    avg3 <- mean(p3)
  }

  # Weighted average if unstable, otherwise use avg1
  chosen_avg <- if (unstable) (avg1 * 0.2 + avg2 * 0.3 + avg3 * 0.5) else avg1
  daily_avg <- chosen_avg / 7

  total_sales <- sum(p1, p2, p3)
  if (total_sales < as.numeric(row["Bottles_Per_Case"])) {
    return(0)  # No MSS if total sales < 1 case
  }

  reorder_days <- if (row["Category"] == "Beer") 14 else 10
  MSS <- daily_avg * reorder_days

  return(round(MSS, 2))
}

Function to convert reorder to cases

convert_reorder_to_cases <- function(dataset) {
  for (start_week in 1:39) {
    reorder_col <- paste0("Reorder_Weeks_", start_week, "_", start_week + 14)
    case_col <- paste0("Reorder_Cases_Weeks_", start_week, "_", start_week + 14)
    
    dataset[[case_col]] <- ceiling(dataset[[reorder_col]] / as.numeric(dataset$Bottles_Per_Case))
  }
  return(dataset)
}

# Apply my reorder function across sliding windows
for (start_week in 1:39) {
  reorder_col_name <- paste0("Reorder_Weeks_", start_week, "_", start_week + 14)

  High_Volume_Weekly_DS_copy[[reorder_col_name]] <- apply(High_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_reorder_my_way(row, start_week)
  })

  Medium_Volume_Weekly_DS_copy[[reorder_col_name]] <- apply(Medium_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_reorder_my_way(row, start_week)
  })

  Low_Volume_Weekly_DS_copy[[reorder_col_name]] <- apply(Low_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_reorder_my_way(row, start_week)
  })
}

# Apply my MSS function across sliding windows
for (start_week in 1:39) {
  mss_col_name <- paste0("MSS_Weeks_", start_week, "_", start_week + 14)

  High_Volume_Weekly_DS_copy[[mss_col_name]] <- apply(High_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_mss_my_way(row, start_week)
  })

  Medium_Volume_Weekly_DS_copy[[mss_col_name]] <- apply(Medium_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_mss_my_way(row, start_week)
  })

  Low_Volume_Weekly_DS_copy[[mss_col_name]] <- apply(Low_Volume_Weekly_DS_copy, 1, function(row) {
    calculate_mss_my_way(row, start_week)
  })
}

# Convert reorder bottles to cases using dynamic outputs
High_Volume_Weekly_DS_copy <- convert_reorder_to_cases(High_Volume_Weekly_DS_copy)
Medium_Volume_Weekly_DS_copy <- convert_reorder_to_cases(Medium_Volume_Weekly_DS_copy)
Low_Volume_Weekly_DS_copy <- convert_reorder_to_cases(Low_Volume_Weekly_DS_copy)

# Replace this with My dataset and target ItemID
item_data <- High_Volume_Weekly_DS_copy %>% filter(ItemID == "42838")

# Step 2: Get the reorder quantity (Weeks 16–53)
reorder_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# Step 3: Get the MSS data
mss_long <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Step 4: Get weekly sales from Week16 to Week53
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Step 5: Get the Reorder in Cases data
reorder_cases_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# Step 6: Combine all data
combined_plot_data_mine <- sales_long %>%
  left_join(reorder_long, by = "Reorder_Week") %>%
  left_join(mss_long, by = "Reorder_Week") %>%
  left_join(reorder_cases_long, by = "Reorder_Week")

# Step 7: Plot
plot_ly() %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~Sales,
    type = "scatter", mode = "lines+markers",
    name = "Sales",
    line = list(color = "black"),
    marker = list(color = "black"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Sales:", Sales)
  ) %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~Reorder_Qty,
    type = "scatter", mode = "lines+markers",
    name = "Reorder Quantity",
    line = list(color = "blue"),
    marker = list(color = "blue"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Reorder Qty:", Reorder_Qty,
                  "<br>Reorder Cases:", Reorder_Cases)
  ) %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~MSS,
    type = "scatter", mode = "lines+markers",
    name = "MSS",
    line = list(color = "red"),
    marker = list(color = "red"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>MSS:", MSS)
  ) %>%
  layout(
    title = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)<br><sub>Item: DISARONNO AMARETTO - 750MLL (ItemID 42838)</sub>",
    xaxis = list(
      title = "Week Number",
      tickmode = "linear",
      tick0 = 16,
      dtick = 2
    ),
    yaxis = list(title = "Value"),
    hovermode = "closest"
  )

# Replace this with My dataset and target ItemID
item_data <- High_Volume_Weekly_DS_copy %>% filter(ItemID == "18467")

# Step 2: Get the reorder quantity (Weeks 16–53)
reorder_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Qty"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Qty)

# Step 3: Get the MSS data
mss_long <- item_data %>%
  pivot_longer(
    cols = starts_with("MSS_Weeks_"),
    names_to = "Window",
    values_to = "MSS"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=MSS_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, MSS)

# Step 4: Get weekly sales from Week16 to Week53
sales_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Week"),
    names_to = "Week",
    values_to = "Sales"
  ) %>%
  mutate(Week_Num = as.numeric(str_remove(Week, "Week"))) %>%
  filter(Week_Num >= 16, Week_Num <= 53) %>%
  select(Week_Num, Sales) %>%
  rename(Reorder_Week = Week_Num)

# Step 5: Get the Reorder in Cases data
reorder_cases_long <- item_data %>%
  pivot_longer(
    cols = starts_with("Reorder_Cases_Weeks_"),
    names_to = "Window",
    values_to = "Reorder_Cases"
  ) %>%
  mutate(
    Start_Week = as.numeric(str_extract(Window, "(?<=Reorder_Cases_Weeks_)\\d+")),
    Reorder_Week = Start_Week + 15
  ) %>%
  select(Reorder_Week, Reorder_Cases)

# Step 6: Combine all data
combined_plot_data_mine <- sales_long %>%
  left_join(reorder_long, by = "Reorder_Week") %>%
  left_join(mss_long, by = "Reorder_Week") %>%
  left_join(reorder_cases_long, by = "Reorder_Week")

# Step 7: Plot
plot_ly() %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~Sales,
    type = "scatter", mode = "lines+markers",
    name = "Sales",
    line = list(color = "black"),
    marker = list(color = "black"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Sales:", Sales)
  ) %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~Reorder_Qty,
    type = "scatter", mode = "lines+markers",
    name = "Reorder Quantity",
    line = list(color = "blue"),
    marker = list(color = "blue"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>Reorder Qty:", Reorder_Qty,
                  "<br>Reorder Cases:", Reorder_Cases)
  ) %>%
  add_trace(
    data = combined_plot_data_mine,
    x = ~Reorder_Week, y = ~MSS,
    type = "scatter", mode = "lines+markers",
    name = "MSS",
    line = list(color = "red"),
    marker = list(color = "red"),
    hoverinfo = "text",
    text = ~paste("Week:", Reorder_Week,
                  "<br>MSS:", MSS)
  ) %>%
  layout(
    title = "Sales vs Reorder Quantity vs MSS (Weeks 16–53)<br><sub>Item: SCOTTY'S VODKA 50ML (ItemID 18467)</sub>",
    xaxis = list(
      title = "Week Number",
      tickmode = "linear",
      tick0 = 16,
      dtick = 2
    ),
    yaxis = list(title = "Value"),
    hovermode = "closest"
  )

---

Comparing Algorithms

Okay! So now that I have this, I want to statistically compare both algorithms.

Comparing reorder quantity to actual sales, this could be a better statistical strategy to compare how well the Minimum Shelf Stock (MSS) and Reorder Quantity work relative to sales patterns — particularly in preventing:

Stockouts (sales MSS -> risk of not having enough on shelf) Overstocking (MSS or reorder is way higher than needed for normal fluctuations)

Stockouts

How often does sales exceed MSS? (risk of stockout)

#MINE
stockout_risk_your <- sum(combined_plot_data_mine$Sales > combined_plot_data_mine$MSS) / nrow(combined_plot_data_mine)
cat("Stockout Risk - My Algorithm:", round(stockout_risk_your * 100, 2), "%\n")

## Stockout Risk - My Algorithm: 21.05 %

#ABS
stockout_risk_abs <- sum(combined_plot_data_abs$Sales > combined_plot_data_abs$MSS) / nrow(combined_plot_data_abs)
cat("Stockout Risk - ABS Algorithm:", round(stockout_risk_abs * 100, 2), "%\n")

## Stockout Risk - ABS Algorithm: 28.95 %

#WEIGHTED DATA (This may be use for my presentation)
stockout_risk_weighted <- sum(combined_plot_data_weighted$Sales > combined_plot_data_weighted$MSS) / nrow(combined_plot_data_weighted)
cat("Stockout Risk - Weighted Algorithm:", round(stockout_risk_weighted * 100, 2), "%\n")

## Stockout Risk - Weighted Algorithm: 10.53 %

# Binary 1 = stockout risk, 0 = safe
risk_flag_your <- as.integer(combined_plot_data_mine$Sales > combined_plot_data_mine$MSS)
risk_flag_abs <- as.integer(combined_plot_data_abs$Sales > combined_plot_data_abs$MSS)
risk_flag_weighted <- as.integer(combined_plot_data_weighted$Sales > combined_plot_data_weighted$MSS)

# McNemar's test for paired binary outcomes
mcnemar.test(table(risk_flag_abs, risk_flag_your))

## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  table(risk_flag_abs, risk_flag_your)
## McNemar's chi-squared = 0.21053, df = 1, p-value = 0.6464

mcnemar.test(table(risk_flag_weighted, risk_flag_abs))

## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  table(risk_flag_weighted, risk_flag_abs)
## McNemar's chi-squared = 2.4, df = 1, p-value = 0.1213

mcnemar.test(table(risk_flag_weighted, risk_flag_your))

## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  table(risk_flag_weighted, risk_flag_your)
## McNemar's chi-squared = 2.25, df = 1, p-value = 0.1336

FOR NOTE:

What I tested:

I used McNemar’s test, which can help compare two algorithms when their results are binary (1 = stockout risk, 0 = safe) on the same cases (same weeks).

Does my algorithm and the ABS algorithm disagree in a meaningful, non-random way about stockout risks?

McNemar’s Test Results

1. Scotty’s Vodka – 50mL
   • Chi-squared = 0.8
   • p-value = 0.3711
2. Disaronno Amaretto – 750mL
   • Chi-squared = 1.33
   • p-value = 0.2482

What That Means:

P-values > 0.05 mean: - There is no statistically significant difference in how the two algorithms label stockout risk. - Your algorithm and ABS agree most of the time on whether a stockout is likely or not. - Any differences you’re seeing are likely due to random chance, not systematic differences.

In context: - For both Scotty’s and Disaronno, the custom algorithm’s stockout predictions don’t differ much from ABS’s. - That’s not actually a bad thing tho — it could mean my algorithm does a good job mimicking OR improving the method while keeping risk patterns a bit similar.

NOW I NEED TO LOOK AT… - where they disagree. Even if overall they match, maybe there are specific weeks or sales spikes where your algorithm is better at flagging risk. - excess stock metric - Fit quality breakdown (“Too Low” / “Too High” / “Good Fit”) - Volatility comparison

Overstock Metric: Average Excess Inventory

This tells me if the algorithm is overstocking relative to sales — (how much higher MSS is than actual sales each week.)

#MINE
excess_stock_your <- mean(pmax(combined_plot_data_mine$MSS - combined_plot_data_mine$Sales, 0))
cat("Avg Excess Stock - My Algorithm:", round(excess_stock_your, 2), "\n")

## Avg Excess Stock - My Algorithm: 55.62

#ABS
excess_stock_abs <- mean(pmax(combined_plot_data_abs$MSS - combined_plot_data_abs$Sales, 0))
cat("Avg Excess Stock - ABS Algorithm:", round(excess_stock_abs, 2), "\n")

## Avg Excess Stock - ABS Algorithm: 3.68

#WEIGHTED DATA (This may be use for my presentation)
excess_stock_weighted <- mean(pmax(combined_plot_data_weighted$MSS - combined_plot_data_weighted$Sales, 0))
cat("Avg Excess Stock - Weighted Algorithm:", round(excess_stock_weighted, 2), "\n")

## Avg Excess Stock - Weighted Algorithm: 63.08

Reorder Quantity Volatility

This measures how much reorder quantities bounce around week to week. Lower is more stable and predictable (which store managers like).

#MINE
reorder_volatility_your <- sd(combined_plot_data_mine$Reorder_Qty, na.rm = TRUE)
cat("Reorder Qty Volatility - My Algorithm:", round(reorder_volatility_your, 2), "\n")

## Reorder Qty Volatility - My Algorithm: 120.94

#ABS
reorder_volatility_abs <- sd(combined_plot_data_abs$Reorder_Qty, na.rm = TRUE)
cat("Reorder Qty Volatility - ABS Algorithm:", round(reorder_volatility_abs, 2), "\n")

## Reorder Qty Volatility - ABS Algorithm: 5.62

reorder_volatility_weighted <- sd(combined_plot_data_weighted$Reorder_Qty, na.rm = TRUE)
cat("Reorder Qty Volatility - Weighted Algorithm:", round(reorder_volatility_weighted, 2), "\n")

## Reorder Qty Volatility - Weighted Algorithm: 109.06

evaluate_fit <- function(sales, mss) {
  diff_ratio <- (sales - mss) / ifelse(mss == 0, 1, mss) # prevent division by zero. This calculates the percentage difference between Sales and MSS.

#   If sales are way higher than MSS -> risk stockouts -> “Too Low”
#   If MSS is way higher than sales -> wasting shelf space -> “Too High”
#   If MSS is pretty close to sales -> balancing well -> “Good Fit”

  
  case_when(
    diff_ratio > 0.10 ~ "Too Low", # Sales are >10% above MSS (bad! MSS is too low)
    diff_ratio < -0.10 ~ "Too High", # Sales are >10% below MSS (bad! MSS is too high)
    TRUE ~ "Good Fit" # MSS is close enough to sales (within + or - 10%)
  )
}

#Why Use 0.10 (10%) As the Cutoff?

#That 0.10 is a tolerance window. It means:
#   If MSS is within + or - 10% of actual sales -> it’s considered a “Good Fit”
#   More than +10% -> you’re probably overstocking
#   More than −10% -> you’re understocking (risking a stockout)

# 10% is just a reasonable default. You can change it if you want tighter or looser definition

# Apply to both datasets
combined_plot_data_mine$fit_category <- evaluate_fit(combined_plot_data_mine$Sales, combined_plot_data_mine$MSS)
combined_plot_data_abs$fit_category <- evaluate_fit(combined_plot_data_abs$Sales, combined_plot_data_abs$MSS)
combined_plot_data_weighted$fit_category <- evaluate_fit(combined_plot_data_weighted$Sales, combined_plot_data_weighted$MSS)

# Count proportions
table_mine <- prop.table(table(combined_plot_data_mine$fit_category))
table_abs <- prop.table(table(combined_plot_data_abs$fit_category))
table_weighted <- prop.table(table(combined_plot_data_weighted$fit_category))

cat("\nFit Breakdown - My Algorithm:"); print(round(table_mine * 100, 1))

## 
## Fit Breakdown - My Algorithm:

## 
## Good Fit Too High  Too Low 
##     18.4     63.2     18.4

cat("\nFit Breakdown - ABS Algorithm:"); print(round(table_abs * 100, 1))

## 
## Fit Breakdown - ABS Algorithm:

## 
## Good Fit Too High  Too Low 
##      5.3     65.8     28.9

cat("\nFit Breakdown - Weighted Algorithm:"); print(round(table_weighted * 100, 1))

## 
## Fit Breakdown - Weighted Algorithm:

## 
## Good Fit Too High  Too Low 
##     10.5     84.2      5.3

Metric	What It Tells You
Stockout Risk	If I am understocking
Avg Excess Stock	If I am overstocking
Reorder Volatility	If I am ordering is stable or noisy
Balance Score	How well MSS aligns with actual demand

---

Metrics recieved for Scottys Vodka (item 18467) and Disaronno Amaretto (item 42838)

Scottys Vodka:

Metric	My Algorithm	ABS Algorithm	I n terpretation
Stockout Risk	21.05%	13.16%	My algorithm is more prone to u n derstocking, which can lead to stockouts
Avg Excess Stock	55.62	60.45	I am slightly more efficient, with less excess inventory
Reorder Volatility	120.94	111.13	My reorder amounts are a bit more erratic than ABS’s
Balance Score	18.4% Good Fit	18.4% Good Fit	Tie — both hit the same % of weeks where MSS matched demand well
	18.4% Too Low	10.5% Too Low	ABS is less likely to understock (better safety margin)
	63.2% Too High	71.1% Too High	My model overstocks slightly less than ABS

What This Suggests:

Strengths (My algorithm) - hold less excess inventory, which is good for saving space and money. - slightly reduce overstocking compared to ABS. - achieve the same % of Good Fits as ABS.

Weaknesses of my Algorithm - Higher stockout risk (21% vs. 13%) is a major concern — especially for high-demand items. - More week-to-week variability in reorder quantity might frustrate managers or disrupt logistics. - More “Too Low” weeks than ABS — meaning you’re sometimes not covering demand spikes.

What McNemar’s Test Tells Us

The McNemar test (p = 0.37) shows that the difference in stockout risks between the algorithms isn’t statistically significant — at least not with my my data sample. But the practical impact of stockouts might still be important, depending on the product type.

---

Disaronno Amaretto:

Metric	My Algorithm	ABS Algorithm	Interpretation
Stockout Risk	36.84%	28.95%	My algorithm is more aggressive, leading to higher risk of stockouts.
Avg Excess Stock	2.77	3.68	I am holding less unnecessary inventory — more efficient shelf usage.
Reorder Volatility	3.65	5.62	My orders are more stable, easier for store staff to manage.
MSS Fit – Good Fit %	10.5%	5.3%	I have a slightly better balance, but both struggle to match MSS to sales closely.
MSS Too High %	60.5%	65.8%	I am overstocking slightly less than ABS.
MSS Too Low %	28.9%	28.9%	Equal understock risk — which aligns with the identical “Too Low” fit breakdown.

Interpretation & Takeaways

1. My algorithm reduces overstocking more effectively, as seen in both lower Excess Stock and fewer Too High MSS weeks.

2. However, the cost of that efficiency is higher stock out risk — my algorithm crosses the 35% mark, which is pretty high. It might be too aggressive in cutting safety stock for this product.

3. Stability is a win — My Reorder Volatility is much lower, which helps operational consistency.

4. Neither algorithm fits perfectly, but Mys edges out in the “Good Fit” category. That said, both still leave room for improvement in MSS tuning for this product.

Project Conclusion - This project explored two algorithms — the ABS baseline and my customized model — to optimize Minimum Shelf Stock (MSS) and Reorder Quantities for alcohol inventory across different store types. - I focused on balancing stock availability vs. inventory efficiency, using real 2024 sales data and evaluating weekly performance. - My algorithm aimed to reduce overstocking and excess inventory, and it succeeded in doing so across products like Scotty’s Vodka and Disaronno Amaretto. But it did at times have it’s points of over stocking, when we reach certain weeks as we discussed above. - However, this came at the cost of higher stockout risk, especially for fast-moving products — highlighting the tradeoff between aggressiveness and safety stock. - Key metrics like Excess Stock, Reorder Volatility, Fit Quality, and McNemar’s Test were used to compare both models fairly. - While neither algorithm is perfect, my version offers an efficient, customizable alternative that can be fine-tuned by product type or store profile, because it can definitely be considered when looking at over sold products as we seen with Disaronno Amaretto. - Next Steps could include testing hybrid thresholds, adding external factors like promotions, and automating MSS updates for real-time responsiveness.

In conclusion, this project tried to create an inventory algorithm that could improve ABS Stores’ reorder quantities and MSS, and the results showed potential in some areas while other areas could lack. Comparing the original ABS model with my approach, I highlighted some places with improvement to manage stockouts and stabilize reorder patterns on specific time periods of the weeks, but there are some differences in terms of its responsiveness with different products. I wish to have the next time use more sets of products that are similar in sale patterns and test to see how the algorithm would respond, but that would take extremely long to process all 500 products per each store. I also would suggest refining the performance of the algorithm with more instability measures to target adjustments on certain weeks to create a more adaptable system for ABS retail stores.