Radical Line

Author

Eric W. Weisstein
October 21, 2005

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

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

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

Graphic

c[1]={{{0,0},1},{{1.3,0},.6}};
c[2]={{{0,0},1},{{2,0},.6}};
Show[GraphicsArray[Table[Show[
				Graphics[{RadicalLine[c[j]],Table[Circle[c[j][[i,1]],c[j][[i,2]]],{i,2}]}],AspectRatio->Automatic,DisplayFunction->Identity],{j,2}]
		],
	DisplayFunction->$DisplayFunction]

Derivation

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

Length[pairs=Subsets[Select[CentralCircles,CircleFunction[#]=!=Null&],{2}]]

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

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

Table

Suppress lines at infinity

?Name

?TrilinearLine

TableForm[{
Name/@#[[2]],
#[[-1,-1,1]]/.X[n_]:>L[n],
If[StringQ[#],#,""]&[Name[CenterLine[#[[-1,-1,1]]]]]
}&/@Select[l,#[[-1,-1]]=!={}&&#[[-1,-1,1]]=!=X[6]&],TableDepth->2]

By Line

ls=Select[l,#[[-1,-1]]=!={}&];

u=Union[#[[-1,-1,1]]&/@ls]

(Subscript[X, 6])s are concentric

{#[[1,-1,-1,1]],CenterLine[#[[1,-1,-1,1]]],Map[Name,#[[2]]&/@#,{2}]}&/@Function[line,Select[ls,#[[-1,-1,1]]==line&]]/@u//ColumnForm