Cyclocevian Conjugate

Author

Eric W. Weisstein
March 7, 2008

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

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

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

Figure

t=Triangle[{{0,0},{1,0},{4/10,7/10}}];
p=X[3][t];
ap=Intersections[Line[Coordinates/@{VertexPoints[t][[#]],p}],
Line[Coordinates/@Drop[VertexPoints[t],{#}]]]&/@Range[3];
circ=Circumcircle[Coordinates/@ap];
aap=Flatten[Complement@@@Simplify[Transpose[{Intersections[circ,#]&/@Sides[t],List/@ap}]]];
Show[Graphics[{
t,
{Purple,circ},
{Red,Line[Coordinates/@#]&/@Transpose[{ap,VertexPoints[t]}]},
{Blue,lines=Line[Coordinates/@#]&/@Transpose[{aap,VertexPoints[t]}]},
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
Append[#,Red]&/@Transpose[{ap,{"A'","B'","C'"}}],
Append[#,Blue]&/@Transpose[{aap,{"A''","B''","C''"}}],
{
{p,"P",Red},
{Intersections@@Take[lines,2],"X",Blue}
}
],LabelOffset->.04,PointSize[.025]]
}],AspectRatio->Automatic,PlotRange->All]

Gergonne Point is Self-Conclocevian Conjugate

Symmetrize/@(Together//@ToSidelengths[CyclocevianConjugate[X[7]]])

Symmetrize[CenterFunction[X[7]]]

Table

t=Triangle[Table[Random[Real,{0,1},30],{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,
p=kc[[i]],
pt=Switch[rl=CyclocevianConjugate[p]/.rules,
_?(#=={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[kc]}
]

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

conj=Monitor[ExactTrilinears[Triangle[6.,9.,13.],CyclocevianConjugate[x=#]][[1]]&/@KimberlingCenters,x];//Timing

t=Function[ccc,Position[KimberlingCoordinates,_?(Abs[ccc-#]<10^-7&)]]/@conj;//Timing

Select[t,Length[#]>2&]

pairs=Flatten/@DeleteCases[MapIndexed[{#2[[1]],#}&,t],{_,{}}]

TableForm[{KimberlingCenters[[#1]],Name[KimberlingCenters[[#1]]],#2,Name[X[#2]]}&@@@pairs,TableDepth->2]