--- title: "Integration Workflows: Combining Supervised and Unsupervised Learning" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Integration Workflows: Combining Supervised and Unsupervised Learning} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 5 ) ``` ```{r setup} library(tidylearn) library(dplyr) library(ggplot2) ``` ## Introduction Five 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. ## Dimensionality Reduction as Preprocessing 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. ### Basic Usage ```{r} # Reduce dimensions before classification reduced <- tl_reduce_dimensions(iris, response = "Species", method = "pca", n_components = 3) # Inspect reduced data head(reduced$data) ``` ```{r} # 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) ``` ```{r} # Training-set accuracy. Use tl_evaluate() rather than comparing $.pred by # hand: what $.pred holds depends on the method and prediction type. tl_evaluate(model_reduced) ``` ### Comparison: Original vs Reduced Features ```{r} # 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") cat("PCA features:", n_reduced, "->", acc(eval_pca), "%\n") cat("Feature reduction:", round((1 - n_reduced / n_original) * 100, 1), "%\n") ``` ## Cluster-Based Feature Engineering 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. ### Adding Cluster Features ```{r} # Add cluster features data_clustered <- tl_add_cluster_features(iris, response = "Species", method = "kmeans", k = 3) # Check new features names(data_clustered) ``` ```{r} # Train model with cluster features model_cluster <- tl_model(data_clustered, Species ~ ., method = "forest") print(model_cluster) ``` ### Performance Comparison ```{r} # 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") cat("With cluster features:", round(acc_with_cluster * 100, 1), "%\n") ``` ## Semi-Supervised Learning 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. ### Training with Limited Labels ```{r} # 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) ``` ```{r} # Check how labels were propagated label_mapping <- model_semi$semisupervised_info$label_mapping print(label_mapping) ``` ```{r} # 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") labeled_pct <- round( length(labeled_indices) / nrow(iris) * 100, 1 ) cat("Proportion of data labeled:", labeled_pct, "%\n") ``` ### Comparison: Semi-Supervised vs Fully Supervised ```{r} # 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") cat("Semi-supervised (15 labels + propagation):", round(accuracy_semi * 100, 1), "%\n") ``` ## Anomaly-Aware Modeling `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. ### Flagging Anomalies ```{r, eval=FALSE} # Flag anomalies as a feature model_anomaly_flag <- tl_anomaly_aware(iris, Species ~ ., response = "Species", anomaly_method = "dbscan", action = "flag", supervised_method = "forest") # Check anomaly info cat("Anomalies detected:", model_anomaly_flag$anomaly_info$n_anomalies, "\n") ``` ### Removing Anomalies ```{r, eval=FALSE} # Remove anomalies before training model_anomaly_remove <- tl_anomaly_aware(iris, Species ~ ., response = "Species", anomaly_method = "dbscan", action = "remove", supervised_method = "forest") cat("Anomalies removed:", model_anomaly_remove$anomalies_removed, "\n") ``` ## Stratified Models 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. ### Training Stratified Models ```{r} # Train separate models for different clusters stratified_models <- tl_stratified_models(mtcars, mpg ~ ., cluster_method = "kmeans", k = 3, supervised_method = "linear") # Check structure names(stratified_models) length(stratified_models$supervised_models) ``` ```{r} # Predictions using stratified models preds_stratified <- predict(stratified_models) head(preds_stratified) ``` ```{r} # Calculate RMSE rmse_stratified <- sqrt(mean((preds_stratified$.pred - mtcars$mpg)^2)) cat("Stratified Model RMSE:", round(rmse_stratified, 2), "\n") # 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") ``` ## Complete Integration Workflow Combining multiple integration techniques: ```{r} # 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) ``` ```{r} # 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") ``` ## Practical Example: Credit Risk Assessment ```{r} # 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 ) ``` ```{r} # 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") ``` ## What Each Combination Buys You - **Dimensionality reduction before fitting** trades some accuracy for a smaller feature space. Whether the trade is worth making is empirical -- run the comparison above on your own data. - **Cluster features** give a model a handle on group structure it cannot otherwise express. On data with no group structure they add noise. - **Semi-supervised learning** is worth reaching for when labels are expensive and unlabelled observations are plentiful. - **Anomaly-aware modelling** decides what happens to outliers explicitly rather than leaving it to the loss function. - **Stratified models** fit one model per cluster, which reads more easily than a single model with many interaction terms, and needs enough observations in every cluster to be estimable. ## Function Reference | 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 | ## Where to Go Next - `vignette("unsupervised-learning")` — the clustering and ordination steps above, driven directly - `vignette("tuning-and-pipelines")` — `tl_pipeline()` does the train-then-replay bookkeeping for you - `vignette("automl")` — `tl_auto_ml()` applies the PCA and clustering variants automatically