Note

This Mathematica notebook is from the WWW project A Visual Dictionary of Special Plane Curves. Copyright © 1995-2000 by Xah Lee. (http://xahlee.org/)

Packages and Initializations

Needs["ParaPlot`"]
Needs["PlaneCurveFormulas`"]
Needs["PlaneCurveGenerator`"]

Needs["Graphics`ImplicitPlot`"]
(*MathSource Item:0200-529*)

Clear[distPartition, DeleteLongLine]

distPartition::usage = "distPartition[{ point1, point2,...}, dist_]
partitions the list of points into sublists such that 
the distance between neighboring points is less than dist.
i.e. if point i and point i+1 have distance greater than dist, then
they become boundaries.";


distPartition[ li_List, dist_ ] :=
	Module[{positions},
		positions = Flatten@ Position[
			N@ Sqrt[#.#]& /@ Rest[ li-RotateRight[li] ],
			x_/; (x > dist), {1} 
		];
		Take[li, #]& /@ Partition[
			Flatten@ Insert[ {1, Length@ li},
				Flatten@ Transpose[{positions, positions +1}],
				2
			], 2
		]
	]

DeleteLongLine::usage = "
DeleteLongLine[ graphicPrimitivesList , dist] will return a list
of 2D graphic primitives such that any line longer then dist in
graphicPrimitivesList will be deleted.";

DeleteLongLine[ gp_List , dist_] :=
	DeleteCases[
		gp /. Line[li_] :> Line /@ distPartition[li, dist],
		Line[{{__}}] | Line[{x_,x_}],
		-1
	]

Note: Mathematica Graphics bug

Note: A bug in Mathematica version 2.1 will cause plotting of large circle with small PlotRange to generate a PostScript error. To see whether this bug is on your version, try:

Show[Graphics[Circle[{0,0},30], PlotRange->{{29,31},{-1,1}}]]

If everything runs fine, you should see an arc of a circle of radius 30, otherwise you will hear a beep and see either an incomplete arc or an error placeholder for the graphics.
To get around this bug, either increase PlotRange to include all parts of the circle or execute the following code. It breaks a Circle primitive into several arcs.

Unprotect[Circle];
Circle[{x_,y_},r_] :=
      Table[Circle[{x,y},r,{th,th+Pi/6}],{th,0,2Pi-Pi/6,Pi/6}];
Protect[Circle];

Witch of Agnesi

Description

?WitchOfAgnesi

?WitchOfAgnesiGenerator

WitchOfAgnesiGenerator[{-1.2, 1,  .05}, 
      PlotRange -> {{-5, 4}, {- .5, 2.5}}, 
      LastFrameOnly -> True, Ticks -> {Range[-5, 5], {1, 2}}, 
      Epilog -> {Text["L", {-3, 2}, {0, -1}], 
          Text["M", {1.1,  .3}, {0, 0}], 
          Text["N", {3, 2}, {0, -1.2}], {Hue[ .7], PointSize[ .02], 
            Point[{3.14, 2}]}}];

ParaPlot[WitchOfAgnesi[][t], {t, -1.1, 1.1}, 
      AspectRatio -> Automatic, 
      PlotRange -> {{-2.2, 2.2}, {- .2, 1.5}}];

Graphics Gallery

Caustic

Clear[curves]
Do[ParaPlot[WitchOfAgnesi[][t], {t, -1.5, 1.5,  .1}, 
        CausticLineLength -> 50, CausticOrigin -> {0, i}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-1, 1} 3.3, {-2.3, 1.5}}, 
        Background -> GrayLevel[0], Axes -> False], {i, 
        1.1, -2, - .5}]

Parallels

Clear[curves]

curves = 
        Parallel[WitchOfAgnesi[][t], t, 
          Range[-3, 2,  .2]];
ParaPlot[curves, {t, -1.3, 1.3}, 
        PlotStyle -> 
          Table[Hue[0, 1 - i,  .8], {i, 0, 1, 1/Length@curves}], 
        AspectRatio -> Automatic, 
        PlotRange -> {{-1, 1} 3.3, {-1, 1} 2.3}, 
        Background -> GrayLevel[0], Axes -> False];

Evolutes

