another experiment

library(tidyverse)

# Simplify the Motor Trends data to two predictors legible at aspect ratio 1.
mtcars |>
  transform(hp00 = hp/100) |>
  subset(select = c(mpg, hp00, wt)) ->
subcars

head(subcars)

##                    mpg hp00    wt
## Mazda RX4         21.0 1.10 2.620
## Mazda RX4 Wag     21.0 1.10 2.875
## Datsun 710        22.8 0.93 2.320
## Hornet 4 Drive    21.4 1.10 3.215
## Hornet Sportabout 18.7 1.75 3.440
## Valiant           18.1 1.05 3.460

# Here's the setup; i want to project the data points onto the gradient axis.
ggplot(subcars) +
  aes(x = hp00, y = wt) +
  coord_equal() +
  geom_point()

compute_group_proj <- function(data, scales, na.rm = FALSE) {
    
    # arbitrary values of computed aesthetics
    res <- transform(
      data,
      xend = NA_real_,
      yend = NA_real_
    )
    # empty initialized output
    res <- data[c(), , drop = FALSE]
    
    lm(outcome ~ x + y, data) |>
         coefficients() |>
          as.list() |> as.data.frame() ->
    gradient
    
    # no referent means no projection
    if (is.null(gradient) || ! is.data.frame(gradient)) return(res)
    
    # compute and collect projections of `data` onto `referent` rows
    inertias <- gradient$x^2 + gradient$y^2
    for (i in seq(nrow(gradient))) {
      data$dots <- data$x * gradient$x[i] + data$y * gradient$y[i]
      res_i <- transform(
        data,
        xend = dots / inertias[i] * gradient$x[i],
        yend = dots / inertias[i] * gradient$y[i]
      )
      res <- rbind(res, res_i)
    }
    
    res
}


subcars %>% 
  rename(x = hp00, y = wt, outcome = mpg) %>% 
  compute_group_proj() %>% 
  head()

##                   outcome    x     y      dots     xend     yend
## Mazda RX4            21.0 1.10 2.620 -13.65494 1.726263 2.106873
## Mazda RX4 Wag        21.0 1.10 2.875 -14.64379 1.851273 2.259445
## Datsun 710           22.8 0.93 2.320 -11.95145 1.510907 1.844035
## Hornet 4 Drive       21.4 1.10 3.215 -15.96225 2.017954 2.462876
## Hornet Sportabout    18.7 1.75 3.440 -18.90000 2.389346 2.916153
## Valiant              18.1 1.05 3.460 -16.75345 2.117978 2.584954

StatProj <- ggproto("StatProj", Stat,
  required_aes = c("x", "y", "outcome"),
  compute_group = compute_group_proj
)

last_plot() +
  geom_segment(stat = StatProj, 
               aes(outcome = mpg))