D2DTangentConics2D

The package D2DTangentConics2D provides functions for constructing conics and quadratics that satisfy five conditions.  Each condition may be either passing through a given point or tangent to a given line.

Initialization

BeginPackage["D2DTangentConics2D`",{"D2DCircle2D`", "D2DEllipse2D`", "D2DExpressions2D`", "D2DGeometry2D`", "D2DHyperbola2D`", "D2DLine2D`", "D2DLoci2D`", "D2DMaster2D`", "D2DParabola2D`", "D2DPencil2D`", "D2DPoint2D`", "D2DQuadratic2D`", "D2DSolve2D`", "D2DTransform2D`"}];

D2DTangentConics2D::usage=
   "D2DTangentConics2D is a package for constructing tangent conics and quadratics.";

TangentConics2D::usage=
   "TangentConics2D[{obj1,obj2,obj3,obj4,obj5}] constructs list of conic curves given five objects; the objects may be any combination of points and lines; the conics will pass through the given points and be tangent to the given lines.";

TangentQuadratics2D::usage=
   "TangentQuadratics2D[{obj1,obj2,obj3,obj4,obj5}] constructs list of quadratics given five objects; the objects may be any combination of points and lines; the quadratics will pass through the given points and be tangent to the given lines.";

Begin["`Private`"];

Error Messages

General Error Messages

TangentConics2D::coincident=
   "Two or more of the defining points or lines are coincident; no proper conic can be constructed.";

TangentConics2D::collinear=
   "Three or more of the defining points are collinear; no proper conic can be constructed.";

TangentConics2D::concurrent=
   "Three or more of the tangent lines are concurrent; no proper conic can be constructed.";

TangentConics2D::linesThru=
   "One of the points is on more than one of the tangent lines; no proper conic can be constructed.";

TangentConics2D::parallel=
   "Three or more of the defining lines are parallel; no proper conic can be constructed.";

TangentConics2D::pointsOn=
   "Two or more of the points are on a tangent line; no proper conic can be constructed.";

Utilities

Numeric Computations

The private function N$2D numerically normalizes lines and quadratics (or lists of such objects) if approximate numerical computations are underway; otherwise, no action is taken.

N$2D[expr_List] := Map[N$2D,expr];

N$2D[L:Line2D[a_,b_,c_]] :=
   If[IsApproximate2D[L],Line2D[ N[L] ],L];

N$2D[P:Point2D[{x_,y_}]] :=
   If[IsApproximate2D[P],N[P],P];

N$2D[Q:Quadratic2D[a_,b_,c_,d_,e_,f_]] :=
   If[IsApproximate2D[Q],Quadratic2D[ N[Q] ],Q];

Number of Points on a Line

The private function CountPointsOn$2D returns the number of points from a given list that are on a given line.

