---
title: "A supplier Risk and Impact Model"
author: "Islam Md Monaim"
date: "2026-04-29"
output: pdf_document
---

```{r}
# Create a data frame summarizing the problems solved
problems_summary <- data.frame(
  Problem = c(
    "Spend concentration",
    "Emissions concentration",
    "Poor data quality"
  ),
  Why_It_Matters = c(
    "Financial and operational risk",
    "CSRD Scope 3 reporting requirements",
    "Audit and reporting risk"
  ),
  Your_Solution = c(
    "Spend heatmap and top spenders",
    "Emissions ranking and segmentation",
    "SDQI scoring"
  ),
  stringsAsFactors = FALSE
)
problems_summary
```
```{r}
knitr::kable(
  problems_summary,
  caption = "Summary of Problems Soved by the Supplier Risk and Impact Model"
)
```
 # Importing  and examining the required datasets for this project 
```{r}
# importing dataset 
benchmarks<- read.csv("C:/Users/monai/OneDrive - student.uni-halle.de/Desktop/Project 1/benchmark_factors.csv")
quality_flags<- read.csv("C:/Users/monai/OneDrive - student.uni-halle.de/Desktop/Project 1/data_quality_flags.csv")
emissions<- read.csv("C:/Users/monai/OneDrive - student.uni-halle.de/Desktop/Project 1/emissions_reports.csv")
suppliers<- read.csv("C:/Users/monai/OneDrive - student.uni-halle.de/Desktop/Project 1/suppliers.csv")
```
# Loading Final Dataset 
```{r, echo=FALSE, message=FALSE, warning=FALSE}
library(dplyr)
# Creating the master dataset 
eu_emissions<-emissions %>%
  left_join(suppliers, by = "supplier_id") %>%
  left_join(benchmarks, by = "category") %>%
  left_join(quality_flags, by = "supplier_id")
```

 # Calculating total emissions 
 Total emissions = scope1 + scope2 + scope 3
```{r}
library(dplyr)
library(ggplot2)
library(lubridate)
eu2<- eu_emissions %>% 
  mutate(
    submission_date = ymd(submission_date),
    scope1_emissions = as.numeric(scope1_emissions),
    scope2_emissions = as.numeric(scope2_emissions),
    scope3_emissions = as.numeric(scope3_emissions),
    annual_spend = as.numeric(annual_spend),
    criticality_score = as.numeric(criticality_score),
    total_emissions = scope1_emissions + scope2_emissions + scope3_emissions
  
  )
eu2 %>% 
   summarise(
    n_rows = n(),
    n_suppliers = n_distinct(supplier_id),
    emissions_missing = sum(is.na(total_emissions))
  )
```
# Building an SDQI score from the available flags(0-100)
```{r}
eu2 <- eu2 %>%
  mutate(
    # Ensure flags are logical
    missing_fields = as.logical(missing_fields),
    inconsistent_units = as.logical(inconsistent_units),
    outlier_flag = as.logical(outlier_flag),
    late_submission_flag = as.logical(late_submission_flag),
    methodology_flag = as.logical(methodology_flag),

    # Penalty points
    flag_penalty_points =
      12 * as.integer(missing_fields) +
      10 * as.integer(inconsistent_units) +
      6  * as.integer(outlier_flag) +
      4  * as.integer(late_submission_flag) +
      6  * as.integer(methodology_flag),

    # SDQI derived: higher = better
    sdqi_score = pmax(0, pmin(100, 100 - flag_penalty_points))
  )

eu2 %>%
  summarise(
    sdqi_min = min(sdqi_score, na.rm = TRUE),
    sdqi_median = median(sdqi_score, na.rm = TRUE),
    sdqi_mean = mean(sdqi_score, na.rm = TRUE),
    sdqi_max = max(sdqi_score, na.rm = TRUE)
  )
```
# Sanity Check 
```{r}
eu2 %>%
  count(sdqi_score, sort = TRUE) %>%
  slice_head(n = 15)
```
The SDQI frequency table shows that most suppliers achieve very high data‑quality scores, with 558 suppliers scoring 100 and a large concentration between 90 and 96. This indicates strong completeness, consistency, timeliness, and methodological reliability across the supply base. Only a small number of suppliers fall below 80, representing the main data‑quality risk group. The distribution is heavily right‑skewed, meaning data quality is generally strong with a long tail of lower‑quality suppliers requiring targeted improvement.
# Aggregate to supplier level 
 ## Assuptions (practical and common in supplier Risk Model)
 1. Spend is stable per supplier , so we take max(annual_spend)
 2. Criticality : Use max(criticality_score)(worst-case operational risk)
 3. Emissions: sum(total_emissions) across reported years 
 4. SDQI : take min(sdqi_score)(worst data quality year drives risk)
 5. Flags : take any (True) across years 
