{affiner}
is an extraction and improvement of the low-level geometric and R 4.2 affine transformation feature functionality used in {piecepackr} to render board game pieces in {grid}
using a 3D oblique projection.
The current goals are to:
{piecepackr}
users to use this low-level geometric functionality without exporting it in {piecepackr}
(which already has a large API) in case they want to do things like implement custom polyhedral dice.{grid}
(and perhaps {ggplot2}
).Some particular intended strengths compared to other R geometry packages:
{grid}
(e.g. oblique projections and isometric projections).{grid}
. The affine_settings()
function which reverse engineers useGrob()
’s vp
and transformation
arguments is even available as a “standalone” file that can be copied over into other R packages under the permissive Unlicense.as_coord2d()
method for angle()
objects lets you compute the regular polygon vertices and center using polar coordinatesaffine_settings()
and affineGrob()
or grid.affine()
to render arbitrary “illustrated” grobs within each of these parallelograms.library("affiner")
library("grid")
as_coord2d(angle(seq(90, 360 + 90, by = 60), "degrees"),
xy <-radius = c(rep(0.488, 6), 0))
$translate(x = 0.5, y = 0.5)
xy list()
l_xy <-$top <- xy[c(1, 2, 7, 6)]
l_xy$right <- xy[c(7, 4, 5, 6)]
l_xy$left <- xy[c(2, 3, 4, 7)]
l_xy
gpar(fill = NA, col = "black", lwd = 12)
gp_border <- viewport(width = unit(3, "inches"), height = unit(3, "inches"))
vp_define <-
c("#D55E00", "#56B4E9", "#009E73")
colors <- c(0.25, 0.25, 0.2)
spacings <- c("pkgname", "right\nface", "left\nface")
texts <- c(45, 0, 0)
rots <- c(52, 80, 80)
fontsizes <- c("top", "right", "left")
sides <- gridpattern::names_polygon_tiling[c(5, 9, 7)]
types <- list()
l_grobs <-grid.newpage()
for (i in 1:3) {
sides[i]
side <- l_xy[[side]]
xy_side <-if (requireNamespace("gridpattern", quietly = TRUE)) {
gridpattern::grid.pattern_polygon_tiling(
bg <-colour = "grey80",
fill = c(colors[i], "white"),
type = types[i],
spacing = spacings[i],
draw = FALSE)
else {
} rectGrob(gp = gpar(col = NA, fill = colors[i]))
bg <-
} textGrob(texts[i], rot = rots[i],
text <-gp = gpar(fontsize = fontsizes[i]))
affine_settings(xy_side, unit = "snpc")
settings <- l_grobs[[side]] <- grobTree(bg, text)
grob <-grid.affine(grob,
vp_define = vp_define,
transform = settings$transform,
vp_use = settings$vp)
grid.polygon(xy_side$x, xy_side$y, gp = gp_border)
}
isocubeGrob()
/ grid.isocube()
provides a convenience wrapper around affineGrob()
/ grid.affine()
for the isometric cube case:
grid.newpage()
grid.isocube(top = l_grobs$top,
right = l_grobs$right,
left = l_grobs$left)
Our high-level strategy for rendering 3D objects is as follows:
Figure out the “physical” 3D coordinates of the cube face vertices in “inches”. These cube faces will correspond to target “3D viewports” we’ll want to render the illustrated cube face grobs into.
Project these 3D coordinates onto a “physical” xy-plane (corresponding to our graphics device) in “inches” using a parallel projection (in this example we’ll do a couple oblique projections and an isometric projection). Note since all parallel projections are affine transformations we know the projected vertices of a square “3D viewport” will project to the 2D coordinates of a “parallelogram viewport”.
(If they don’t already do so) translate these parallelograms so they lie within the graphics device view (i.e. the “parallelogram viewport” vertices are all in the upper right quadrant of the xy-plane).
alpha
angle between 0 and 90 degrees then any flat faces lying directly on the xy-plane will stay where they are and any flat faces on a parallel higher plane will only be shifted up/right. So in this case one usually doesn’t need to such a translation assuming all your “objects” were placed in the upper quadrant of the xy-plane to begin with.Use affine_settings()
and grid.affine()
/ affineGrob()
to render the illustrated cube face “grobs” within these affine transformed “parallelogram viewports”. The order these are drawn is important but in this example we manually sorted them ahead of time in an order that worked for our target projections.
library("affiner")
library("grid")
as_coord3d(x = c(0, 0, 1, 1) - 0.5, y = c(1, 0, 0, 1) - 0.5, z = 0.5)
xyz_face <- list() # order faces for our target projections
l_faces <-$bottom <- xyz_face$clone()$
l_faces rotate("z-axis", angle(180, "degrees"))$
rotate("y-axis", angle(180, "degrees"))
$north <- xyz_face$clone()$
l_faces rotate("z-axis", angle(90, "degrees"))$
rotate("x-axis", angle(-90, "degrees"))
$east <- xyz_face$clone()$
l_faces rotate("z-axis", angle(90, "degrees"))$
rotate("y-axis", angle(90, "degrees"))
$west <- xyz_face$clone()$
l_faces rotate("y-axis", angle(-90, "degrees"))
$south <- xyz_face$clone()$
l_faces rotate("z-axis", angle(180, "degrees"))$
rotate("x-axis", angle(90, "degrees"))
$top <- xyz_face$clone()$
l_faces rotate("z-axis", angle(-90, "degrees"))
c("#D55E00", "#009E73", "#56B4E9", "#E69F00", "#CC79A7", "#0072B2")
colors <- c(0.25, 0.2, 0.25, 0.25, 0.25, 0.25)
spacings <- function(digit) {
die_face_grob <-if (requireNamespace("gridpattern", quietly = TRUE)) {
gridpattern::grid.pattern_polygon_tiling(
bg <-colour = "grey80",
fill = c(colors[digit], "white"),
type = gridpattern::names_polygon_tiling[digit],
spacing = spacings[digit],
draw = FALSE)
else {
} rectGrob(gp = gpar(col = NA, fill = colors[digit]))
bg <-
} textGrob(digit, gp = gpar(fontsize = 72))
digit <-grobTree(bg, digit)
} lapply(1:6, function(i) die_face_grob(i))
l_face_grobs <-grid.newpage()
for (i in 1:6) {
viewport(x = unit((i - 1) %% 3 + 1, "inches"),
vp <-y = unit(3 - ((i - 1) %/% 3 + 1), "inches"),
width = unit(1, "inches"), height = unit(1, "inches"))
pushViewport(vp)
grid.draw(l_face_grobs[[i]])
popViewport()
grid.text("The six die faces", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
}
# re-order face grobs for our target projections
# bottom = 6, north = 4, east = 5, west = 2, south = 3, top = 1
l_face_grobs[c(6, 4, 5, 2, 3, 1)]
l_face_grobs <- function(l_xy, l_face_grobs) {
draw_die <- min(vapply(l_xy, function(x) min(x$x), numeric(1)))
min_x <- min(vapply(l_xy, function(x) min(x$y), numeric(1)))
min_y <- lapply(l_xy, function(xy) {
l_xy <-$translate(x = -min_x + 0.5, y = -min_y + 0.5)
xy
})grid.newpage()
viewport(width = unit(1, "inches"), height = unit(1, "inches"))
vp_define <- gpar(col = "black", lwd = 4, fill = NA)
gp_border <-for (i in 1:6) {
l_xy[[i]]
xy <- affine_settings(xy, unit = "inches")
settings <-grid.affine(l_face_grobs[[i]],
vp_define = vp_define,
transform = settings$transform,
vp_use = settings$vp)
grid.polygon(xy$x, xy$y, default.units = "inches", gp = gp_border)
}
}# oblique projection of dice onto xy-plane
lapply(l_faces, function(xyz) {
l_xy_oblique1 <-$clone() |>
xyz as_coord2d(scale = 0.5)
})draw_die(l_xy_oblique1, l_face_grobs)
grid.text("Oblique projection\n(onto xy-plane)", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
# oblique projection of dice on xz-plane
lapply(l_faces, function(xyz) {
l_xy_oblique2 <-$clone()$
xyz permute("xzy") |>
as_coord2d(scale = 0.5, alpha = angle(135, "degrees"))
})draw_die(l_xy_oblique2, l_face_grobs)
grid.text("Oblique projection\n(onto xz-plane)", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))
# isometric projection
lapply(l_faces, function(xyz) {
l_xy_isometric <-$clone()$
xyz rotate("z-axis", angle(45, "degrees"))$
rotate("x-axis", angle(-(90 - 35.264), "degrees")) |>
as_coord2d()
})
draw_die(l_xy_isometric, l_face_grobs)
grid.text("Isometric projection", y = 0.9,
gp = gpar(fontsize = 18, face = "bold"))