library(tidylearn)
library(dplyr)
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.5.3Five functions put an unsupervised step in front of a supervised one: reduce the features, add cluster membership as a feature, propagate labels you do not have, handle outliers explicitly, or fit one model per cluster.
They coordinate the wrapped packages rather than implementing
anything new. Each step is an ordinary tl_model() object,
so $fit still reaches what the underlying package returned
— $fit$model for the unsupervised step.
One rule governs all five, and it is the thing that goes wrong most often: the unsupervised step is fitted on training data and must then be applied to the test set, never refitted on it. Every example below carries the transformation across explicitly, because refitting leaks the test set into the model.
PCA or MDS collapses correlated predictors into fewer components before the supervised fit. That costs some information and buys a smaller, less collinear feature space.
# Reduce dimensions before classification
reduced <- tl_reduce_dimensions(iris,
response = "Species",
method = "pca",
n_components = 3)
# Inspect reduced data
head(reduced$data)
#> # A tibble: 6 × 4
#> PC1 PC2 PC3 Species
#> <dbl> <dbl> <dbl> <fct>
#> 1 -2.26 -0.478 0.127 setosa
#> 2 -2.07 0.672 0.234 setosa
#> 3 -2.36 0.341 -0.0441 setosa
#> 4 -2.29 0.595 -0.0910 setosa
#> 5 -2.38 -0.645 -0.0157 setosa
#> 6 -2.07 -1.48 -0.0269 setosa# Train classifier on the reduced features. iris has three species, so this
# needs a multiclass-capable method -- logistic regression is binary only.
model_reduced <- tl_model(reduced$data, Species ~ ., method = "forest")
print(model_reduced)
#> tidylearn Model
#> ===============
#> Paradigm: supervised
#> Method: forest
#> Task: Classification
#> Formula: Species ~ .
#>
#> Training observations: 150# Split data for fair comparison
split <- tl_split(iris, prop = 0.7, stratify = "Species", seed = 123)
# Model with original features
model_original <- tl_model(split$train, Species ~ ., method = "forest")
eval_original <- tl_evaluate(model_original, new_data = split$test)
# Model with PCA features
reduced_train <- tl_reduce_dimensions(split$train,
response = "Species",
method = "pca",
n_components = 3)
model_pca <- tl_model(reduced_train$data, Species ~ ., method = "forest")
# The test set must be projected through the PCA fitted on the training
# data -- refitting PCA on the test set would leak information
test_transformed <- predict(
reduced_train$reduction_model,
new_data = split$test %>% select(-Species)
)
test_transformed$Species <- split$test$Species
eval_pca <- tl_evaluate(model_pca, new_data = test_transformed)
# Compare results
acc <- function(x) round(x$value[x$metric == "accuracy"] * 100, 1)
n_original <- ncol(split$train) - 1
n_reduced <- sum(grepl("^PC", names(reduced_train$data)))
cat("Original features:", n_original, "->", acc(eval_original), "%\n")
#> Original features: 4 -> 93.3 %
cat("PCA features:", n_reduced, "->", acc(eval_pca), "%\n")
#> PCA features: 3 -> 91.1 %
cat("Feature reduction:",
round((1 - n_reduced / n_original) * 100, 1), "%\n")
#> Feature reduction: 25 %Add cluster assignments as a feature, so a model that cannot express
group structure directly gets a column that encodes it. The cluster
model is kept on the result as a "cluster_model" attribute,
which is what you need to assign test rows to the same clusters.
# Compare models with and without cluster features
split_comp <- tl_split(iris, prop = 0.7, stratify = "Species", seed = 42)
# Without cluster features
model_no_cluster <- tl_model(split_comp$train, Species ~ ., method = "forest")
preds_no_cluster <- predict(model_no_cluster, new_data = split_comp$test)
acc_no_cluster <- mean(preds_no_cluster$.pred == split_comp$test$Species)
# With cluster features
train_clustered <- tl_add_cluster_features(split_comp$train,
response = "Species",
method = "kmeans",
k = 3)
model_with_cluster <- tl_model(train_clustered, Species ~ ., method = "forest")
# Need to get cluster model for test data
cluster_model <- attr(train_clustered, "cluster_model")
test_clusters <- predict(cluster_model, new_data = split_comp$test[, -5])
test_clustered <- split_comp$test
test_clustered$cluster_kmeans <- as.factor(test_clusters$cluster)
preds_with_cluster <- predict(model_with_cluster, new_data = test_clustered)
acc_with_cluster <- mean(preds_with_cluster$.pred == split_comp$test$Species)
cat("Without cluster features:", round(acc_no_cluster * 100, 1), "%\n")
#> Without cluster features: 93.3 %
cat("With cluster features:", round(acc_with_cluster * 100, 1), "%\n")
#> With cluster features: 93.3 %When labels are expensive and unlabelled rows are plentiful, cluster the full dataset and give each cluster the majority label of whatever labelled rows fall in it. The propagated labels are guesses, and the fit is only as good as the assumption that clusters line up with classes.
# Use only 10% of labels
set.seed(123)
labeled_indices <- sample(nrow(iris), size = 15) # 15 of 150 labelled
# supervised_method defaults to "tree". Named here because a forest is
# the better fit for propagated labels: the propagation step introduces
# noise, and averaging over trees absorbs more of it than one tree does.
model_semi <- tl_semisupervised(iris, Species ~ .,
labeled_indices = labeled_indices,
cluster_method = "kmeans",
supervised_method = "forest")
print(model_semi)
#> tidylearn Model
#> ===============
#> Paradigm: supervised
#> Method: forest
#> Task: Classification
#> Formula: Species ~ .
#>
#> Training observations: 150# Check how labels were propagated
label_mapping <- model_semi$semisupervised_info$label_mapping
print(label_mapping)
#> # A tibble: 3 × 2
#> cluster cluster_label
#> <int> <chr>
#> 1 1 virginica
#> 2 2 versicolor
#> 3 3 setosa# Evaluate against the true labels
preds_semi <- predict(model_semi, new_data = iris, type = "class")
accuracy_semi <- mean(preds_semi$.pred == iris$Species)
cat("Accuracy with only", length(labeled_indices), "labels:",
round(accuracy_semi * 100, 1), "%\n")
#> Accuracy with only 15 labels: 90 %
labeled_pct <- round(
length(labeled_indices) / nrow(iris) * 100, 1
)
cat("Proportion of data labeled:", labeled_pct, "%\n")
#> Proportion of data labeled: 10 %# Fully supervised with same amount of data
labeled_data <- iris[labeled_indices, ]
model_full <- tl_model(labeled_data, Species ~ ., method = "forest")
preds_full <- predict(model_full, new_data = iris, type = "class")
accuracy_full <- mean(preds_full$.pred == iris$Species)
cat("Fully supervised (15 samples):", round(accuracy_full * 100, 1), "%\n")
#> Fully supervised (15 samples): 94.7 %
cat("Semi-supervised (15 labels + propagation):",
round(accuracy_semi * 100, 1), "%\n")
#> Semi-supervised (15 labels + propagation): 90 %tl_anomaly_aware() runs outlier detection first and then
does one of two things with what it finds: action = "flag"
adds an indicator column and keeps the rows,
action = "remove" drops them.
One model per cluster, for data where the relationship differs between groups. It reads more easily than a single model carrying many interaction terms, and it needs enough rows in every cluster for each fit to be estimable.
# Train separate models for different clusters
stratified_models <- tl_stratified_models(mtcars, mpg ~ .,
cluster_method = "kmeans",
k = 3,
supervised_method = "linear")
#> Note: Response 'mpg' has 6 unique numeric values. Treating as regression. Convert to factor for classification.
#> Note: Response 'mpg' has 8 unique numeric values. Treating as regression. Convert to factor for classification.
# Check structure
names(stratified_models)
#> [1] "cluster_model" "supervised_models" "formula"
#> [4] "data"
length(stratified_models$supervised_models)
#> [1] 3# Predictions using stratified models
preds_stratified <- predict(stratified_models)
head(preds_stratified)
#> # A tibble: 6 × 2
#> .pred .cluster
#> <dbl> <int>
#> 1 20.7 3
#> 2 20.5 3
#> 3 24.7 3
#> 4 21.4 1
#> 5 19.2 2
#> 6 18.1 1# Calculate RMSE
rmse_stratified <- sqrt(mean((preds_stratified$.pred - mtcars$mpg)^2))
cat("Stratified Model RMSE:", round(rmse_stratified, 2), "\n")
#> Stratified Model RMSE: 1.06
# Compare with single model
model_single <- tl_model(mtcars, mpg ~ ., method = "linear")
preds_single <- predict(model_single)
rmse_single <- sqrt(mean((preds_single$.pred - mtcars$mpg)^2))
cat("Single Model RMSE:", round(rmse_single, 2), "\n")
#> Single Model RMSE: 2.15Combining multiple integration techniques:
# Step 1: Split data
workflow_split <- tl_split(iris, prop = 0.7, stratify = "Species", seed = 42)
# Step 2: Reduce dimensions
workflow_reduced <- tl_reduce_dimensions(workflow_split$train,
response = "Species",
method = "pca",
n_components = 3)
# Step 3: Add cluster features to reduced data
workflow_clustered <- tl_add_cluster_features(workflow_reduced$data,
response = "Species",
method = "kmeans",
k = 3)
# Step 4: Train final model
workflow_model <- tl_model(workflow_clustered, Species ~ ., method = "forest")
print(workflow_model)
#> tidylearn Model
#> ===============
#> Paradigm: supervised
#> Method: forest
#> Task: Classification
#> Formula: Species ~ .
#>
#> Training observations: 105# Transform test data through same pipeline
# 1. Apply PCA transformation
test_pca <- predict(workflow_reduced$reduction_model,
new_data = workflow_split$test[, -5])
test_pca$Species <- workflow_split$test$Species
# 2. Get cluster assignments. The cluster model was fitted on the PC
# columns; predict() matches new_data to those columns by name and
# errors on a mismatch rather than assigning against the wrong ones.
cluster_model_wf <- attr(workflow_clustered, "cluster_model")
test_clusters_wf <- predict(cluster_model_wf, new_data = test_pca)
test_pca$cluster_kmeans <- as.factor(test_clusters_wf$cluster)
# 3. Predict
workflow_preds <- predict(workflow_model, new_data = test_pca)
workflow_accuracy <- mean(workflow_preds$.pred == workflow_split$test$Species)
cat("Complete Workflow Accuracy:", round(workflow_accuracy * 100, 1), "%\n")
#> Complete Workflow Accuracy: 91.1 %# Simulate credit data
set.seed(42)
n <- 500
credit_data <- data.frame(
age = rnorm(n, 40, 12),
income = rnorm(n, 50000, 20000),
debt_ratio = runif(n, 0, 0.5),
credit_score = rnorm(n, 700, 100),
years_employed = rpois(n, 5)
)
# Create target variable (default risk)
credit_data$default <- factor(
ifelse(
credit_data$debt_ratio > 0.4 & credit_data$credit_score < 650,
"Yes", "No"
)
)
# Split data
credit_split <- tl_split(
credit_data, prop = 0.7, stratify = "default", seed = 123
)# Strategy 1: Add customer segments as features
credit_clustered <- tl_add_cluster_features(credit_split$train,
response = "default",
method = "kmeans",
k = 4)
model_credit <- tl_model(credit_clustered, default ~ ., method = "forest")
# Transform test data
cluster_model_credit <- attr(credit_clustered, "cluster_model")
test_clusters_credit <- predict(cluster_model_credit,
new_data = credit_split$test[, -6])
test_credit <- credit_split$test
test_credit$cluster_kmeans <- as.factor(test_clusters_credit$cluster)
preds_credit <- predict(model_credit, new_data = test_credit)
accuracy_credit <- mean(preds_credit$.pred == credit_split$test$default)
cat("Credit Risk Model Accuracy:", round(accuracy_credit * 100, 1), "%\n")
#> Credit Risk Model Accuracy: 100 %| Function | Puts this in front of the supervised fit |
|---|---|
tl_reduce_dimensions() |
PCA or MDS |
tl_add_cluster_features() |
Cluster membership as a column |
tl_semisupervised() |
Label propagation from clusters |
tl_anomaly_aware() |
Outlier detection, flagged or removed |
tl_stratified_models() |
One model per cluster |
vignette("unsupervised-learning") — the clustering and
ordination steps above, driven directlyvignette("tuning-and-pipelines") —
tl_pipeline() does the train-then-replay bookkeeping for
youvignette("automl") — tl_auto_ml() applies
the PCA and clustering variants automatically