0
$\begingroup$

With the help of the answer of the question Amelioration of a 3D plot, I have been able to construct the following plot

SetOptions[{Plot, ListPlot, ArrayPlot, ContourPlot, DiscretePlot3D, 
   Plot3D, Graph3D}, 
  BaseStyle -> {14, Directive[FontFamily -> "Times New Roman"]}];
arrowAxes[arrowLength_] := 
 Map[{Black, Arrow[Tube[{{0, 0, 0}, #}]]} &, 
  arrowLength IdentityMatrix[3]]
With[{zproj = -1.5}, 
 Module[{f, surface, graphicsComplexPts, contourParts, contourProjPts,
    projection}, f[x_, y_] := -(x^2 + y^2)^.2;
  surface = 
   Plot3D[f[x, y], {x, -1, 1}, {y, -1, 1}, PlotRange -> {-1, 0}, 
    ClippingStyle -> None, MeshFunctions -> {#3 &}, Mesh -> 15, 
    MeshStyle -> {Opacity[.5], Red, Thickness[.0075]}, Boxed -> False,
     Axes -> False, PlotPoints -> 200, 
    PlotStyle -> {Opacity[0.5], Cyan}, Lighting -> "Neutral"];
  (*Plot3D returns a Graphics3D object with a GraphicsComplex,
  first element of which is a list of points*)
  graphicsComplexPts = surface[[1, 1]];
  (*Find Line heads within GraphicsComplex*)
  contourParts = Position[surface, _Line];
  (*using GraphicsComplex indexing,map to projected contours.*)
  contourProjPts[k_] := 
   graphicsComplexPts[[surface[[Sequence @@ contourParts[[k]], 
        1]]]] /. {x_, y_, z_} -> {x, y, zproj};
  (*make projection with graphics primitives*)
  projection = 
   Graphics3D[{Red, 
     Table[Line@contourProjPts[k], {k, 1, Length@contourParts}], 
     arrowAxes[.8]}];
  Show[{surface, projection}, PlotRange -> {All, All, {zproj, 0.1}}, 
   BoxRatios -> {1, 1, 1.4}]]]

Mathematica graphics

But I have not been able to place correctly the origin where I want --- on the projected hyperplan ---, to have the same color for the background of the level set than for the surface, to put {x, y, z} label on the axes and to downsize the tube and the arrowheads.

$\endgroup$
  • $\begingroup$ A link to the prior Q&A would be helpful $\endgroup$ – Michael E2 Jan 27 '18 at 15:26
  • $\begingroup$ It's done Michael E2 $\endgroup$ – cyrille.piatecki Jan 27 '18 at 16:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.