# Hinton Diagrams in Practice: A Gallery

    library(gghinton)
    library(ggplot2)

Hinton diagrams work for any 2D numerical matrix where relative magnitude matters: signed or unsigned, sparse or dense. This vignette shows a range of real use cases across statistics, machine learning, biology, and finance.

## 1. Correlation matrix

The classic application. `cor(mtcars)` gives an 11x11 signed matrix where positive correlations appear as white squares and negative as black. The size immediately flags the dominant relationships without any colour-scale calibration.

    df_cor <- as_hinton_df(cor(mtcars))
    vars <- colnames(mtcars)

    ggplot(df_cor, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = seq_along(vars), labels = vars) +
      scale_y_continuous(breaks = seq_along(vars), labels = rev(vars)) +
      coord_fixed() +
      theme_hinton() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
      labs(
        title    = "Correlation matrix: mtcars",
        subtitle = "White = positive, black = negative"
      )

Compare this to a heatmap of the same data: the Hinton version makes it immediately obvious which correlations are large (e.g., `cyl`-`disp`, `wt`-`disp`) and which are near-zero, without having to interpret a colour gradient.

## 2. PCA loadings

The rotation matrix from principal component analysis is signed: a variable loads positively on a component if it increases in the direction of that component, negatively if it opposes it. The Hinton diagram shows at a glance which variables dominate each component and in what direction.

    pca <- prcomp(scale(mtcars))
    # First four principal components
    loadings <- pca$rotation[, 1:4]
    colnames(loadings) <- paste0("PC", 1:4)

    df_pca <- matrix_to_hinton(loadings)

    ggplot(df_pca, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:4, labels = colnames(loadings)) +
      scale_y_continuous(breaks = seq_along(rownames(loadings)),
                         labels = rev(rownames(loadings))) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "PCA loadings: mtcars",
        subtitle = "Each column is a principal component"
      )

PC1 (the largest component) shows large white squares for the performance variables (`cyl`, `disp`, `hp`, `wt`) and a large black square for `mpg` (the size/power vs efficiency axis). PC2 and beyond reveal finer structure.

## 3. Confusion matrix

A confusion matrix records how often a classifier assigns class i to class j. For a well-performing classifier, the diagonal dominates; errors appear as smaller off-diagonal squares. Hinton diagrams make systematic confusions (e.g., class A is often mistaken for class B) instantly visible.

    # Realistic confusion matrix for a 5-class classifier
    # (e.g., handwritten digit recognition on a held-out test set)
    classes <- c("0", "1", "2", "3", "4")
    conf <- matrix(c(
      96,  0,  1,  2,  1,
       0, 98,  1,  0,  1,
       2,  1, 88,  5,  4,
       1,  0,  4, 91,  4,
       1,  2,  4,  2, 91
    ), nrow = 5, byrow = TRUE,
    dimnames = list(actual = classes, predicted = classes))

    # Row-normalise so each row shows the conditional error distribution
    conf_prop <- prop.table(conf, margin = 1)

    df_conf <- as_hinton_df(conf_prop)

    ggplot(df_conf, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:5, labels = classes) +
      scale_y_continuous(breaks = 1:5, labels = rev(classes)) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "Classifier confusion matrix (row-normalised)",
        subtitle = "Diagonal = correct; off-diagonal = errors",
        x = "Predicted", y = "Actual"
      )

The dominant diagonal shows mostly correct predictions. The visible off-diagonal squares for classes “2” and “3” reveal that these are most often confused with each other, useful feedback for improving the model.

## 4. Social mobility: occupational status transitions

`datasets::occupationalStatus` records the joint distribution of fathers’ and sons’ occupational prestige in the United Kingdom (Hope 1982; 8 prestige categories, 1 = highest). Row-normalising gives the empirical probability that a son reaches status j given his father was in status i.

    trans <- prop.table(occupationalStatus, margin = 1)
    df_mob <- as_hinton_df(trans)

    ggplot(df_mob, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:8,
                         labels = colnames(occupationalStatus)) +
      scale_y_continuous(breaks = 1:8,
                         labels = rev(rownames(occupationalStatus))) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "Occupational mobility: UK (Hope 1982)",
        subtitle = "Row-normalised; large square = likely transition",
        x = "Son's status", y = "Father's status"
      )

