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`"]
(*MathSource Item:0207-986*)

Needs["PlaneCurveFormulas`"](*0208-482*)

Needs["PlaneCurveGenerator`"](*0208-314*)

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

$HistoryLength = 10;

Concohid of Nicomedes

Description

ConchoidOfNicomedesGenerator[ 1,2, LastFrameOnly->True];

Clear[a, k, gp]; a = 1; k = 2;
gp = 
        ParaPlot[{t, a}, {t,  -a  -  k,  
            a  +  k,  (2*(a  +  k))/40}, 
          ConchoidSetting -> {{0, 0}, {-k, k}}, 
          DotStyle -> {Hue[0], Hue[ .7], Hue[ .8]}, 
          PlotDot -> False, AspectRatio -> Automatic];
ParaPlot[
        Conchoid[{t, a}, {0, 0}, {-k, k}], {t, -a - k, a + k}, 
        PlotStyle -> {Hue[0], Hue[ .65]}, 
        PlotRange -> FullOptions[gp, PlotRange], 
        AspectRatio -> Automatic];
ParaPlot[ConchoidOfNicomedes[a, k][t], {t, -a - k, a + k}, 
        PlotRange -> FullOptions[gp, PlotRange], 
        AspectRatio -> Automatic];
Clear[a, k, gp];

A plot showing conchoids with pole at origin, line at y==1, and offsets from -2 to 2.