# problem: How supplier data quality is distribuited across dataset 
```{r}
supplier_data<-eu2 %>% 
  group_by(supplier_id) %>%
  summarise(
    supplier_name = first(supplier_name),
    country = first(country),
    region = first(region),
    category = first(category),
    tier = first(tier),

    annual_spend = max(annual_spend, na.rm = TRUE),
    criticality_score = max(criticality_score, na.rm = TRUE),
    total_emissions = sum(total_emissions, na.rm = TRUE),
    sdqi_score = min(sdqi_score, na.rm = TRUE),

    missing_fields = any(missing_fields == TRUE, na.rm = TRUE),
    inconsistent_units = any(inconsistent_units == TRUE, na.rm = TRUE),
    outlier_flag = any(outlier_flag == TRUE, na.rm = TRUE),
    late_submission_flag = any(late_submission_flag == TRUE, na.rm = TRUE),
    methodology_flag = any(methodology_flag == TRUE, na.rm = TRUE),

    .groups = "drop"
  )
supplier_data %>% slice_head(n=5)
summary(supplier_data$sdqi_score)
```
 # Mostly strong data quality with a few suppliers need improvement, and most supplier are in a healthy band.
 
#4. Converting SDQI to Data Quality Risk 
  data_quality_risk = 100 - sdqi_score
  # Understand overall data quality maturity 
  # Identify outliers 
  # validate SDQI score model 
  # Support CSRD reporting 
```{r}
supplier_data <- supplier_data %>% 
  mutate(
    data_quality_risk = 100 - sdqi_score
  )
supplier_data %>% 
  select(sdqi_score, data_quality_risk) %>%
  summary()
```
  
The SDQI summary shows that supplier data quality is generally strong , with scores ranging from 59 to 100. The median SDQI score is 80, indicating that most suppliers provide reliable and complete data. The derived data_quality_risk metric confirms this patterrn , with an average risk score of 20.9 and a maximum of 41. Only a small number of suppliers fall into the high risk category , while the majority demonstrate solid data maturity. This distribution highlights a healthy supply base with a few suppliers requiring targeted data-quality inprovements.


# 5. Normalize all four dimensions(robust ranking), we'll use percentile ranks in [0,1] for each demension: 
1. spend_rank
2.criticality_rank 
3.emissions_rank 
4. dq_rank 
```{r}
supplier_data <- supplier_data %>% 
  mutate(
    spend_rank = percent_rank(annual_spend),
    criticality_rank = percent_rank(criticality_score),
    emissions_rank = percent_rank(total_emissions),
    dq_rank = percent_rank(data_quality_risk)
  )
supplier_data

```

