Complement

Author

Eric W. Weisstein
October 25, 2005

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

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

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

Derivation

eqn1=Factor[Distance[{a1,b1,g1},Trilinears[Centroid]]^2-4Distance[Trilinears[Centroid],{a2,b2,g2}]^2]

eqn1=((a^6) (a1^2) (a2^2)-2 (a^4) (a1^2) (a2^2) (b^2)+3 (a^5) a1 (a2^2) b b1-5 (a^3) a1 (a2^2) (b^3) b1+2 (a^4) (a2^2) (b^2) (b1^2)-3 (a^2) (a2^2) (b^4) (b1^2)-2 (a^5) (a1^2) a2 b b2-2 (a^4) a1 a2 (b^2) b1 b2-2 (a^2) a1 a2 (b^4) b1 b2-2 a a2 (b^5) (b1^2) b2-3 (a^4) (a1^2) (b^2) (b2^2)+2 (a^2) (a1^2) (b^4) (b2^2)-5 (a^3) a1 (b^3) b1 (b2^2)+3 a a1 (b^5) b1 (b2^2)-2 (a^2) (b^4) (b1^2) (b2^2)+(b^6) (b1^2) (b2^2)-2 (a^4) (a1^2) (a2^2) (c^2)-7 (a^3) a1 (a2^2) b b1 (c^2)-2 (a^2) (a2^2) (b^2) (b1^2) (c^2)+8 (a^3) (a1^2) a2 b b2 (c^2)+10 (a^2) a1 a2 (b^2) b1 b2 (c^2)+8 a a2 (b^3) (b1^2) b2 (c^2)-2 (a^2) (a1^2) (b^2) (b2^2) (c^2)-7 a a1 (b^3) b1 (b2^2) (c^2)-2 (b^4) (b1^2) (b2^2) (c^2)+3 (a^5) a1 (a2^2) c g1-7 (a^3) a1 (a2^2) (b^2) c g1+(a^4) (a2^2) b b1 c g1-5 (a^2) (a2^2) (b^3) b1 c g1-2 (a^4) a1 a2 b b2 c g1-6 (a^2) a1 a2 (b^3) b2 c g1-6 (a^3) a2 (b^2) b1 b2 c g1-2 a a2 (b^4) b1 b2 c g1-5 (a^3) a1 (b^2) (b2^2) c g1+a a1 (b^4) (b2^2) c g1-7 (a^2) (b^3) b1 (b2^2) c g1+3 (b^5) b1 (b2^2) c g1-5 (a^3) a1 (a2^2) (c^3) g1-5 (a^2) (a2^2) b b1 (c^3) g1+14 (a^2) a1 a2 b b2 (c^3) g1+14 a a2 (b^2) b1 b2 (c^3) g1-5 a a1 (b^2) (b2^2) (c^3) g1-5 (b^3) b1 (b2^2) (c^3) g1+2 (a^4) (a2^2) (c^2) (g1^2)-2 (a^2) (a2^2) (b^2) (c^2) (g1^2)-2 (a^2) (b^2) (b2^2) (c^2) (g1^2)+2 (b^4) (b2^2) (c^2) (g1^2)-3 (a^2) (a2^2) (c^4) (g1^2)+6 a a2 b b2 (c^4) (g1^2)-3 (b^2) (b2^2) (c^4) (g1^2)-2 (a^5) (a1^2) a2 c g2+8 (a^3) (a1^2) a2 (b^2) c g2-2 (a^4) a1 a2 b b1 c g2+14 (a^2) a1 a2 (b^3) b1 c g2+6 a a2 (b^4) (b1^2) c g2+6 (a^4) (a1^2) b b2 c g2+14 (a^3) a1 (b^2) b1 b2 c g2-2 a a1 (b^4) b1 b2 c g2+8 (a^2) (b^3) (b1^2) b2 c g2-2 (b^5) (b1^2) b2 c g2-6 (a^2) a1 a2 b b1 (c^3) g2-6 a a1 (b^2) b1 b2 (c^3) g2-2 (a^4) a1 a2 (c^2) g1 g2+10 (a^2) a1 a2 (b^2) (c^2) g1 g2-6 (a^3) a2 b b1 (c^2) g1 g2+14 a a2 (b^3) b1 (c^2) g1 g2+14 (a^3) a1 b b2 (c^2) g1 g2-6 a a1 (b^3) b2 (c^2) g1 g2+10 (a^2) (b^2) b1 b2 (c^2) g1 g2-2 (b^4) b1 b2 (c^2) g1 g2-2 (a^2) a1 a2 (c^4) g1 g2-2 a a2 b b1 (c^4) g1 g2-2 a a1 b b2 (c^4) g1 g2-2 (b^2) b1 b2 (c^4) g1 g2+8 a a2 (b^2) (c^3) (g1^2) g2+8 (a^2) b b2 (c^3) (g1^2) g2-2 a a2 (c^5) (g1^2) g2-2 b b2 (c^5) (g1^2) g2-3 (a^4) (a1^2) (c^2) (g2^2)-2 (a^2) (a1^2) (b^2) (c^2) (g2^2)-5 (a^3) a1 b b1 (c^2) (g2^2)-5 a a1 (b^3) b1 (c^2) (g2^2)-2 (a^2) (b^2) (b1^2) (c^2) (g2^2)-3 (b^4) (b1^2) (c^2) (g2^2)+2 (a^2) (a1^2) (c^4) (g2^2)+a a1 b b1 (c^4) (g2^2)+2 (b^2) (b1^2) (c^4) (g2^2)-5 (a^3) a1 (c^3) g1 (g2^2)-7 a a1 (b^2) (c^3) g1 (g2^2)-7 (a^2) b b1 (c^3) g1 (g2^2)-5 (b^3) b1 (c^3) g1 (g2^2)+3 a a1 (c^5) g1 (g2^2)+3 b b1 (c^5) g1 (g2^2)-2 (a^2) (c^4) (g1^2) (g2^2)-2 (b^2) (c^4) (g1^2) (g2^2)+(c^6) (g1^2) (g2^2));

