14.6 Conclusion
This chapter walked a complete BI project end-to-end through the spec-driven workflow — from a vague stakeholder email, to a written Business Requirements Specification, to a project-ready dataset, four named deliverables, and an executable validation suite that mechanically verifies the deliverables against the spec. Along the way, we:
- Translated a discovery conversation into a BRS with measurable acceptance criteria.
- Authored a data specification that surfaced an upstream pipeline change before any analysis began.
- Used AI as a draft-and-critique partner, with explicit ethical guardrails.
- Built four deliverables — exploratory analysis, predictive model, ranked risk list, executive summary outline — that map one-to-one to the BRS.
- Validated every acceptance criterion as a runnable check that fails loudly when the project drifts.
The discipline pays off most on iteration. When the HR team comes back next quarter with a new question, the spec, the analysis, and the validation suite are still in the project notebook — ready to re-run, re-check, and re-deliver. In the next chapter we apply the same instinct to a different output format: instead of a notebook for analysts, we build a dashboard for non-technical stakeholders to interact with directly.
14.6.1 Complete Code Listing
Below is the complete R code used in this chapter as a single script. You can copy this code into an R Markdown or Quarto document, render it, and reproduce the spec-driven workflow end-to-end.
Complete Code
# -------------------------------------------
# 1. Load packages
# -------------------------------------------
if(!require("pacman")) install.packages("pacman")
pacman::p_load("tidyverse", "psych", "lubridate", "knitr", "kableExtra")
# -------------------------------------------
# 2. Load the raw absence-event data
# -------------------------------------------
absenteeism_raw <- read_delim(
"https://ljkelly3141.github.io/datasets/bi-book/Absenteeism_at_work.csv",
delim = ";"
)
# -------------------------------------------
# 3. Helper: mode of a vector
# -------------------------------------------
mode_value <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
# -------------------------------------------
# 4. Aggregate to employee-level (preserving ID per spec)
# -------------------------------------------
employee_data <- absenteeism_raw |>
group_by(ID) |>
summarise(
Age = first(Age),
`Service time` = first(`Service time`),
`Body mass index` = first(`Body mass index`),
Education = first(Education),
`Distance from Residence to Work` = first(`Distance from Residence to Work`),
`Most common reason for absence` = mode_value(`Reason for absence`),
`Number of absence` = sum(`Reason for absence` != 0),
`Absenteeism time in hours` = sum(`Absenteeism time in hours`)
) |>
mutate(
Education = factor(Education) |>
fct_recode(
"high school" = "1",
"graduate" = "2",
"postgraduate" = "3",
"master and doctor" = "4"
)
)
# -------------------------------------------
# 5. Derive the Chronic flag (BRS: > 40 hr / quarter)
# -------------------------------------------
employee_data <- employee_data |>
mutate(
`Hours per quarter` = `Absenteeism time in hours` / 8, # 8 quarters in dataset
Chronic = `Hours per quarter` > 40
)
# -------------------------------------------
# 6. Deliverable 1: exploratory plots
# -------------------------------------------
ggplot(employee_data, aes(x = Education, y = `Hours per quarter`)) +
geom_boxplot(fill = "steelblue", alpha = 0.5) +
geom_hline(yintercept = 40, linetype = "dashed", color = "red") +
labs(
title = "Quarterly absenteeism by education level",
subtitle = "Dashed line: 40-hour chronic threshold",
y = "Hours per quarter",
x = NULL
) +
theme_minimal()
absenteeism_raw |>
filter(`Day of the week` %in% 2:6) |>
mutate(
`Day of the week` = factor(
`Day of the week`,
levels = 2:6,
labels = c("Mon", "Tue", "Wed", "Thu", "Fri")
)
) |>
group_by(`Day of the week`) |>
summarise(`Total hours` = sum(`Absenteeism time in hours`)) |>
ggplot(aes(x = `Day of the week`, y = `Total hours`)) +
geom_col(fill = "steelblue") +
labs(
title = "Total absenteeism by day of the week",
y = "Total hours absent (across all events)",
x = NULL
) +
theme_minimal()
# -------------------------------------------
# 7. Deliverable 2: predictive model
# -------------------------------------------
set.seed(42)
n <- nrow(employee_data)
train_idx <- sample(seq_len(n), size = floor(0.7 * n))
train_data <- employee_data[train_idx, ]
test_data <- employee_data[-train_idx, ]
model <- glm(
Chronic ~ Age + `Service time` + `Body mass index` +
Education + `Distance from Residence to Work`,
data = train_data,
family = binomial()
)
test_data <- test_data |>
mutate(
`Predicted probability` = predict(model, newdata = test_data, type = "response"),
`Predicted chronic` = `Predicted probability` > 0.5
)
accuracy <- mean(test_data$`Predicted chronic` == test_data$Chronic)
# -------------------------------------------
# 8. Deliverable 3: ranked risk list
# -------------------------------------------
risk_list <- employee_data |>
mutate(
`Predicted probability` = predict(model, newdata = employee_data, type = "response")
) |>
arrange(desc(`Predicted probability`)) |>
select(
ID,
`Predicted probability`,
`Hours per quarter`,
Chronic,
Age,
Education,
`Service time`,
`Body mass index`
)
# -------------------------------------------
# 9. Validation suite
# -------------------------------------------
validate_data_quality <- function(data) {
list(
completeness_age = list(
passed = all(!is.na(data$Age)),
message = "All employees have a non-missing Age."
),
completeness_service = list(
passed = all(!is.na(data$`Service time`)),
message = "All employees have a non-missing Service time."
),
accuracy_age_range = list(
passed = all(data$Age >= 27 & data$Age <= 58),
message = "All Age values fall in the documented 27-58 range."
),
accuracy_bmi_range = list(
passed = all(data$`Body mass index` >= 19 & data$`Body mass index` <= 40),
message = "All BMI values fall within plausible bounds (19-40)."
),
consistency_education = list(
passed = all(levels(data$Education) %in%
c("high school", "graduate", "postgraduate", "master and doctor")),
message = "Education levels match the documented factor labels."
)
)
}
validate_deliverables <- function(model, accuracy, threshold = 0.70) {
predictors <- attr(terms(model), "term.labels")
forbidden <- c("Gender", "Ethnicity", "Religion")
list(
no_protected_predictors = list(
passed = !any(forbidden %in% predictors),
message = "Model formula excludes protected characteristics."
),
accuracy_meets_kpi = list(
passed = accuracy >= threshold,
message = sprintf(
"Held-out accuracy %.1f%% meets the %.0f%% KPI threshold.",
accuracy * 100, threshold * 100
)
)
)
}
checks <- c(
validate_data_quality(employee_data),
validate_deliverables(model, accuracy)
)
results <- tibble::tibble(
check = names(checks),
passed = vapply(checks, \(x) x$passed, logical(1)),
message = vapply(checks, \(x) x$message, character(1))
)
print(results)