| SOCR ≫ | DSPA ≫ | Topics ≫ |
This DSPA section Appendix.3.4 (4D Manifolds) is part of the DSPA Appendix on visualization of geometric and parametric surfaces. This DSPA Appendix (3) covers the following topics:
This section illustrates an innovative approach to render (high-dimensional) surfaces that are natively embedded in 4D using time-like animation along one of the dimensions to generate 3D embeddings of the manifolds. Examples of 4D manifolds include the Klein Bottle and are useful for visualization of constrained optimization problems where high-dimensional objective functions are minimized over specific domains.
#, results="hide"}
library(plotly)
library(tidyverse)We will start by generating a generic 4D plotter function that can be called repeatedly with different parametric manifold descriptions.
This function plots functions that can be described in this parametric form \(w = f(x,y,z)\). This will allow us to render 4D parametric manifolds as 3D surfaces where with the \(4^{th}\) dimension (either of \(x,y,z\)) may be specified as a horizontal slider.
plot_4d <- function(f, x, y, z, slide_axis="z") {
stopifnot(slide_axis %in% c("x","y","z"))
x_range <- x
x_label <- "x"
y_range <- y
y_label <- "y"
slide_range <- z
if (slide_axis=="x") {
slide_range <- x
x_range < z
x_label <- "z"
} else if (slide_axis=="y") {
x_range <- x
y_range <- z
y_label <- "y"
slide_range <- y
}
frames <- list()
plt <- plot_ly()
for (i in 1:length(slide_range)) {
slide_val <- slide_range[i]
# Generate the w values for f(x,y,z)
if (slide_axis=="z") {
w <-(matrix(apply(expand.grid(x_range,y_range,slide_val),1,f),length(x_range),length(y_range)))
} else if (slide_axis=="x") {
w <-(matrix(apply(expand.grid(slide_val,y_range,x_range),1,f),length(x_range),length(y_range)))
} else if (slide_axis=="y") {
w <-(matrix(apply(expand.grid(x_range,slide_val,y_range),1,f),length(x_range),length(y_range)))
}
# A the start, only make the first frame visible
visible <- i==as.integer(length(slide_range)/2)
# Add this trace (first frame) to the plot
plt <- add_trace(plt, x=x_range, y=y_range, z=w, type="surface", visible=visible,
name=as.character(slide_val), showlegend=FALSE,
colors = colorRamp(rainbow(8)), opacity=1.0, hoverinfo="none")
# Configure this step in the slider to make this frame visible and none other
step <- list(args = list('visible', rep(FALSE, length(slide_range))),
method = 'restyle', label=paste0(slide_axis, "=", round(slide_val,3)))
step$args[[2]][i] = TRUE
frames[[i]] = step
}
# Show the plot + slider focused on the middle plot
plt %>%
layout(
title = paste0("4D Plot - sliding on ",slide_axis, " axis"),
scene = list(zaxis=list(title="w=f(x,y,z)"), xaxis=list(title=x_label), yaxis=list(title=y_label)),
sliders = list(list(active = as.integer(length(slide_range)/2),
currentvalue = list(prefix = paste0(slide_axis, ":")),
steps = frames))) %>%
hide_colorbar()
}Next we will explore several 4D manifolds that have canonical parametric function representations.
Suppose we try to minimize the function \(w=f(x,y,x)=-(x^3 +5y-2^z)\), subject to these constraints: \[\begin{cases} x -\frac{y}{2}+z^2 \leq 50\\ \mod(x, 4) + \frac{y}{2} \leq 1.5 \end{cases}.\] This is indeed a rather complicated optimization problem of a highly non-linear function. You can experiment finding solutions using grid search, non-linear optimization, or using the Wolfram Alpha services.
We will attempt to render the 4D objective function by embedding it into 3D along one of the coordinate axes (dimensions). Then, using a slider to traverse the spectrum of (time-like) values may give us clues as to where the local and global extrema of the cost function may be localized. Let’s define the objective function, the constraints, and use the plot_4d() function we defined above to render the 4D manifold as 3D-cine surfaces.
p3_ineq <- function(x) {
c((x[1]-.5*x[2]+x[3]^2),(x[1]%%4) + (x[2]/2))
}
p3_ineq_lb <- c(-Inf,-Inf)
p3_ineq_ub <- c(50,1.5)
p3_objective <- function(x,restrictDomain=TRUE) {
if (restrictDomain) {
if (!all(p3_ineq(x)<=p3_ineq_ub) & all(p3_ineq(x)>=p3_ineq_lb)) {
return (NA)
}
}
-1 * (x[1]^3 + 5*x[2] - 2^x[3])
}
p3_x <- seq(-50,50,length=50)
p3_y <- seq(-50,50,length=50)
p3_z <- seq(-50,50,length=50)Let’s first embed the objective function in 3D by cine-animating along the x-axis.
plot_4d(p3_objective,p3_x,p3_y,p3_z,slide_axis = "x")Next, we will render a 3D cine-animation immersing the objective function along the y-axis.
plot_4d(p3_objective,p3_x,p3_y,p3_z,slide_axis = "y")Finally, we will embed the objective function along the z-axis.
plot_4d(p3_objective,p3_x,p3_y,p3_z,slide_axis = "z")We saw the Klein Bottle surface earlier, which has a number of alternative parametrizations. Now, we can adopt some of the 3D equations embedding the Klein bottle in 3D by plotting \(w\) as the result instead of 0. One specific implicit equation immersion of the Klein bottle is:
\[ w=f(x,y,z)=(x^2+y^2+z^2+2y-1)\times((x^2+y^2+z^2-2y-1)^2-8z^2) + 16\times x\times z\times (x^2+y^2+z^2-2y-1).\]
klein <- function(x) {
(x[1]^2+x[2]^2+x[3]^2+2*x[2]-1)*((x[1]^2+x[2]^2+x[3]^2-2*x[2]-1)^2-8*x[3]^2) + 16*x[1]*x[3]*(x[1]^2+x[2]^2+x[3]^2-2*x[2]-1)
}
klein_x <- seq(-1,1,length=50)
klein_y <- seq(-1,1,length=50)
klein_z <- seq(-1,1,length=50)Again, we first embed the Klein bottle in 3D by cine-animating along the x-axis.
plot_4d(klein, klein_x, klein_y, klein_z, slide_axis = "x")Next, we will render it along the y-axis.
plot_4d(klein, klein_x, klein_y, klein_z, slide_axis = "y")Finally, we will embed the Klein bottle in 3D along the z-axis.
plot_4d(klein, klein_x, klein_y, klein_z, slide_axis = "z")Clearly such cine-like strategies, use of glyphs, creative utilization of color, and other mechanisms may be useful to render high-dimensional manifolds that are not easily interpreted as 1D (curves), 2D (surfaces) or 3D (manifolds) objects.