有没有一种方法可以创建3D图，其轮廓在R中的图下方？

Question

是否有一种方法可以在R中创建3d绘图，该绘图在绘图下方具有这样的轮廓？如果没有，是否可以采用现有的等高线图并将其放在3d persp图的顶部？

我已经能够绘制3d图以及函数和约束的轮廓图，但是无法将两者结合起来。这是我的R代码：

obj = function(x1,x2){
  value = -(cos((x1-.1)*x2))^2 - x1*sin(3*x1+x2)
  return(value)
}

con1 = function(x1,x2){
  t = atan2(x1,x2)
  value = x1^2 + x2^2 -((2*cos(t)-1/2*cos(2*t)-1/4*cos(3*t)-1/8*cos(4*t))^2) - ((2*sin(t))^2)
  return(value)
}


x1 = seq(-2.25,2.5,.015)
x2 = seq(-2.5,1.75,.015)

out = outer(x1,x2,obj)

infeasible = ifelse(c(outer(x1,x2,con1)<=0),1,0)
image(x1,x2,out,xlab=expression(x[1]),ylab=expression(x[2]),main="Modified Townsend Problem")

X = cbind(expand.grid(x1,x2),infeasible)
points(X[X[,3]==0,1],X[X[,3]==0,2],pch=19,col="lightgrey")

persp(x1,x2,out,phi=35,col="lightgrey")

任何建议或软件包都非常感谢。

Answer 1

我认为这可以通过?contourLines和您的观点进行一些转换来实现：

p <- persp(x1, x2, out, phi=35, col="#00000000", border=NA, box=FALSE)
cl <- contourLines(x1, x2, replace(out, outer(x1,x2,con1) > 0, NA))
levs <- factor(sapply(cl, `[[`, "level"))
Map(
  function(cl,col) lines(trans3d(cl$x, cl$y, min(out), pmat=p), col=col),
  cl,
  hcl.colors(nlevels(levs), "YlOrRd", rev = TRUE)[levs]
)
par(new=TRUE)
persp(x1, x2, out, phi=35, col="lightgrey")