(******************************************************************* This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialization Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) BeginPackage["CompG`"] PointQ::usage="PointQ[p] yields True if p is a two-component vector (see VectorQ). The components may be numeric or nonnumeric."; NPointQ::usage="NPointQ[p] yields True if p is a point (PointQ[p] yields True) with numeric components (see NumericQ)."; Begin["`Private`"]; PointQ=VectorQ[#]\[And](Length[#]===2)&; NPointQ=VectorQ[#,NumericQ]\[And](Length[#]===2)&; End[] OriginQ::usage="OriginQ[p] yields True if the components of a point p are zero (exact or floating point, i.e. 0 or 0.)."; Begin["`Private`"]; OriginQ=MatchQ[#.#,0|0.]&; End[] SegmentQ::usage="SegmentQ[{p1,p2}] yields True if p1 and p2 are two points (any pair of points defines a segment). The empty list {} and two points s.t. OriginQ[p2-p1] gives True define degenerate segments."; NSegmentQ::usage="NSegmentQ[{p1,p2}] yields True if p1 and p2 are points with numeric components (see SegmentQ)."; Begin["`Private`"]; SegmentQ=MatrixQ[#]\[And](Dimensions[#]==={2,2})&; NSegmentQ=MatrixQ[#,NumericQ]\[And](Dimensions[#]==={2,2})&; End[] LineQ::usage="LineQ[s] yields True if s is a list of two distinct points (s defines a line)."; NLineQ::usage="NLineQ[s] yields True if s is a list of two distinct points with numeric components (see LineQ)."; Begin["`Private`"]; LineQ=SegmentQ[#]\[And]\[Not]OriginQ[#\[LeftDoubleBracket]2\ \[RightDoubleBracket]-#\[LeftDoubleBracket]1\[RightDoubleBracket]]&; NLineQ=NSegmentQ[#]\[And]\[Not]OriginQ[#\[LeftDoubleBracket]2\ \[RightDoubleBracket]-#\[LeftDoubleBracket]1\[RightDoubleBracket]]&; End[] HalfLineQ::usage="HalfLineQ[s] yields True if s is a list of two distinct points (s defines a halfline emanating from the first and passing through the second point)."; NHalfLineQ::usage="NHalfLineQ[s] yields True if s is a list consisting of two distinct points with numeric components (see HalfLineQ)."; Begin["`Private`"]; HalfLineQ=LineQ; NHalfLineQ=NLineQ; End[] PathQ::usage="PathQ[p] yields True if p is a list of three points or more. Those points define a path (segments are not paths)."; NPathQ::usage="NPathQ[p] yields True if p is a list of three or more points with numeric components (see PathQ)."; Begin["`Private`"]; PathQ=MatrixQ[#]\[And]MatchQ[Dimensions@#,{x_/;x\[GreaterEqual]3,2}]&; NPathQ=MatrixQ[#,NumericQ]\[And] MatchQ[Dimensions@#,{x_/;x\[GreaterEqual]3,2}]&; End[] NondegeneratePathQ::usage="NondegeneratePathQ[p] yields True if every edge of path p is a nondegenerate segment (see PathQ and SegmentQ)."; DegeneratePathQ::usage="DegeneratePathQ[p] yields True if path p has some degenerate edge (see NondegeneratePathQ)."; Begin["`Private`"]; DegeneratePathQ=Or@@Map[OriginQ,Most[RotateLeft[#]-#]]&; NondegeneratePathQ=\[Not]DegeneratePathQ[#]&; End[] ClosedPathQ::usage="ClosedPathQ[{p1,...,pn}] yields True if the path {p1,,...,pn} (n\[GreaterEqual]3) is closed, i.e. OriginQ[pn-p1] returns True."; OpenPathQ::usage="OpenPathQ[{p1,...,pn}] yields True if the path {p1,,...,pn} (n\[GreaterEqual]3) is not closed, i.e. OriginQ[pn-p1] returns False."; Begin["`Private`"]; ClosedPathQ=OriginQ[First[#]-Last[#]]&; OpenPathQ=\[Not]OriginQ[First[#]-Last[#]]&; End[] ClosePath::usage="ClosePath[p] acts on an open path p by appending to it its first point (see OpenPathQ)."; OpenPath::usage="OpenPath[p] acts on a closed path p by repeatedly deleting the last point until it becomes different from the first one (see ClosedPathQ).\nOpening degenerate closed path may lead to non-paths (lists of one or two points)."; Begin["`Private`"]; OpenPath=NestWhile[Most,#,Length[#]>1\[And]OriginQ[First[#]-Last[#]]&]&; ClosePath=If[\[Not]OriginQ[First[#]-Last[#]],Append[#,First@#],#]&; End[] VectorNorm::usage="VectorNorm[p] computes the euclidean norm of a point p."; CompG::"zv"="Nonzero vector required by `1`."; UnitVector::usage="UnitVector[p] returns the unit vector associated to a nonzero point p (i.e. OriginQ[p] returns False)."; Begin["`Private`"]; VectorNorm=Sqrt[#.#]&; UnitVector= If[OriginQ[#],Message[CompG::"zv",HoldForm[UnitVector]];$Failed; Abort[],#/Sqrt[#.#]]&; End[] WedgeProduct::usage="WedgeProduct[{x1,y1},{x2,y2}] computes x1 y2 - x2 y1."; Begin["`Private`"]; WedgeProduct=#1\[LeftDoubleBracket]1\[RightDoubleBracket]#2\ \[LeftDoubleBracket]2\[RightDoubleBracket]-#1\[LeftDoubleBracket]2\ \[RightDoubleBracket]#2\[LeftDoubleBracket]1\[RightDoubleBracket]&; End[] DoubleArea::usage="DoubleArea[{p1, p2,...,pn}] computes the signed double area of the polygon with vertices p1,...,pn (n\[GreaterEqual]3)."; DoubleArea3::usage="DoubleArea3[{p1, p2,p3}] efficiently computes the signed double area of the triangle with vertices p1,p2,p3."; CompG::"da"="`1` requires a list of three or more points."; Begin["`Private`"]; DoubleArea= If[Length[#]\[GreaterEqual]3,#\[LeftDoubleBracket]1\[RightDoubleBracket].(\ RotateLeft[#\[LeftDoubleBracket]2\[RightDoubleBracket]]- RotateRight[#\[LeftDoubleBracket]2\[RightDoubleBracket]])&[ Transpose[#]],Message[CompG::"da",HoldForm[DoubleArea]];Abort[]]&; DArea3=#\[LeftDoubleBracket]1,1\[RightDoubleBracket]#\[LeftDoubleBracket]2, 2\[RightDoubleBracket]-#\[LeftDoubleBracket]1, 2\[RightDoubleBracket]#\[LeftDoubleBracket]2, 1\[RightDoubleBracket]+#\[LeftDoubleBracket]2, 1\[RightDoubleBracket]#\[LeftDoubleBracket]3, 2\[RightDoubleBracket]-#\[LeftDoubleBracket]2, 2\[RightDoubleBracket]#\[LeftDoubleBracket]3, 1\[RightDoubleBracket]+#\[LeftDoubleBracket]3, 1\[RightDoubleBracket]#\[LeftDoubleBracket]1, 2\[RightDoubleBracket]-#\[LeftDoubleBracket]3, 2\[RightDoubleBracket]#\[LeftDoubleBracket]1, 1\[RightDoubleBracket]&; DoubleArea3=DArea3; End[] LeftTurnQ::usage="LeftTurnQ[{p1,p2,p3}] yields True if the nondegenerate numeric path directed from p1 to p3 has a left turn at p2 (see NondegeneratePathQ, NPathQ)."; RightTurnQ::usage="RightTurnQ[{p1,p2,p3}] yields True if the nondegenerate numeric path directed from p1 to p3 has a right turn at p2 (see NondegeneratePathQ, NPathQ)."; NoTurnQ::usage="NoTurnQ[{p1,p2,p3}] yields True if p1,p2,p3 are three collinear numeric points, i.e. they define a degenerate triangle (see DoubleArea, DoubleArea3, LeftTurnQ and RightTurnQ)."; Begin["`Private`"]; LeftTurnQ=(Sign[DArea3[#]]===1)&; RightTurnQ=Sign[DArea3[#]]===-1&; NoTurnQ=Sign[DArea3[#]]===0&; End[] Angle::usage="Angle[p1,p0,p2] yields the angle at p0 determined by three points p1,p0,p2 with p1\[NotEqual]p0 and p2\[NotEqual]p0, and measured from p1 to p2.\nAngle[p1,p2] is equivalent to Angle[p1,{0,0},p2].\nAngle[p] returns the polar angle of p, i.e. Angle[{1,0},{0,0},p]."; CompG::"ang1"="A nonzero numeric point is required in `1`."; CompG::"ang2"="Two nonzero numeric points are required in `1`."; CompG::"ang3"="Angle[p1,p2,p3] requires numeric arguments with p1,p3\[NotEqual]p2."; Begin["`Private`"]; Angle[p_]:= If[NPointQ[p]\[And]\[Not]OriginQ[p],Mod[ArcTan@@p,2\[Pi]], Message[CompG::"ang1",HoldForm[Angle[p]]];Abort[]]; Angle[p_,q_]:= If[And@@(NPointQ[#]\[And]\[Not]OriginQ[#]&/@{p,q}), Mod[ArcTan@@q-ArcTan@@p,2\[Pi]], Message[CompG::"ang2",HoldForm[Angle[p,q]]];Abort[]]; Angle[p_,o_,q_]:= If[And@@(NPointQ/@{p,o,q})\[And]\[Not]OriginQ[p-o]\[And]\[Not]OriginQ[ q-o],Mod[ArcTan@@(q-o)-ArcTan@@(p-o),2\[Pi]], Message[CompG::"ang3",HoldForm[Angle[p,o,q]]];Abort[]]; End[] NPolarOrdering::usage="NPolarOrdering[{p1,p2,...}] takes a list of numeric points and returns their polar ordering (the list {i1,i2,...} s.t. {pi1,pi2,...} is ordered by increasing polar angle). Ties are broken considering the radial distance.\nThe following options can be specified:\nOrigin->{ox,oy} defines the pole. No point pi may coincide with the pole.\nDirection->{x,y} ({x,y}\[NotEqual]{0,0}): the polar axis is the halfline leading from the pole o to o+{x,y}."; NPolarSort::usage="NPolarSort[{p1,p2,...}] sorts lists of points by increasing polar angle. Ties are broken considering the norm. NPolarSort can be given the same options of NPolarOrdering."; Origin::usage="Origin->{x,y} is an option for NPolarSort and NPolarOrdering that specifies a numeric pole {x,y}."; CompG::"NPOs"="NPolarSort or NPolarOrdering called with `1` points equal to the pole `2`."; CompG::"NPOd"="NPolarSort and NPolarOrdering require a numeric nonzero point {x,y} in Direction->{x,y}, not `1`."; CompG::"NPOor"="NPolarSort and NPolarOrdering require a numeric pole {x,y} in Origin->{x,y}, not `1`."; Begin["`Private`"]; Options[NPolarOrdering]={Origin\[Rule]{0,0},Direction\[Rule]{1,0}}; NPolarOrdering[s:{___?NPointQ},opts___?OptionQ]:=Block[{pts,o,d}, {o,d}={Origin,Direction}/.{opts}/.Options[NPolarOrdering]; If[\[Not]NPointQ[d]\[Or]OriginQ[d],Message[CompG::"NPOd",d];Abort[]]; If[\[Not]NPointQ[o],Message[CompG::"NPOor",o];Abort[]]; pts=#-o&/@s; If[#>0,Message[CompG::"NPOs",#,o];Abort[]]&@Count[pts,x_/;OriginQ[x]]; coreNPolarOrdering]; Options[NPolarSort]={Origin\[Rule]{0,0},Direction\[Rule]{1,0}}; NPolarSort[s:{___?NPointQ},opts___?OptionQ]:=Block[{pts,o,d}, {o,d}={Origin,Direction}/.{opts}/.Options[NPolarSort]; If[\[Not]NPointQ[d]\[Or]OriginQ[d],Message[CompG::"NPOd",d];Abort[]]; If[\[Not]NPointQ[o],Message[CompG::"NPOor",o];Abort[]]; pts=#-o&/@s; If[#>0,Message[CompG::"NPOs",#,o];Abort[]]&@Count[pts,x_/;OriginQ[x]]; s\[LeftDoubleBracket]coreNPolarOrdering(* [pts,o, d]*)\[RightDoubleBracket]]; coreNPolarOrdering(* [pts,o,d] *):= With[{r=Range@Length@pts, crit1=WedgeProduct[d, pts\[LeftDoubleBracket]#\[RightDoubleBracket]]> 0\[Or](WedgeProduct[d, pts\[LeftDoubleBracket]#\[RightDoubleBracket]]==0\[And] d.pts\[LeftDoubleBracket]#\[RightDoubleBracket]>0)&, crit2=(WedgeProduct[pts\[LeftDoubleBracket]#1\[RightDoubleBracket], pts\[LeftDoubleBracket]#2\[RightDoubleBracket]]> 0)\[Or](WedgeProduct[ pts\[LeftDoubleBracket]#1\[RightDoubleBracket], pts\[LeftDoubleBracket]#2\[RightDoubleBracket]]== 0 \[And] VectorNorm[pts\[LeftDoubleBracket]#1\[RightDoubleBracket]]< VectorNorm[ pts\[LeftDoubleBracket]#2\[RightDoubleBracket]])&}, Join[Sort[Cases[r,i_/;crit1[i]],crit2], Sort[Cases[r,i_/;\[Not]crit1[i]],crit2]]]; End[] NLexOrdering::usage="NLexOrdering[s,opts] takes a set s of numeric points and computes their lexicographic ordering (i.e. the positions in s at which each element appears when the list s is lexicographically sorted) using options opts.\nThe following options can be supplied:\nDirection->{{x,y},{x',y'}} (Det[{{x,y},{x',y'}}]\[NotEqual]0) orders along the direction of {x,y} with ties broken using direction {x',y'}.\nDirection->{x,y} is equivalent to Direction->{{x,y},{-y,x}}.\n{{x,y},{x',y'}} defaults to {{1,0},{0,1}}."; NLexSort::usage="NLexSort[s,opts] takes a set s of numeric points and returns their lexicographic ordering using options opts. NLexSort uses the same options of NLexOrdering."; CompG::"NLOn"="The generalized lexicographic ordering requires a numeric nonzero point p1 in Direction->p1, and a pair of numeric linearly independent points in Direction -> {p1,p2}, not `1`."; Begin["`Private`"]; checkNLexOptions= With[{d=Direction/.#1/.Options[#2]}, Switch[d, x_/;NPointQ[ x]\[And]\[Not]OriginQ[ x],{d,{-d\[LeftDoubleBracket]2\[RightDoubleBracket], d\[LeftDoubleBracket]1\[RightDoubleBracket]}}, x:{_?NPointQ,_?NPointQ}/;Det[x]\[NotEqual]0,d,_, Message[CompG::"NLOn",d];Abort[]]]&; Options[NLexOrdering]={Direction\[Rule]{{1,0},{0,1}}}; NLexOrdering[s:{___?NPointQ},opts___?OptionQ]:= Module[{d},d=checkNLexOptions[{opts},NLexOrdering]; d=Inverse[d]; Ordering[#.d&/@s]]; Options[NLexSort]={Direction\[Rule]{{1,0},{0,1}}}; NLexSort[s:{___?NPointQ},opts___?OptionQ]:= Module[{d},d=checkNLexOptions[{opts},NLexSort]; d=Inverse[d]; s\[LeftDoubleBracket]Ordering[#.d&/@s]\[RightDoubleBracket]]; End[] NMinLexOrdering::usage="NMinLexOrdering[s,opts] takes a list of points s, a set of options opts, and yields the indices of points attaining the lexicographic minimum.\nOptions as in NLexOrdering."; NMinLexSort::usage="NMinLexSort[s,opts] takes a list of points s, a set of options opts, and yields the points attaining the lexicographic minimum.\nOptions as in NLexOrdering."; NMaxLexOrdering::usage="NMaxLexOrdering[s,opts] takes a list of points s, a set of options opts, and yields the list of indices of points attaining the lexicographic maximum.\nOptions as in NLexOrdering."; NMaxLexSort::usage="NMaxLexSort[s,opts] takes a list of points s, a set of options opts, and yields the points attaining the lexicographic maximum.\nOptions as in NLexSort."; Begin["`Private`"]; Options[NMinLexOrdering]={Direction\[Rule]{{1,0},{0,1}}}; NMinLexOrdering[s:{___?NPointQ},opts___?OptionQ]:= Module[{d=checkNLexOptions[{opts},NMinLexOrdering]},d=Inverse[d]; Ordering[#.d&/@s,1]]; Options[NMaxLexOrdering]={Direction\[Rule]{{1,0},{0,1}}}; NMaxLexOrdering[s:{___?NPointQ},opts___?OptionQ]:= Module[{d=checkNLexOptions[{opts},NMaxLexOrdering]},d=Inverse[d]; Ordering[#.d&/@s,-1]]; Options[NMinLexSort]={Direction\[Rule]{{1,0},{0,1}}}; NMinLexSort[s:{___?NPointQ},opts___?OptionQ]:= Module[{d=checkNLexOptions[{opts},NMinLexSort]},d=Inverse[d]; s\[LeftDoubleBracket]Ordering[#.d&/@s,1]\[RightDoubleBracket]]; Options[NMaxLexSort]={Direction\[Rule]{{1,0},{0,1}}}; NMaxLexSort[s:{___?NPointQ},opts___?OptionQ]:= Module[{d=checkNLexOptions[{opts},NMaxLexSort]},d=Inverse[d]; s\[LeftDoubleBracket]Ordering[#.d&/@s,-1]\[RightDoubleBracket]]; End[] Shift::usage="Shift[pts,q] shifts a point or a list of points pts by q.\nShift[pts,Offset[q]] yields pts offset by q."; Begin["`Private`"]; Shift[l_,s_]:=If[Length[Dimensions[l]]===1,l+s,Map[s+#&,l]]; Shift[l_,Offset[s_]]:= If[Length[Dimensions[l]]===1,Offset[s,l],Map[Offset[s,#]&,l]]; End[] Scale::usage="Scale[pts, {fx,fy}] takes a point {px,py} and gives {px fx, py fy} (pts denotes a single point or a list of points)."; ComplexScale::usage="ComplexScale[pts, {fx,fy}] acts on a point {px,py} yielding {px fx - py fy, px fy+py fx} (pts denotes a single point or a list of points)."; Begin["`Private`"]; Scale[p_,s_]:=If[Length[Dimensions[p]]===1,s*p, Map[s*#&,p]]; ComplexScale[p_,s_]:= If[Length[Dimensions[p]]=== 1,{p\[LeftDoubleBracket]1\[RightDoubleBracket] s\[LeftDoubleBracket]1\ \[RightDoubleBracket]- p\[LeftDoubleBracket]2\[RightDoubleBracket]s\[LeftDoubleBracket]2\ \[RightDoubleBracket], p\[LeftDoubleBracket]1\[RightDoubleBracket]s\[LeftDoubleBracket]2\ \[RightDoubleBracket]+ p\[LeftDoubleBracket]2\[RightDoubleBracket]s\[LeftDoubleBracket]1\ \[RightDoubleBracket]}, Map[{#\[LeftDoubleBracket]1\[RightDoubleBracket] s\[LeftDoubleBracket]1\ \[RightDoubleBracket]-#\[LeftDoubleBracket]2\[RightDoubleBracket]s\ \[LeftDoubleBracket]2\[RightDoubleBracket],#\[LeftDoubleBracket]1\ \[RightDoubleBracket]s\[LeftDoubleBracket]2\[RightDoubleBracket]+#\ \[LeftDoubleBracket]2\[RightDoubleBracket]s\[LeftDoubleBracket]1\ \[RightDoubleBracket]}&,p]]; End[] Slant::usage="Slant[pts,s] acts on a point {px,py} yielding {px+s py, px} (pts denotes a single point or a list of points)."; Begin["`Private`"]; Slant[p_,s_]:= If[Length[Dimensions[p]]===1,{{1,s},{0,1}}.p,Map[{{1,s},{0,1}}.#&,p]]; End[] Rotate::usage="Rotate[pts, \[Theta], {cx,cy}] counterclockwise rotates by \[Theta] radians around {cx,cy}.\n{cx,cy} defaults to {0,0} and pts can be a list of points)."; Begin["`Private`"]; Rotate[p_,\[Theta]_,o_:{0,0}]:= If[Length[Dimensions[p]]===1, o+{{Cos[\[Theta]],-Sin[\[Theta]]},{Sin[\[Theta]],Cos[\[Theta]]}}.(p-o), Map[o+{{Cos[\[Theta]],-Sin[\[Theta]]},{Sin[\[Theta]],Cos[\[Theta]]}}.(#- o)&,p]]; End[] Reflect::usage="Reflect[pts,{p1,p2}] reflects about the line determined by two distinct points p1,p2 (pts denotes a single point or a list of points)."; Begin["`Private`"]; \!\(\(Reflect[p_, r_] := With[{M = \({{#\[LeftDoubleBracket]1\[RightDoubleBracket]\^2 - #\[LeftDoubleBracket]2\[RightDoubleBracket]\^2, 2 #\[LeftDoubleBracket]1\[RightDoubleBracket] #\[LeftDoubleBracket]2\[RightDoubleBracket]}, {2 #\[LeftDoubleBracket]1\[RightDoubleBracket] #\[LeftDoubleBracket]2\[RightDoubleBracket], \(-#\[LeftDoubleBracket]1\[RightDoubleBracket]\^2\) + #\[LeftDoubleBracket]2\[RightDoubleBracket]\^2}} &\)[UnitVector[r\[LeftDoubleBracket]2\[RightDoubleBracket] - r\[LeftDoubleBracket]1\[RightDoubleBracket]]]}, If[Length[Dimensions[p]] === 1, M . \((p - r\[LeftDoubleBracket]1\[RightDoubleBracket])\) + r\[LeftDoubleBracket]1\[RightDoubleBracket], Map[M . \((# - r\[LeftDoubleBracket]1\[RightDoubleBracket])\) + r\[LeftDoubleBracket]1\[RightDoubleBracket] &, p]]];\)\) End[] Transform::usage="Transform[pts,{{t11,t12,t13},{t21,t22,t23}}] takes a point {x,y} and yields {t11 x +t12 y + t13, t21 x + t22 y + t23} (pts denotes a single point or a list of points)."; Begin["`Private`"]; Transform[p_,T_]:= If[Length[Dimensions[p]]===1,T.{Sequence@@p,1},Map[T.{Sequence@@#,1}&,p]]; End[] CartesianLine::usage="CartesianLine[{p1,p2}] yields the cartesian equation of the line defined by two distinct points p1, p2 as a pure function.\nThe traditional equation in x and y is given by CartesianLine[{p1,p2}][x,y]."; Begin["`Private`"]; CartesianLine[L_]:= Evaluate[(L\[LeftDoubleBracket]2,1\[RightDoubleBracket]- L\[LeftDoubleBracket]1, 1\[RightDoubleBracket])#2-(L\[LeftDoubleBracket]2, 2\[RightDoubleBracket]- L\[LeftDoubleBracket]1,2\[RightDoubleBracket])#1+ L\[LeftDoubleBracket]1, 1\[RightDoubleBracket]L\[LeftDoubleBracket]2, 2\[RightDoubleBracket]- L\[LeftDoubleBracket]2, 1\[RightDoubleBracket]L\[LeftDoubleBracket]1, 2\[RightDoubleBracket]\[Equal]0]&; End[] ParametricLine::usage="ParametricLine[{p1,p2}] yields the parametric equations of the line through distinct points p1, p2 as a pure function.\nThe traditional equations in t are given by ParametricLine[{p1,p2}][t]."; tPoint::usage="tPoint[t,{p1,p2}] yields the point (1-t)p1+t p2."; MidPoint::usage="MidPoint[{p1,p2}] yields the midpoint 1/2(p1+p2) of segment p1,p2."; Begin["`Private`"]; ParametricLine[L_]:= Evaluate[{L\[LeftDoubleBracket]1, 1\[RightDoubleBracket]+#( L\[LeftDoubleBracket]2,1\[RightDoubleBracket]- L\[LeftDoubleBracket]1,1\[RightDoubleBracket]), L\[LeftDoubleBracket]1, 2\[RightDoubleBracket]+#( L\[LeftDoubleBracket]2,2\[RightDoubleBracket]- L\[LeftDoubleBracket]1,2\[RightDoubleBracket])}]&; tPoint={1-#1,#1}.#2&; MidPoint=(1/2 Plus@@#)&; End[] CartesianAxis::usage="CartesianAxis[{p1,p2}] yields the cartesian equation of the axis of a nondegnerate segment p1,p2 as a pure function.\nThe traditional equation in x and y is given by CartesianAxis[{p1,p2}][x,y]."; Begin["`Private`"]; CartesianAxis[L_]:=CartesianLine[Rotate[L,\[Pi]/2,MidPoint[L]]]; End[] ParametricAxis::usage="ParametricAxis[{p1,p2}] yields the parametric equations of the axis of a nondegenerate segment p1,p2 as a pure function.\nThe traditional equations in t are given by ParametricAxis[{p1,p2}][t]."; Begin["`Private`"]; ParametricAxis[L_]:= Evaluate[MidPoint[ L]+#*{L\[LeftDoubleBracket]1,2\[RightDoubleBracket]- L\[LeftDoubleBracket]2,2\[RightDoubleBracket], L\[LeftDoubleBracket]2,1\[RightDoubleBracket]- L\[LeftDoubleBracket]1,1\[RightDoubleBracket]}]&; End[] CircumCircle::"usage"="CircumCircle[{p1,p2,p3}] gives the circumcircle of three points as {{cx,cy},r} where {cx,cy} is the circumcenter and r the circumradius.\nCircumCircle[p1,\[Phi],p2] takes two points p1, p2, an angle \[Phi], and computes the circle through p1 and p2 whose tangent at p1 forms an angle \[Phi] w.r.to the directed line p1 p2.\nCircumCircle[p1,Absolute[\[Phi]],p2] measures the angle from the horizontal axis.\nDegenerate circles are returned as {{\[Infinity],\[Infinity]},\[Infinity]}."; Absolute::"usage"="See CircumCircle."; Begin["`Private`"]; \!\(\(CircumCircle[pts : {p1_, p2_, p3_}] := With[{\[ScriptCapitalA] = DArea3[pts]}, If[\[ScriptCapitalA] \[Equal] 0, Return[{{\[Infinity], \[Infinity]}, \[Infinity]}]]; \({#1, VectorNorm[#1 - p1]} &\)[0.5\ \((p1 + p2)\) + 0.5 \(\((p1 - p3)\) . \((p2 - p3)\)\ Rotate[p2 - p1, \[Pi]\/2]\)\/\[ScriptCapitalA]]];\)\) CircumCircle[p1_,Absolute[\[Phi]_],p2_]:= CircumCircle[p1,N[\[Phi]-Angle[p2-p1]],p2]; \!\(\(CircumCircle[p1_, \[Phi]_, p2_] := If[Mod[\[Phi], \[Pi]] \[Equal] 0, {{\[Infinity], \[Infinity]}, \[Infinity]}, {0.5\ \((p1 + p2)\) - 0.5\ Cot[\[Phi]]\ Rotate[p2 - p1, \[Pi]\/2], VectorNorm[p1 - p2]\/\(2\ Abs[Sin[\[Phi]]]\)}];\)\) End[] LeftPoint::"usage"="NPointLocation[q,Line[{p1,p2}] yields LeftPoint if point q is to the left of the directed line from p1 to p2 (\[NotEqual]p1)."; RightPoint::"usage"="NPointLocation[q,Line[{p1,p2}] yields RightPoint if point q is to the right of the directed line from p1 to p2 (\[NotEqual]p1)."; NPointLocation::"usage"="NPointLocation[q,Line[{p1,p2}]] yields LeftPoint (resp. InPoint, RightPoint) if the query point q is to the left of (resp. on, to the right of) the line directed from p1 to p2 (p1\[NotEqual]p2).\n\nInstead of Line[{p1,p2}] one can specify \nHalfLine[{p1,p2}] for the halfline emanating from p1 and passing through p2 (\[NotEqual]p1),\nSegment[{p1,p2}] for the segment with endpoints p1 p2 (distinct or not),\nConvex[{p1,p2,p3,...}] or Simple[{p1,p2,p3,...}] for a convex or a simple polygon with vertices {p1,p2,p3,...},\nCircle[{p1,p2,p3}] for the circle determined by three non collinear points;\nin these cases the output is InPoint if q belongs to the (relative) interior, BorderPoint if q is on the (relative) boundary, and OutPoint otherwise.\n\nNPointLocation[q,obj] and NPointLocation[obj,q] give the same result."; InPoint::"usage"="NPointLocation[q,obj] yields InPoint if point q belongs to the relative interior of a geometric object obj."; OutPoint::"usage"="NPointLocation[q,obj] yields OutPoint if point q is external to a geometric object obj."; BorderPoint::"usage"="NPointLocation[q,obj] yields BorderPoint if point q is on the relative boundary of a geometric object obj."; Begin["`Private`"]; SetAttributes[NPointLocation,Orderless]; End[] Begin["`Private`"]; NPointLocation[q_?NPointQ,Line[L_?NLineQ]]:=coreNPLLine[q,L]; coreNPLLine[q_,L_]:=Switch[Sign[DArea3[{Sequence@@L,q}]], 1,LeftPoint, -1,RightPoint, _,InPoint]; End[] HalfLine::"usage"="HalfLine[{p1,p2}] represents a halfline directed from point p1 to point p2\[NotEqual]p1."; Begin["`Private`"]; NPointLocation[q_?NPointQ,HalfLine[L_?NHalfLineQ]]:=coreNPLHalfLine[q,L]; coreNPLHalfLine[q_,L_]:=Switch[coreNPLLine[q,L], LeftPoint|RightPoint,OutPoint, InPoint,Switch[ Sign[(q-L\[LeftDoubleBracket]1\[RightDoubleBracket]).(L\ \[LeftDoubleBracket]2\[RightDoubleBracket]- L\[LeftDoubleBracket]1\[RightDoubleBracket])], 1,InPoint, 0,BorderPoint, _,OutPoint]] End[] Segment::"usage"="Segment[{p1,p2}] denotes a segment with endpoints p1 and p2. The endpoints may coincide. The empty list {} is considered as a degenerate segment (see SegmentQ)."; Begin["`Private`"]; NPointLocation[q_?NPointQ,Segment[L_?NLineQ]]:=coreNPLSegment[q,L]; coreNPLSegment[q_,L_]:= Which[MemberQ[#,OutPoint],OutPoint,MemberQ[#,BorderPoint],BorderPoint, True,InPoint]&@{coreNPLHalfLine[q,L],coreNPLHalfLine[q,Reverse@L]}; NPointLocation[q_?NPointQ, Segment[L_/; NSegmentQ[L]\[And] OriginQ[L\[LeftDoubleBracket]2\[RightDoubleBracket]- L\[LeftDoubleBracket]1\[RightDoubleBracket]]]]:= If[OriginQ[q-L\[LeftDoubleBracket]1\[RightDoubleBracket]],BorderPoint, OutPoint]; NPointLocation[q_?NPointQ,v_?NPointQ]:=If[OriginQ[q-v],BorderPoint,OutPoint]; NPointLocation[q_?NPointQ,{}]=OutPoint; End[] Convex::"usage"="Convex[{p1,p2,p3,...}] represents a convex polygon with vertices p1,p2,..."; Begin["`Private`"]; NPointLocation[q_?NPointQ,Convex[s_?NPathQ]]:= With[{e=Partition[s,2,1,{1,1}]}, If[MemberQ[#/.{InPoint\[Rule]BorderPoint},BorderPoint], Return[BorderPoint]]&[coreNPLSegment[q,#]&/@e]; If[DoubleArea[s]\[Equal]0,Return[OutPoint]]; If[Length[Union[coreNPLLine[q,#]&/@e]]===1,InPoint,OutPoint]]; End[] Simple::"usage"="Simple[{p1,p2,p3,...}] represents a simple polygon with vertices p1,p2,..."; Begin["`Private`"]; NPointLocation[q_?NPointQ,Simple[s_?NPathQ]]:= With[{sortededges= If[OrderedQ[#1,Last[#1]\[LessEqual]Last[#2]&],#1,Reverse@#1]&/@ Partition[s,2,1,{1,1}]}, If[MemberQ[coreNPLSegment[q,#]&/@sortededges,InPoint|BorderPoint], Return[BorderPoint]]; If[OddQ[Count[#1,RightPoint]],InPoint,OutPoint]&[ NPointLocation[q,Line[#1]]&/@ Cases[sortededges,{{_,yl_},{_,yh_}}/; yh\[GreaterEqual]Last[q]&&yl0,{Strong, intpoint[a,H]},True,empty]]; End[] Begin["`Private`"]; NIntersection[Line[L_?NLineQ],Segment[S_?NLineQ]]:=coreNIntLS[L,S]; coreNIntLS[L_,S_]:= With[{a=DArea3[{Sequence@@L,#1}]&/@S}, Which[OriginQ[a],{Weak,Segment[S]}, a\[LeftDoubleBracket]1\[RightDoubleBracket]- a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0,empty, a\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0,{Weak, S\[LeftDoubleBracket]1\[RightDoubleBracket]}, a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0,{Weak, S\[LeftDoubleBracket]2\[RightDoubleBracket]}, a\[LeftDoubleBracket]1\[RightDoubleBracket]a\[LeftDoubleBracket]2\ \[RightDoubleBracket]<0,{Strong,intpoint[a,S]},True,empty]]; End[] Begin["`Private`"]; NIntersection[Line[L_?NLineQ],{}]=empty; NIntersection[Line[L_?NLineQ],q_?NPointQ]:= coreNPLLine[q,L]/.\[InvisibleSpace]{LeftPoint|RightPoint\[Rule]empty, InPoint\[Rule]{Weak,q}}; NIntersection[Line[L_?NLineQ],Segment[S_?NSegmentQ]]/; OriginQ[S\[LeftDoubleBracket]2\[RightDoubleBracket]- S\[LeftDoubleBracket]1\[RightDoubleBracket]]:= coreNPLLine[S\[LeftDoubleBracket]1\[RightDoubleBracket], L]/.\[InvisibleSpace]{LeftPoint|RightPoint\[Rule]empty, InPoint\[Rule]{Weak,S\[LeftDoubleBracket]1\[RightDoubleBracket]}}; End[] Begin["`Private`"]; equiorientedQ=(#1\[LeftDoubleBracket]2\[RightDoubleBracket]-#1\ \[LeftDoubleBracket]1\[RightDoubleBracket]).(#2\[LeftDoubleBracket]2\ \[RightDoubleBracket]-#2\[LeftDoubleBracket]1\[RightDoubleBracket])>0&; End[] Begin["`Private`"]; NIntersection[HalfLine[Hp_?NHalfLineQ],HalfLine[Hq_?NHalfLineQ]]:= coreNIntHH[Hp,Hq]; coreNIntHH[Hp_,Hq_]:= With[{a=DArea3[{Sequence@@Hp,#1}]&/@Hq,b=DArea3[{Sequence@@Hq,#1}]&/@Hp}, Which[ OriginQ[a], collinearity[ Sequence@@(Join@@@Transpose[{{Hp,{0,1}},{Hq,\[Gamma]1[Hp]/@Hq}}]), "HH"](* fourcoll[a,b,Hp,Hq]*), a\[LeftDoubleBracket]1\[RightDoubleBracket]- a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0,empty, a\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[Hq\[LeftDoubleBracket]1\[RightDoubleBracket], Hp]/.\[InvisibleSpace]{InPoint|BorderPoint\[Rule]{Weak, Hq\[LeftDoubleBracket]1\[RightDoubleBracket]}, OutPoint\[Rule]empty}, a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[Hq\[LeftDoubleBracket]2\[RightDoubleBracket], Hp]/.\[InvisibleSpace]{BorderPoint\[Rule]{Weak, Hq\[LeftDoubleBracket]2\[RightDoubleBracket]}, OutPoint\[Rule]empty, InPoint\[Rule]{Strong, Hq\[LeftDoubleBracket]2\[RightDoubleBracket]}}, b\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[Hp\[LeftDoubleBracket]1\[RightDoubleBracket], Hq]/.\[InvisibleSpace]{InPoint|BorderPoint\[Rule]{Weak, Hp\[LeftDoubleBracket]1\[RightDoubleBracket]}, OutPoint\[Rule]empty}, b\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[Hp\[LeftDoubleBracket]2\[RightDoubleBracket], Hq]/.\[InvisibleSpace]{BorderPoint\[Rule]{Weak, Hp\[LeftDoubleBracket]2\[RightDoubleBracket]}, OutPoint\[Rule]empty, InPoint\[Rule]{Strong, Hp\[LeftDoubleBracket]2\[RightDoubleBracket]}}, b\[LeftDoubleBracket]1\[RightDoubleBracket] (b\[LeftDoubleBracket]1\ \[RightDoubleBracket]-b\[LeftDoubleBracket]2\[RightDoubleBracket])>0&& a\[LeftDoubleBracket]1\[RightDoubleBracket](a\[LeftDoubleBracket]1\ \[RightDoubleBracket]-a\[LeftDoubleBracket]2\[RightDoubleBracket]) >0,{Strong, intpoint[a,Hq]},True,empty]]; End[] Begin["`Private`"]; NIntersection[HalfLine[H_?NHalfLineQ],Segment[S_?NLineQ]]:=coreNIntHS[H,S]; coreNIntHS[H_,S_]:= With[{a=DArea3[{Sequence@@H,#1}]&/@S,b=DArea3[{Sequence@@S,#1}]&/@H}, Which[OriginQ[a], collinearity[ Sequence@@({{H,{0,1}}, If[OrderedQ[#],{S,#},Reverse/@{S,#}]&[\[Gamma]1[H]/@S]}// Join@@@Transpose[#]&),"HS"](*fourcoll1[H,S]*), a\[LeftDoubleBracket]1\[RightDoubleBracket]- a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0,empty, a\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[S\[LeftDoubleBracket]1\[RightDoubleBracket], H]/.\[InvisibleSpace]{OutPoint\[Rule]empty, InPoint|BorderPoint\[Rule]{Weak, S\[LeftDoubleBracket]1\[RightDoubleBracket]}}, a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, coreNPLHalfLine[S\[LeftDoubleBracket]2\[RightDoubleBracket], H]/.\[InvisibleSpace]{OutPoint\[Rule]empty, InPoint|BorderPoint\[Rule]{Weak, S\[LeftDoubleBracket]2\[RightDoubleBracket]}}, b\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, coreNPLSegment[H\[LeftDoubleBracket]1\[RightDoubleBracket], S]/.\[InvisibleSpace]{OutPoint\[Rule]empty, InPoint|BorderPoint\[Rule]{Weak, H\[LeftDoubleBracket]1\[RightDoubleBracket]}}, b\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, coreNPLSegment[H\[LeftDoubleBracket]2\[RightDoubleBracket], S]/.\[InvisibleSpace]{OutPoint\[Rule]empty, BorderPoint\[Rule]{Weak, H\[LeftDoubleBracket]2\[RightDoubleBracket]}, InPoint\[Rule]{Strong, H\[LeftDoubleBracket]2\[RightDoubleBracket]}}, b\[LeftDoubleBracket]1\[RightDoubleBracket](b\[LeftDoubleBracket]1\ \[RightDoubleBracket]-b\[LeftDoubleBracket]2\[RightDoubleBracket])>0&& a\[LeftDoubleBracket]1\[RightDoubleBracket]a\[LeftDoubleBracket]2\ \[RightDoubleBracket]<0,{Strong,intpoint[a,S]},True,empty]]; End[] Begin["`Private`"]; NIntersection[HalfLine[H_?NHalfLineQ],{}]={False,{}}; NIntersection[HalfLine[H_?NHalfLineQ],q_?NPointQ]:= coreNPLSegment[q,H]/.\[InvisibleSpace]{BorderPoint|InPoint\[Rule]{Weak,q}, OutPoint\[Rule]empty}; NIntersection[HalfLine[H_?NHalfLineQ],Segment[S_?NSegmentQ]]/; OriginQ[{-1,1}.S]:= coreNPLSegment[S\[LeftDoubleBracket]1\[RightDoubleBracket], H]/.\[InvisibleSpace]{BorderPoint|InPoint\[Rule]{Weak, S\[LeftDoubleBracket]1\[RightDoubleBracket]}, OutPoint\[Rule]empty}; End[] Begin["`Private`"]; NIntersection[Segment[Sp_?NLineQ],Segment[Sq_?NLineQ]]:=coreNIntSS[Sp,Sq]; coreNIntSS[Sp_,Sq_]:= With[{a=(DoubleArea[Append[Sp,#1]]&)/@Sq, b=(DoubleArea[Append[Sq,#1]]&)/@Sp}, Which[OriginQ[a], collinearity[ Sequence@@({{Sp,{0,1}}, If[OrderedQ[#],{Sq,#},Reverse/@{Sq,#}]&[\[Gamma]1[Sp]/@Sq]}// Join@@@Transpose[#]&),"SS"], a\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal] a\[LeftDoubleBracket]2\[RightDoubleBracket],empty, a\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, auxSS[Sq\[LeftDoubleBracket]1\[RightDoubleBracket],Sp], a\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, auxSS[Sq\[LeftDoubleBracket]2\[RightDoubleBracket],Sp], b\[LeftDoubleBracket]1\[RightDoubleBracket]\[Equal]0, auxSS[Sp\[LeftDoubleBracket]1\[RightDoubleBracket],Sq], b\[LeftDoubleBracket]2\[RightDoubleBracket]\[Equal]0, auxSS[Sp\[LeftDoubleBracket]2\[RightDoubleBracket],Sq], a\[LeftDoubleBracket]1\[RightDoubleBracket]a\[LeftDoubleBracket]2\ \[RightDoubleBracket]<0\[And] b\[LeftDoubleBracket]1\[RightDoubleBracket]b\[LeftDoubleBracket]2\ \[RightDoubleBracket]<0,{Strong,intpoint[a,Sq]},True,empty]]; auxSS=coreNPLSegment[#1,#2]/.\[InvisibleSpace]{OutPoint\[Rule]empty, InPoint|BorderPoint\[Rule]{Weak,#1}}&; End[] Begin["`Private`"]; NIntersection[Segment[Sp_?NLineQ],{}]:=empty; NIntersection[Segment[Sp_?NLineQ],q_?NPointQ]:=auxSS[q,Sp]; NIntersection[Segment[Sp_?NLineQ],Segment[s_]]/; NSegmentQ[s]\[And]\[Not]LineQ[s]:= auxSS[s\[LeftDoubleBracket]1\[RightDoubleBracket],Sp]; End[] Begin["`Private`"]; NIntersection[Segment[Sp_?NSegmentQ], Segment[Sq_?NSegmentQ]]/;\[Not](LineQ[Sp]\[Or]LineQ[Sq]):= If[OriginQ[ Sp\[LeftDoubleBracket]1\[RightDoubleBracket]- Sq\[LeftDoubleBracket]1\[RightDoubleBracket]],{Weak, Sp\[LeftDoubleBracket]1\[RightDoubleBracket]},empty]; NIntersection[Segment[Sp_?NSegmentQ],q_?NPointQ]/;\[Not]LineQ[Sp]:= If[OriginQ[Sp\[LeftDoubleBracket]1\[RightDoubleBracket]-q],{Weak,q}, empty]; NIntersection[p_?NPointQ,q_?NPointQ]:=If[OriginQ[p-q],{Weak,p},empty]; NIntersection[Segment[Sp_?NSegmentQ],{}]/;\[Not]LineQ[Sp]:=empty; NIntersection[p_?NPointQ,{}]:={False,{}}; NIntersection[{},{}]:=empty; End[] NPolygonQ::"usage"="NPolygonQ[{p1,p2,...,pn}] yields True if a list of three or more numeric points defines a polygon (i.e. if the intersection of any pair of adjacent edges reduces to a common endpoint)."; NSimplePolygonQ::"usage"="NSimplePolygonQ[{p1,p2,...,pn}] yields True if a list of three or more numeric points defines a simple polygon (i.e. the intersection of any pair of nonconsecutive edges is empty)."; Begin["`Private`"]; NPolygonQ[list_?NPathQ]:=(If[DegeneratePathQ[list],Return[False]]; MatchQ[ Map[coreNIntSS[#1\[LeftDoubleBracket]1\[RightDoubleBracket],#1\ \[LeftDoubleBracket]2\[RightDoubleBracket]]&, Nest[Partition[#1,2,1,{1,1}]&,list,2]],{{Weak,_?NPointQ}..}]); NSimplePolygonQ[list_?NPathQ]:=(If[Length[list]===3,Return[NPolygonQ[list]]]; NPolygonQ[list]&& Module[{n=Length[list],edgelist=Partition[list,2,1,{1,1}],f}, f=Function[ i,(coreNIntSS[ edgelist\[LeftDoubleBracket] i\[RightDoubleBracket],#1]&)/@ edgelist\[LeftDoubleBracket] Mod[Range[i+2,n+i-2],n, 1]\[RightDoubleBracket]];(MatchQ[#1,{{False,{}}..}]&)[ Join@@f/@Range[n]]]); End[] EndPackage[]