D2DQuadratic2D

The package D2DQuadratic2D implements the Quadratic2D object.

Initialization

BeginPackage["D2DQuadratic2D`", {"D2DEquations2D`", "D2DExpressions2D`", "D2DLine2D`", "D2DLoci2D`", "D2DMaster2D`", "D2DNumbers2D`", "D2DPoint2D`", "D2DSketch2D`", "D2DTransform2D`"}];

D2DQuadratic2D::usage=
   "D2DQuadratic2D is a package providing support for the quadratic object.";

Quadratic2D::usage=
   "Quadratic2D[a,b,c,d,e,f] represents the polynomial a*x^2+b*x*y+c*y^2+d*x+e*y+f.";

Begin["`Private`"];

Description

Representation

Format:  Quadratic2D[a,b,c,d,e,f]
A quadratic is used to represent a quadratic polynomial in two unknowns.  Quadratic2D[a,b,c,d,e,f] represents .

Graphics

Provides graphics primitives for a quadratic by extending the Mathematica Display command. Executed when the package is loaded.

SetDisplay2D[
   Quadratic2D[a_,b_,c_,d_,e_,f_],
   Loci2D[Quadratic2D[a,b,c,d,e,f]]];

Validation

Format: Quadratic2D[a,b,c,d,e,f]
Detects a quadratic with imaginary coefficients and returns the $Failed symbol.  If the imaginary parts are insignificant, they are removed.

Quadratic2D::imaginary=
   "An invalid quadratic of the form 'Quadratic2D[`1`, `2`, `3`, `4`, `5`, `6`]' has been detected; the arguments cannot be imaginary.";

Quadratic2D[a_,b_,c_,d_,e_,f_] :=
   (Quadratic2D @@ ChopImaginary2D[Quadratic$2D[a,b,c,d,e,f]]) /;
(FreeQ[{a,b,c,d,e,f},_Pattern] && IsTinyImaginary2D[{a,b,c,d,e,f}]);

Quadratic2D[a_,b_,c_,d_,e_,f_] :=
   (Message[Quadratic2D::imaginary,a,b,c,d,e,f];$Failed) /;
(FreeQ[{a,b,c,d,e,f},_Pattern] && IsComplex2D[{a,b,c,d,e,f},0]);

Format: Quadratic2D[a,b,c,d,e,f]
Returns the $Failed symbol when an invalid quadratic is detected (the first five coefficients are zero).  Also, normalizes quadratics with tiny coefficients to improve numerical stability.

Quadratic2D::invalid=
   "An invalid quadratic of the form 'Quadratic2D[`1`, `2`, `3`, `4`, `5`, `6`]' was encountered; at least one of the first five coefficients must be non-zero.";

Quadratic2D[a_,b_,c_,d_,e_,f_] :=
   (Message[Quadratic2D::invalid,a,b,c,d,e,f];$Failed) /;
(FreeQ[{a,b,c,d,e,f},_Pattern] && IsZero2D[{a,b,c,d,e},And,0]);

Quadratic2D[a_,b_,c_,d_,e_,f_] :=
   (Quadratic2D @@ ({a,b,c,d,e,f}/Sqrt[a^2+b^2+c^2+d^2+e^2])) /;
(FreeQ[{a,b,c,d,e,f},_Pattern] && IsZero2D[{a,b,c,d,e},And]);

Format: IsValid2D[quad]
Verifies that a quadratic is valid.

IsValid2D[
   Quadratic2D[a_?IsScalar2D,b_?IsScalar2D,
               c_?IsScalar2D,d_?IsScalar2D,
               e_?IsScalar2D,f_?IsScalar2D]] := True;

Transformations

Reflect

Format: Reflect2D[quad,line]
Reflects a 'quadratic' in a line.

Reflect2D[Q:Quadratic2D[a_,b_,c_,d_,e_,f_],L:Line2D[p_,q_,r_]] :=
   Module[{eq1,eq2,x,y},
      eq1=Equation2D[Q,{x,y}];
      eq2=Reflect2D[eq1,{x,y},L];
      Quadratic2D[eq2,{x,y}] ];

Rotate

Format: Rotate2D[quad,θ,coords]
Rotates a quadratic by an angle θ about a position specified by a coordinate list.  If the third argument is omitted, it defaults to the origin (see D2DTransform2D.html).

Rotate2D[Q:Quadratic2D[a_,b_,c_,d_,e_,f_],theta_?IsScalar2D,
         {h_?IsScalar2D,k_?IsScalar2D}] :=
   Module[{eq1,eq2,x,y},
      eq1=Equation2D[Q,{x,y}];
      eq2=Rotate2D[eq1,{x,y},theta,{h,k}];
      Quadratic2D[eq2,{x,y}] ];

Scale

Format: Scale2D[quad,s,coords]
Scales a quadratic from a position given by coordinates.  If the third argument is omitted, it defaults to the origin (see D2DTransform2D.html).