ParaPlot[
	WitchOfAgnesi[][t],
	{t, -1.5, 1.5},
	ArcLengthPartition[WitchOfAgnesi[][t], {t,-1.3,1.3}, 37],
	PlotOsculatingCircle->True,
	PlotCurve->True,
	PlotDot->False,
	CurveColorFunction->{Hue[0]&},
	CurveStyle->{Thickness[.007]},
	AspectRatio->Automatic,
	PlotRange->{{-1,1} 8,{-1.5,8}} ,
	PlotStyle->Table[Hue[i], {i,0,1,1/20}],
	Background->GrayLevel[0],
	Axes->False
];

ParaPlot[WitchOfAgnesi[][t], {t, -1.5, 1.5, (2.8/70)}, 
      NormalLineLength -> 100, PlotOsculatingCircle -> False, 
      PlotCurve -> True, PlotDot -> False, 
      CurveColorFunction -> {Hue[0] &}, 
      CurveStyle -> {Thickness[ .004]}, AspectRatio -> Automatic, 
      Axes -> False, Background -> GrayLevel[0], 
      PlotRange -> {{-1, 1} 3.3, {-1, 1} 2.3} 2];

ParaPlot[WitchOfAgnesi[][t], {t, -1.5, 1.5, 2.8/70}, 
        PlotEvolute -> True, PlotCurve -> True, 
        PlotDot -> False, CurveColorFunction -> {Hue[0] &}, 
        CurveStyle -> {Thickness[ .004]}, AspectRatio -> Automatic, 
        Axes -> False, Background -> GrayLevel[0], 
        PlotRange -> {{-1, 1} 3.3, {-1, 
                  1} 2.3} 2];

Ploting the evolute of witch of Agnesi. We use DeleteLongLine defined at the top of this notebook to get rid of the asymptotes.

Clear[ witchGP, witchEvoluteGP, gp]

witchGP = First@ ParametricPlot[
	Evaluate@ WitchOfAgnesi[][t],
	{t, -1.5, 1.5},
	AspectRatio->Automatic,
	PlotRange->{{-1,1} 3.3,{-1,1} 2.3} 2,
	DisplayFunction->Identity
];

witchEvoluteGP = First@ ParaPlot[
	Evolute[WitchOfAgnesi[][t],t],
	{t, -1.5, 1.5},
	PlotCurve->True,
	PlotDot->False,
	CurveColorFunction->{Hue[0]&},
	AspectRatio->Automatic,
	PlotRange->{{-1,1},{-1,1} } 8,
	DisplayFunction->Identity
];

witchEvoluteGP = DeleteLongLine[witchEvoluteGP, 70];

Show[
	Graphics[{
		{Hue[.7], witchGP},
		witchEvoluteGP
	}],
	AspectRatio->Automatic,
	Axes->False,
	PlotRange->{{-1,1},{-1,1}} 8
];

Radial

ParaPlot[
		WitchOfAgnesi[][t],
		{t, -1.5,1.5, .1},
		PlotRadial->True,	
		AspectRatio->Automatic,
		PlotRange->{{-1,1} 3.3,{-2.3,1.5}},
		Background->GrayLevel[0],
		Axes->False
];

ParametricPlot[
		Evaluate[{
			WitchOfAgnesi[][t],
			Radial[ WitchOfAgnesi[][t], t]
		}],
		{t, -1.5,1.5},
		AspectRatio->Automatic,
		PlotRange->{{-1,1},{-1,1}}5,
		PlotStyle->{Hue[.75], Hue[0],Hue[.35,1,.7]}
];

Conchoids

ParaPlot[
	WitchOfAgnesi[][t],
	{t, -1.3, 1.3, 2.6/25},
	ConchoidSetting->{{0,0},Range[0,4,.2]},
	PlotCurve->False,
	PlotDot->False,
	CurveColorFunction->{GrayLevel[1]&},
	DotStyle->Table[{PointSize[.015], Hue[i]}, {i,.5,1,1/60}],
	AspectRatio->Automatic,
	Axes->False,
	Background->GrayLevel[0],
	PlotRange->{{-1,1} 3.3,{-1,3.3}}
];