eqn2=Numerator[Together[Det[{{a1,b1,g1},{a2,b2,g2},Trilinears[Centroid]}]]]

Factor//@Solve[{
eqn1==0,
eqn2==0,
g2==1
},{a2,b2}]

ComplementPoint[{a1_,b1_,g1_}]:=CyclicTrilinears[(b b1+c g1)/a]
ComplementPoint[ctr_]:=ComplementPoint[Trilinears[ctr]] /; MemberQ[Centers,ctr]

ComplementPoint[Trilinears[NagelPoint]]//Together

ComplementPoint[Trilinears[Circumcenter]]//Together

Trilinears[NinePointCenter]

ComplementPoint[NagelPoint]

Examples

k=KimberlingCenters;

Do[
Print[{i,IncidentCenters[k,ComplementPoint[Trilinears[X[i]]],MaxIterations->1]//Timing}],
{i,200}]

Do[
Print[{i,If[MemberQ[k,X[i]],IncidentCenters[k,ComplementPoint[Trilinears[X[i]]],MaxIterations->1]//Timing,InputForm[CenterFunction[X[i]]]]}],
{i,1001,Length[k]}]

Do[
Print[{i,If[MemberQ[k,X[i]],IncidentCenters[k,ComplementPoint[Trilinears[X[i]]],MaxIterations->1]//Timing,InputForm[CenterFunction[X[i]]]]}],
{i,1187,Length[k]}]

Do[
Print[{i,If[MemberQ[k,X[i]],IncidentCenters[k,ComplementPoint[Trilinears[X[i]]],MaxIterations->1]//Timing,InputForm[CenterFunction[X[i]]]]}],
{i,1192,Length[k]}]

Error

CenterFunction[X[202]]

CenterFunction[X[203]]

MemberQ[KimberlingCenters,X[202]]

List

l={{1,{366.82 Second,{X[10]}}},{2,{327.04 Second,{X[2]}}},{3,{344.68 Second,{X[5]}}},{4,{385.32 Second,{X[3]}}},{5,{387.21 Second,{X[140]}}},{6,{382.61 Second,{X[141]}}},{7,{385.51 Second,{X[9]}}},{8,{381.94 Second,{X[1]}}},{9,{383.33 Second,{X[142]}}},{10,{338.78 Second,{X[1125]}}},{11,{336.8 Second,{}}},{12,{384.57 Second,{}}},{13,{388.63 Second,{X[618]}}},{14,{388.97 Second,{X[619]}}},{15,{390.98 Second,{X[623]}}},{16,{391.52 Second,{}}},{17,{392.21 Second,{X[629]}}},{18,{349.35 Second,{X[630]}}},{19,{348.86 Second,{}}},{20,{398.38 Second,{X[4]}}},{21,{391.96 Second,{X[442]}}},{22,{382.52 Second,{X[427]}}},{23,{390.6 Second,{X[858]}}},{24,{393.28 Second,{}}},{25,{394.58 Second,{X[1368]}}},{26,{354.4 Second,{}}},{27,{357.55 Second,{X[440]}}},{28,{395.02 Second,{}}},{29,{401.6 Second,{}}},{30,{1672.47 Second,{}}},{31,{317.49 Second,{}}},{32,{385.07 Second,{X[626]}}},{33,{400.01 Second,{}}},{34,{399.43 Second,{}}},{35,{400.29 Second,{}}},{36,{399.78 Second,{}}},{37,{395.25 Second,{}}},{38,{384.36 Second,{X[1215]}}},{39,{312.42 Second,{}}},{40,{401.69 Second,{X[946]}}},{41,{395.47 Second,{}}},{42,{397.32 Second,{}}},{43,{397.44 Second,{}}},{44,{397.4 Second,{}}},{45,{397.9 Second,{}}},{46,{384.45 Second,{}}},{47,{337.47 Second,{}}},{48,{401.87 Second,{}}},{49,{394.6 Second,{}}},{50,{395.09 Second,{}}},{51,{398.36 Second,{}}},{52,{407.97 Second,{X[1216]}}},{53,{404.68 Second,{}}},{54,{356.63 Second,{X[1209]}}},{55,{354.92 Second,{}}},{56,{400.35 Second,{X[1329]}}},
{61,{161.11000000000013` Second,{X[635]}}},{62,{200.12999999999977` Second,{X[636]}}},{63,{202.22000000000003` Second,{X[226]}}},
{65,{204.37999999999988` Second,{X[960]}}},{66,{203.87999999999988` Second,{X[206]}}},
{68,{208.51000000000022` Second,{X[1147]}}},
{69,{208.` Second,{X[6]}}},
{72,{205.60999999999967` Second,{X[942]}}},{74,{194.4300000000003` Second,{X[113]}}},{75,{163.19999999999982` Second,{X[37]}}},{76,{186.98000000000002` Second,{X[39]}}},{78,{212.14000000000033` Second,{X[1210]}}},{80,{211.44999999999982` Second,{X[214]}}},{81,{207.26000000000113` Second,{X[1211]}}},{85,{110.74000000000001` Second,{X[1212]}}},{86,{111.17000000000002` Second,{X[1213]}}},{92,{116.86000000000013` Second,{X[1214]}}},{95,{117.29000000000019` Second,{X[233]}}},{98,{123.98999999999978` Second,{X[114]}}},{99,{117.18000000000029` Second,{X[115]}}},{100,{116.38999999999942` Second,{X[11]}}},{101,{117.23000000000047` Second,{X[116]}}},{102,{125.30000000000018` Second,{X[117]}}},{103,{122.1899999999996` Second,{X[118]}}},{104,{120.16000000000031` Second,{X[119]}}},{105,{118.32999999999993` Second,{X[120]}}},{106,{118.75` Second,{X[121]}}},{107,{123.03999999999996` Second,{X[122]}}},{108,{121.67999999999984` Second,{X[123]}}},{109,{121.7199999999998` Second,{X[124]}}},{110,{120.29000000000042` Second,{X[125]}}},{111,{120.00999999999976` Second,{X[126]}}},{112,{122.28999999999996` Second,{X[127]}}},{115,{120.33999999999969` Second,{X[620]}}},{144,{129.08999999999924` Second,{X[7]}}},{145,{123.13000000000102` Second,{X[8]}}},{146,{129.35999999999876` Second,{X[74]}}},{147,{132.48000000000047` Second,{X[98]}}},{148,{126.76999999999862` Second,{X[99]}}},{149,{126.60000000000036` Second,{X[100]}}},{150,{128.1299999999992` Second,{X[101]}}},{151,{142.23000000000138` Second,{X[102]}}},{152,{135.79999999999927` Second,{X[103]}}},{153,{133.35000000000036` Second,{X[104]}}},{167,{124.32999999999993` Second,{X[10]}}},{174,{126.71000000000095` Second,{X[2090]}}},{180,{125.76000000000022` Second,{X[10]}}},{186,{128.0099999999984` Second,{X[2072]}}},{187,{126.38000000000102` Second,{X[625]}}},{188,{127.17999999999847` Second,{X[178]}}},{189,{130.09000000000196` Second,{X[223]}}},{190,{125.8700000000008` Second,{X[1086]}}},{192,{125.06999999999971` Second,{X[75]}}},{193,{132.15999999999985` Second,{X[69]}}},{194,{128.61000000000058` Second,{X[76]}}},{200,{128.3700000000008` Second,{}}}
};

{X[#[[1]]],CenterName[X[#[[1]]]],#[[-1,-1,1]],CenterName[#[[-1,-1,1]]]}&/@Select[l,#[[-1,-1]]=!={}&]//ColumnForm

Line Derivation

l=.

Solve[(l α+m β+n γ/.{α->1,β->1})==0,γ]

p1=ComplementPoint[{1,1,((-l-m)/n)}]

Solve[(l α+m β+n γ/.{α->0,β->1})==0,γ]

p2=ComplementPoint[{0,1,-(m/n)}]

a b c n Factor[LineEquation[{p1,p2}]]

Factor/@(Coefficient[%,#]&/@{α,β,γ})

InputForm[%]

Table

Print[Length[circs=Lines]];
t=Triangle[Table[Random[Real,{0,1},20],{3},{2}]];
kc=KimberlingCenters;
rules=Join[Thread[{a,b,c}->SideLengths[Evaluate[t]]],Thread[{A,B,C}->Angles[Evaluate[t]]]];

Length[k=Rest[#]/First[#]&/@((Trilinears/@KimberlingCenters)/.rules)]//Timing

search::zero="Bad zero encountered `1`";
l={};
Do[
Print[l0={
i,
circs[[i]],
rc=TrilinearComplement[circs[[i]]][[1]]/.rules;
(
pt=Switch[rc,
_?(#=={0,0,0}&),{0,0,0},
Or@@Thread[#==0]&,Message[search:zero,#];rc,
_,Rest[rc]/First[rc]
];
If[pt=={0,0,0},{0},
If[#=={},{},kc[[#]]]&[Flatten[Position[k,_?(#==pt&)]]]
]
)//Timing
}];
AppendTo[l,l0],
{i,Length[circs]}
]

TableForm[{
#[[2]],
If[#[[-1,-1]]=={},"*",#[[-1,-1,1]]],
If[#[[-1,-1]]=={},"*",LineName[#[[-1,-1,1]]]]
}&/@l,TableDepth->2]

New Centers

Complement of the Brocard Axis

TrilinearComplement[BrocardAxis][[1,1]]

Simplify[Together//@ToSidelengths[TrigExpand[%102]],TriangleQ[]]

Symmetrize[%]

InputForm[%]

Complement of the Fermat Axis

Symmetrize[TrilinearComplement[FermatAxis][[1,1]]]

InputForm[%]

Complement of the Gergonne Line

Symmetrize[TrilinearComplement[GergonneLine][[1,1]]]

Complement of the Orthic Axis

Symmetrize[ToSidelengths[TrilinearComplement[OrthicAxis][[1,1]]]]

InputForm[%]