Scale2D[Q:Quadratic2D[a_,b_,c_,d_,e_,f_],s_?IsScalar2D,
        {h_?IsScalar2D,k_?IsScalar2D}] :=
   Module[{eq1,eq2,x,y},
      eq1=Equation2D[Q,{x,y}];
      eq2=Scale2D[eq1,{x,y},s,{h,k}];
      Quadratic2D[eq2,{x,y}] ] /;
Not[IsZeroOrNegative2D[s]];

Translate

Format: Translate2D[quad,{u,v}]
Translates a quadratic delta distance.

Translate2D[Quadratic2D[a_,b_,c_,d_,e_,f_],
          {u_?IsScalar2D,v_?IsScalar2D}] :=
   Quadratic2D[a,b,c,d-2*a*u-b*v,e-2*c*v-b*u,
               a*u^2+b*u*v+c*v^2-u*d-v*e+f];

Quadratic Construction

Simplify and FullSimplify

Format: Simplify[quad] and FullSimplify[quad]
Extends the Mathematica Simplify and FullSimplify commands to simplify the coefficients of a quadratic by factoring out common factors.  Executed when the package is loaded.

protected=Unprotect[Simplify];
Simplify[expr_?(!FreeQ[#,Quadratic2D[a_,b_,c_,d_,e_,f_]]&),
         opts___] :=
   Simplify[expr /. Quadratic2D[a_,b_,c_,d_,e_,f_] :>
              (Quadratic$2D @@
                  SimplifyCoefficients2D[{a,b,c,d,e,f}]),
            opts] /. Quadratic$2D->Quadratic2D;
Protect[Evaluate[protected]];

protected=Unprotect[FullSimplify];
FullSimplify[expr_?(!FreeQ[#,Quadratic2D[a_,b_,c_,d_,e_,f_]]&),
             opts___] :=
   FullSimplify[expr /. Quadratic2D[a_,b_,c_,d_,e_,f_] :>
                 (Quadratic$2D @@
                     SimplifyCoefficients2D[{a,b,c,d,e,f}]),
            opts] /. Quadratic$2D->Quadratic2D;
Protect[Evaluate[protected]];

Normalize

Format: Quadratic2D[quad]
Normalizes the coefficients of a quadratic in two unknowns so that the sum of the squares of the first five coefficients equals one.

Quadratic2D[Quadratic2D[a_,b_,c_,d_,e_,f_]] :=
   (Quadratic2D @@ ({a,b,c,d,e,f}/Sqrt[a^2+b^2+c^2+d^2+e^2]));

Quadratic from Equation/Polynomial

Format: Quadratic2D[expr,{x,y}]
Forms a quadratic from a polynomial or equation in two unknowns.  For example, when the expression is will return Quadratic2D[a,n,c,d,e,f]; the polynomial     will also return Quadratic2D[a,n,c,d,e,f. The x and y arguments are assumed to be the names of the variables.

Quadratic2D::noPoly=
   "The expression `1` cannot be recognized as a quadratic polynomial or equation in variables `2` and `3`.";

Quadratic2D[expr_,{x_,y_}] :=
   Module[{eqn,a,b,c,d,e,f},
      eqn=If[Head[expr]===Equal,
             expr[[1]]-expr[[2]],
             expr] //Expand;
      a=Coefficient[eqn,x^2];
      b=Coefficient[eqn,x*y];
      c=Coefficient[eqn,y^2];
      d=Coefficient[Expand[eqn /. {x*y->0}],x];
      e=Coefficient[Expand[eqn /. {x*y->0}],y];
      f=(eqn /. {x->0,y->0}) //Expand;
      If[IsZero2D[a*x^2+b*x*y+c*y^2+d*x+e*y+f-eqn],
         Quadratic2D[a,b,c,d,e,f],
         Message[Quadratic2D::noPoly,expr,x,y];$Failed] ];

Quadratic from Coordinates

Format: Quadratic2D[coords]
Forms a (degenerate) quadratic from a point given by a coordinate list (a point circle).

Quadratic2D[{x_?IsScalar2D,y_?IsScalar2D}] :=
   Quadratic2D[1,0,1,-2*x,-2*y,x^2+y^2];

Quadratic Through Three Points

Format: Quadratic2D[point,point,point]
Constructs a quadratic (circle) that passes through three points.

Quadratic2D[Point2D[{x1_,y1_}],Point2D[{x2_,y2_}],Point2D[{x3_,y3_}]] :=
   Module[{eqn,x,y},
      eqn=Det[{{ x^2+ y^2, x, y,1},
               {x1^2+y1^2,x1,y1,1},
               {x2^2+y2^2,x2,y2,1},
               {x3^2+y3^2,x3,y3,1}}];
      Quadratic2D[eqn,{x,y}] ];

Quadratic Through Five Points

Format: Quadratic2D[point,point,point,point,point]
Constructs a quadratic that passes through five points.

Quadratic2D[Point2D[{x1_,y1_}],Point2D[{x2_,y2_}],Point2D[{x3_,y3_}],
            Point2D[{x4_,y4_}],Point2D[{x5_,y5_}]] :=
   Module[{full,a,b,c,d,e,f},
      full={{x1^2, x2^2, x3^2, x4^2, x5^2},
            {x1*y1,x2*y2,x3*y3,x4*y4,x5*y5},
            {y1^2, y2^2, y3^2, y4^2, y5^2},
            {x1,   x2,   x3,   x4,   x5},
            {y1,   y2,   y3,   y4,   y5},
            {1,    1,    1,    1,    1}};
      {a,b,c,d,e,f}=Map[Det[Transpose[Drop[full,{#}]]]&,{1,2,3,4,5,6}];
      Quadratic2D[a,-b,c,-d,e,-f] ];

Quadratic Tangent to Five Lines

Format: Quadratic2D[line,line,line,line,line]
Constructs a quadratic tangent to five lines.  The private function Reciprocal$2D constructs the reciprocal of a conic with respect to the unit circle .  If any of the lines pass through the origin, the entire configuration is transformed to avoid the infinities involved.

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];

Quadratic2D[L1:Line2D[a1_,b1_,c1_],L2:Line2D[a2_,b2_,c2_],
            L3:Line2D[a3_,b3_,c3_],L4:Line2D[a4_,b4_,c4_],
            L5:Line2D[a5_,b5_,c5_]] :=
   Module[{u,v,lns,Q},
      {u,v}=RandomInteger[{-5, 5}, 2];
      lns=Translate2D[{L1,L2,L3,L4,L5},{u,v}];
      Q=Quadratic2D[lns];
      Translate2D[Q,{-u,-v}] ] /;
IsZero2D[{c1,c2,c3,c4,c5},Or];

Quadratic2D[Line2D[a1_,b1_,c1_],Line2D[a2_,b2_,c2_],
            Line2D[a3_,b3_,c3_],Line2D[a4_,b4_,c4_],
            Line2D[a5_,b5_,c5_]] :=
   Reciprocal$2D[
      Quadratic2D[
         Point2D[{-a1/c1,-b1/c1}],Point2D[{-a2/c2,-b2/c2}],
         Point2D[{-a3/c3,-b3/c3}],Point2D[{-a4/c4,-b4/c4}],
         Point2D[{-a5/c5,-b5/c5}]]] /;
Not[IsZero2D[{c1,c2,c3,c4,c5},Or]];

Quadratic from Two Lines

Format: Quadratic2D[line,line]
Constructs a quadratic representing two lines multiplied together.

Quadratic2D[Line2D[a1_,b1_,c1_],Line2D[a2_,b2_,c2_]] :=
   Quadratic2D[a1*a2,a1*b2+a2*b1,b1*b2,a1*c2+a2*c1,b1*c2+b2*c1,c1*c2];

Quadratic from Focus/Directrix/Eccentricity

Format: Quadratic2D[point,line,e]
Constructs a quadratic from a focus point, directrix line and eccentricity.

Quadratic2D::eccentricity=
   "The eccentricity `1` is invalid; the eccentricity must be positive.";

Quadratic2D[Point2D[{x1_,y1_}],L2:Line2D[a2_,b2_,c2_],e_?IsScalar2D] :=
   Module[{l,m,r},
      If[IsZeroOrNegative2D[e],
         Message[Quadratic2D::eccentricity,e];$Failed,
         {p,q,r}=List @@ Line2D[L2];
         Quadratic2D[e^2*p^2-1, 2*e^2*p*q, e^2*q^2-1,
                     2*(x1+e^2*p*r), 2*(y1+e^2*q*r),e^2*r^2-x1^2-y1^2]] ];

Quadratic Vertex Equation

Format: Quadratic2D[point,fcLen,e,θ]
Constructs a quadratic from the vertex point, focal length, eccentricity and rotation angle.  If the rotation angle is omitted, it defaults to zero.

Quadratic2D::invLen=
   "A non-positive focal chord length, `1`, is invalid; no valid quadratic can be constructed.";

Quadratic2D::invEcc=
   "A negative eccentricity, `1`, is invalid; no valid quadratic can be constructed.";

Quadratic2D[P1:Point2D[{x1_,y1_}],fcLen_?IsScalar2D,e_?IsScalar2D] :=
   Quadratic2D[P1,fcLen,e,0];

Quadratic2D[Point2D[{x1_,y1_}],fcLen_?IsScalar2D,
            e_?IsScalar2D,theta_?IsScalar2D] :=
   Module[{eqn,x,y},
      Which[
         IsZeroOrNegative2D[fcLen],
            Message[Quadratic2D::invLen,fcLen];$Failed,
         IsNegative2D[e],
            Message[Quadratic2D::invEcc,e];$Failed,
         True,
            eqn=(y-y1)^2==fcLen*(x-x1)-(1-e^2)(x-x1)^2;
            Rotate2D[Quadratic2D[eqn,{x,y}],theta,{x1,y1}]] ];

Epilogue

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