如何在R中的3D图上添加椭圆平面

Question

R code about plot plane z = x+y：

library("rgl")
f <- function(x,y) 
x+y

x_grid <- seq(0,1, length=20)
y_grid <- x_grid 
z_grid <- outer(x_grid, y_grid, f)
surface3d(x_grid, y_grid, z_grid,front="line",back="line")
axes3d() 

R code about plot ellipse 5x^2-4xy+5y^2=1：

my.fun <- function(x,y){5*x^2 - 4*x*y + 5*y^2}
x<-seq(-sqrt(5/21), sqrt(5/21), length.out = 101)
y<-seq(-sqrt(5/21), sqrt(5/21), length.out = 101)
z<-outer(x,y,my.fun)
contour(x, y, z, levels = 1, drawlabels = 0, xlab = "x", ylab = "y")

How to add ellipse plane to 3D plot in R? Thanks!

Answer 1

Still not sure what you are trying to do, but this plots the intersection of your plane

z = x + y

and your parabolic ellipsoid

z = 5x ² -4xy + 5y ²

and colors the resulting ellipse as in your linked image.

library(rgl)
f      <- function(x,y) x+y
my.fun <- function(x,y) 5*x^2 - 4*x*y + 5*y^2

x_grid <- seq(0,1, length=20)
z_grid <- outer(x_grid, x_grid, f)

theta <- seq(0,2*pi,length=1000)
r     <- sqrt(5/21)
df    <- expand.grid(x=r*cos(theta),y=r*cos(theta))
df$z  <- with(df,f(x,y) - my.fun(x,y))
xyz   <- df[df$z>=0,]
surface3d(x_grid, x_grid, z_grid, front="line",back="line")
axes3d() 
zlim    <- range(-1000*f(xyz$x,xyz$y))
zlen    <- diff(zlim) + 1
palette <- heat.colors(zlen)                       
col     <- palette[-1000*f(xyz$x,xyz$y)-zlim[1]+1 ]
with(xyz,points3d(x,y,f(x,y),color=col))

This uses a quick and dirty approach to calculating the intersection of the plane and the ellipsoid: create a relatively fine grid of points in (x,y) and then simply identify all the points where f(x,y) - my.fun(x,y) < 0 . These points are inside the ellipse formed by the intersection. Then just plot those points.

The idiomatic way to do this, I think, is using ploygon3d(...) but when I tried that the function did not converge...

EDIT Response to OP's comment.

So this plots the intersection of your parabolic ellipsoid with the place z = 1 and colors the result based on increasing values of x (which looks like the image you provided). I have no idea what the point of this is...

library(rgl)
f      <- function(x,y) rep(1,length(x))
my.fun <- function(x,y) 5*x^2 - 4*x*y + 5*y^2

x_grid <- seq(0,1, length=20)
z_grid <- outer(x_grid, x_grid, f)

theta <- seq(0,2*pi,length=1000)
r     <- sqrt(5/21)
df    <- expand.grid(x=r*cos(theta),y=r*cos(theta))
df$z  <- with(df,f(x,y) - my.fun(x,y))
xyz   <- df[df$z>=0,]
surface3d(x_grid, x_grid, z_grid, front="line",back="line")
axes3d() 
zlim    <- range(-1000*xyz$x)
zlen    <- diff(zlim) + 1
palette <- heat.colors(zlen)               # height color lookup table
col     <- palette[-1000*xyz$x-zlim[1]+1 ] # assign colors to heights for each point
with(xyz,points3d(x,y,f(x,y),color=col))