Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

POC: no hardcoded position scales #6080

Draft
wants to merge 8 commits into
base: main
Choose a base branch
from

Conversation

teunbrand
Copy link
Collaborator

@teunbrand teunbrand commented Sep 5, 2024

This PR explores #3898.

Briefly, it un-hardcodes the x/y position aesthetics to allow for other aesthetics.

For now, consider this PR a probe into feasibility, rather a fully fledged fix. The main gripe I have with the implementation at the time of writing, is that a lot of method signatures need to be changed to accommodate an arbitrary number of position scales, instead of just x/y. That said, I don't think these are very popular methods to edit in extensions, so it needn't be too bad.

Just to demonstrate that this PR works and we can use other position scales, I've drafted a quick coord that does a perspective transform on x,y,z-coordinate data. Plot decoration such as axes and gridlines aren't implemented properly. In the details tab is the implemention of coord_3d() and scale_z_continuous(), for the curious among us.

devtools::load_all("~/packages/ggplot2")
#> ℹ Loading ggplot2

# Based on graphics/src/plot3d.c
make_transform <- function(x_range = c(0, 1), y_range = c(0, 1), z_range = c(0, 1), 
                           theta = 30, phi = 30, expand = 1,
                           r = sqrt(3), d = 1) {
  identity_matrix <- diag(4)
  
  # Center ranges at origin
  m <- identity_matrix
  m[4, 1:3] <- -0.5 * c(sum(x_range), sum(y_range), sum(z_range))
  
  # Scale all between [0, 1]
  t <- identity_matrix
  diag(t) <- c(2, 2, 2 * expand, 2) / 
    c(diff(x_range), diff(y_range), diff(z_range), 2)
  m <- m %*% t
  
  # Rotate X
  angle <- -0.5 * pi
  cos <- cos(angle)
  sin <- sin(angle)
  t <- identity_matrix
  t[2:3, 2:3] <- c(cos, -sin, sin, cos)
  m <- m %*% t
  
  # Rotate Y
  angle <- -theta * pi / 180
  cos <- cos(angle)
  sin <- sin(angle)
  t <- identity_matrix
  t[cbind(c(1, 3, 1, 3), c(1, 1, 3, 3))] <- c(cos, sin, -sin, cos)
  m <- m %*% t
  
  # Rotate X
  angle <- phi * pi / 180
  cos <- cos(angle)
  sin <- sin(angle)
  t <- identity_matrix
  t[2:3, 2:3] <- c(cos, -sin, sin, cos)
  m <- m %*% t
  
  # Eyepoint to origin
  t <- identity_matrix
  t[4, 3] <- -r - d
  m <- m %*% t
  
  # Perspective
  t <- identity_matrix
  t[3, 4] <- -1 / d
  m %*% t
}

coord_3d <- function(theta = 30, phi = 30, expand = 1,
                     r = sqrt(3), d = 1) {
  mtx  <- make_transform(theta = theta, phi = phi, expand = expand, r = r, d = d)
  view <- expand.grid(x = c(0, 1), y = c(0, 1), z = c(0, 1))
  view <- trans3d(view$x, view$y, view$z, mtx)
  view <- list(x = range(view$x), y = range(view$y))
  ggproto(
    NULL, Coord3D,
    mtx = mtx,
    view = view
  )
}

scale_z_continuous <- function(...) {
  continuous_scale(
    "z", palette = identity, guide = "none", ...,
    super = ScaleContinuousPosition
  )
}

Coord3D <- ggproto(
  "Coord3D", CoordCartesian,
  aesthetics = c("x", "y", "z"),
  setup_layout = function(layout, params) {
    layout$SCALE_Z <- 1L
    CoordCartesian$setup_layout(layout, params)
  },
  setup_panel_params = function(self, scales, params = list()) {
    c(
      view_scales_from_scale(scales$x, self$limits$x),
      view_scales_from_scale(scales$y, self$limits$y),
      view_scales_from_scale(scales$z, self$limits$z)
    )
  },
  transform = function(self, data, panel_params) {
    data$z <- data$z %||% -Inf
    scales <- aes_to_scale(names(data))
    
    for (aes in self$aesthetics) {
      i <- scales == aes
      data[i] <- lapply(data[i], panel_params[[aes]]$rescale)
      data[i] <- lapply(data[i], squish_infinite)
    }
    
    xyz <- trans3d(data$x, data$y, data$z, self$mtx)
    data$x <- rescale(xyz$x, from = range(self$view$x))
    data$y <- rescale(xyz$y, from = range(self$view$y))
    data
  }
)

The premise is that with normal Cartesian coords, you have your classic two dimensions. Here I'm adapting an example from ?persp to demonstrate.

x <- seq(-10, 10, length.out = 30)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)

# Adapt for long format data
df <- data.frame(
  x = x[as.vector(col(z))], 
  y = y[as.vector(row(z))], 
  z = as.vector(z)
)

p <- ggplot(df, mapping = aes(x, y, z = z, colour = z)) +
  geom_line(aes(group = x)) +
  geom_line(aes(group = y)) +
  scale_colour_viridis_c()

p

With our new coord, we can pull the z aesthetic into a 3rd dimension, and project the 3D coordinates back to the x/y plane.
Please note that the coord has no notion of depth, so if we were to do this with polygons instead of lines, the overlap would be all wrong.

p + coord_3d()
#> Theme element `axis.title.z` is missing

To show that it can change perspective, let's change the phi (colatitude).

p + coord_3d(phi = 50)
#> Theme element `axis.title.z` is missing

To show that it responds to a z-scale:

p + coord_3d() + scale_z_continuous(limits = c(-5, 15))
#> Theme element `axis.title.z` is missing

Created on 2024-09-05 with reprex v2.1.1

I have no idea how well this would work for using 1D->2D transformation.

@teunbrand teunbrand marked this pull request as draft September 5, 2024 20:15
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

1 participant