CountPointsOn$2D[pts_List,L:Line2D[a_,b_,c_]] :=
  Count[Map[IsOn2D[#,L]&, pts], True];

The private function MaxPointsOn$2D returns the maximum number of points from a given list that are on any of the lines in a list.

MaxPointsOn$2D[pts_List,lns_List] :=
   If[Length[pts]<1 || Length[lns]<1,
      0,
      Max @@ Map[CountPointsOn$2D[pts,#]&,lns] ];

Number of Lines Through a Point

The private function CountLinesThru$2D returns the number of lines from a given list that pass through a given point.

CountLinesThru$2D[lns_List,P:Point2D[{x_,y_}]] :=
   Count[Map[IsOn2D[P,#]&, lns], True];

The private function MaxLinesThru$2D returns the maximum number of lines from a given list that pass through any of the points in a list.

MaxLinesThru$2D[lns_List,pts_List] :=
  If[Length[lns]<1 || Length[pts]<1,
     0,
     Max @@ Map[CountLinesThru$2D[lns,#]&,pts] ];

Validity Queries

The private function ValidObjectsQ$2D verifies that the object list contains valid objects.  The function private ValidConfigurationQ$2D verifies that the configuration of the objects is valid.

ValidObjectsQ$2D[obj_List,funcName_] :=
   ((Count[Map[IsValid2D,obj],True]==
     Count[Map[Is2D[#,{Point2D,Line2D}]&,obj],True]==
     Length[obj]==5) &&
    IsNumeric2D[obj,funcName]);

ValidConfigurationQ$2D[obj_List] :=
   Module[{pts,lns},
      pts=Select[N$2D[obj],Is2D[#,{Point2D}]&];
      lns=Select[N$2D[obj],Is2D[#,{Line2D}]&];
      Which[
         IsCoincident2D[pts],
            Message[TangentConics2D::coincident];False,
         IsCoincident2D[lns],
            Message[TangentConics2D::coincident];False,
         IsCollinear2D[pts],
            Message[TangentConics2D::collinear];False,
         IsConcurrent2D[lns],
            Message[TangentConics2D::concurrent];False,
         IsTripleParallel2D[lns],
            Message[TangentConics2D::parallel];False,
         MaxPointsOn$2D[pts,lns]>1,
            Message[TangentConics2D::pointsOn];False,
         MaxLinesThru$2D[lns,pts]>1,
            Message[TangentConics2D::linesThru];False,
         True,
            True] ];

Polynomials

Point on Line

The private function Polynomial$2D forms a polynomial by substituting the coordinates of a point  into the equation of a line.

Polynomial$2D[Point2D[{x_,y_}],Line2D[a_,b_,c_]] := a*x+b*y+c;

Point on Quadratic

The private function Polynomial$2D forms a polynomial by substituting the coordinates of a point into a quadratic equation

Polynomial$2D[Point2D[{x_,y_}],Quadratic2D[a_,b_,c_,d_,e_,f_]] :=
   a*x^2+b*x*y+c*y^2+d*x+e*y+f;

Line Tangent to Quadratic

The private function Polynomial$2D forms a polynomial of coefficients from a line and a quadratic when the line is tangent to the quadratic.

Polynomial$2D[Line2D[p_,q_,r_],Quadratic2D[a_,b_,c_,d_,e_,f_]] :=
   ((4*c*f-e^2)*p^2+(4*a*f-d^2)*q^2+(4*a*c-b^2)*r^2+
    2*(b*d-2*a*e)*q*r+2*(b*e-2*c*d)*p*r+2*(d*e-2*b*f)*p*q);

Quadratic and Conic Construction

Quadratic Tangent to Five Objects

Format: TangentQuadratics2D[{,,,,}]
Constructs a list of quadratics tangent to five objects.  The objects may be any combination of points or lines.

TangentQuadratics2D[obj_List] :=
   If[ValidConfigurationQ$2D[obj],
      TangentQuadratic$2D[obj//N$2D],
      {}] /;
ValidObjectsQ$2D[obj,TangentQuadratics2D];

Conic Tangent to Five Objects

Format: TangentConics2D[{,,,,}]
Constructs a list of conics tangent to five objects.  The objects may be any combination of points or lines.

TangentConics2D[obj_List] :=
   Module[{Q,conics},
      If[ValidConfigurationQ$2D[obj],
         Q=TangentQuadratics2D[obj//N$2D];
         conics=Flatten[Map[Loci2D,Q]];
         Union[
            Select[conics,
                   Is2D[#,{Circle2D,Ellipse2D,Hyperbola2D,Parabola2D}]&]],
         {}] ] /;
ValidObjectsQ$2D[obj,TangentConics2D];      

Preprocess Arguments

Preprocesses the arguments to private function TangentQuadratic$2D to match the implemented functions.

TangentQuadratic$2D[{a_,b_,c_,d_,e_}] :=
   TangentQuadratic$2D[a,b,c,d,e];

TangentQuadratic$2D[a___,L1_Line2D,b___,L2_Line2D,c___,L3_Line2D,d___] :=
   TangentInverse$2D[{L1,L2,L3,a,b,c,d}];

TangentQuadratic$2D[a___,L_Line2D,b___,P_Point2D,c___] :=
   TangentQuadratic$2D[a,P,b,c,L];

TangentQuadratic$2D[a___,P_Point2D,b___,L_Line2D,c___] :=
   (TangentQuadratic$2D[{P,L},a,b,c]) /;
IsOn2D[P,L];

Five Points

Private function that constructs a list containing one quadratic passing through five points.

TangentQuadratic$2D[P1_,P2_,P3_,P4_,P5_] :=
   {Quadratic2D[P1,P2,P3,P4,P5] //N$2D};

Four Points, One Line (No Points on Line)

Private function that constructs a list containing two quadratics passing through four points and tangent to one line.  None of the points can be on the tangent line.

TangentQuadratic$2D[P1_Point2D,P2_Point2D,P3_Point2D,P4_Point2D,
                    L5_Line2D] :=
    Module[{Q,k,allRoots,realRoots},
       Q=Quadratic2D[{Line2D[P1,P2],Line2D[P3,P4]},
                     {Line2D[P1,P3],Line2D[P2,P4]},k,Pencil2D] //N$2D;
       allRoots=Solve2D[{Polynomial$2D[L5,Q]==0},{k}];
       realRoots=Select[allRoots,IsReal2D[k /. #]&];
       N$2D[Map[(Q /. #)&, realRoots]] ];

Four Points, One Line (One Point on Line)

Private function that constructs a list containing one quadratic passing through four points and tangent to one line.  One of the points must be on the tangent line.

TangentQuadratic$2D[{P1_Point2D,L1_Line2D},P2_Point2D,P3_Point2D,
                    Point2D[{x4_,y4_}]] :=
   Module[{x,y,L12,L13,L23,ln,k},
      L12=Polynomial$2D[Point2D[{x,y}],Line2D[P1,P2]];
      L13=Polynomial$2D[Point2D[{x,y}],Line2D[P1,P3]];
      L23=Polynomial$2D[Point2D[{x,y}],Line2D[P2,P3]];
      ln=Polynomial$2D[Point2D[{x,y}],L1];
      k=(L12*L13)/(ln*L23) /. {x->x4,y->y4};
      {Quadratic2D[L12*L13-k*ln*L23,{x,y}] //N$2D} ];

Three Points, Two Lines (No Points on Lines)

Private function that constructs a list containing four quadratics given three points and two tangent lines.  None of the points can be on the tangent lines.

TangentQuadratic$2D[Point2D[{0,0}],Point2D[{x2_,y2_}],Point2D[{x3_,y3_}],
                    Line2D[a1_,b1_,c1_],Line2D[a2_,b2_,c2_]] :=
   Module[{p11,p12,p13,p21,p22,p23,p31,p32,p33,a,b,ans,k,Q},
      p11=c1; p12=a1*x2+b1*y2+c1; p13=a1*x3+b1*y3+c1;
      p21=c2; p22=a2*x2+b2*y2+c2; p23=a2*x3+b2*y3+c2;
      p31=1;  p32=a*x2+b*y2+1;    p33=a*x3+b*y3+1;
      ans=Solve2D[{p11*p21*p32^2==p12*p22*p31^2,
                   p12*p22*p33^2==p13*p23*p32^2},{a,b}];
      ans=Select[ans,(IsReal2D[a /. #] && IsReal2D[b /. #])&];
      k=c1*c2;
      Q=(a1*x+b1*y+c1)*(a2*x+b2*y+c2)-k*(a*x+b*y+1)^2;
      N$2D[Map[Quadratic2D[(Q /. #),{x,y}]&,ans]] ];

TangentQuadratic$2D[P1:Point2D[{x1_,y1_}],P2:Point2D[{x2_,y2_}],
                    P3:Point2D[{x3_,y3_}],
                    L1:Line2D[a1_,b1_,c1_],L2:Line2D[a2_,b2_,c2_]] :=
   Module[{pt2,pt3,ln1,ln2,Q},
      {pt2,pt3,ln1,ln2}=Translate2D[{P2,P3,L1,L2},{-x1,-y1}] //N$2D;
      Q=TangentQuadratic$2D[Point2D[{0,0}],pt2,pt3,ln1,ln2];
      N$2D[Translate2D[Q,{x1,y1}]] ];

Three Points, Two Lines (One Point on Line)

Private function that constructs a list containing up to two quadratics through three points, tangent to two lines when one of the points is on a tangent line.

TangentQuadratic$2D[{P1_Point2D,L1_Line2D},P2_Point2D,P3_Point2D,
                    L4_Line2D] :=
   Module[{Q,k,allRoots,roots},
      Q=Quadratic2D[{L1,Line2D[P2,P3]},
                    {Line2D[P1,P2],Line2D[P1,P3]},k,Pencil2D];
      allRoots=Solve2D[{Polynomial$2D[L4,Q]==0},{k}];
      roots=Select[allRoots,IsReal2D[k /. #]&];
      N$2D[Map[(Q /. #)&,roots]] ];

Three Points, Two Lines (Two Points On Lines)

Private function that constructs a list containing up to one quadratic through three points, tangent to two lines when two of the points are on the tangent lines (one point on each tangent line).

TangentQuadratic$2D[{P1_Point2D,L1_Line2D},
                    {P3_Point2D,L3_Line2D},P2:Point2D[{x2_,y2_}]] :=
   Module[{x,y,ln13,ln1,ln3,k},
      ln13=Polynomial$2D[Point2D[{x,y}],Line2D[P1,P3]];
      ln1=Polynomial$2D[Point2D[{x,y}],L1];
      ln3=Polynomial$2D[Point2D[{x,y}],L3];
      k=(ln1*ln3)/ln13^2 /. {x->x2,y->y2};
      {Quadratic2D[ln1*ln3-k*ln13^2,{x,y}] //N$2D} ];

Reciprocal Method

Private function that constructs a list containing quadratics given five elements (points or tangent lines).  The method of reciprocals is used.  Using the reciprocal method converts a case with more than two tangent lines to its reciprocal, which has two or fewer tangent lines.

TangentInverse$2D[origObjs_List] :=
   Module[{offset,objsTrans,invertedObjs,Q},
      offset=SaveOffset$2D[origObjs];
      objsTrans=Translate2D[origObjs,-offset];
      invertedObjs=Map[Invert$2D,objsTrans] //N$2D;
      Q=TangentQuadratic$2D[invertedObjs];
      Translate2D[Map[Reciprocal$2D,Q],offset] //N$2D ];

Private functions that constructs the pole point of a line with respect to a unit circle and the polar line of a point with respect to a circle.

Invert$2D[Line2D[a_,b_,c_]] := Point2D[{-a/c,-b/c}];

Invert$2D[Point2D[{x_,y_}]] := Line2D[x,y,-1];

Private function that constructs the reciprocal quadratic of a quadratic with respect to a unit circle.

Reciprocal$2D[Quadratic2D[a_,b_,c_,d_,e_,f_]] :=
   Quadratic2D[4*c*f-e^2,2*d*e-4*b*f,4*a*f-d^2,
               4*c*d-2*b*e,4*a*e-2*d*b,4*a*c-b^2] //N$2D;

Private functions that determine an offset that will safely position a list of objects insuring that no line passes through the center of inversion and no point is coincident with the center of inversion.  The center of inversion is the origin (0,0).

InvalidOffsetQ$2D[P1:Point2D[{x1_,y1_}],offset:{dx_,dy_}] :=
   IsCoincident2D[P1,Point2D[offset]];

InvalidOffsetQ$2D[L1:Line2D[a1_,b1_,c1_],offset:{dx_,dy_}] :=
   IsOn2D[Point2D[offset],L1];

SaveOffset$2D[obj_List] :=
   Module[{offset={0,0}},
      While[MemberQ[Map[InvalidOffsetQ$2D[#,offset]&,obj],
                    True],
            offset=RandomInteger[{-4, 4}, 2]];
      offset ];

Epilogue

End[ ]; (* end of "`Private" *)
EndPackage[ ]; (* end of "D2DTangentConics2D`" *)