Triangle Point Picking

Author

Eric W. Weisstein
February 22, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/TrianglePointPicking.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/TrianglePointPicking.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<DiscreteMath`ComputationalGeometry`

Code

NonRandomTrianglePoints[v_List,n_]:=Module[{},
Table[#1v[[1]]+(1-#1)#2v[[2]]&@@Table[Random[],{2}],{n}]
]

RandomQuadrilateralPoints[v_List,n_]:=Module[{},
Table[#1v[[1]]+#2v[[2]]&@@Table[Random[],{2}],{n}]
]

RandomTrianglePoints[v_List,n_]:=Select[RandomQuadrilateralPoints[v,n],Length[ConvexHull[Join[v,{{0,0},#}]]]==3&]

RandomTrianglePoints[v_List,n_]:=Module[{p,q=Plus@@v},
Table[If[Length[ConvexHull[Join[v,{{0,0},p=RandomQuadrilateralPoints[v,1][[1]]}]]]==3,p,q-p],{n}]
]

TriangleArea[v_List?MatrixQ]:=Abs[Det[Append[#,1]&/@v]]/2/;Dimensions[v]=={3,2}

eq={{0,0},{1,0},{1,Sqrt[3]}/2};
rt={{0,0},{1,0},{0,1}};

Wrong Picking

pts=Table[Random[],{1000},{2}];

v1={1,0};
v2=Through[{Cos,Sin}[Pi/3]];

Show[Graphics[{
Line[{1/2,Sqrt[3]/6}+#&/@(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])],
{Red,
PointSize[.02],
Point[#1v1+(1-#1)#2v2]&@@@pts
}
}],AspectRatio->Automatic,PlotRange->All]

Right triangle

With[{b=.7},
Show[Graphics[{
{PointSize[.02],Red,Point/@Table[{#,b(1-#) Random[]}&[Random[]],{1000}]},
Line[{{0,0},{1,0},{0,b},{0,0}}]
},AspectRatio->Automatic]
]
]

With[{b=1},
Show[Graphics[{
{PointSize[.02],Red,Point/@Table[{#,b(1-#) Random[]}&[Random[]],{1000}]},
Line[{{0,0},{1,0},{0,b},{0,0}}]
},AspectRatio->Automatic]
]
]

Correct Picking

pts=Table[Random[],{1000},{2}];

Equilateral Triangle

v1={1,0};
v2=Through[{Cos,Sin}[Pi/3]];

Show[Graphics[{
Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])],
Line[{1,1/Sqrt[3]}-{1/2,Sqrt[3]/6}+#&/@(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#+1/4)/3]]&/@Range[0,3])],
{Red,
PointSize[.02],
Point[-{1/2,Sqrt[3]/6}+#1v1+#2v2]&@@@pts
},
Circle[{0,0},Sqrt[3]/3]
}],AspectRatio->Automatic,PlotRange->All]

xform[x0_]:=With[{x1={0,Sqrt[3]/3},x2={1/2,-Sqrt[3]/6}},
If[Det[{x2-x1,x1-x0}]>=0,
x0,{1/2,1/(2Sqrt[3])}-x0]
]

Show[Graphics[{
Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])],
Line[{1/2,1/(2Sqrt[3])}+#&/@(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#+1/4)/3]]&/@Range[0,3])],
{Red,
PointSize[.02],
Point[xform[-{1/2,Sqrt[3]/6}+#1v1+#2v2]]&@@@pts
}
}],AspectRatio->Automatic,PlotRange->All]

Right Triangle

goodpts=Sort/@pts;

Show[Graphics[{
Line[Partition[rt,4,3,1][[1]]],
Red,PointSize[.01],Point/@RandomTrianglePoints[Rest[rt],5000]}],
AspectRatio->Automatic]

Show[Graphics[{
Point/@Select[Table[Random[],{5000},{2}],Greater@@#&]
},AspectRatio->Automatic]
]

Distance from Fixed Points

Norm/@(Subtract@@@Partition[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,2]),2,1,1])

pts=Table[Random[],{10^4},{2}];

pts2=(xform[-{1/2,Sqrt[3]/6}+#1v1+#2v2]&@@@pts);

Show[Graphics[{
Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])],
PointSize[.02],
{Red,Point/@Take[pts2,1000]},
Point[{0,0}]
}],AspectRatio->Automatic]

Norm/@(Subtract@@@Partition[RegularPolygon[3,(1/(Sqrt[3]))][[1]],2,1,1])

Show[Graphics[{ClosedLine@@RegularPolygon[3,(1/(Sqrt[3]))],PointSize[.02],Point[{0,0}]}],AspectRatio->Automatic,Axes->True]

Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]]

<<Graphics`InequalityGraphics`

InequalityPlot[(1/(2 (Sqrt[3])))-(x/2)-(((Sqrt[3]) y)/2)>0&&(1/(2 (Sqrt[3])))+x>0&&(1/(2 (Sqrt[3])))-(x/2)+(((Sqrt[3]) y)/2)>0,{x},{y}]

Center

Mean[Norm/@pts2]

1/Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]],{x,-∞,∞},{y,-∞,∞}]

(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]](Sqrt[(x^2)+(y^2)]),{x,-∞,∞},{y,-∞,∞}]

FullSimplify[%]

N[%]

(1/216) (24 (Sqrt[3])+9 ArcSinh[(Sqrt[3])]+3Log[2+(Sqrt[3])])//Simplify

N[%]

(4/(Sqrt[3]))NIntegrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]](Sqrt[(x^2)+(y^2)]),{x,-∞,∞},{y,-∞,∞}]

From a Fixed Corner

Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])]

Mean[Norm/@((#-{(1/2),-(1/(2 (Sqrt[3])))})&/@pts2)]

RegularPolygon[3,(1/(Sqrt[3]))]

(4/(Sqrt[3]))NIntegrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]](Sqrt[(((x-(1/(Sqrt[3]))))^2)+(y^2)]),{x,-∞,∞},{y,-∞,∞}]

(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]](Sqrt[(((x-(1/(Sqrt[3]))))^2)+(y^2)]),{x,-∞,∞},{y,-∞,∞}]

