3
$\begingroup$

I want to draw the following projection picture for the cuspidal cubic curve in Mathematica. Does anybody know how to do this?

enter image description here

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ ContourPlot[y^2 == x^3, {x, -2, 2}, {y, -2, 2}] $\endgroup$
    – cvgmt
    Commented Mar 27 at 10:12
  • $\begingroup$ Thank you, but I want to add the projection part(down arrow and the bottom line) as well. Your answer only gives the curve part. $\endgroup$
    – eloparti
    Commented Mar 27 at 10:20
  • 1
    $\begingroup$ What information can you get from the bottom line? As I see it, it provides no information about the function. $\endgroup$
    – azerbajdzan
    Commented Mar 27 at 11:02
  • $\begingroup$ @azerbajdzan It denotes the projection onto x-axis, and the dashed line is the singilarity of the function at the origin. That's why I would like to keep them. $\endgroup$
    – eloparti
    Commented Mar 27 at 11:07
  • $\begingroup$ I see no projection. I see line from left to right without any difference between region on the left of the zero and right of the zero. $\endgroup$
    – azerbajdzan
    Commented Mar 27 at 11:20

2 Answers 2

Reset to default
4
$\begingroup$

Mainly because I wanted to figure out the Bezier curve, having just given another Bezier answer. After doing it, I thought, Why not share?, even though this sort of plain Graphics is what I learned to do back around 1990 and was still doing when I found this community. Others may benefit from looking up Text[] for any annotations to be added (be sure to check out MaTeX` too) as well as styling directives like Thickness and colors.

Block[{t = 0.9, x, y, pts},
 x = t^2; y = t^3;
 pts = {{x, -y}, {-1/3 x, y}, {-1/3 x, -y}, {x, y}};
 Graphics[{
   White, EdgeForm[Black], Rectangle[-{x, x}, {x, x}]
   , Black, BezierCurve[pts]
   , {Dashed, Black, Line[{{0, x}, {0, -1.6 x}}]}
   , {Black, Line[{{-x, -1.6 x}, {t^2, -1.6 x}}], 
    Line[{{0, -1.56 x}, {0, -1.64 x}}], 
    Arrow[{{0.1 x, -1.1 x}, {0.1 x, -1.5 x}}]}
   }]
 ]

Note: On my Front End, there seems to be a bug ("14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)"). Depending on the image size of the graph, the cusp is sometimes not rendered. The export seems to work, though.

Improve this answer
$\endgroup$
0
4
$\begingroup$ 
fu = y^2 == x^3;
xrange = {-2, 2};
lines = Select[
   FunctionDomain[SolveValues[fu, y], x] /. 
     Inequality | GreaterEqual | LessEqual | Greater | Less | Or -> 
      List // Flatten, NumericQ];

GraphicsColumn[{ContourPlot[
     Evaluate@fu, {x, Splice@xrange}, {y, -3, 3}, 
     Epilog -> {Dashed, InfiniteLine[{{#, 0}, {#, 1}}] & /@ lines}, 
     FrameLabel -> {{"", ""}, {"", fu}}], 
    Graphics[{ColorData[97, 1], AbsoluteThickness[1.6`], 
      MeshPrimitives[
       Region[ImplicitRegion[
          LogicalExpand[
           FunctionDomain[SolveValues[#, y], x] && y == 0.05], {x, 
           y}], PlotRange -> {xrange, {-0.1, 0.1}}] // 
        DiscretizeRegion, 1]}, PlotRange -> {xrange, {-0.1, 0.1}}, 
     Axes -> {True, False}]}] &@fu

enter image description here

enter image description here

enter image description here

enter image description here

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thank you very much, I see you have added more examples which is great! $\endgroup$
    – eloparti
    Commented Mar 27 at 15:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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