The dominant diagonal confirms occupational inheritance. The asymmetry between upward and downward mobility is visible: squares above the diagonal (upward mobility) are generally comparable in size to those below (downward), suggesting roughly symmetric short-range mobility but with persistence at the extremes.

## 5. Credit rating transitions

Credit rating agencies publish annual studies of how often issuers move between rating categories over a one-year horizon. The matrix below uses approximate values representative of S&P Global’s published long-run averages. The structure is highly diagonal (most issuers retain their rating) with probability of default increasing sharply for lower-rated issuers.

    ratings <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D")

    # Approximate one-year transition probabilities (illustrative;
    # based on S&P Global published default studies).
    # Rows sum to 1.
    sp_mat <- matrix(c(
      # AAA      AA       A     BBB      BB       B     CCC       D
      0.9181,  0.0748,  0.0050,  0.0006,  0.0008,  0.0000,  0.0000,  0.0007,
      0.0057,  0.9109,  0.0762,  0.0054,  0.0010,  0.0006,  0.0002,  0.0000,
      0.0009,  0.0226,  0.9115,  0.0560,  0.0064,  0.0020,  0.0004,  0.0002,
      0.0002,  0.0027,  0.0507,  0.8685,  0.0588,  0.0129,  0.0024,  0.0038,
      0.0003,  0.0010,  0.0067,  0.0778,  0.7749,  0.1106,  0.0101,  0.0186,
      0.0000,  0.0006,  0.0025,  0.0104,  0.0720,  0.7653,  0.0613,  0.0879,
      0.0000,  0.0000,  0.0023,  0.0090,  0.0194,  0.1326,  0.4493,  0.3874,
      0.0000,  0.0000,  0.0000,  0.0000,  0.0000,  0.0000,  0.0000,  1.0000
    ), nrow = 8, byrow = TRUE,
    dimnames = list(from = ratings, to = ratings))

    df_sp <- as_hinton_df(sp_mat)

    ggplot(df_sp, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:8, labels = ratings) +
      scale_y_continuous(breaks = 1:8, labels = rev(ratings)) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "Credit rating one-year transition probabilities",
        subtitle = "Approximate values based on S&P Global published studies",
        x = "To rating", y = "From rating"
      )

The shrinking diagonal squares from AAA towards CCC show increasing instability at lower ratings. The large square at D->D (bottom right) reflects that default is effectively an absorbing state in the short run. The Hinton diagram makes this structural feature (near-certain retention near the top, near-certain default absorption at the bottom) visible at a glance.

## 6. Nucleotide substitution rates

In molecular evolution, the rate matrix Q describes the instantaneous rates at which DNA bases substitute for one another. Under the Kimura (1980) two-parameter model, transitions (purine<->purine: A<->G; pyrimidine<->pyrimidine: C<->T) occur at rate kappa relative to transversions (purine<->pyrimidine).

