First we need to understanding what is produced in Todmorden to understand the scope of the project. Lets look at the breakdown of materials, orders, volume and value of production in Todmorden. The thought here is to understand what needs to be moved and what risks we my have.
# Take all production orders from our foundries
dist_ph_l1 <- foundry_production_orders |>
# filter to Todmorden and what has been delivered
filter(!is.na(`Actual Delivery Date`),
`Reporting Entity Description` == 'WM Europe') |>
# review by product hierarchy level 1
group_by(`Cognos TM1 Cube Code - Level 1 Description`)|>
# determine # of parts, orders, quantity and value
summarise(SKUs = n_distinct(`Material Code`),
Orders = n_distinct(Order),
Volume = sum(`Goods Receipt Quantity`),
`Value (GBP)` = sum(`Goods Receipt Quantity` * `Standard Unit Price - GBP (Converted from Company Currency)`)) |>
# what is the distribution of the # of materials across each product hierarchy
mutate(`Prop of SKUs` = percent(prop.table(SKUs),accuracy = .1),
`Prop of Orders` = percent(prop.table(Orders),accuracy = .1),
`Prop of Volume` = percent(prop.table(Volume),accuracy = .1),
`Prop of Value` = percent(prop.table(`Value (GBP)`),accuracy = .1))|>
ungroup()|>
select(contains('Cognos'),contains('SKU'),contains('order'),contains('volume'),contains('value'))|>
# Sort greatest to least
arrange(desc(`Value (GBP)`))
# Display data as table
kable(dist_ph_l1,format.args = list(big.mark = ','),digits = 0)
| Cognos TM1 Cube Code - Level 1 Description | SKUs | Prop of SKUs | Orders | Prop of Orders | Volume | Prop of Volume | Value (GBP) | Prop of Value |
|---|---|---|---|---|---|---|---|---|
| Centrifugal Pumps (not Dewatering) | 1,526 | 97.3% | 20,869 | 98.9% | 30,986 | 98.9% | 55,165,902 | 98.8% |
| Others | 30 | 1.9% | 116 | 0.5% | 192 | 0.6% | 489,082 | 0.9% |
| Positive Displacement Pumps (PD) | 1 | 0.1% | 11 | 0.1% | 11 | 0.0% | 120,596 | 0.2% |
| Cyclones | 6 | 0.4% | 83 | 0.4% | 99 | 0.3% | 33,145 | 0.1% |
| Crushers | 2 | 0.1% | 4 | 0.0% | 9 | 0.0% | 32,879 | 0.1% |
| Centrifugal Pumps (Dewatering) | 3 | 0.2% | 10 | 0.0% | 10 | 0.0% | 6,199 | 0.0% |
| Other Rubber Product and Equipment Lining | 1 | 0.1% | 9 | 0.0% | 9 | 0.0% | 6,015 | 0.0% |
Slurry pumps make up the vast majority of what is produced in Todmorden. Risk to other product groups are extremely low.
## `summarise()` has grouped output by 'Reporting Entity Description', 'Material
## Code', 'Material Description', 'Range', 'Model', 'Size', 'Size Range',
## 'first_6'. You can override using the `.groups` argument.
First lets take the pump parts made at each foundry and run a fuzzy match between all other sites using the Levenshtein distance. The idea here is that this will identify all possible matches where SKUs potentially use the same pattern. The result of the fuzzy match will provide the *distance. The lower the distance the more similar the part numbers are to each other.
**The Levenshtein distance (method=‘lv’) counts the number of deletions, insertions and substitutions necessary to turn b into a. This method is equivalent to R’s native adist function.*
fuzzy_match <- pump_parts_by_site |>
# Run fuzzy match to identify all possible reasonable options
stringdist_join(pump_parts_by_site,
by = 'Material Code',
method = 'lv',
mode = 'full',
max_dist = 8,
distance_col = 'distance')
nrow(fuzzy_match)
## [1] 5856890
Now that is way to many matches!
Lets narrow down our search. We can filter to Europe and remove matches occurring at the same location as we do not care about similar parts made at the same foundry.
europe_fuzzy_match <- fuzzy_match|>
rename(`From` = `Reporting Entity Description.x`,
`To` = `Reporting Entity Description.y`)|>
# Filter to remove matches at same location & filter down to Europe
filter(From != To,
From == 'WM Europe')
nrow(europe_fuzzy_match)
## [1] 1326442
Getting better.
In order to further narrow down our matches, we can look at the matches with the smallest distance for that part to ensure we are looking at the matches with the highest likelihood of having the same pattern.
min_dist_match <- europe_fuzzy_match |>
# Identify the smallest distance for each part number
group_by(`Material Code.x`)|>
mutate(min_distance = min(distance))|>
ungroup()|>
# Filter to only display smallest distance
filter(distance == min_distance) |>
select(-min_distance)
nrow(min_dist_match)
## [1] 3808
Much better!
Now we can try and improve the accuracy. Lets make sure we are only looking at matches for the same type of part (i.e. an impeller is matched with an impeller).
mat_key_match <- min_dist_match|>
# Filter to only supply matches where the matches are the same type of part
filter(mat_key.x == mat_key.y |
(is.na(mat_key.x) & is.na(mat_key.y)))
nrow(mat_key_match)
## [1] 2847
Lastly, lets identify which matches have the same first 6 characters as these we can confidently say are our highest likelihood matches to having the same pattern in common.
where_else_made <- mat_key_match|>
# Identify the parts where the first 6 character match
mutate(match_first_6 = first_6.x == first_6.y,
match_accuracy = stringsim(a = `Material Code.x`,b = `Material Code.y`))
Lets visualize our results.
# Visualize our results
where_else_made|>
distinct(`Material Code.x`,`Material Description.x`,`Material Code.y`,`Material Description.y`,distance,match_accuracy,match_first_6)|>
ggplot(aes(distance,match_accuracy,color = match_first_6))+
geom_point(alpha = .5,position=position_jitter(width = .2))+
scale_color_manual(values = c(ot_grey,ot_navy))+
scale_y_continuous(labels = percent_format())+
labs(
title = "SKUs with capability to be produced elsewhere",
x = "Distance",
y = "SKU Match Accuracy"
)
In blue we can see all of our matches where the first 6 characters are identical. These are the ones we want to focus on as they will have the highest likelihood of having the same pattern. We can see that majority of them have a distance of 0 to 2 between matches. Most of these will be from certifications or different materials.
Now that we have our matches lets see how many parts we can confidently move somewhere else.
First we need to determine the total SKUs Europe produces.
# Get list of all parts in Europe we need to move
ruby_mon_sku <- pump_parts_by_site|>
filter(`Reporting Entity Description` == 'WM Europe')|>
select(-`Reporting Entity Description`,-first_6,-mat_key)
ruby_mon_sku|>
distinct(`Material Code`)|>
nrow()
## [1] 1526
Now lets determine how many of those SKUs are we able to move and what is the confidence level?
# Get a list of all the parts we have confidence in moving
move_list <- where_else_made|>
# Filter to exact matches and matches where the probability is high
filter(distance == 0 |
match_first_6 == TRUE)|>
# Assign move_probability to our matches
mutate(move_probability = case_when(distance==0 ~ '100%',
match_first_6 == TRUE ~ 'High'))|>
# Get distinct list of materials needed to move from our matches
distinct(`Material Code.x`,distance,match_first_6,match_accuracy,move_probability)|>
# Filter to highest probability where there are multiple matches in each category
group_by(`Material Code.x`) |>
mutate(max_accuracy = max(match_accuracy)) |>
ungroup()|>
filter(match_accuracy == max_accuracy)|>
select(`Material Code.x`,move_probability)|>
rename(`Material Code` = `Material Code.x`)
ruby_mon_sku <- ruby_mon_sku|>
left_join(move_list, by = 'Material Code')|>
mutate(move_probability = case_when(is.na(move_probability) ~ 'Low',
TRUE ~ move_probability))
ruby_mon_sku|>
group_by(move_probability)|>
summarise(no_of_SKUs = n_distinct(`Material Code`))|>
ungroup()|>
mutate(prop = percent(prop.table(no_of_SKUs),accuracy = .1))
## # A tibble: 3 × 3
## move_probability no_of_SKUs prop
## <chr> <int> <chr>
## 1 100% 503 33.0%
## 2 High 418 27.4%
## 3 Low 605 39.6%
1/3 of the SKUs we have a 100% confidence we can move. Close to another 1/3 we have a very high confidence level we can move based off the matches we were able to come up with. The last 1/3 we will need to address case by case.
If we break down the different groups of what we can move where does most of the value sit?
ruby_mon_sku|>
group_by(move_probability)|>
summarise(`Value (GBP)` = sum(`Value (GBP)`))|>
ungroup()|>
ggplot(aes(move_probability,`Value (GBP)`))+
geom_col(fill = ot_navy)+
geom_text(aes(label = dollar(`Value (GBP)`,prefix = '£',scale = 1e-6,accuracy = .1,suffix = 'M')), vjust = 1.5, colour = "white")+
scale_y_continuous(labels = dollar_format(prefix = '£',scale = 1e-6,accuracy = .1,suffix = 'M'))+
theme_minerals_light_grid
This is good news. Most of the value is sitting the categories in which we are confident we are able to move.
However, practically speaking how much volume does this mean we are confident we can move?
ruby_mon_sku|>
group_by(move_probability)|>
summarise(Volume = sum(Volume))|>
ungroup()|>
ggplot(aes(move_probability,Volume))+
geom_col(fill = ot_navy)+
geom_text(aes(label = comma(Volume)), vjust = 1.5, colour = "white")+
scale_y_continuous(labels = comma_format())+
theme_minerals_light_grid
By far the majority of the volume we can confidently say we are able to move. The parts we are unsure of are relatively low volume. This is interesting because the category we have low likelihood of moving has a high value. Why might this be? Do we have very high value parts that we need to ensure we make a plan for?
ruby_mon_sku|>
ggplot(aes(move_probability,`Value (GBP)`,label = `Material Code`))+
geom_jitter(alpha = .5,color = ot_navy,position = position_jitter(seed = 1,width = .25))+
geom_text_repel(position = position_jitter(seed = 1,width = .25),size = 3,max.overlaps = 30)+
scale_y_continuous(labels = dollar_format(prefix = '£',scale = 1e-6,accuracy = .1,suffix = 'M'))+
theme_minerals_light_grid
Yes, it looks like we have HTP parts that we can not confidently say can be made at another internal site. We need to make sure we account for these parts and when we transition these over to another internal foundry.
Now lets look value by pump range.
ruby_mon_sku|>
group_by(Range,move_probability)|>
summarise(`Value (GBP)` = sum(`Value (GBP)`))|>
ungroup()|>
mutate(Range = reorder(Range,`Value (GBP)`))|>
ggplot(aes(Range,`Value (GBP)`))+
geom_col(fill = ot_navy)+
coord_flip()+
facet_wrap(~move_probability)+
geom_text(aes(label = dollar(`Value (GBP)`,prefix = '£',scale = 1e-6,accuracy = 1,suffix = 'M')),size = 2.5,hjust = -.1)+
scale_y_continuous(labels = dollar_format(prefix = '£',scale = 1e-6,suffix = 'M'),limits = c(0,17000000))+
theme_minerals_blank+
theme(
axis.text = element_text(size = 8)
)
## `summarise()` has grouped output by 'Range'. You can override using the
## `.groups` argument.
The highest value ranges by far are AH and HTP. Most of the AH can be made somewhere else so the items we have not found a match for can most likely be transitioned as well or depreciated and substituted with a alternate part. As for HTP, about half the value of what has been produced in the last 3 years can be made in either Chile or South Africa but the other half will probably require retooling and adding capability to produce these parts at other locations.
Now lets figure out how many patterns these SKUs make up so we can start to understand how many patterns we are physically going to need to move.
pattern_list|>
distinct(ID) |>
nrow()
## [1] 2856
Based off the list Todmorden sent Division about 1-2 years ago it appears there are 2669 distinct entries.
The pattern numbers were not provided so we are moving forward with the assumption that the pattern numbers are equal to the part numbers they provided.
From here we can run a fuzzy match using the detect function as the method of matching. This will take the truncated part number provided in the pattern file and provide all possible matches where that string of characters appears as a subset in the SKUs produced.
ruby_mon_pattern_matches <- ruby_mon_sku |>
select(`Material Code`)|>
# Fuzzy join to patterns by joining on a subset of a string
fuzzy_full_join(pattern_list, by = c('Material Code' = 'Part Number'), match_fun = str_detect)|>
group_by(`Material Code`)|>
# Determine the number of matches each material has
mutate(no_of_matches = case_when(!is.na(`Material Code`) & !is.na(`Part Number`) ~ n(),
TRUE ~ NA),
# Provide status for each material. Does it have a match, multiple matches, or no match
pattern_match_status = case_when(is.na(`Material Code`) ~ 'Remaining Patterns',
is.na(`Part Number`) ~ 'No Match',
!is.na(`Material Code`) &
!is.na(`Part Number`) &
no_of_matches == 1 ~ 'Match',
!is.na(`Material Code`) &
!is.na(`Part Number`) &
no_of_matches > 1 ~ 'Multiple Match'),
# For the multiple match materials provide level of accuracy between the matches
pattern_match_accuracy = case_when(no_of_matches > 1 ~ stringsim(a = `Material Code`,b = `Part Number`),
TRUE ~ NA),
# Rank the level of accuracy to help determine the correct match
rank = case_when(pattern_match_status == 'Multiple Match' ~ rank(desc(pattern_match_accuracy)),
TRUE ~ NA))|>
ungroup()
# write_xlsx(ruby_mon_pattern_matches,'ruby_monday_pattern_matches.xlsx')
# write_xlsx(europe_patterns,'europe_patterns.xlsx')
ruby_mon_pattern_matches |>
group_by(pattern_match_status)|>
summarise(no_of_SKUs = n_distinct(`Material Code`,na.rm = TRUE),
no_of_patterns = n_distinct(`Part Number`,na.rm = TRUE)) |>
ungroup()
## # A tibble: 4 × 3
## pattern_match_status no_of_SKUs no_of_patterns
## <chr> <int> <int>
## 1 Match 825 536
## 2 Multiple Match 412 333
## 3 No Match 289 0
## 4 Remaining Patterns 0 1945
Out of the 1540 SKUs produced we have 80% of them have a match to the pattern list. However, of that 80%, 20% have multiple matches that need to be confirmed. Due to the data quality of the pattern list it will be difficult to confidently identify the true match without manual intervention.
ruby_mon_pattern_matches|>
mutate(SKUs = case_when(is.na(`Material Code`) ~ NA,
TRUE ~ 'Material'))|>
make_long(SKUs,pattern_match_status)|>
ggplot(aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = factor(node),
label = node)) +
geom_sankey(flow.alpha = 0.5,width = 0.3) +
geom_sankey_text(size = 2.5, color = "white",na.rm = TRUE) +
scale_fill_manual(values = c(ot_dark_navy,ot_navy,ot_alt_yellow,ot_burnt_orange,"darkgrey"),na.value = 'white') +
theme_sankey(base_size = 16) +
theme(legend.position = "none")