<<Utilities`Simplify`

LogExpand[%63]//Factor

N[%]

From Nearest Corner

Monte Carlo

pts=Table[Random[],{10^5},{2}];

pts2=(xform[-{1/2,Sqrt[3]/6}+#1v1+#2v2]&@@@pts);

Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])]

Mean[Min/@Map[Norm,Transpose[Outer[Subtract,{{(1/2),-(1/(2 (Sqrt[3])))},{0,(1/(Sqrt[3]))},{-(1/2),-(1/(2 (Sqrt[3])))}},Take[pts2,10^5],1]],{2}]]

Recognize

<<Utilities`Simplify`

TranscendentalRecognize[0.3510211148792663`,{Log[3]/Sqrt[3],Sqrt[3]}]

Pieces

RegularPolygon[3,(1/(Sqrt[3]))]

mind=Min[Sqrt[(x-#[[1]])^2+(y-#[[2]])^2]&/@{{(1/(Sqrt[3])),0},{-(1/(2 (Sqrt[3]))),(1/2)},{-(1/(2 (Sqrt[3]))),-(1/2)}}]

Simplify`PiecewiseIntegrate;PiecewiseDump`$ShowIntegrals=True;

(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]]mind,{x,-∞,∞},{y,-∞,∞}]//InputForm

i=(4*(HoldForm[Integrate[Sqrt[1 - 2*Sqrt[3]*x + 3*x^2 + 3*y^2]/Sqrt[3], 
     {x, 0, 1/(4*Sqrt[3])}, {y, -(Sqrt[3]*x), Sqrt[3]*x}]] + 
   HoldForm[Integrate[Sqrt[1 - 2*Sqrt[3]*x + 3*x^2 + 3*y^2]/Sqrt[3], 
     {x, 1/(4*Sqrt[3]), 1/Sqrt[3]}, {y, (-Sqrt[3] + 3*x)/(3*Sqrt[3]), 
      (Sqrt[3] - 3*x)/(3*Sqrt[3])}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 - 3*y + 3*y^2]/Sqrt[3], 
     {x, 0, 1/(4*Sqrt[3])}, {y, Sqrt[3]*x, (Sqrt[3] - 3*x)/(3*Sqrt[3])}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 - 3*y + 3*y^2]/Sqrt[3], 
     {x, -1/(2*Sqrt[3]), 0}, {y, 0, (Sqrt[3] - 3*x)/(3*Sqrt[3])}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 + 3*y + 3*y^2]/Sqrt[3], 
     {x, 0, 1/(4*Sqrt[3])}, {y, (-Sqrt[3] + 3*x)/(3*Sqrt[3]), 
      -(Sqrt[3]*x)}]] + HoldForm[Integrate[
     Sqrt[1 + Sqrt[3]*x + 3*x^2 + 3*y + 3*y^2]/Sqrt[3], 
     {x, -1/(2*Sqrt[3]), 0}, {y, (-Sqrt[3] + 3*x)/(3*Sqrt[3]), 0}]]))/Sqrt[3];

ReleaseHold[i/.Integrate:>NIntegrate]

v5.2

(d=ReleaseHold[i]//Simplify)//Timing

N[d]

...wrong...

v6

(d=ReleaseHold[i]//FullSimplify)//Timing

N[d]

(d=(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]]mind,{x,-∞,∞},{y,-∞,∞}])//FullSimplify//Timing

N[d]

From Farthest Corner

Monte Carlo

pts=Table[Random[],{10^5},{2}];

pts2=(xform[-{1/2,Sqrt[3]/6}+#1v1+#2v2]&@@@pts);

Line[(Sqrt[3]/3Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])]

Mean[Max/@Map[Norm,Transpose[Outer[Subtract,{{(1/2),-(1/(2 (Sqrt[3])))},{0,(1/(Sqrt[3]))},{-(1/2),-(1/(2 (Sqrt[3])))}},Take[pts2,10^5],1]],{2}]]

Recognize

<<Utilities`Simplify`

N[(1/36) (-6 (Sqrt[3]) ArcSinh[(Sqrt[3])]+27 Log[3]+(Sqrt[3]) (4+3 Log[3])),20]

TranscendentalRecognize[d,{Log[3],Sqrt[3],Log[3]Sqrt[3],Sqrt[3]ArcSinh[Sqrt[3]]}]//Simplify

N[%24,20]

Pieces

RegularPolygon[3,(1/(Sqrt[3]))]

maxd=Max[Sqrt[(x-#[[1]])^2+(y-#[[2]])^2]&/@{{(1/(Sqrt[3])),0},{-(1/(2 (Sqrt[3]))),(1/2)},{-(1/(2 (Sqrt[3]))),-(1/2)}}]

Simplify`PiecewiseIntegrate;PiecewiseDump`$ShowIntegrals=True;

(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]]maxd,{x,-∞,∞},{y,-∞,∞}]//InputForm

i=(4*(HoldForm[Integrate[Sqrt[1 - 2*Sqrt[3]*x + 3*x^2 + 3*y^2]/Sqrt[3], 
     {x, -1/(2*Sqrt[3]), 0}, {y, Sqrt[3]*x, -(Sqrt[3]*x)}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 - 3*y + 3*y^2]/Sqrt[3], 
     {x, 0, 1/Sqrt[3]}, {y, (-Sqrt[3] + 3*x)/(3*Sqrt[3]), 0}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 - 3*y + 3*y^2]/Sqrt[3], 
     {x, -1/(2*Sqrt[3]), 0}, {y, (-Sqrt[3] + 3*x)/(3*Sqrt[3]), Sqrt[3]*x}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 + 3*y + 3*y^2]/Sqrt[3], 
     {x, 0, 1/Sqrt[3]}, {y, 0, (Sqrt[3] - 3*x)/(3*Sqrt[3])}]] + 
   HoldForm[Integrate[Sqrt[1 + Sqrt[3]*x + 3*x^2 + 3*y + 3*y^2]/Sqrt[3], 
     {x, -1/(2*Sqrt[3]), 0}, {y, -(Sqrt[3]*x), (Sqrt[3] - 3*x)/(3*Sqrt[3])}]]))/Sqrt[3];

ReleaseHold[i/.Integrate:>NIntegrate]

(d=ReleaseHold[i/.HoldPattern[Integrate[x__]]:>NIntegrate[x,WorkingPrecision->20]])//Timing

(d=ReleaseHold[i/.HoldPattern[Integrate[x__]]:>NIntegrate[x,WorkingPrecision->30]])//Timing

(d=ReleaseHold[i/.HoldPattern[Integrate[x__]]:>NIntegrate[x,WorkingPrecision->50]])//Timing

v5.2

Timing[d=ReleaseHold[i]//Simplify]

N[d,10]

...wrong...

v6

Timing[d=ReleaseHold[i]//FullSimplify]

Internal`DeactivateMessages[Select[Table[(NSolve[(a-b Sqrt[3])^n==36477-21060 (Sqrt[3]),n])[[1,1,2]],{a,-20,20},{b,-20,20}],Im[#]==0.&]
]

N[d]

(d=(4/(Sqrt[3]))Integrate[Boole[Inequalities[RegularPolygon[3,(1/(Sqrt[3]))],{x,y}]]maxd,{x,-∞,∞},{y,-∞,∞}]//FullSimplify)//Timing

<<Utilities`Simplify`

LogExpand[d]

N[d]

Using Trilinears

t=Triangle[Through[{Sin,Cos}[-2Pi #/3]]&/@Range[3]]

Show[Graphics[{
t,
{Red,Point/@(TrilinearToCartesian[t,#]&/@Table[Random[],{5000},{3}])
}
},AspectRatio->Automatic]]//Timing