The rate matrix has a negative diagonal (rate of leaving that base) and positive off-diagonal entries. With kappa = 4 (transitions four times more frequent than transversions) the structure is immediately visible as a Hinton diagram: two large white squares per row (transitions) and two small white squares (transversions), with the large black diagonal showing the net departure rate.

    # Kimura 2-parameter rate matrix, kappa = 4
    # Rows: source base; Columns: destination base
    # Diagonal is negative (departure rate); off-diagonal positive (arrival rate)
    kappa <- 4
    # Under K80: transversion rate beta, transition rate alpha = kappa * beta
    # With overall rate normalised: beta = 1/(2+2*kappa)
    beta  <- 1 / (2 + 2 * kappa)
    alpha <- kappa * beta

    bases <- c("A", "C", "G", "T")
    Q <- matrix(c(
      -(alpha + 2*beta),  beta,               alpha,              beta,
       beta,             -(alpha + 2*beta),   beta,               alpha,
       alpha,             beta,              -(alpha + 2*beta),   beta,
       beta,              alpha,              beta,              -(alpha + 2*beta)
    ), nrow = 4, byrow = TRUE,
    dimnames = list(from = bases, to = bases))

    df_Q <- matrix_to_hinton(Q)

    ggplot(df_Q, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:4, labels = bases) +
      scale_y_continuous(breaks = 1:4, labels = rev(bases)) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = paste0("Kimura K80 substitution rate matrix (kappa = ", kappa, ")"),
        subtitle = "White = positive rate; black = negative diagonal (departure rate)",
        x = "To", y = "From"
      )

The white squares for A<->G and C<->T transitions are four times larger than the transversion squares, exactly kappa = 4. The black diagonal squares show the total departure rate for each base. This relationship, invisible in a table of numbers, is obvious at a glance in the Hinton diagram.

## 7. Regression coefficient matrix

When fitting the same regression model across multiple outcomes (or multiple groups), the coefficient matrix (outcomes as rows, predictors as columns) can be viewed as a Hinton diagram. Signed coefficients show direction of effect; size shows relative importance.

    # Three simple regressions: mpg, hp, and wt each predicted by
    # a common set of standardised predictors from mtcars
    outcomes  <- c("mpg", "hp", "wt")
    predictors <- c("cyl", "disp", "drat", "qsec", "gear", "carb")

    # Fit and collect standardised coefficients (excluding intercept)
    coef_mat <- sapply(outcomes, function(y) {
      fit <- lm(reformulate(predictors, response = y),
                data = as.data.frame(scale(mtcars)))
      coef(fit)[predictors]
    })
    # coef_mat is predictors x outcomes; transpose to outcomes x predictors
    coef_mat <- t(coef_mat)

    df_coef <- matrix_to_hinton(coef_mat)

    ggplot(df_coef, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = seq_along(predictors), labels = predictors) +
      scale_y_continuous(breaks = seq_along(outcomes),
                         labels = rev(outcomes)) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "Standardised regression coefficients",
        subtitle = "Each row is a separate outcome; white = positive effect",
        x = "Predictor", y = "Outcome"
      )

Variables with opposite effects on fuel economy versus engine power appear as contrasting colours in the same column, a feature that would require careful colour-scale alignment to communicate with a heatmap.

## 8. Cross-tabulation: hair and eye colour

`datasets::HairEyeColor` is a 3D table (hair x eye x sex). Collapsing over sex gives a 2D contingency table of hair-eye colour combinations. Hinton diagrams of contingency tables show which combinations are over- or under-represented, though for simple counts the unsigned mode applies (all squares are black).

    # Collapse over sex dimension
    hair_eye <- margin.table(HairEyeColor, margin = c(1, 2))

    # Row-normalise: probability of each eye colour given hair colour
    hair_eye_prop <- prop.table(hair_eye, margin = 1)

    df_he <- as_hinton_df(hair_eye_prop)

    ggplot(df_he, aes(x = col, y = row, weight = weight)) +
      geom_hinton() +
      scale_fill_hinton() +
      scale_x_continuous(breaks = 1:4, labels = colnames(hair_eye)) +
      scale_y_continuous(breaks = 1:4, labels = rev(rownames(hair_eye))) +
      coord_fixed() +
      theme_hinton() +
      labs(
        title    = "Eye colour given hair colour (HairEyeColor)",
        subtitle = "Row-normalised; larger square = more probable combination",
        x = "Eye colour", y = "Hair colour"
      )

The dominant squares (brown eyes with brown hair, blue eyes with blond hair) stand out immediately. The rarity of blue eyes with black hair is near- invisible, exactly as it should be.