ParaPlot[
	WitchOfAgnesi[][t],
	{t, -1.42, 1.4},
	ArcLengthPartition[WitchOfAgnesi[][t], {t,-1.42,1.4}, 50],
	ConchoidSetting->{{1.3,10},Range[-6,6,.2]},
	PlotCurve->False,
	PlotDot->False,
	CurveColorFunction->{GrayLevel[1]&},
	DotStyle->Table[{PointSize[.015], Hue[i]}, {i,0,.5,1/60}],
	AspectRatio->Automatic,
	Axes->False,
	Background->GrayLevel[0],
	PlotRange->{{-1,1} 3.3,{-1,1} 2.3}
];

Clear[curves]

curves =
	Conchoid[ WitchOfAgnesi[][t], {0,-.95}, Range[-2,2,4/8]];

ParaPlot[
	curves,
	{t, -1.5, 1.5},
	AspectRatio->Automatic,
	Axes->False,
	PlotStyle->Table[Hue[i], {i,.6,1,(1-.6)/(Length@ curves/2)}],
	Background->GrayLevel[0],
	PlotRange->{{-1,1} 6 ,{-1,1} 4}
];

Conchoid Movie

We want to make an animation of concohids of witch of Agnesi with respect to a point that moves along a certain curve.

In this animation, we choose the point to move along a parabola.

Clear[curves]

ParametricPlot[
	Evaluate[{
		WitchOfAgnesi[][t],
		Rotate[Parabola[][t] {1,3}, 20 Degree]+ {-.8,-2.5}
	}],
	{t, -3,3},
	AspectRatio->Automatic,
	PlotRange->{{-1,1} 6 ,{-1,1} 3},
	PlotStyle->{Hue[.75], Hue[0],Hue[.35,1,.7]}
];

Clear[pathCurve, pathCurvePoints]
pathCurve = 
      N[Rotate[Parabola[][t] {1, 3}, 
            20 °]] + {- .8, -2.5}; 
pathCurvePoints = (pathCurve /. t -> #1 &) /@ 
        ArcLengthPartition[pathCurve, {t, -3, 3}, 24];

Do[ParaPlot[
        Conchoid[WitchOfAgnesi[][t], 
          pathCurvePoints[[i]], 
          Range[-3, 3, (6/8)]], {t, -1.5, 1.5}, PlotPoints -> 50, 
        AspectRatio -> Automatic, Axes -> False, 
        PlotStyle -> Table[Hue[j], {j,  .6, 1, ((1 -  .6)/8)}], 
        Background -> GrayLevel[0], 
        PlotRange -> {{-7, 6}, {-3.5, 4}}], {i, 1, 
        Length[pathCurvePoints], 1}]

Involute

Inversion

ParaPlot[WitchOfAgnesi[][t], {t, -1.5, 1.5,  .1}, 
      InversionCircle -> {{0,  .5}, 1}, AspectRatio -> Automatic, 
      PlotRange -> {{-1, 1}, {-1, 1}} 3, 
      Axes -> True];

Clear[curves]

curves = Table[ Inversion[WitchOfAgnesi[][t], {{0,i},1}], {i,-1,1.6,.2}];

ParametricPlot[
	Evaluate@ curves,
	{t, -1.5, 1.5},
	AspectRatio->Automatic,
	PlotRange->{{-1,1},{-1,1}}3,
	PlotStyle->
		Table[ {Thickness[.008],Hue[.6,i,.8]}, {i,0,1,1/Length@ curves}],
	Background->GrayLevel[0],
	Frame->True,
	FrameTicks->{Range[-4,4],Range[-4,4]},
	Axes->False
];

Pedal

ParaPlot[WitchOfAgnesi[][t], {t, -1.5, 1.5,  .1}, 
      PedalPoint -> {1, -1}, AspectRatio -> Automatic, 
      PlotRange -> {{-1, 1}, {-1, 1}} 3, 
      Axes -> True];

Clear[curves];
curves = 
        Table[Pedal[WitchOfAgnesi[][t], t, {0, i}], {i, -1, 
            1.6,  .20001}];

ParametricPlot[Evaluate[curves], {t, -1.5, 1.5}, 
      AspectRatio -> Automatic, 
      PlotRange -> {{-1, 1}, {0 -  .1, 1.4}}, 
      PlotStyle -> 
        Table[{Thickness[ .007], Hue[ .9, i,  .8]}, {i, 0, 1, 
            (1/Length)[curves]}], Frame -> True, 
      FrameTicks -> {Range[-1, 1,  .5], Range[-1, 1,  .5]}, 
      Axes -> False, Background -> GrayLevel[0]];