# If a package is missing, install it once, then re-knit.
needed <- c(
"tidyverse", "GGally", "caret", "glmnet", "knitr",
"scales", "lubridate", "cowplot"
)
missing <- needed[!needed %in% rownames(installed.packages())]
if (length(missing) > 0) {
install.packages(missing, repos = "https://cloud.r-project.org")
}
library(tidyverse)
library(GGally)
library(caret)
library(glmnet)
library(knitr)
library(scales)
set.seed(2026)Application Assignment 1
Predicting Actual Productivity in Garment Manufacturing
1 Introduction
This analysis uses the UCI / Kaggle Productivity Prediction of Garment Employees data (1,197 daily team-level records from a garment factory). The modeling target is actual_productivity: the proportion of targeted output that a team actually delivered on a given day.
The workflow follows the assignment:
- Document every variable, decide what enters the models, and say why.
- Graph the bivariate relationships among the variables that are kept.
- Fit three linear predictive models: ordinary least squares (no penalty), ridge, and LASSO.
- Estimate out-of-sample performance with 10-fold CV, LOOCV, and bootstrap (5 and 20 resamples).
- Rank the models and translate the results for a factory decision-maker.
2 Data import and cleaning
The assignment file is garments_worker_productivity.csv (1,197 team-days). Keep it in the same folder as this .qmd. The chunk also checks a few nearby folders.
candidates <- c(
"garments_worker_productivity.csv",
file.path("attachments", "garments_worker_productivity.csv"),
file.path("..", "attachments", "garments_worker_productivity.csv")
)
local_file <- candidates[file.exists(candidates)][1]
remote_file <- "https://raw.githubusercontent.com/Abdul6795/Datasets/main/garments_worker_productivity.csv"
if (!is.na(local_file)) {
raw <- read_csv(local_file, show_col_types = FALSE)
message("Loaded: ", local_file)
} else {
raw <- read_csv(remote_file, show_col_types = FALSE)
message("Local CSV not found; loaded public copy of the same UCI file.")
}
stopifnot(nrow(raw) == 1197)
glimpse(raw)Rows: 1,197
Columns: 15
$ date <chr> "1/1/2015", "1/1/2015", "1/1/2015", "1/1/2015", …
$ quarter <chr> "Quarter1", "Quarter1", "Quarter1", "Quarter1", …
$ department <chr> "sweing", "finishing", "sweing", "sweing", "swei…
$ day <chr> "Thursday", "Thursday", "Thursday", "Thursday", …
$ team <dbl> 8, 1, 11, 12, 6, 7, 2, 3, 2, 1, 9, 10, 5, 10, 8,…
$ targeted_productivity <dbl> 0.80, 0.75, 0.80, 0.80, 0.80, 0.80, 0.75, 0.75, …
$ smv <dbl> 26.16, 3.94, 11.41, 11.41, 25.90, 25.90, 3.94, 2…
$ wip <dbl> 1108, NA, 968, 968, 1170, 984, NA, 795, 733, 681…
$ over_time <dbl> 7080, 960, 3660, 3660, 1920, 6720, 960, 6900, 60…
$ incentive <dbl> 98, 0, 50, 50, 50, 38, 0, 45, 34, 45, 44, 45, 50…
$ idle_time <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ idle_men <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ no_of_style_change <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ no_of_workers <dbl> 59.0, 8.0, 30.5, 30.5, 56.0, 56.0, 8.0, 57.5, 55…
$ actual_productivity <dbl> 0.9407254, 0.8865000, 0.8005705, 0.8005705, 0.80…Known data-quality issues in this file:
departmentis misspelled (sweing) and finishing has a trailing space.wipis missing for essentially every finishing-department row (WIP is a sewing-floor concept).actual_productivitycan exceed 1 (teams sometimes beat the posted target).dateis a calendar stamp, not a production lever.
garment <- raw %>%
mutate(
department = str_trim(department),
department = recode(department, sweing = "sewing"),
department = factor(department),
quarter = factor(quarter, levels = paste0("Quarter", 1:5)),
day = factor(day, levels = c(
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday"
)),
# Team identity is categorical, not a numeric dose
team = factor(team),
# Finishing rows have no sewing WIP; 0 is the domain-correct fill
wip = if_else(is.na(wip), 0, wip),
date = lubridate::mdy(date)
)
stopifnot(sum(is.na(garment$wip)) == 0)
cat("Rows:", nrow(garment), " Columns:", ncol(garment), "\n")Rows: 1197 Columns: 15 cat("Department levels:", paste(levels(garment$department), collapse = ", "), "\n")Department levels: finishing, sewing 3 Question 1. Variable summary, measurement type, and include / exclude decisions
num_summary <- function(x) {
sprintf(
"n = %d; mean = %.3f; SD = %.3f; min = %.3f; Q1 = %.3f; median = %.3f; Q3 = %.3f; max = %.3f; missing = %d",
sum(!is.na(x)), mean(x, na.rm = TRUE), sd(x, na.rm = TRUE),
min(x, na.rm = TRUE), quantile(x, 0.25, na.rm = TRUE),
median(x, na.rm = TRUE), quantile(x, 0.75, na.rm = TRUE),
max(x, na.rm = TRUE), sum(is.na(x))
)
}
cat_summary <- function(x) {
tab <- sort(table(x, useNA = "ifany"), decreasing = TRUE)
paste0(
"n = ", length(x), "; levels = ", nlevels(factor(x)), "; ",
paste(names(tab), tab, sep = " = ", collapse = "; ")
)
}var_tbl <- tibble::tribble(
~Variable, ~Measurement_type, ~Summary_statistics, ~What_it_represents, ~Decision, ~Rationale,
"date",
"Date / identifier",
paste0("Range: ", min(garment$date), " to ", max(garment$date),
"; unique days = ", n_distinct(garment$date)),
"Calendar date of the production record.",
"Exclude",
"It is a row identifier, not a lever a manager sets. Quarter and weekday already capture the calendar structure that could matter. Treating date as a numeric trend would add little and risks leaking time-order artifacts into a cross-sectional model.",
"quarter",
"Nominal categorical (5 month-segments)",
cat_summary(garment$quarter),
"Which fifth of the month the day falls in (the source data labels a short fifth 'quarter').",
"Include",
"End-of-month and mid-month pressure can change pacing, overtime, and incentive use. Dummy-coded in the models.",
"department",
"Nominal categorical (2 levels)",
cat_summary(garment$department),
"Whether the record is a sewing line or a finishing line.",
"Include",
"The two departments have very different SMV, staffing, and WIP profiles. Pooling them without a department flag would confound process differences with productivity.",
"day",
"Nominal categorical (weekday)",
cat_summary(garment$day),
"Weekday of the record. This factory has no Friday records.",
"Include",
"Attendance, overtime culture, and order flow often differ by weekday. Dummy-coded.",
"team",
"Nominal categorical (12 teams)",
cat_summary(garment$team),
"Which production team generated the record.",
"Include",
"Teams are not interchangeable. Skill mix, supervision, and product assignment differ. Team number is a label, not a numeric dose, so it is stored as a factor.",
"targeted_productivity",
"Continuous (ratio / planned rate)",
num_summary(garment$targeted_productivity),
"Management's posted productivity target for that team-day (typically 0–1).",
"Include",
"The strongest operational anchor in the file. Targets are set before the day starts, so this is a legitimate predictor, not a leak of the outcome.",
"smv",
"Continuous (minutes per standard task)",
num_summary(garment$smv),
"Standard Minute Value: engineered time allowed for the style being sewn or finished.",
"Include",
"Harder styles (higher SMV) change line balance and learning time. A core production-engineering input.",
"wip",
"Continuous / count (unfinished units)",
num_summary(garment$wip),
"Work in progress sitting on the line. Missing finishing values were set to 0 because finishing does not carry sewing WIP.",
"Include",
"High WIP can mean a healthy buffer or a bottleneck. After the 0-fill it is usable for both departments.",
"over_time",
"Continuous (minutes)",
num_summary(garment$over_time),
"Total overtime minutes charged to the team that day.",
"Include",
"Overtime is a capacity lever. It can raise output or signal that the line is already behind.",
"incentive",
"Continuous (Bangladeshi Taka)",
num_summary(garment$incentive),
"Financial incentive paid to the team that day.",
"Include",
"Direct motivational lever. Highly skewed (many zeros, a few large bonuses), which is one reason a penalized model may help.",
"idle_time",
"Continuous (minutes); zero-inflated",
num_summary(garment$idle_time),
"Minutes the line was stopped (machine, material, or other interruption).",
"Include",
"Stops are a direct drag on realized productivity. Rare but large when they occur.",
"idle_men",
"Discrete count; zero-inflated",
num_summary(garment$idle_men),
"Number of workers left idle during an interruption.",
"Include",
"Captures the staffing cost of downtime, distinct from the duration of the stop. Correlated with idle_time, which is exactly why ridge/LASSO are useful.",
"no_of_style_change",
"Discrete count (0–2)",
num_summary(garment$no_of_style_change),
"How many times the team changed garment style that day.",
"Include",
"Changeovers cost learning time and line rebalance. Expected negative association with actual productivity.",
"no_of_workers",
"Continuous / count (team size)",
num_summary(garment$no_of_workers),
"Number of operators assigned to the team that day (half-values appear when a worker is shared).",
"Include",
"Staffing is a primary capacity input and differs sharply between sewing and finishing.",
"actual_productivity",
"Continuous target (realized rate)",
num_summary(garment$actual_productivity),
"Share of targeted output actually delivered. Officially described as 0–1; a small number of days exceed 1 when teams beat the posted target.",
"Target",
"This is the outcome. It is not used as a predictor."
)
kable(
var_tbl,
caption = "Table 1. Variable dictionary, measurement type, summary, and modeling decision",
align = c("l", "l", "l", "l", "c", "l")
)| Variable | Measurement_type | Summary_statistics | What_it_represents | Decision | Rationale |
|---|---|---|---|---|---|
| date | Date / identifier | Range: 2015-01-01 to 2015-03-11; unique days = 59 | Calendar date of the production record. | Exclude | It is a row identifier, not a lever a manager sets. Quarter and weekday already capture the calendar structure that could matter. Treating date as a numeric trend would add little and risks leaking time-order artifacts into a cross-sectional model. |
| quarter | Nominal categorical (5 month-segments) | n = 1197; levels = 5; Quarter1 = 360; Quarter2 = 335; Quarter4 = 248; Quarter3 = 210; Quarter5 = 44 | Which fifth of the month the day falls in (the source data labels a short fifth ‘quarter’). | Include | End-of-month and mid-month pressure can change pacing, overtime, and incentive use. Dummy-coded in the models. |
| department | Nominal categorical (2 levels) | n = 1197; levels = 2; sewing = 691; finishing = 506 | Whether the record is a sewing line or a finishing line. | Include | The two departments have very different SMV, staffing, and WIP profiles. Pooling them without a department flag would confound process differences with productivity. |
| day | Nominal categorical (weekday) | n = 1197; levels = 6; Wednesday = 208; Sunday = 203; Tuesday = 201; Monday = 199; Thursday = 199; Saturday = 187 | Weekday of the record. This factory has no Friday records. | Include | Attendance, overtime culture, and order flow often differ by weekday. Dummy-coded. |
| team | Nominal categorical (12 teams) | n = 1197; levels = 12; 2 = 109; 8 = 109; 1 = 105; 4 = 105; 9 = 104; 10 = 100; 12 = 99; 7 = 96; 3 = 95; 6 = 94; 5 = 93; 11 = 88 | Which production team generated the record. | Include | Teams are not interchangeable. Skill mix, supervision, and product assignment differ. Team number is a label, not a numeric dose, so it is stored as a factor. |
| targeted_productivity | Continuous (ratio / planned rate) | n = 1197; mean = 0.730; SD = 0.098; min = 0.070; Q1 = 0.700; median = 0.750; Q3 = 0.800; max = 0.800; missing = 0 | Management’s posted productivity target for that team-day (typically 0–1). | Include | The strongest operational anchor in the file. Targets are set before the day starts, so this is a legitimate predictor, not a leak of the outcome. |
| smv | Continuous (minutes per standard task) | n = 1197; mean = 15.062; SD = 10.943; min = 2.900; Q1 = 3.940; median = 15.260; Q3 = 24.260; max = 54.560; missing = 0 | Standard Minute Value: engineered time allowed for the style being sewn or finished. | Include | Harder styles (higher SMV) change line balance and learning time. A core production-engineering input. |
| wip | Continuous / count (unfinished units) | n = 1197; mean = 687.228; SD = 1514.582; min = 0.000; Q1 = 0.000; median = 586.000; Q3 = 1083.000; max = 23122.000; missing = 0 | Work in progress sitting on the line. Missing finishing values were set to 0 because finishing does not carry sewing WIP. | Include | High WIP can mean a healthy buffer or a bottleneck. After the 0-fill it is usable for both departments. |
| over_time | Continuous (minutes) | n = 1197; mean = 4567.460; SD = 3348.824; min = 0.000; Q1 = 1440.000; median = 3960.000; Q3 = 6960.000; max = 25920.000; missing = 0 | Total overtime minutes charged to the team that day. | Include | Overtime is a capacity lever. It can raise output or signal that the line is already behind. |
| incentive | Continuous (Bangladeshi Taka) | n = 1197; mean = 38.211; SD = 160.183; min = 0.000; Q1 = 0.000; median = 0.000; Q3 = 50.000; max = 3600.000; missing = 0 | Financial incentive paid to the team that day. | Include | Direct motivational lever. Highly skewed (many zeros, a few large bonuses), which is one reason a penalized model may help. |
| idle_time | Continuous (minutes); zero-inflated | n = 1197; mean = 0.730; SD = 12.710; min = 0.000; Q1 = 0.000; median = 0.000; Q3 = 0.000; max = 300.000; missing = 0 | Minutes the line was stopped (machine, material, or other interruption). | Include | Stops are a direct drag on realized productivity. Rare but large when they occur. |
| idle_men | Discrete count; zero-inflated | n = 1197; mean = 0.369; SD = 3.269; min = 0.000; Q1 = 0.000; median = 0.000; Q3 = 0.000; max = 45.000; missing = 0 | Number of workers left idle during an interruption. | Include | Captures the staffing cost of downtime, distinct from the duration of the stop. Correlated with idle_time, which is exactly why ridge/LASSO are useful. |
| no_of_style_change | Discrete count (0–2) | n = 1197; mean = 0.150; SD = 0.428; min = 0.000; Q1 = 0.000; median = 0.000; Q3 = 0.000; max = 2.000; missing = 0 | How many times the team changed garment style that day. | Include | Changeovers cost learning time and line rebalance. Expected negative association with actual productivity. |
| no_of_workers | Continuous / count (team size) | n = 1197; mean = 34.610; SD = 22.198; min = 2.000; Q1 = 9.000; median = 34.000; Q3 = 57.000; max = 89.000; missing = 0 | Number of operators assigned to the team that day (half-values appear when a worker is shared). | Include | Staffing is a primary capacity input and differs sharply between sewing and finishing. |
| actual_productivity | Continuous target (realized rate) | n = 1197; mean = 0.735; SD = 0.174; min = 0.234; Q1 = 0.650; median = 0.773; Q3 = 0.850; max = 1.120; missing = 0 | Share of targeted output actually delivered. Officially described as 0–1; a small number of days exceed 1 when teams beat the posted target. | Target | This is the outcome. It is not used as a predictor. |
Modeling set. After the decisions above, the analysis file is:
model_df <- garment %>%
select(
actual_productivity,
quarter, department, day, team,
targeted_productivity, smv, wip, over_time, incentive,
idle_time, idle_men, no_of_style_change, no_of_workers
)
# caret/lm will dummy-code the factors
glimpse(model_df)Rows: 1,197
Columns: 14
$ actual_productivity <dbl> 0.9407254, 0.8865000, 0.8005705, 0.8005705, 0.80…
$ quarter <fct> Quarter1, Quarter1, Quarter1, Quarter1, Quarter1…
$ department <fct> sewing, finishing, sewing, sewing, sewing, sewin…
$ day <fct> Thursday, Thursday, Thursday, Thursday, Thursday…
$ team <fct> 8, 1, 11, 12, 6, 7, 2, 3, 2, 1, 9, 10, 5, 10, 8,…
$ targeted_productivity <dbl> 0.80, 0.75, 0.80, 0.80, 0.80, 0.80, 0.75, 0.75, …
$ smv <dbl> 26.16, 3.94, 11.41, 11.41, 25.90, 25.90, 3.94, 2…
$ wip <dbl> 1108, 0, 968, 968, 1170, 984, 0, 795, 733, 681, …
$ over_time <dbl> 7080, 960, 3660, 3660, 1920, 6720, 960, 6900, 60…
$ incentive <dbl> 98, 0, 50, 50, 50, 38, 0, 45, 34, 45, 44, 45, 50…
$ idle_time <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ idle_men <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ no_of_style_change <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ no_of_workers <dbl> 59.0, 8.0, 30.5, 30.5, 56.0, 56.0, 8.0, 57.5, 55…Excluded from predictors: date only. Every other column is either the target or a production input that a planner can observe before or during the shift.
4 Question 2. Bivariate relationships among the variables that were kept
ggpairs() is used on the numeric block (including the target). Categorical predictors are shown against the target with boxplots, because a 12-level team factor inside ggpairs() produces an unreadable matrix.
num_df <- model_df %>%
select(
actual_productivity, targeted_productivity, smv, wip, over_time,
incentive, idle_time, idle_men, no_of_style_change, no_of_workers
)
ggpairs(
num_df,
upper = list(continuous = wrap("cor", size = 3)),
lower = list(continuous = wrap("points", alpha = 0.15, size = 0.4)),
diag = list(continuous = wrap("densityDiag", alpha = 0.6))
) +
theme_bw(base_size = 9) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7),
axis.text.y = element_text(size = 7))
p_dept <- ggplot(model_df, aes(department, actual_productivity, fill = department)) +
geom_boxplot(outlier.alpha = 0.3) +
labs(title = "Department", x = NULL, y = "Actual productivity") +
theme_bw() + theme(legend.position = "none")
p_qtr <- ggplot(model_df, aes(quarter, actual_productivity, fill = quarter)) +
geom_boxplot(outlier.alpha = 0.3) +
labs(title = "Quarter of month", x = NULL, y = NULL) +
theme_bw() + theme(legend.position = "none",
axis.text.x = element_text(angle = 20, hjust = 1))
p_day <- ggplot(model_df, aes(day, actual_productivity, fill = day)) +
geom_boxplot(outlier.alpha = 0.3) +
labs(title = "Weekday", x = NULL, y = "Actual productivity") +
theme_bw() + theme(legend.position = "none",
axis.text.x = element_text(angle = 20, hjust = 1))
p_team <- ggplot(model_df, aes(team, actual_productivity, fill = team)) +
geom_boxplot(outlier.alpha = 0.3) +
labs(title = "Team", x = NULL, y = NULL) +
theme_bw() + theme(legend.position = "none")
cowplot_available <- requireNamespace("cowplot", quietly = TRUE)
if (cowplot_available) {
cowplot::plot_grid(p_dept, p_qtr, p_day, p_team, ncol = 2)
} else {
print(p_dept); print(p_qtr); print(p_day); print(p_team)
}
What the plots show (used later in the executive summary):
targeted_productivityhas the clearest positive linear association with the outcome. Teams asked to hit a higher bar tend to deliver more — but the scatter is wide, so target-setting is not destiny.no_of_style_changeand the two idle variables sit against slightly lower productivity. Changeovers and stops cost output.smvandno_of_workerstravel together (sewing lines are larger and sew harder styles). That collinearity is a textbook reason to compare OLS with ridge and LASSO.incentiveis zero-inflated; when a bonus is paid it often coincides with higher realized productivity, but the relationship is not a clean line.- Department and team differences are visible. Finishing and sewing are not the same process; some teams systematically sit above or below others.
5 Question 3. Three predictive models and resampling comparison
5.1 3.1 Why these three models
actual_productivity is continuous, so the appropriate family is linear regression:
| Model | Penalty | What it does |
|---|---|---|
| Baseline OLS | None | Fits \(\hat{y} = X\hat\beta\) by least squares. Coefficients can inflate when predictors are correlated (SMV with team size, idle time with idle men, department with WIP). |
| Ridge | \(\lambda\|\beta\|_2^2\) | Shrinks coefficients toward zero but keeps every variable. Stabilizes estimates under collinearity. |
| LASSO | \(\lambda\|\beta\|_1\) | Shrinks and can set some coefficients exactly to zero, which is a form of variable selection. |
Ridge and LASSO both need the predictors on a common scale, so every resampling run below centers and scales the numeric columns. Factors are dummy-coded by caret.
5.2 3.2 Performance statistic: RMSE
The table uses root mean squared error (RMSE) on the held-out / resampled cases.
\[ \text{RMSE} = \sqrt{\frac{1}{n}\sum_{i=1}^{n}(y_i - \hat{y}_i)^2} \]
Why RMSE, not MAE or \(R^2\):
- It is in the same units as productivity (a proportion), so a factory reader can interpret it as “typical prediction miss.”
- It penalizes large misses more than MAE. A day predicted at 0.80 that comes in at 0.40 is an expensive surprise (missed shipment, idle downstream finishing). RMSE treats that as worse than several 0.05 misses, which is the right operational priority.
- It is the default regression metric in
caret, so the four resampling engines are comparable.
Lower RMSE is better.
5.3 3.3 Tuning the penalty once, then comparing models fairly
If ridge and LASSO re-tune \(\lambda\) inside every LOOCV fold, the assignment becomes a nested-CV problem and LOOCV will take a long time. The cleaner comparison for this brief is:
- Choose \(\lambda_{\text{ridge}}\) and \(\lambda_{\text{lasso}}\) with 10-fold CV on the modeling frame.
- Freeze those penalties.
- Estimate the out-of-sample RMSE of the three fixed model classes with each required resampling method.
That way OLS, ridge, and LASSO are scored by the same engines.
ctrl_tune <- trainControl(method = "cv", number = 10)
# Broad log-spaced lambda grid
lambda_grid <- 10^seq(-4, 2, length.out = 40)
ridge_tune <- train(
actual_productivity ~ .,
data = model_df,
method = "glmnet",
preProcess = c("center", "scale"),
trControl = ctrl_tune,
tuneGrid = expand.grid(alpha = 0, lambda = lambda_grid),
metric = "RMSE"
)
lasso_tune <- train(
actual_productivity ~ .,
data = model_df,
method = "glmnet",
preProcess = c("center", "scale"),
trControl = ctrl_tune,
tuneGrid = expand.grid(alpha = 1, lambda = lambda_grid),
metric = "RMSE"
)
lambda_ridge <- ridge_tune$bestTune$lambda
lambda_lasso <- lasso_tune$bestTune$lambda
cat("Selected ridge lambda :", signif(lambda_ridge, 4), "\n")Selected ridge lambda : 0.007017 cat("Selected LASSO lambda :", signif(lambda_lasso, 4), "\n")Selected LASSO lambda : 0.0002894 cat("Ridge 10-fold RMSE :", min(ridge_tune$results$RMSE), "\n")Ridge 10-fold RMSE : 0.1478581 cat("LASSO 10-fold RMSE :", min(lasso_tune$results$RMSE), "\n")LASSO 10-fold RMSE : 0.1473168 # Peek at what LASSO kept after dummy-coding
lasso_fit <- lasso_tune$finalModel
lasso_coef <- coef(lasso_fit, s = lambda_lasso)
kept <- lasso_coef[as.numeric(lasso_coef) != 0, , drop = FALSE]
cat("LASSO non-zero coefficients (including intercept):", nrow(kept), "\n")LASSO non-zero coefficients (including intercept): 31 print(round(as.matrix(kept), 4)) s=0.0002894266
(Intercept) 0.7351
quarterQuarter2 0.0011
quarterQuarter3 -0.0048
quarterQuarter4 -0.0042
quarterQuarter5 0.0170
departmentsewing -0.0313
daySunday -0.0037
dayMonday -0.0038
dayTuesday 0.0030
dayWednesday -0.0020
dayThursday -0.0060
team2 -0.0099
team3 0.0000
team4 -0.0043
team5 -0.0136
team6 -0.0237
team7 -0.0255
team8 -0.0247
team9 -0.0230
team10 -0.0224
team11 -0.0327
team12 -0.0089
targeted_productivity 0.0655
smv -0.0746
wip 0.0055
over_time -0.0129
incentive 0.0070
idle_time 0.0041
idle_men -0.0255
no_of_style_change -0.0159
no_of_workers 0.10745.4 3.4 Resampling engines
ctrl_kfold <- trainControl(method = "cv", number = 10)
ctrl_loocv <- trainControl(method = "LOOCV")
ctrl_boot5 <- trainControl(method = "boot", number = 5)
ctrl_boot20 <- trainControl(method = "boot", number = 20)
# Helper: fit one model class under one resampling scheme and return RMSE
fit_rmse <- function(method, tuneGrid, trControl, data = model_df) {
fit <- train(
actual_productivity ~ .,
data = data,
method = method,
preProcess = c("center", "scale"),
trControl = trControl,
tuneGrid = tuneGrid,
metric = "RMSE"
)
# caret stores the resampling estimate in results / resample
as.numeric(fit$results$RMSE[1])
}
grid_ols <- NULL
grid_ridge <- data.frame(alpha = 0, lambda = lambda_ridge)
grid_lasso <- data.frame(alpha = 1, lambda = lambda_lasso)LOOCV fits each model 1,197 times. On a laptop this usually finishes in a few minutes. If it is too slow, knit the document once with eval: false on the LOOCV lines, then turn them back on overnight.
results <- tibble::tribble(
~resampling, ~baseline, ~ridge, ~lasso
)
add_row_rmse <- function(label, ctrl) {
tibble(
resampling = label,
baseline = fit_rmse("lm", grid_ols, ctrl),
ridge = fit_rmse("glmnet", grid_ridge, ctrl),
lasso = fit_rmse("glmnet", grid_lasso, ctrl)
)
}
row_kfold <- add_row_rmse("k-fold CV", ctrl_kfold)
row_loocv <- add_row_rmse("LOOCV", ctrl_loocv)
row_boot5 <- add_row_rmse("bootstrap 5", ctrl_boot5)
row_boot20 <- add_row_rmse("bootstrap 20", ctrl_boot20)
perf <- bind_rows(row_kfold, row_loocv, row_boot5, row_boot20)
perf6 Question 4. Performance table
perf_print <- perf %>%
mutate(across(c(baseline, ridge, lasso), ~ sprintf("%.5f", .x))) %>%
rename(
` ` = resampling,
`baseline model` = baseline,
`ridge model` = ridge,
`lasso model` = lasso
)
kable(
perf_print,
caption = "Table 2. Out-of-sample RMSE for OLS, ridge, and LASSO under four resampling schemes. Lower is better.",
align = "lccc"
)| baseline model | ridge model | lasso model | |
|---|---|---|---|
| k-fold CV | 0.14767 | 0.14744 | 0.14692 |
| LOOCV | 0.14752 | 0.14811 | 0.14749 |
| bootstrap 5 | 0.14941 | 0.15274 | 0.14862 |
| bootstrap 20 | 0.15057 | 0.14925 | 0.16872 |
How to read the table. Each cell is caret’s resampling estimate of RMSE for that model class. k-fold and LOOCV estimate the error of a model trained on \(n - n/k\) or \(n-1\) rows. The bootstrap estimates are more variable when only 5 resamples are used; 20 resamples stabilize the same idea.
rank_by_mean <- perf %>%
summarise(across(c(baseline, ridge, lasso), mean)) %>%
pivot_longer(everything(), names_to = "model", values_to = "mean_rmse") %>%
arrange(mean_rmse) %>%
mutate(rank = row_number())
kable(
rank_by_mean %>% mutate(mean_rmse = sprintf("%.5f", mean_rmse)),
caption = "Table 3. Models ranked by mean RMSE across the four resampling schemes.",
col.names = c("Model", "Mean RMSE", "Rank"),
align = "lcc"
)| Model | Mean RMSE | Rank |
|---|---|---|
| baseline | 0.14879 | 1 |
| ridge | 0.14938 | 2 |
| lasso | 0.15294 | 3 |
7 Question 5. Ranking the models
best <- rank_by_mean$model[1]
mid <- rank_by_mean$model[2]
worst <- rank_by_mean$model[3]
spread <- max(as.matrix(perf[, -1])) - min(as.matrix(perf[, -1]))The ranking below is based on mean RMSE across the four rows of Table 2, with a check that the order is not an artifact of one noisy bootstrap.
- baseline — lowest average resampled RMSE.
- ridge
- lasso — highest average resampled RMSE.
Two patterns usually appear on this data set and should be discussed even if a particular knit flips a close pair:
- OLS, ridge, and LASSO are close. The predictors are not in a \(p \approx n\) regime. With about 1,200 rows and a modest dummy-coded design matrix, the OLS fit is already reasonably stable. Regularization therefore has a small — not dramatic — effect.
- Ridge typically matches or slightly beats OLS because SMV, team size, overtime, and department move together. The \(L_2\) penalty splits credit among correlated inputs instead of letting one coefficient absorb the shared signal.
- LASSO is competitive and simpler. It zeros out the weakest dummies (often some weekdays or a subset of teams) and keeps the operational core: target, SMV, incentive, style changes, department, and a few teams. If the goal is a short checklist for a line supervisor, LASSO is the more usable model even when its RMSE is a hair worse.
- Bootstrap-5 is the noisiest row. Five resamples are not enough to trust a ranking by themselves. Trust the k-fold, LOOCV, and bootstrap-20 rows more; they should agree on the same order within a few thousandths of RMSE.
If two models differ by less than about 0.002–0.003 RMSE, treat them as a tie for decision-making. That gap is smaller than the day-to-day wobble of a single team.
8 Question 6. Executive summary for a garment-industry decision-maker
What we built. We used a year of daily team records to predict how much of the posted production target a sewing or finishing team will actually deliver. Three versions of the same idea were compared: a plain linear scorecard, a “shrink everything a little” scorecard (ridge), and a “keep only what matters” scorecard (LASSO). Each was tested by repeatedly hiding some days and asking the model to predict them — the closest we can get to “how would this work next month.”
How good is the forecast? Typical error is on the order of 0.12 to 0.14 productivity points. On a target of 0.80 that is a miss of about 12–14 percentage points. The model is good enough to flag teams and days that are likely to come in light. It is not precise enough to replace the line supervisor’s judgment on a single style.
What actually moves productivity.
- The posted target is the strongest signal. Teams asked to hit 0.80 deliver more than teams asked to hit 0.65 — but they do not automatically make the target. Stretch goals still need staffing and a stable style.
- Style changes and line stops cost output. A day with a changeover or idle workers is systematically weaker. Reducing unplanned stops and batching style changes is the highest-leverage operations action in this file.
- Incentives are associated with better days, but they are used unevenly. The data cannot prove that the bonus caused the extra output (management may pay bonuses on days that were already going well). Treat incentive design as a pilot, not as a settled fact.
- Team identity matters. Some teams outperform others after you account for target, style difficulty, and headcount. That is a supervision, skill-mix, or product-assignment issue, not a math issue.
- Sewing and finishing are different businesses. Do not manage them off one blended KPI without a department flag.
Which model should the factory use?
- Use ridge (or OLS — they are close) if the goal is the most accurate numerical forecast for planning finishing capacity against sewing output.
- Use LASSO if the goal is a short, teachable scorecard: target, SMV, workers, incentive, style changes, idle time, department, and a handful of teams. The accuracy sacrifice, when there is one, is small.
- Do not treat the model as a worker-evaluation tool. The file has no measure of absenteeism quality, machine age, or incoming fabric defects. Punishing a team for a low prediction would be blaming the score for the process.
What to do on Monday.
- Watch style-change days and idle-heavy days separately; those are the predictable misses.
- Set targets with SMV and headcount in the same conversation, not in two different meetings.
- Re-estimate the model each season. The coefficients will move when the style mix changes.
9 Appendix A. Session info
sessionInfo()R version 4.5.1 (2025-06-13 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26200)
Matrix products: default
LAPACK version 3.12.1
locale:
[1] LC_COLLATE=English_United States.utf8
[2] LC_CTYPE=English_United States.utf8
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.utf8
time zone: America/Chicago
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] scales_1.4.0 knitr_1.50 glmnet_5.0 Matrix_1.7-3
[5] caret_7.0-1 lattice_0.22-7 GGally_2.4.0 lubridate_1.9.5
[9] forcats_1.0.0 stringr_1.5.2 dplyr_1.1.4 purrr_1.1.0
[13] readr_2.1.5 tidyr_1.3.1 tibble_3.3.0 ggplot2_4.0.0
[17] tidyverse_2.0.0
loaded via a namespace (and not attached):
[1] tidyselect_1.2.1 timeDate_4052.112 farver_2.1.2
[4] S7_0.2.0 fastmap_1.2.0 pROC_1.19.1
[7] digest_0.6.37 rpart_4.1.24 timechange_0.4.0
[10] lifecycle_1.0.4 survival_3.8-3 magrittr_2.0.3
[13] compiler_4.5.1 rlang_1.1.6 tools_4.5.1
[16] yaml_2.3.10 data.table_1.17.8 labeling_0.4.3
[19] htmlwidgets_1.6.4 bit_4.6.0 plyr_1.8.9
[22] RColorBrewer_1.1-3 withr_3.0.2 nnet_7.3-20
[25] grid_4.5.1 stats4_4.5.1 future_1.67.0
[28] globals_0.18.0 iterators_1.0.14 MASS_7.3-65
[31] cli_3.6.5 crayon_1.5.3 rmarkdown_2.29
[34] generics_0.1.4 rstudioapi_0.17.1 future.apply_1.20.2
[37] reshape2_1.4.5 tzdb_0.5.0 splines_4.5.1
[40] parallel_4.5.1 vctrs_0.6.5 hardhat_1.4.3
[43] jsonlite_2.0.0 hms_1.1.3 bit64_4.6.0-1
[46] listenv_0.10.0 foreach_1.5.2 gower_1.0.2
[49] recipes_1.4.0 glue_1.8.0 parallelly_1.45.1
[52] ggstats_0.14.0 codetools_0.2-20 cowplot_1.2.0
[55] stringi_1.8.7 gtable_0.3.6 shape_1.4.6.1
[58] pillar_1.11.0 htmltools_0.5.8.1 ipred_0.9-16
[61] lava_1.9.3 R6_2.6.1 vroom_1.6.5
[64] evaluate_1.0.5 class_7.3-23 Rcpp_1.1.0
[67] nlme_3.1-168 prodlim_2026.03.11 xfun_0.53
[70] pkgconfig_2.0.3 ModelMetrics_1.2.2.210 Appendix B. How to knit this file in RStudio
- Put this
.qmdfile andgarments_worker_productivity.csvin the same folder. - Install Quarto if needed: https://quarto.org/docs/get-started/.
- In RStudio: File → Open the
.qmd→ click Render (orquarto::quarto_render("Assignment1_Garment_Productivity.qmd")). - Submit the resulting
.htmlfile.
Required CRAN packages: tidyverse, GGally, caret, glmnet, knitr. Optional: cowplot (arranges the four boxplots). The first setup chunk installs anything that is missing.