Lets start by bringing in the following:
Production orders over the last 3 years that have been routed through a moulding line
Africa’s historical production orders from legacy system
The moulding line each SKU is produced on and how frequency
Size categories of each moulding line
SKU mapping table to SAP from Africa’s legacy system
# Production orders from SAP which have been routed through moulding lines in our foundries
SAP_production_orders <- read_csv("01 Source Data/Foundry Production Orders.csv")
## Rows: 71377 Columns: 57
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (42): Company Code, Company Description, Goods Receipt Quantity (Unit),...
## dbl (10): Finish Date Original, Sales Document, Order Category, Sales Docum...
## date (5): Creation Date, Finish Date, Finish Date Actual, Delivery Date (Ac...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Historical Production orders from Africa's legacy system
africa_production_orders <- read_xlsx("01 Source Data/Africa Foundry Production Data.xlsx")
# TACs and weights
TAC_and_weights <- read_csv("01 Source Data/TAC and Weights.csv")
## Rows: 2660396 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Plant Code, Material Code
## dbl (2): Standard Unit Price - GBP (Converted from Company Currency), Net We...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Africa SKU mapping table to SAP SKU numbers
LN_to_SAP_SKU_mapping <- read_csv("01 Source Data/tbl_Material_Master_Mapping.csv")
## Rows: 51096 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): Key, Project, Item Code, SAP Material Number
## dbl (1): Company Code
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Product Classification Data
product_classification <- read_csv("01 Source Data/Product Classification.csv")
## Rows: 1296300 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): Material Code, Material Description, Cognos TM1 Cube Code - Class,...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Size categories of moulding lines
moulding_line_meta_data <- read_xlsx('01 Source Data/Foundry Workcenters.xlsx',sheet = 'Moulding Line Workcenters')
# Each moulding line every material is made on
wc_sku_made_on <- read_csv("01 Source Data/Workcenters Materials Made On.csv")
## Rows: 5297 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Work Center Code, Material Code
## dbl (2): no_of_orders, quantity
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
We also need to import the custom function that was developed to assist in classifying our SKU meta data. These functions help us classify AH, MC and HTP pump ranges based off of the intelligent part numbering system.
# Import Custom Functions to Classify AH, MC, and HTP SKUs
source("00 R Scripts/Product Classification Functions.R")
Now that we have imported everything we need. Lets start cleansing our data.
First lets start by incorporating the production history from Africa’s legacy system. To begin we must make sure that we merge SKUs to their SAP counterparts. We will join and replace the SKU mapping table to production data and replace the SKUs
ZA_MOs_w_SAP_SKUs <- africa_production_orders|>
# Join SAP part numbers to legacy system data
left_join(LN_to_SAP_SKU_mapping |>
distinct(`Item Code`,`SAP Material Number`),
by = 'Item Code')|>
# Create field that uses the SAP SKU and if blank use the legacy system SKU
mutate(`Material Code` = case_when(is.na(`SAP Material Number`) ~ `Item Code`,
TRUE ~ `SAP Material Number`)) |>
# Remove unnecessary fields
select(-`Item Code`,-`SAP Material Number`)
Now that we have replaced the SKU numbers lets make sure we remove orders that are not needed.
We have been told to remove orders where the moulding line is blank as they are rework orders. We also need to remove duplicates in the data. Duplicates are due to HBF routings. There is no way for them to identify the moulding line a part was produced on. They only have the ability to send us the moulding lines from the routings which when joined causes duplicates in our data. To remove these we will default these to the smallest moulding line each part is set up to be produced on.
ZA_MOs_wo_rework <- ZA_MOs_w_SAP_SKUs |>
# Level the size so we can filter to smallest possible moulding line
mutate(Size = Size |> as_factor()|> fct_relevel(c('Small','Medium','Large')))|>
# Filter out rework orders and duplicate orders
filter(!is.na(`Moulding Line`),
as.numeric(Size) == 1 |
is.na(as.numeric(Size))) |>
# Remove the remainder duplicates that are left
distinct()
Now we will select the columns that are needed so we can merge with our data from Africa. But first lets see what fields we have in our Africa data set.
ZA_MOs_wo_rework |>
glimpse()
## Rows: 49,633
## Columns: 10
## $ Order <chr> "508231", "508232", "122667", "122673", "508204", "508…
## $ `Plant Code` <chr> "ZA60", "ZA60", "ZA60", "ZA60", "ZA60", "ZA60", "ZA60"…
## $ Description <chr> "CAST THROATBUSH", "CAST THROATBUSH", NA, NA, "CAST TH…
## $ Qty <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ `Delivery Date` <dttm> 2024-02-06 00:00:00, 2024-02-06 00:00:00, 2024-02-02 …
## $ `Moulding Line` <chr> "MOULDING S1", "MOULDING S1", "MOULDING S1", "MOULDING…
## $ Size <fct> Small, Small, Small, Small, Small, Small, Small, Small…
## $ `Net Weight` <dbl> 411.0, 411.0, NA, NA, 411.0, NA, NA, 3.0, 3.0, 3.0, 3.…
## $ `Standard Cost` <dbl> 39772.3124, 39772.3124, 53922.1395, 53922.1395, 39772.…
## $ `Material Code` <chr> "GPP12083HNT1A05C", "GPP12083HNT1A05C", "G10032HSPRTSD…
To do a union we need to have all the same fields and they must be the same names. So lets make sure we select the following fields in this order for both data sets.
For the remainder the columns such as Moulding Line, Size and Net Weight. We will use these later to improve the accuracy of our SKU size meta data and our weight data. However, there is more processing that needs to be done to these fields. We will join these fields later after more processing has been completed on them.
SAP_MOs <- SAP_production_orders|>
select(Order,
`Plant Code`,
`Material Code`,
`Goods Receipt Quantity`,
`Actual Delivery Date`)
ZA_MOs <- ZA_MOs_wo_rework |>
select(Order,
`Plant Code`,
`Material Code`,
Qty,
`Delivery Date`)
Now we need to rename the fields that do not match.
ZA_MOs <- ZA_MOs |>
rename(`Goods Receipt Quantity` = Qty,
`Actual Delivery Date` = `Delivery Date`)
Now that both data sets have the same columns in the same order we can combine them.
foundry_production_orders <- SAP_MOs|>
union_all(ZA_MOs)
We need to now join meta data attributes and product heirarchy to the part numbers. We also need to add a field for business unit.
# Create table to add business unit
company_tbl <- SAP_production_orders|>
distinct(`Plant Code`,`Plant Description`,`Reporting Entity Description`)
foundry_production_orders <- foundry_production_orders|>
left_join(product_classification, by = 'Material Code')|>
left_join(company_tbl,by = 'Plant Code') |>
rename(Range = `SD_PRODUCT_RANGE - Range of Product Models Description`,
Model = `SD_PRODUCT_MODEL - Product Model Description`,
Size = `SD_PRODUCT_SIZE - Product Size Description`)|>
left_join(TAC_and_weights, by = c('Material Code','Plant Code'))
Next lets rename columns to more user friendly names that way we can understand what they mean and also combine Africa data with SAP data.
# Rename Meta Data attributes
SAP_production_orders <- SAP_production_orders |>
rename(Range = `SD_PRODUCT_RANGE - Range of Product Models Description`,
Model = `SD_PRODUCT_MODEL - Product Model Description`,
Size = `SD_PRODUCT_SIZE - Product Size Description`)
# Rename Size Range to clarify this is the size of the moulding line and not the SKU size
moulding_line_size <- moulding_line_meta_data |>
rename(`Line Size Range` = `Size Range`)
When it comes to classifying the size of our SKUs, when we are not able to determine the size of the part based off its part number, we will look at the size of the moulding line in which it was produced on. Therefore we need to join the moulding line size to the data that shows the frequency in which each SKU was made on each moulding line.
wc_sku_made_on <- wc_sku_made_on |>
left_join(moulding_line_size,by = 'Work Center Code')
glimpse(wc_sku_made_on)
## Rows: 5,297
## Columns: 11
## $ `Work Center Code` <chr> "F00535", "F00535", "F00535", "F00535", "F00…
## $ `Material Code` <chr> "XMC30532XS-001A65C", "XMC35083PS3A61C", "MK…
## $ no_of_orders <dbl> 2, 7, 1, 1, 8, 5, 2, 11, 55, 38, 3, 5, 1, 1,…
## $ quantity <dbl> 2, 7, 1, 1, 8, 5, 2, 11, 55, 38, 3, 5, 1, 1,…
## $ `Plant Code` <chr> "AU01", "AU01", "AU01", "AU01", "AU01", "AU0…
## $ `Plant Description` <chr> "WMA Artarmon- Prod Plant", "WMA Artarmon- P…
## $ `Work Center Description` <chr> "5 ft BOXES HEAVY JOBBING", "5 ft BOXES HEAV…
## $ `Value Stream Type` <chr> "Heavy Bay", "Heavy Bay", "Heavy Bay", "Heav…
## $ `Box Size (meters)` <chr> "1.5", "1.5", "1.5", "1.5", "3 - 3.4", "1.5"…
## $ `Box Size (feet)` <chr> "5 ft", "5 ft", "5 ft", "5 ft", "10&11 ft", …
## $ `Line Size Range` <chr> "Medium", "Medium", "Medium", "Medium", "Lar…
In order to understand the products we are working with we need to ensure that we have completion of meta data for pump parts. There is on going work to complete this however there are still many parts missing meta data. We will need to complete any of the missing meta data attributes.
First step is to create a list of the SKUs we need to classify.
# From the foundry production orders filter to pumps and take a unique list of required fields
pump_parts <- foundry_production_orders |>
filter(`Cognos TM1 Cube Code - Level 1 Description` == 'Centrifugal Pumps (not Dewatering)') |>
distinct(`Material Code`,`Material Description`,Range,Model,Size,`Basic Material`)
Now that we have a unique list of all the pump parts, lets check the completeness of the fields.
## # A tibble: 2 × 7
## completion_status Range Range.prop Model Model.prop Size Size.prop
## <chr> <int> <dbl> <int> <dbl> <int> <dbl>
## 1 Blank 1790 0.450 1786 0.449 2954 0.742
## 2 Not Blank 2189 0.550 2193 0.551 1025 0.258
Range and Model fields are 55% complete and Size is 26% complete. There is a good amount of work that needs to be done to finish classifying the parts we are working with.
First lets start by running the parts through the custom functions to classify Range, Model, Size for AH, MC and HTP parts.
pump_parts_after_function <- pump_parts |>
classify_AH()|>
classify_MC()|>
classify_HTP()
Lets check to see how well that worked.
## # A tibble: 2 × 7
## completion_status Range Range.prop Model Model.prop Size Size.prop
## <chr> <int> <dbl> <int> <dbl> <int> <dbl>
## 1 Blank 1146 0.288 1144 0.288 2199 0.553
## 2 Not Blank 2833 0.712 2835 0.712 1780 0.447
Range and Model fields are 71% complete and Size is 45% complete. We have improved Range and Model by 16% and size by 19%.
Now that we have classified what we can using the functions created. We need to go through and classify the remaining missing attributes. To do this lets first mark the parts that are going to be priority for our first project.
### Send data to wider team to classify ----
# Identify what parts are priority for Ruby Monday
list_not_classified_priority <- foundry_production_orders |>
filter(`Cognos TM1 Cube Code - Level 1 Description` == 'Centrifugal Pumps (not Dewatering)') |>
filter(`Reporting Entity Description` %in% c('WM South Africa','WM Europe')) |>
distinct(`Cognos TM1 Cube Code - Level 1 Description`,
`Material Code`,
`Material Description`,
Range,
Model,
Size) |>
classify_AH()|>
classify_MC()|>
classify_HTP()|>
filter(is.na(Range)|
is.na(Model)|
is.na(Size))|>
distinct(`Material Code`)|>
mutate(priority = 'X')
After we have identified the ones that are priority lets now join them to the whole list and create an excel file. We can send this excel file to send to the product team to help with classification.
# Join priority parts to entire list
list_not_classified <- pump_parts_after_function |>
filter(is.na(Range)|
is.na(Model)|
is.na(Size))|>
left_join(list_not_classified_priority,by = 'Material Code')
# write list to excel to send to wider team for classification
# write_xlsx(list_not_classified,"02 Shared Data/parts_produced_not_classified (prioritized).xlsx")
Now that our prioritized list has been classified by the wider team lets bring it in and join it with our
### Read in file after it has been classified by wider team----
list_classified <- read_xlsx("01 Source Data/parts_produced_not_classified (prioritized) (classified).xlsx")
### Merge classified data with rest of data ----
pump_parts_after_classification <- pump_parts_after_function |>
left_join(list_classified |> select(-`Material Description`), by = 'Material Code')|>
mutate(Range = case_when(is.na(Range.y) ~ Range.x,
TRUE ~ Range.y),
Model = case_when(is.na(Model.y) ~ Model.x,
TRUE ~ Model.y),
Size = case_when(is.na(Size.y) ~ Size.x,
TRUE ~ Size.y))|>
select(-contains('.x'),-contains('.y'),-priority)
Now that we have have classified our parts to the best of our ability we will need categorize the size into buckets.
For this we will take a 3 tiered approach.
Tier 1: We will group size into buckets using the meta data we have just classified in the previous step using the chart below provided by product managers.
Tier 2: Where we are missing a meta data attribute or it is unknown we will use the size of the moulding line in which the part is most frequently produced on.
Tier 3: When the part is made on two different size moulding lines and equal amount then we will default to the smallest one.
We will apply this same logic to both the SAP and Africa legacy system data.
## Assign size category ----
# Level 1: Assign based off classification ----
tier_1_size_grouping <- pump_parts_after_classification |>
mutate(size_range = case_when(Size %in% c('125','100','150','200','250','1/0.75','1.5/2','4/3','2/1.5','2/2','75','3/3','3/2','4/4','38','65','40','2','1.5/1','280','50','3','80') ~ 'Small',
Size %in% c('300','350','400','450','6/4','6/5','6/6','8/6','8/8','10/8','12/10','10/10','12/12','4') ~ 'Medium',
Size %in% c('500','550','560','600','650','660','700','750','760','16/14','20/18','14/12','18/16','20/20','700','800','1000','26/24') ~ 'Large'))
# Level 2: Assign based off moulding line most frequently produced on ----
tier_2_size_grouping <- wc_sku_made_on|>
group_by(`Material Code`,`Line Size Range`)|>
summarise(no_of_orders = sum(no_of_orders),
quantity = sum(quantity))|>
ungroup()|>
group_by(`Material Code`)|>
mutate(no_of_sizes = n_distinct(`Line Size Range`),
rank = rank(desc(no_of_orders)))|>
ungroup() |>
filter(rank == 1)|>
rename(size_range = `Line Size Range`)|>
select(`Material Code`,size_range)
## `summarise()` has grouped output by 'Material Code'. You can override using the
## `.groups` argument.
# Level 3: Default to smalles moulding line produced on ----
tier_3_size_grouping <- wc_sku_made_on |>
group_by(`Material Code`,`Line Size Range`)|>
summarise(no_of_orders = sum(no_of_orders),
quantity = sum(quantity))|>
ungroup()|>
select(-no_of_orders,-quantity)|>
mutate(`Line Size Range` = factor(`Line Size Range`,levels = c('Small','Medium','Large')))|>
pivot_wider(names_from = `Line Size Range`, values_from = `Line Size Range`)|>
mutate(`Line Size Range` = case_when(is.na(Small) & is.na(Medium) ~ 'Large',
!is.na(Small) & !is.na(Medium) & !is.na(Large) ~ 'Medium',
is.na(Small) ~ 'Medium',
TRUE ~ 'Small'))|>
rename(size_range = `Line Size Range`)|>
select(`Material Code`,size_range)
## `summarise()` has grouped output by 'Material Code'. You can override using the
## `.groups` argument.
# Bring together ----
material_size_range <- tier_1_size_grouping |>
rename(size_range_1 = size_range)|>
left_join(tier_2_size_grouping,by = 'Material Code')|>
rename(size_range_2 = size_range)|>
left_join(tier_3_size_grouping,by = 'Material Code')|>
rename(size_range_3 = size_range)|>
left_join(ZA_MOs_wo_rework|>distinct(`Material Code`,Size)|>rename(size_range = Size), by = 'Material Code') |>
rename(size_range_4 = size_range)|>
# If level 1 is missing then level 2 if both are missing then level 3
mutate(`Size Range` = case_when(!is.na(size_range_1) ~ size_range_1,
is.na(size_range_1) & !is.na(size_range_2) ~ size_range_2,
is.na(size_range_1) & is.na(size_range_2) & !is.na(size_range_3) ~ size_range_3,
TRUE ~ size_range_4))|>
select(`Material Code`,`Size Range`)
Now that we have done all this work to classify our meta data lets join it back to our production order dataset that we will end up using for analysis.
## Swap out the unclassified data with the classified data----
foundry_production_orders_wo_clean_weights <- foundry_production_orders |>
left_join(pump_parts_after_classification |> select(-`Material Description`), by = 'Material Code')|>
left_join(material_size_range, by = 'Material Code')|>
select(-contains('.x'))|>
rename(Range = Range.y,
Model = Model.y,
Size = Size.y)|>
mutate(first_6 = str_sub(`Material Code`,1,6),
mat_key = case_when(str_detect(`Material Description`,'VOLUTE LNR') | str_detect(`Material Description`,'VOLUTE LINER') ~ 'volute liner',
str_detect(`Material Description`,'FPLI') |
str_detect(`Material Description`,'FRAME PLATE LINER INSERT') |
str_detect(`Material Description`,'FRAME PLATE LNR INSERT') |
str_detect(`Material Description`,'F.P.L.I.') |
str_detect(`Material Description`,'LINER INSERT,FP') |
str_detect(`Material Description`,'FRAME PL LNR INST') |
str_detect(`Material Description`,'FPL INSERT') ~ 'frame plate liner insert',
str_detect(`Material Description`,'CPLI') |
str_detect(`Material Description`,'COVER PLATE LINER INSERT') |
str_detect(`Material Description`,'COVER PLATE LNR INSERT') |
str_detect(`Material Description`,'C.P.L.I.') |
str_detect(`Material Description`,'CPL INSERT') ~ 'cover plate liner insert',
str_detect(`Material Description`,'FRM PL') |
str_detect(`Material Description`,'FM PL') |
str_detect(`Material Description`,'FRAME PLATE LINER') ~ 'frame plate liner',
str_detect(`Material Description`,'CVR PL') |
str_detect(`Material Description`,'COVER PLATE LINER') ~ 'cover plate liner',
str_detect(`Material Description`,'THROATBUSH')|
str_detect(`Material Description`,'THRTBSH') |
str_detect(`Material Description`,'TB,') |
str_detect(`Material Description`,'THROAT BUSH')~ 'throatbush',
str_detect(`Material Description`,'BACKLINER')|
str_detect(`Material Description`,'BACK LNR') |
str_detect(`Material Description`,'BACK LINER')|
str_detect(`Material Description`,'LINER, BACK')~ 'back liner',
str_detect(`Material Description`,'COVER PLATE') ~ 'cover plate',
str_detect(`Material Description`,'FRAME PLATE') ~ 'frame plate',
str_detect(`Material Description`,'VOLUTE') ~ 'volute',
str_detect(`Material Description`,'IMP') ~ 'impeller',
str_detect(`Material Description`,'END COVER')|
str_detect(`Material Description`,'ENDCOVER')~ 'end cover',
str_detect(`Material Description`,'SUCTION COVER')|
str_detect(`Material Description`,'SUCTION CVR')~ 'suction cover',
str_detect(`Material Description`,'LABYTH')|
str_detect(`Material Description`,'LABYRINTH') ~ 'labyrinth',
str_detect(`Material Description`,'STUFFING BOX') ~ 'stuffing box',
str_detect(`Material Description`,'EXPELLER RING')|
str_detect(`Material Description`,'EXP RNG')|
str_detect(`Material Description`,'EXPELLER RNG') ~ 'expeller ring',
str_detect(`Material Description`,'EXPELLER')~ 'expeller',
str_detect(`Material Description`,'BOWL')~ 'bowl',
str_starts(`Material Description`,'BUSH')~ 'bush',
str_detect(`Material Description`,'END CAP')~ 'end cap',
str_detect(`Material Description`,'CAP')~ 'cap',
str_detect(`Material Description`,'DOOR')~ 'door',
str_detect(`Material Description`,'CASING')~ 'casing',
str_detect(`Material Description`,'BEARING HOUSING')~ 'bearing housing',
str_detect(`Material Description`,'ADAPTOR PLATE') |
str_detect(`Material Description`,'ADPT PL')~ 'adaptor plate',
str_detect(`Material Description`,'AGITATOR')~ 'agitator',
str_detect(`Material Description`,'COLLECTION CHAMBER')~ 'collection chamber',
str_detect(`Material Description`,'SEAL ADAPTOR')|str_detect(`Material Description`,'SEAL ADPT')~ 'seal adaptor',
str_detect(`Material Description`,'BEARING CARRIER')~ 'bearing carrier',
TRUE ~ NA))
Now that we have cleaned the production orders and classification data. We must make sure our weights are clean. We know from past analyses that our net weights are not maintained. This means we have a lot of blanks and weights that are too small. For example, a pump part listed as .01 kgs.
To clean the weights the methodology we will use is as follows:
First, we have a hypothesis that there is a correlation between the TAC of a part and the weight. As a part gets larger the cost is larger. Assuming that there is a correlation between the two, we can use a linear regression to estimate the weights that are blank or incorrect.
**Linear regression analysis is used to predict the value of a variable based on the value of another variable.*
In order to run a linear regression we must create a distinct list of the parts and their prices at each plant. We will need to run the linear regression
weights_prices <- foundry_production_orders_wo_clean_weights|>
distinct(`Plant Code`,`Material Code`,`Standard Unit Price - GBP (Converted from Company Currency)`,`Net Weight`)
Now we will create category columns to help us determine which weights need to be run through the model and estimated. We will work off the assumption that we do not produce parts that are 1kg or less. Any part with a blank weight or weight of 1kg or less will get a category of zero weight.
# Estimate Weights that are 0
weights <- weights_prices|>
mutate(zero_price = case_when(`Standard Unit Price - GBP (Converted from Company Currency)` == 0 |
is.na(`Standard Unit Price - GBP (Converted from Company Currency)`)~ 'Zero Price',
TRUE ~ 'Has Price'),
zero_weight = case_when(`Net Weight` <= 1 |
is.na(`Net Weight`) ~ 'Zero Weight',
TRUE ~ 'Has Weight'))
Now we can create a training and test table to run our model with. Training Table - consists of parts that have weight and TAC allowing us to train the model with the correlation between their TAC and weight. Test Table - consists of all the parts that have a TAC but no weight so we can use the model to predict the weight. Since each site has a different cost to produce each part we will need to make sure our model accounts for this. To do this we will nest our data by plant to make sure the model runs on each plant independently.
train_tbl<- weights |>
filter(zero_weight == 'Has Weight',
zero_price == 'Has Price') |>
nest(.by = `Plant Code`)
test_tbl <- weights |>
filter(zero_weight == 'Zero Weight',
zero_price == 'Has Price') |>
nest(.by = `Plant Code`)
Now that we have created our training and test tables. We will visualize the correlation between TAC and weight at each plant. I will use a polynomial regression fit line which will allow us to better interpret if we have a true linear correlation between our two variables.
**In statistics, polynomial regression is a form of regression analysis in which the relationship between the independent variable x and the dependent variable y is modeled as an nth degree polynomial in x.*
I will also overlay the parts that are missing weights so we can start to understand where they will lie in our graph after running our model.
# Visualize Weights ----
train_tbl|>
unnest(cols = data)|>
ggplot(aes(`Standard Unit Price - GBP (Converted from Company Currency)`,`Net Weight`,color = zero_weight, label = `Material Code`))+
geom_point(alpha = 2,show.legend = FALSE) +
facet_wrap(~`Plant Code`,scales = 'free')+
geom_smooth(method=loess, col=ot_grey, se=FALSE)+
geom_point(data = test_tbl |> unnest(cols = data) |> filter(zero_weight == 'Zero Weight'), aes(`Standard Unit Price - GBP (Converted from Company Currency)`,`Net Weight`),alpha = 2,show.legend = FALSE) +
scale_color_manual(values = c(ot_alt_navy,ot_orange))+
scale_x_continuous(labels = dollar_format(prefix = '£',scale = 1e-3,suffix = 'K',accuracy = 1))+
theme_minerals_light
## `geom_smooth()` using formula = 'y ~ x'
Looking at our graphs it appears that every site has a very linear
correlation between the TAC and the weight aside from GB01. However, for
GB01 the correlation is linear up until the TAC reaches around £50K. All
of the SKUs with missing weights fall under this price therefore we do
not really need to worry about this having a large impact on our weight
estimations.
Now that we can confidently say we have a linear correlation between TAC and weight at each plant we can us this methodology to estimate our missing weights. Next we will create our model using our training table and then run our test table through it and replace the missing weights with the estimated ones.
# Linear Regression to estimate weights----
## Create Model
set.seed(1234)
lin_reg_model <- linear_reg(mode = 'regression')|>
set_engine('lm')
nested_model <- lin_reg_model|>
nested()
model_fit <- fit(nested_model,`Net Weight` ~ 0 + `Standard Unit Price - GBP (Converted from Company Currency)`, train_tbl)
## Run Model on Test Data
pred_weights <- model_fit |>
predict(test_tbl) |>
bind_cols(test_tbl |> unnest(cols = data))|>
mutate(`Net Weight` = .pred)|>
select(-.pred)
## Combine weight predictions with existing weights
cleaned_weights <- train_tbl|>
unnest(cols = data) |>
union_all(pred_weights) |>
group_by(`Material Code`) |>
summarise(`Net Weight Adj.` = mean(`Net Weight`))|>
ungroup()
cleaned_weights_tbl <- train_tbl|>
unnest(cols = data) |>
union_all(pred_weights) |>
select(-`Net Weight`) |>
left_join(cleaned_weights, by = 'Material Code')
Now that we have our estimated weights, lets plot them to see how accurately they line up with the polynomial regression from earlier.
# Visualize Results
cleaned_weights_tbl |>
ggplot(aes(`Standard Unit Price - GBP (Converted from Company Currency)`,`Net Weight Adj.`,color = zero_weight))+
geom_point(alpha = 2,show.legend = FALSE) +
facet_wrap(~`Plant Code`,scales = 'free')+
geom_smooth(method=loess, se=FALSE, col=ot_grey)+
scale_color_manual(values = c(ot_alt_navy,ot_orange))+
scale_x_continuous(labels = dollar_format(prefix = '£',scale = 1e-3,suffix = 'K',accuracy = 1))+
theme_minerals_light
## `geom_smooth()` using formula = 'y ~ x'
Based off these results, we can confidently say that if these parts
(with no weight) were reweighed today, they would fall close to our
predictions.
Now lets add these estimated weights back to our data.
foundry_production_orders_cleaned <- foundry_production_orders_wo_clean_weights|>
select(-`Net Weight`)|>
left_join(cleaned_weights_tbl |> select(`Plant Code`,`Material Code`,`Net Weight Adj.`), by = c('Plant Code','Material Code'))|>
rename(`Net Weight` = `Net Weight Adj.`)
# create clean data file----
write_csv(foundry_production_orders_cleaned,"Cleaned Data/Foundry Production Orders (Cleaned).csv")