CODEWITHSUNDEEP
rplot
John Smith
John Smith

Reputation: 187

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

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?

enter image description here

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.

Upvotes: 1

Views: 591

Answers (1)

thelatemail
thelatemail

Reputation: 93928

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

enter image description here

Upvotes: 2

Related Questions