Is there a way to create a 3d plot with contours beneath the plot in R?

Question

Is there a way to create a 3d plot in R that has contours beneath the plot like so? If not, is there a way to take my existing contour plot and put it on top of the 3d persp plot?

I have been able to make a 3d plot, and a contour plot of the function and constraint, but have not been able to combine the two. Here is my R code:

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")

Any suggestions or packages that do it are greatly appreciated.

thelatemail · Accepted Answer · 2020-03-12T22:12:09.083

1

I reckon this is doable via ?contourLines and some transformation of your points:

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")

edited Mar 12 '20 at 22:12

answered Mar 12 '20 at 03:55

thelatemail

91,185
12
128
188

Awesome! Thank you. Is there a way to add the same colors that the image() function would produce – John Smith Mar 12 '20 at 03:57
@JohnSmith - possibly, each of the `cl` (`contourLines`) list parts has a `$level` component which you could map to a colour. – thelatemail Mar 12 '20 at 03:58
And I guess I would also need the constrained version. – John Smith Mar 12 '20 at 04:00
@JohnSmith - see the updated version which now has the colours. The constraining i'm not sure how to do. – thelatemail Mar 12 '20 at 04:44
1

To do the constraining, you just need to add `out[which(outer(x1,x2,con1)>0)]=NA` – John Smith Mar 12 '20 at 04:47
@JohnSmith - constraining added now to give exactly what you wanted. – thelatemail Mar 12 '20 at 22:12

Is there a way to create a 3d plot with contours beneath the plot in R?

1 Answers1

Linked