4
$\begingroup$

I can embed a 2D curve f00==0 in 3D space using

zval=0
f00 = -3 (\[Pi]^6/64 + (-x^6 - y^6)) // ExpandAll // FullSimplify
curve = ContourPlot[f00 == 0, {x, -Pi, Pi}, {y, -Pi, Pi}];
XYcirc = Cases[Normal@curve, Line[x_] :> x, Infinity];
Zcirc = Table[zval, {i, Dimensions[XYcirc][[2]]}];
Xcirc = Flatten@XYcirc[[All, All, 1]];
Ycirc = Flatten@XYcirc[[All, All, 2]];
XYZcirc = Transpose[{Xcirc, Ycirc, Zcirc}];
g4 = ListLinePlot3D[XYZcirc, PlotStyle -> Directive[red, Opacity[0.65]], Mesh -> False, PlotRange -> All]

where I have extracted $x,y$ coordinates from f00==0 and set the $z$ coordinate to z=zval. Based on the answer to one of my recent quesions, I can now generate disconnected curves. For instance, setting f1==0 or f2==0 with

f1 = -3 (x^6 + y^6 + z^6) + 5 (x^4 + y^4 + z^4) \[Pi]^2 -  5/9 (x^2 + y^2 + z^2) \[Pi]^4 + \[Pi]^6/81 /. {z -> zval}
f2 = -6 (x^5 + y^5 + z^5) \[Pi] + 20/9 (x^3 + y^3 + z^3) \[Pi]^3 -  2/27 (x + y + z) \[Pi]^5 /. {z -> zval}

gives multiple points. To obtain the coordinates of these points, I have tried the script above for the f1==0 and f2==0 functions, but I get many errors such as

"Part 2 of {23} does not exist."

I have also tried to replace Dimensions[XYcirc] with Dimensions[XYcirc[[1]]], but this also didn't help.

Do you have any suggestions on how to extract these points and plot them in a 3D plot?

Improve this question
$\endgroup$
10
  • $\begingroup$ Please show what you tried: f1==0 gives some surfaces in 3D (not a list {x,y}) $\endgroup$
    – Ulrich Neumann
    Jun 13 at 13:54
  • $\begingroup$ f1=\[Pi]^6/81 - 5/9 \[Pi]^4 (x^2 + y^2) + 5 \[Pi]^2 (x^4 + y^4) - 3 (x^6 + y^6) is a function of $(x,y)$ as I set z=zval. Then plot curve = ContourPlot[f1 == 0, {x, -Pi, Pi}, {y, -Pi, Pi}] and the rest follows from the first script above. $\endgroup$
    – Shasa
    Jun 13 at 13:58
  • 1
    $\begingroup$ ContourPlot3D[f1 == 0, {x, -Pi, Pi}, {y, -Pi, Pi}, {z, -Pi, Pi}, MeshFunctions -> {Function[{x, y, z}, z]}, Mesh -> {{-.3, -.3, -.1, 0.1, .2, .3}}, PlotPoints -> 100, PlotRange -> All, ContourStyle -> None, BoundaryStyle -> None, Boxed -> False]? $\endgroup$
    – cvgmt
    Jun 13 at 14:14
  • $\begingroup$ @Shasa Thank you, I got it. ContourPlot[f1 == 0,...] gives two curves, that might cause the errors! $\endgroup$
    – Ulrich Neumann
    Jun 13 at 14:15
  • 1
    $\begingroup$ @hasa lists=Cases[Normal@curve, Line[x_] :> x, Infinity] . First list: lists[[1]], ... $\endgroup$
    – Ulrich Neumann
    Jun 13 at 14:27

2 Answers 2

Reset to default
7
$\begingroup$

Here's a slightly simpler approach that works even when there is more than one contour, generated using your $f_1$ expression:

curvef1 = ContourPlot[f1 == 0, {x, -Pi, Pi}, {y, -Pi, Pi}];
points3D = 
  Cases[Normal@curvef1, Line[x_] :> x, Infinity] /. 
     {x_?NumericQ, y_?NumericQ} :> {x, y, zval};
ListLinePlot3D[
  points3D, 
  PlotStyle -> Directive[Red, Opacity[0.65]], 
  PlotRange -> All
]

3D contour with two curves

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks! This script generates both coordinates and the final plot. $\endgroup$
    – Shasa
    Jun 13 at 14:37
4
$\begingroup$

Marco's answer would be the best thing to do in this particular case. An alternative that is sometimes done is to use the MeshFunctions option of ContourPlot3D[]:

With[{zval = 0}, 
     {ContourPlot3D[-3 (x^6 + y^6 + z^6) + 5 (x^4 + y^4 + z^4) π^2 -
                    5/9 (x^2 + y^2 + z^2) π^4 + π^6/81 == 0,
                    {x, -π, π}, {y, -π, π}, {z, -1, 1}, 
                    BoundaryStyle -> None, BoxRatios -> Automatic, 
                    ContourStyle -> None, Mesh -> {{zval}}, MeshFunctions -> {#3 &}, 
                    MeshStyle -> Directive[Red, Opacity[0.65]], PlotPoints -> 25], 
      ContourPlot3D[-6 (x^5 + y^5 + z^5) π + 20/9 (x^3 + y^3 + z^3) π^3 -
                    2/27 (x + y + z) π^5 == 0,
                    {x, -π, π}, {y, -π, π}, {z, -1, 1}, 
                    BoundaryStyle -> None, BoxRatios -> Automatic, 
                    ContourStyle -> None, Mesh -> {{zval}}, MeshFunctions -> {#3 &}, 
                    MeshStyle -> Directive[Red, Opacity[0.65]], PlotPoints -> 25]} //
      GraphicsRow]

contours

Improve this answer
$\endgroup$
2
  • $\begingroup$ (+1) Thank you for sharing an alternative answer. $\endgroup$
    – Shasa
    Jun 14 at 6:00
  • $\begingroup$ A similar answer has been suggested by @cvgmt in the comments above. $\endgroup$
    – Shasa
    Jun 14 at 6:14

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.