#6 - Composite priority score(weights)
Default is equal weights(0.25 each). This is a solid 'first version' for governance because it is easy to justify and explain.
```{r}
w_spend <- 0.25
w_crit  <- 0.25
w_emis  <- 0.25
w_dq    <- 0.25

supplier_data<- supplier_data %>%
  mutate(
    priority_score = w_spend * spend_rank +
                     w_crit  * criticality_rank +
                     w_emis  * emissions_rank +
                     w_dq    * dq_rank
  )

summary(supplier_data$priority_score)
```
The priority score ranges from 0.10 to 0.83, with a median of 0.46. This indicates that most suppliers fall into a moderate-priority category , while a smaller group represents high priority suppliers requiring closer management, The top quartile(scores ablove 0.55) includes suppliers with high spend , high criticality, significant emissions , or lower data quality.The lowest-scoring suppliers represent minimal risk and impact. Overall, the distribution shows a balanced supply base with a clear segmentation between low, medium , and high-priority suppliers.

# Turn score into action tiers 
a simple tiering approach:
 1. Monito= bottom 50%
 2.Engage = 50-80%
 3. Prioritize = 80-95%
 4. Critical = Top 5%
```{r}
supplier_data <- supplier_data %>% 
  mutate(
    priority_tier = case_when(
      priority_score <= quantile(priority_score, 0.50, na.rm = TRUE) ~ "Monitor",
      priority_score <= quantile(priority_score, 0.80, na.rm = TRUE) ~ "Engage",
      priority_score <= quantile(priority_score, 0.95, na.rm = TRUE) ~ "Prioritize",
      TRUE ~ "Critical"
    ),
    priority_tier = factor(priority_tier, levels = c("Monitor","Engage","Prioritize","Critical"))
  )
supplier_data %>% count(priority_tier)
supplier_data
```

# Top suppliers - strategic supplier spotlight (Pareto priniciple)
```{r}
top15 <- supplier_data %>%
  arrange(desc(priority_score)) %>%
  select(
    supplier_id, supplier_name, category, region, tier,
    annual_spend, criticality_score, total_emissions, sdqi_score,
    data_quality_risk, priority_score, priority_tier
  ) %>%
  slice_head(n = 15)

top15
```

To support executive decision-making , we extracted the top 15 suppliers based on the Supplier Priority Score. These suppliers represent the highest combined impact across spend, emission, criticality , and data-quality risk. Focusing on the top 15 aligns with CSRD materiality principles and the Pareto effect, whare a small number of suppliers drive the majority of operational and sustainability exposure. This subset forms the core of our strategic supplier engegement plan.

# Visualization(distribution , tier counts , and top 20)
1. How are supplier priority score distributed across the entire supply base?
2.How many Suppliers fall into each tier(Monitor, Engage, Prioritize, Critical)?
3. Who are the highest-priority suppliers we must act on?

```{r}
library(tidyverse)
# Score distribution
ggplot(supplier_data, aes(priority_score)) +
  geom_histogram(bins = 30, fill = "#1f77b4", color = "white") +
  theme_minimal() +
  labs(title = "Priority score distribution", x = "Priority score", y = "Suppliers")

# Tier counts
ggplot(supplier_data, aes(priority_tier)) +
  geom_bar(fill = "#08519c") +
  theme_minimal() +
  labs(title = "Suppliers by priority tier", x = "Priority tier", y = "Suppliers")

# Top 20 suppliers bar chart
supplier_data%>%
  arrange(desc(priority_score)) %>%
  slice_head(n = 20) %>%
  mutate(supplier_name = fct_reorder(supplier_name, priority_score)) %>%
  ggplot(aes(priority_score, supplier_name)) +
  geom_col(fill = "#08519c") +
  theme_minimal() +
  labs(title = "Top 20 suppliers by composite priority score",
       x = "Priority score", y = "Supplier")
```
We visualize the priority score distribution to validate the scoring model and understand how suppliers risk is spread across the supply base. The tier count chart shows how many suppliers fall into each risk category , ensuring that the tier thesholds are meaningful and actionable .Finally, the top 20 suppliers chart highlights the highest-priority suppliers that require immediate attention, supporting CSRD materiality assessment and strategic supplier engagement . Together, these visuals provide a complete view of supplier risk and impact.
