Есть ли способ создать 3D-график с контурами под графиком в R?

Question

Есть ли способ создать 3D-график в R, который имеет контуры под графиком? Если нет, то есть ли способ взять мой существующий контурный график и поместить его поверх трехмерного графика?

Я смог сделать 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")