Parallelian

Author

Eric W. Weisstein
November 17, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/Parallelian.nb.

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

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

Derivation

parallelians=Line@@@((Function[l,Intersections[l,ParallelLine[{α,β,γ},First[#]]]]/@Rest[#])&/@Map[TrilinearLine,NestList[RotateLeft,IdentityMatrix[3],2],{2}])

Parallelians[{α_,β_,γ_}]:={Line[{c α,0,b β+c γ},{-b α,-b β-c γ,0}],Line[{a α+c γ,a β,0},{0,-c β,-a α-c γ}],Line[{0,a α+b β,b γ},{-a α-b β,0,-a γ}]}

Parallelians[{α,β,γ}]

Figure

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Module[{α=.2,β=.3,γ=.4},
Show[Graphics[{
t,
{Red,
Cartesian[#[t]]&/@Parallelians[{α,β,γ}]
},
PointLabels[Join[
{{Cartesian[{α,β,γ}[t]],"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α,β,γ}],{2}]],{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}]
],LabelOffset->-.04,PointSize[.03]
]
}
],AspectRatio->Automatic,PlotRange->All]
]

Conic

Ellipse

pts=Flatten[List@@@Parallelians[{α0,β0,γ0}],1]

Factor[Conic[Take[pts,5]]]

conic=Collect[Last[%],{α^2,β^2,γ^2,α β,β γ,γ α},Factor]

Expand[conic/.Thread[{α,β,γ}->#]&/@pts]

ctr=Symmetrize[Factor[Center[conic]]]

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Block[{α0=.2,β0=.3,γ0=.4},
Show[Graphics[{
t,
{Green,TrilinearCurve[t,conic]},
{Red,
Cartesian[#[t]]&/@Parallelians[{α0,β0,γ0}]
},
PointLabels[Join[
{{Cartesian[{α0,β0,γ0}[t]],"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α0,β0,γ0}],{2}]],{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}],
{{Cartesian[ctr[t]],"(Subscript[O, P])",Green}}
],LabelOffset->-.04,PointSize[.03]
]
}
],AspectRatio->Automatic,PlotRange->All]
]

Homothecy

Homothecy[Point[x_],{Point[y_],r_}]:=(x-y)r+y
Homothecy[t_Triangle,{y_Point,r_}]:=Triangle[homothecy[#,{y,r}]&/@VertexPoints[t]]/;Dimensions[t[[1]]]=={3,2}

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Module[{α=.2,β=.3,γ=.4},
Show[Graphics[{
t,
{Green,ac=Cartesian[AnticevianTriangle[{α,β,γ}][t]]},
{Purple,Homothecy[ac,{Cartesian[{α,β,γ}[t]],1/2}]
},
{Red,
Cartesian[#[t]]&/@Parallelians[{α,β,γ}]
},
PointLabels[Join[
{{Cartesian[{α,β,γ}[t]],"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α,β,γ}],{2}]],{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}]
],LabelOffset->-.04,PointSize[.03]
]
}
],AspectRatio->Automatic,PlotRange->{{-.5,1.2},{-.3,.8}}]
]

Area Theorem

Dalakishvili

areas1=Factor[Area[Triangle[#]]]&/@{{{α,β,γ},{0,a α+b β,b γ},{0,c β,a α+c γ}},
{{a α+b β,0,a γ},{α,β,γ},{c α,0,b β+c γ}},
{{a α+c γ,a β,0},{b α,b β+c γ,0},{α,β,γ}}}

Simplify[Plus@@Sqrt[areas],a>0&&b>0&&c>0&&0<α<1&&0<β<1&&0<γ<1]

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Module[{α=.2,β=.3,γ=.4},
p=Cartesian[{α,β,γ}[t]];
pts=Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α,β,γ}],{2}]];
Show[Graphics[{
{Yellow,
Polygon[{p[[1]],pts[[#1,1]],pts[[#2,1]]}]&@@@{{-2,4},{3,2},{1,-1}}
},
t,
{Red,
Cartesian[#[t]]&/@Parallelians[{α,β,γ}]
},
PointLabels[Join[
{{p,"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{pts,{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}]
],LabelOffset->-.04,PointSize[.03]
],
Text[(Subscript[Δ, A]),{.525,.4},FormatType->{TextStyle->TraditionalForm}],
Text[(Subscript[Δ, B]),{.28,.41},FormatType->{TextStyle->TraditionalForm}],
Text[(Subscript[Δ, C]),{.48,.14},FormatType->{TextStyle->TraditionalForm}]
}
],AspectRatio->Automatic,PlotRange->All]
]

van Lamoen 1

areas2=Factor[Area[Triangle[#]]]&/@{{{1,0,0},{b α,b β+c γ,0},{c α,0,b β+c γ}},
{{0,1,0},{0,c β,a α+c γ},{a α+c γ,a β,0}},
{{0,0,1},{a α+b β,0,a γ},{0,a α+b β,b γ}}}

Simplify[Plus@@Sqrt[areas2],a>0&&b>0&&c>0&&0<α<1&&0<β<1&&0<γ<1]

Need transparency to visualize well

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Module[{α=.2,β=.3,γ=.4},
p=Cartesian[{α,β,γ}[t]];
pts=Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α,β,γ}],{2}]];
Show[Graphics[{
{Yellow,
Polygon/@(Flatten[#,1]&/@Transpose[{List/@Vertices[t],Partition[Coordinates/@pts,2]}])
},
t,
{Red,
Cartesian[#[t]]&/@Parallelians[{α,β,γ}]
},
PointLabels[Join[
{{p,"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{pts,{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}]
],LabelOffset->-.04,PointSize[.03]
],
Text[(Subscript[Δ, A])',{.3,.23}],
Text[(Subscript[Δ, B])',{.57,.21}],
Text[(Subscript[Δ, C])',{.37,.5}]
}
],AspectRatio->Automatic,PlotRange->All]
]

van Lamoen 2

areas3=Factor[Area[Triangle[#]]]&/@{{{α,β,γ},{a α+b β,0,a γ},{a α+c γ,a β,0}},
{{α,β,γ},{b α,b β+c γ,0},{0,a α+b β,b γ}},
{{α,β,γ},{0,c β,a α+c γ},{c α,0,b β+c γ}}}

Subtract@@Simplify[{Times@@areas1,Times@@areas3},a>0&&b>0&&c>0&&0<α<1&&0<β<1&&0<γ<1]

Need transparency to visualize well

t=Triangle[{{0,0},{1,0},{.3,.7}}];
Module[{α=.2,β=.3,γ=.4},
p=Cartesian[{α,β,γ}[t]];
pts=Flatten[Map[Point,Coordinates[Cartesian[#[t]]]&/@Parallelians[{α,β,γ}],{2}]];
Show[Graphics[{
{Yellow,
Polygon[{p[[1]],pts[[#1,1]],pts[[#2,1]]}]&@@@{{1,4},{2,5},{3,6}}
},
t,
{Red,
Cartesian[#[t]]&/@Parallelians[{α,β,γ}]
},
PointLabels[Join[
{{p,"P",Red}},
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Blue]&/@Transpose[{pts,{"(Subscript[P, CB])","(Subscript[P, BC])","(Subscript[P, AC])","(Subscript[P, CA])","(Subscript[P, BA])","(Subscript[P, AB])"}}]
],LabelOffset->.04,PointSize[.03]
],
Text[(Subscript[Δ, A])'',{.3,.22}],
Text[(Subscript[Δ, B])'',{.64,.23}],
Text[(Subscript[Δ, C])'',{.42,.46}]
}
],AspectRatio->Automatic,PlotRange->All]
]