aMin = -2;
aMax = 2;
numberOfCurves = 20;
\(\(curveGP2 = 
        First@ParametricPlot[
\ \ Evaluate@
              Conchoid[{t, 1}, {0, 0}, 
\ \ \ \ \ \ Table[
                  i, {i, aMin, 
                    aMax, \((aMax - aMin)\)/\((numberOfCurves - 
                          1)\)}]], {t, \(-5\), 5}, 
\ \ AspectRatio -> 
              Automatic, 
            PlotStyle -> \((Join[#, Reverse@#] &)\)@
                Table[Hue[i], {i, 0, 1, 1/\((numberOfCurves/2 - 1)\)}], 
            PlotRange -> {{\(-1\), 1} 4, {\(-1\), 3} 1.1}, 
            Background -> GrayLevel[0]];\)\)

The following plot shows how the curve looks like for large constant k.

aMin = -100;
aMax = 100;
numberOfCurves = 10;
curveGP1 = 
        First@ParametricPlot[
            Evaluate@
              Conchoid[{t, 1}, {0, 0}, 
                Table[i, {i, aMin, 
                    aMax, (aMax - aMin)/(numberOfCurves - 
                          1)}]], {t, -50, 50}, 
            AspectRatio -> Automatic, PlotRange -> All];

This sequence of graphics show the effect of varying k while a remain constant.

Do[
	ParaPlot[ ConchoidOfNicomedes[1,k][t], {t,-1.5, 4.7},
		PlotLabel->StringForm["a = 1, k = ``", PaddedForm[k,{3,2}] ],
		AspectRatio->Automatic, PlotRange->{{-6,6},{-4,6}}
	], {k, 0, 4,4/5.}
];

This sequence of graphics show the effect of varying a while k remain constant.

Do[
	ParaPlot[ ConchoidOfNicomedes[a,1][t],
		{t,-1.5, 4.7},
		PlotLabel->StringForm["a = ``, k = 1", PaddedForm[a,{3,2}] ],
		AspectRatio->Automatic,
		PlotRange->{{-6,6},{-2.5,3}+a}
	], {a, 0, 4,4/5.}
]

Graphics Gallery

Family of conchoids of Nicomedes

aMin = -2;
aMax = 2;
numberOfCurves = 100;
\(\(curveGP2 = 
        First@ParametricPlot[
\ \ Evaluate@
              Conchoid[{t, 1}, {0, 0}, 
\ \ \ \ \ \ Table[
                  i, {i, aMin, 
                    aMax, \((aMax - aMin)\)/\((numberOfCurves - 
                          1)\)}]], {t, \(-8\), 8}, 
\ \ AspectRatio -> 
              Automatic, 
            PlotStyle -> \((Join[#, Reverse@#] &)\)@
                Table[Hue[i], {i, 0, 1, 1/\((numberOfCurves/2 - 1)\)}], 
            PlotRange -> {{\(-1\), 1} 4, {\(-1\), 3} 1.1}, 
            Background -> GrayLevel[0]];\)\)

aMin = -20;
aMax = 20;
numberOfCurves = 200;
\(\(ParametricPlot[
\ \ Evaluate@
          Conchoid[{t, 1}, {0, 0}, 
\ \ \ \ \ \ Table[
              i, {i, aMin, 
                aMax, \((aMax - aMin)\)/\((numberOfCurves - 
                      1)\)}]], {t, \(-10\), 10}, 
\ \ AspectRatio -> 
          Automatic, PlotRange -> {{\(-1\), 1} 4, {\(-1\), 3} 1.1}, 
        PlotStyle -> \((Join[#, Reverse@#] &)\)@
            Table[Hue[i], {i, 0, 1, 1/\((numberOfCurves/2 - 1)\)}], 
        Background -> GrayLevel[0]];\)\)

Conchoids

ParaPlot[ConchoidOfNicomedes[1, 2][t], {t,  0,  
          2*Pi,  (2*Pi)/60}, 
        ConchoidSetting -> {{0, 1}, Range[-3, 3,  .2]}, 
        PlotCurve -> True, PlotDot -> False, 
        CurveColorFunction -> {GrayLevel[1] &}, 
        DotStyle -> 
          Table[{PointSize[0.015],  Hue[i]},  {i,  0.5,  1,  1/60}], 
        AspectRatio -> Automatic, Axes -> False, 
        Background -> GrayLevel[0], 
        PlotRange -> {{-1, 1} 2, {- .5, 
                3.2}} 1.6];

Clear[curves]
curves = 
        Conchoid[ConchoidOfNicomedes[1, 2][t], {0, 1.05}, 
          Range[-2, 0, (2/8)]];
ParaPlot[curves, {t, 0, 2 π}, AspectRatio -> Automatic, 
        Axes -> False, 
        PlotStyle -> 
          Table[Hue[i], {i,  .2,  .6, (( .6 -  .2)/Length)[curves]}], 
        Background -> GrayLevel[0]];

Clear[curves]
curves = 
        Conchoid[ConchoidOfNicomedes[1, 2][t], {0, 3.05}, 
          Range[-2, 0, (2/8)]];
ParaPlot[curves, {t, 0, 2 π}, PlotPoints -> 50, 
        AspectRatio -> Automatic, Axes -> False, 
        PlotStyle -> 
          Table[Hue[i], {i,  .6, 1, ((1 -  .6)/Length)[curves]}], 
        Background -> GrayLevel[0]];

Parallels

The following are parallels ploted with asymptotes. For some reason, they look better than without asymptotes.

ParaPlot[
        Parallel[ConchoidOfNicomedes[1, 2][t], t, Range[0, 2, 2/10]], {t, 
          0, 2 π}, AspectRatio -> Automatic, 
        PlotStyle -> Table[Hue[i],  {i,  0,  1,  1/20}], 
        Background -> GrayLevel[0], Axes -> False];

Clear[curves]
curves = 
        Parallel[ConchoidOfNicomedes[1, 2][t], t, 
          Range[-3, 0, 3/15]];
ParaPlot[curves, {t, 0, 2 π}, AspectRatio -> Automatic, 
        PlotStyle -> 
          Table[GrayLevel[i],  {i,  0,  1,  1/Length[curves]}], 
        Background -> GrayLevel[0], Axes -> False];

Ploting without asymptotes

gp1 = 
        First@ParaPlot[
            Parallel[ConchoidOfNicomedes[1, 2][t], t, 
              Range[0, 2, 2/10]], {t, -Pi/2, Pi/2}, 
            AspectRatio -> Automatic, 
            PlotStyle -> Table[Hue[i],  {i,  0,  1,  1/20}], 
            Background -> GrayLevel[0]];

gp2 = 
        First@ParaPlot[
            Parallel[ConchoidOfNicomedes[1, 2][t], t, 
              Range[0, 2, 2/10]], {t, Pi/2, 3/4*2*Pi}, 
            AspectRatio -> Automatic, 
            PlotStyle -> Table[Hue[i],  {i,  0,  1,  1/20}], 
            Background -> GrayLevel[0], 
            Axes -> False];

Show@
        Graphics[{gp1, gp2}, AspectRatio -> Automatic, 
          Background -> GrayLevel[0], 
          PlotRange -> {{-15.92, 16}, {-3.2, 5.12}}];

Evolutes

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> -2};
tZero = t /. Solve[curve == {0, 0}, t];
ParaPlot[Evaluate@curve, {t, -7, 7, 14/60}, 
        PlotOsculatingCircle -> True, PlotCurve -> True, 
        CurveColorFunction -> {Hue[ .7] &}, PlotDot -> False, 
        AspectRatio -> Automatic, 
        PlotStyle -> Table[Hue[i], {i,  0,  1,  1/20}], 
        Background -> GrayLevel[0], Axes -> True, 
        PlotRange -> {{-1, 1} 10, {-1, 1} 10 - 7}];

Owl's eye.

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> -10};
tZero = t /. Solve[curve == {0, 0}, t];
ParaPlot[
        Evaluate@curve, {t,  Sequence @@ tZero, (Last@tZero)*2/100}, 
        PlotOsculatingCircle -> True, PlotCurve -> True, 
        CurveColorFunction -> {Hue[ .7] &}, PlotDot -> False, 
        AspectRatio -> Automatic, 
        PlotStyle -> Table[Hue[i], {i,  0,  1,  1/20}], 
        Background -> GrayLevel[0], Axes -> True, 
        PlotRange -> {{-1, 1} 13, {-1, 1} 13 - 5}];

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> -10};
tZero = t /. Solve[curve == {0, 0}, t];
ParaPlot[
        Evaluate@curve, {t,  Sequence @@ tZero, (Last@tZero)*2/60}, 
        PlotOsculatingCircle -> False, PlotCurve -> True, 
        NormalLineLength -> 100, CurveColorFunction -> {Hue[0] &}, 
        PlotDot -> False, AspectRatio -> Automatic, 
        PlotStyle -> Table[Hue[i], {i,  0,  1,  1/20}], 
        Background -> GrayLevel[0], Axes -> True, 
        PlotRange -> {{-1, 1} 
              10, ({-1, 1} 10 - 7)}];

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> -10};
tZero = t /. Solve[curve == {0, 0}, t];
ParaPlot[
        Evaluate@curve, {t,  Sequence @@ tZero, (Last@tZero)*2/60}, 
        PlotOsculatingCircle -> False, PlotCurve -> True, 
        PlotEvolute -> True, CurveColorFunction -> {Hue[0] &}, 
        PlotDot -> False, AspectRatio -> Automatic, 
        PlotStyle -> Table[Hue[i], {i,  0,  1,  1/20}], 
        Background -> GrayLevel[0], Axes -> True];

ParaPlot[Evolute[curve, t], {t, -8, 8}, 
        AspectRatio -> Automatic, PlotRange -> All];

Radial

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> 100};
tZero = t /. Solve[curve == {0, 0}, t];
ParaPlot[Evaluate@(curve), {t, -5, 5,  .2}, 
        PlotRadial -> True, AspectRatio -> Automatic, 
        Background -> GrayLevel[0]];

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> 100};
tZero = t /. Solve[curve == {0, 0}, t];
ParametricPlot[
        Evaluate@{curve, Radial[curve, t, {0, 0}]}, {t, -5, 5}, 
        AspectRatio -> Automatic, 
        PlotStyle -> {Hue[ .75], Hue[0], 
            Hue[ .35, 1,  .7]}];

curve = {t  +  (k*t)/Sqrt[b^2  +  t^2],  
            b  +  (b*k)/Sqrt[b^2  +  t^2]} /. {b -> 1, 
            k -> -2};
tZero = t /. Solve[curve == {0, 0}, t];
ParametricPlot[
        Evaluate@{curve, Radial[curve, t, {0, 0}]}, {t, -10, 10}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-1, 1}, {-1, 1}} 5, 
        PlotStyle -> {Hue[ .75], Hue[0], 
            Hue[ .35, 1,  .7]}];