47  Dimensionality Reduction in rtemis

decomp() fits a decomposition with a configuration from one of the setup_*() functions listed by available_decomposition(). apply_decomp() transforms new cases with a fitted decomposition, and reconstruct() maps components back to the feature space where the method allows it. This chapter decomposes the 16 voice measures of the Parkinson’s data and the 9 numeric features of the diabetes data, and uses a decomposition inside supervised training.

available_decomposition()

             Autoencoder: Autoencoder (torch)
                     ICA: Independent Component Analysis
                  Isomap: Isomap
                     MDS: Multidimensional Scaling
                     NMF: Non-negative Matrix Factorization
                     PCA: Principal Component Analysis
                    PCoA: Principal Coordinates Analysis
                    tSNE: t-Distributed Stochastic Neighbor Embedding
                    UMAP: Uniform Manifold Approximation and Projection
  VariationalAutoencoder: Variational autoencoder (torch)

47.1 Principal component analysis

The 16 voice measures fall into groups that measure related properties of the voice: five jitter measures, six shimmer measures, two noise ratios, and three nonlinear measures. Their correlations:

pk <- read_parkinsons()
voice <- pk[, Jitter:PPE]
draw_heatmap(cor(voice), zlim = c(-1, 1))

setup_PCA() centers and scales the features by default, so that the decomposition is of the correlation matrix:

ex <- setup_SerialExecution(seed = 2026L)
pca_pk <- decomp(voice, config = setup_PCA(k = 5L), execution_config = ex, verbosity = 0L)
summary(pca_pk@decom)

Importance of first k=5 (out of 16) components:
                         PC1   PC2    PC3    PC4    PC5
Standard deviation     3.356 1.293 1.1138 0.8746 0.5561
Proportion of Variance 0.704 0.105 0.0775 0.0478 0.0193
Cumulative Proportion  0.704 0.808 0.8859 0.9337 0.9530

The first component explains 70.4% of the variance of the 16 measures, and the first three together 88.6%. The loadings show which measures define each component:

loadings <- pca_pk@decom[["rotation"]][, 1:3]
draw_heatmap(loadings, zlim = c(-1, 1))

The first component weighs the jitter and shimmer measures and both noise ratios with loadings of similar magnitude, the harmonics-to-noise ratio with the opposite sign, since a higher value of it indicates a more regular voice: the component is a general measure of voice irregularity. The second component contrasts the jitter measures with the shimmer measures. The fitted scores are in the transformed property. Plotting the first two components for the recordings of six patients shows the structure of the repeated measurements:

scores <- data.table(pca_pk@transformed[, 1:2], subject = pk[["subject"]])
six <- scores[subject %in% 1:6]
draw_scatter(
  six[["PC1"]], six[["PC2"]],
  group = factor(paste("Patient", six[["subject"]])),
  xlab = "PC1", ylab = "PC2",
  point_alpha = 0.6
)

The recordings of different patients overlap, and each patient’s recordings are spread over a region of their own size and position. Across all 42 patients, the variance of the patient means accounts for 51.1% of the variance of the first component and 37.0% of the second: a substantial part of the variation in the voice measures is between patients, the structure that made grouped resampling necessary (Section 11.6).

47.2 Applying a decomposition to new cases

apply_decomp() projects new cases with the fitted centers, scales and loadings. Projecting the first three recordings reproduces their fitted scores:

apply_decomp(pca_pk, voice[1:3], execution_config = ex)

    PC1      PC2   PC3      PC4      PC5
1 0.978  0.05754 1.760 -0.04948  0.47652
2 2.602 -0.55311 1.487  0.05859 -0.06657
3 1.940  0.11550 1.206 -0.68742  0.85668

pca_pk@transformed[1:3, ]

       PC1      PC2   PC3      PC4      PC5
[1,] 0.978  0.05754 1.760 -0.04948  0.47652
[2,] 2.602 -0.55311 1.487  0.05859 -0.06657
[3,] 1.940  0.11550 1.206 -0.68742  0.85668

decomposition_traits() lists which methods can be applied to new cases and which can reconstruct the input:

decomposition_traits()[, c("name", "can_apply", "invertible")]

                     name can_apply invertible
1             Autoencoder      TRUE       TRUE
2                     ICA      TRUE       TRUE
3                  Isomap     FALSE      FALSE
4                     MDS     FALSE      FALSE
5                     NMF      TRUE       TRUE
6                     PCA      TRUE       TRUE
7                    PCoA      TRUE      FALSE
8                    tSNE     FALSE      FALSE
9                    UMAP      TRUE      FALSE
10 VariationalAutoencoder      TRUE       TRUE

47.3 Nonlinear embeddings

t-SNE and UMAP embeddings of the 9 numeric diabetes features, with each patient labeled by the tertile of disease progression, which the decompositions do not use:

db <- read_diabetes()
db_x <- db[, !c("sex", "progression")]
tertile <- cut(
  db[["progression"]],
  quantile(db[["progression"]], c(0, 1 / 3, 2 / 3, 1)),
  include.lowest = TRUE,
  labels = c("Low", "Medium", "High")
)
tsne_db <- decomp(db_x, config = setup_tSNE(k = 2L, perplexity = 30), execution_config = ex, verbosity = 0L)
umap_db <- decomp(db_x, config = setup_UMAP(k = 2L, n_neighbors = 15L), execution_config = ex, verbosity = 0L)
o <- order(tertile)
draw_panels(
  list(
    draw_scatter(
      tsne_db@transformed[o, 1], tsne_db@transformed[o, 2],
      group = tertile[o], xlab = "t-SNE 1", ylab = "t-SNE 2", title = "t-SNE"
    ),
    draw_scatter(
      umap_db@transformed[o, 1], umap_db@transformed[o, 2],
      group = tertile[o], xlab = "UMAP 1", ylab = "UMAP 2", title = "UMAP"
    )
  ),
  ncol = 1L,
  height = 900
)

Neither embedding shows separated groups. The tertiles of progression form a gradient across both embeddings, with substantial overlap, consistent with an \(R^2\) near 0.5 for the supervised models of earlier chapters. The positions of points in these plots depend on the random initialization, the perplexity and the number of neighbors.

47.4 A decomposition inside training

train() accepts a decomposition_config, which is fitted within each training set and applied to the corresponding test set (Section 46.6). A linear model of diabetes progression on the first \(k\) principal components of the 9 numeric features, with sex as an additional feature, for several values of \(k\):

cv <- setup_KFold(n_resamples = 10L, seed = 2026L)
pcr <- rbindlist(lapply(c(2L, 4L, 6L, 9L), function(k) {
  mod <- train(
    db,
    decomposition_config = setup_PCA(k = k, features = names(db_x)),
    hyperparameters = setup_GLM(),
    outer_resampling_config = cv,
    execution_config = ex,
    verbosity = 0L
  )
  data.table(k = k, rsq_test = mod@metrics_test@mean_metrics[["rsq"]])
}))
pcr

       k rsq_test
   <int>    <num>
1:     2   0.4539
2:     4   0.4808
3:     6   0.4796
4:     9   0.4935

With all 9 components, the model is a reparameterization of the linear model on the original features, and its \(R^2\), 0.493, is that of the linear model. Fewer components discard directions of small variance in the features, and with them some of the information that predicts progression.