Abstract
Tangential polygons are (convex) polygons for which every side is tangent to an inscribed circle.
Cyclic polygons are those for which every vertex lies on a circle, the circumcircle.
Bicentric n-gons are those which are both tangential and cyclic.
Every triangle is bicentric.
Bicentric quadrilaterals are those for which the sum of the lengths of opposite sides is the semiperimeter and for which opposite angles sum to pi.
Here we give some results pertaining to invariants of (convex) bicentric hexagons.
A remarkable result of Poncelet is that if one has a pair of circles admitting a bicentric n-gon, then for every point on the circumcircle can be a vertex for a bicentric n-gon.
This is illustrated in the animation at
https://mathworld.wolfram.com/PonceletsPorism.html
The animation indicates that, along with the incentre and circumcentre, the point of intersection of the principal diagonals of a 2m-gon is invariant under the motion.
Such invariants -- here called Poncelet invariants -- have been studied for two centuries, in particular for triangles and bicentric quadrilaterals.
We present results, for bicentric hexagons, that various combinations of distances between vertices - lengths of diagonals and of sides - are invariant.
CAS supplements are available for checking the results.
(* FILE check2407mma.txt
Mathematica supplement for checking
Some Poncelet invariants for bicentric hexagons
submitted for the
Asian Technology Conference in Mathematics, 2024
grantkeady@gmail.com
amca01@gmail.com
Supplements will be available via
https://sites.google.com/site/keadyperthunis/home/papers
When the outputs labelled check are 0 it confirms a result stated in the article.
Section numbers Sn.m and equation numbers may be close to the final version of the article.
*)
(* The tangent lengths, equations (3) and (4) *)
T6bi = {T1, ((T1 + T3) tS)/(1 - T1 T3), T3, tS/T1, (1 - T1 T3)/(T1 + T3), tS/T3};
tS2 = (T1 T3 - T1^2 T3^2)/(1 + T1^2 + T1 T3 + T3^2);
(* A long list of utilities *)
mkEq[u_] := u == 0;
mkIneq[u_] := u >= 0;
n =.;
Tlisn[n_] := Map[(T[#]) &, Range[n]];
elisn[n_]:= Map[(e[#]) &, Range[n]];
Tnsol[n_] := T[n] /. Solve[
SymmetricPolynomial[1, Tlisn[n]] + SymmetricPolynomial[5, Tlisn[n]] ==
SymmetricPolynomial[3, Tlisn[n]], T[n]][[1]];
Tnlise[n_] := Append[Drop[Tlisn[n], -1], Tnsol[n]];
regLis[n_] := Tan[Pi/n]*Table[1, {i, 1, n}];
checkRegn[u_, n_] := Simplify[u /. Join[{tn -> Tan[Pi/n],
PSP1 -> n*Tan[Pi/n], PSP2 -> n*Tan[Pi/n]^2,
PSP3 -> n*Tan[Pi/n]^3,
PSP4 -> n*Tan[Pi/n]^4, PSP5 -> n*Tan[Pi/n]^5},
Map[(T[#] -> Tan[Pi/n]) &, Range[n]]]];
reg6[u_]:= Simplify[u /. {T1->1/Sqrt[3],T3->1/Sqrt[3],tS->1/3}];
Tify[u_, Tlis_, nIn_, tnIn_] := Simplify[ u /. Join[
{PSP1 -> PowerSymmetricPolynomial[1, Tlis],
PSP2 -> PowerSymmetricPolynomial[2, Tlis],
PSP3 -> PowerSymmetricPolynomial[3, Tlis],
PSP4 -> PowerSymmetricPolynomial[4, Tlis],
PSP5 -> PowerSymmetricPolynomial[5, Tlis]},
Table[ PSP[j] -> PowerSymmetricPolynomial[j, Tlis], {j, 1, 10}],
Table[ e[j] -> SymmetricPolynomial[j, Tlis], {j, 1, nIn}],
{n -> nIn, tn -> tnIn}]];
f3Factor[u_]:= Factor[u /. Extension->Sqrt[3]];
etoPRules= { e1 -> PSP1, e[1]-> PSP1,
e2 -> (PSP1^2-PSP2)/2, e[2]-> (PSP1^2-PSP2)/2,
e3 -> (PSP1^3-3*PSP1*PSP2+2*PSP3)/6,
e[3] -> (PSP1^3-3*PSP1*PSP2+2*PSP3)/6,
e4 -> (PSP1^4-6*PSP1^2*PSP2+8*PSP1*PSP3+3*PSP2^2-6*PSP4)/24,
e[4] -> (PSP1^4-6*PSP1^2*PSP2+8*PSP1*PSP3+3*PSP2^2-6*PSP4)/24,
e5 -> (PSP1^5 - 10*PSP1^3*PSP2 + 15*PSP1*PSP2^2 +
(20*PSP1^2 - 20*PSP2)*PSP3 - 30*PSP1*PSP4 + 24*PSP5)/120,
e[5] -> (PSP1^5 - 10*PSP1^3*PSP2 + 15*PSP1*PSP2^2 +
(20*PSP1^2 - 20*PSP2)*PSP3 - 30*PSP1*PSP4 + 24*PSP5)/120};
stoT[u_,Tlis_] := Module[{u6= u /{e6->e[6]},nn=Length[Tlis]},
Simplify[u /. Join[Table[e[k]->SymmetricPolynomial[k, Tlis],{k,1,nn}],
{e1 -> SymmetricPolynomial[1, Tlis],
e2 -> SymmetricPolynomial[2, Tlis],
e3 -> SymmetricPolynomial[3, Tlis],
e4 -> SymmetricPolynomial[4, Tlis],
e5 -> SymmetricPolynomial[5, Tlis],
PSP1 -> PowerSymmetricPolynomial[1, Tlis],
PSP2 -> PowerSymmetricPolynomial[2, Tlis],
PSP3 -> PowerSymmetricPolynomial[3, Tlis],
PSP4 -> PowerSymmetricPolynomial[4, Tlis],
PSP5 -> PowerSymmetricPolynomial[5, Tlis]}]]];
reducetSPowers[u_] :=
Module[{du = Denominator[Factor[u]], nu = Numerator[Factor[u]],
tS2 = (T1 T3 - T1^2 T3^2)/(1 + T1^2 + T1 T3 + T3^2), dus, nus, rules},
rules = {tS^2 -> tS2, tS^3 -> tS*tS2, tS^4 -> tS2^2,
tS^5 -> tS*tS2^2, tS^6 -> tS2^3, tS^7 -> tS*tS2^3,
tS^8 -> tS2^4, tS^9 -> tS*tS2^4, tS^10->tS2^5,
tS^11 -> tS*tS2^5, tS^12 -> tS2^6, tS^13 -> tS*tS2^6,
tS^14 -> tS2^7, tS^15 -> tS*tS2^7, tS^16->tS2^8,
tS^17 -> tS*tS2^8, tS^18 -> tS2^9, tS^19 -> tS*tS2^9,
tS^20 -> tS2^10, tS^21 -> tS*tS2^10, tS^22->tS2^11};
dus = Collect[Collect[du, tS, Factor] /. rules, tS, Factor];
nus = Collect[Collect[nu, tS, Factor] /. rules, tS, Factor];
nus/dus];
removePBraks[u_]:= Simplify[u /. {
PSP[1]->PSP1,PSP[2]-> PSP2, PSP[3]-> PSP3, PSP[4]-> PSP4,PSP[5]-> PSP5}];
removeeBraks[u_]:= Simplify[u /. {
e[1]-> e1,e[2]-> e2, e[3]-> e3,e[4]-> e4,e[5]-> e5,e[6]-> e6}];
(* S1.3 *)
check= Simplify[
T6bi[[1]]*T6bi[[3]] + T6bi[[3]]*T6bi[[5]] + T6bi[[5]]*T6bi[[1]]-1]
check= reducetSPowers[Simplify[
T6bi[[2]]*T6bi[[4]] + T6bi[[4]]*T6bi[[6]] + T6bi[[6]]*T6bi[[2]]-1]]
circumRSFn[tS_] := (1 - tS^2)*(1 + tS)*(1 + 3*tS)/(16*tS^2);
RSbi= Map[(1+#^2)&,T6bi]
check= reducetSPowers[1/RSbi[[1]]+1/RSbi[[3]]+1/RSbi[[5]]- (1/RSbi[[2]]+1/RSbi[[4]]+1/RSbi[[6]])]
(* preparing for S3.3 *)
sumRSrecipT =
reducetSPowers[(1/RSbi[[1]] + 1/RSbi[[3]] + 1/RSbi[[5]]) + (1/RSbi[[2]] + 1/RSbi[[4]] + 1/RSbi[[6]])]
(* The elementary symmetric polynomials, S1.4 *)
e1bi= Collect[SymmetricPolynomial[1,T6bi],tS]
e2bi= reducetSPowers[Collect[SymmetricPolynomial[2,T6bi],tS]]
check = reducetSPowers[(e2bi - 2)^2 - 1/tS2]
e3bi= reducetSPowers[Collect[SymmetricPolynomial[3,T6bi],tS]];
e2m2p2= reducetSPowers[(e2bi-2)^2];
check= reducetSPowers[e2m2p2*e3bi-(e2m2p2+1)*e1bi]
e4bi= reducetSPowers[Collect[SymmetricPolynomial[4,T6bi],tS]];
check= reducetSPowers[(e2bi-2)*e4bi- e2bi]
e5bi= reducetSPowers[Collect[SymmetricPolynomial[5,T6bi],tS]];
check= reducetSPowers[e2m2p2*e5bi-e1bi]
e6bi= reducetSPowers[Collect[SymmetricPolynomial[6,T6bi],tS]];
check= reducetSPowers[e2m2p2*(e2bi-2)e6bi-1]
check= reducetSPowers[e1bi-e3bi+e5bi]
toe1e2Rules={ e6->1/(e2-2)^3,e4->e2/(e2-2),e5->e1/(e2-2)^2,e3->(1+1/(e2-2)^2)*e1 };
(* brief look ahead to S3.3 but also relating to eq(7) of S1.2 *)
sumRSrecipe= Factor[2*(-3+2*e2-e4)/(-1+e2-e4+e6) /. toe1e2Rules]
(* (4 (-2 + e2)^2)/((-3 + e2) (-1 + e2)) *)
sumRSrecipeT = reducetSPowers[sumRSrecipe /. e2 -> e2bi]
sumRSrecipT = reducetSPowers[(1/RSbi[[1]] + 1/RSbi[[3]] +
1/RSbi[[5]]) + (1/RSbi[[2]] + 1/RSbi[[4]] + 1/RSbi[[6]])]
checkdiffsumRSrecipT = reducetSPowers[(1/RSbi[[1]] + 1/RSbi[[3]] + 1/RSbi[[5]]) -
(1/RSbi[[2]] + 1/RSbi[[4]] + 1/RSbi[[6]])]
check= Simplify[sumRSrecipT-sumRSrecipeT]
check= Simplify[(1-tS2)*sumRSrecipT-4]
(* return to S1.4: the palindromic equation *)
poly6[T_] := T^6 - e1*T^5 + e2*T^4 - e3*T^3 + e4*T^2 - e5*T + e6;
poly6bi = poly6[T] /. toe1e2Rules;
poly6bih = Collect[(-2 + e2)^3*poly6bi /. T -> Th/Sqrt[e2 - 2], Th,
FullSimplify[#, Assumptions -> {e1 > 2*Sqrt[3], e2 > 5}] &]
(* clearly palindromic.
Neater to show reduction to cubic for general palindromic *)
pali6e[E1_, E2_, E3_, z_] := z^6 - E1*z^5 + E2*z^4 - E3*z^3 + E2*z^2 - E1*z + 1;
u = z + 1/z;
check = Simplify[
pali6e[E1, E2, E3, z] - z^3*(u^3 - E1*u^2 + (E2 - 3)*u + 2*E1 - E3)]
(* S1.5 *)
RSFn[e2_] := (e2 - 3)*(e2 - 1)^2*(e2 + 1)/(16*(e2 - 2)^2);
RSreg = FullSimplify[RSFn[5]]
check= RSreg-4/3;
dSFn[e2_] := (e2 - 5)*(e2 - 3)^2*(e2 - 1)/(16*(e2 - 2)^2)
fuss6 = 3*(RRS - ddS)^4 - 4*(RRS + ddS)*(RRS - ddS)^2 - 16*RRS*ddS
check = Simplify[4/3 - (RRS /.
Solve[Simplify[(fuss6 /. ddS -> 0)/RRS^3] == 0, RRS][[1]])]
check = Simplify[fuss6 /. {RRS -> RSFn[e2], ddS -> dSFn[e2]}]
(* S1.6 checks are done in this supplement after setting up distances in S2
Could be done earlier *)
(* S2 *)
(* S2.1 and S2.2 assembling the distance matrix
Only checking Theorem 2 for our bicentric hexagons *)
twoDiag[j_]:= 4*R*T6bi[[j]]/(1+T6bi[[j]]^2);
d13 = twoDiag[2];
d24 = twoDiag[3];
d35 = twoDiag[4];
d46 = twoDiag[5];
d15 = twoDiag[6];
d26 = twoDiag[1];
dSidesFromT:= {d12-> (T6bi[[1]]+T6bi[[2]]), d23-> (T6bi[[3]]+T6bi[[2]]),
d34-> (T6bi[[3]]+T6bi[[4]]),d45-> (T6bi[[5]]+T6bi[[4]]),
d56-> (T6bi[[5]]+T6bi[[6]]),d16-> (T6bi[[6]]+T6bi[[1]])};
d14= (d13*d24-d12*d34)/d23
check= reducetSPowers[Simplify[(d14- (d15*d46-d16*d45)/d56) /. dSidesFromT]]
d25= (d15*d26-d12*d56)/d16 ; (* CHECK! *)
check= reducetSPowers[Simplify[(d25- (d24*d35-d45*d23)/d34) /. dSidesFromT]]
d36 = (d13*d26-d23*d16)/d12;
check = reducetSPowers[Simplify[(d36 - (d35*d46-d34*d56)/d45) /. dSidesFromT]]
upperDM6d= {{0,d12,twoDiag[2],d14,twoDiag[6],d16}, {0,0,d23,twoDiag[3],d25,twoDiag[1]},
{0,0,0,d34,twoDiag[4],d36},
{0,0,0,0,d45,twoDiag[5]},
{0,0,0,0,0,d56},
{0,0,0,0,0,0}} /.dSidesFromT;
(* in following, consider R as a function of tS and
tS as a function of (T1,T3) *)
upperDM6 = { {0, (-T1 + T1^2*T3 - T1*tS - T3*tS)/(-1 + T1*T3),
(-4*R*T1*T3*(T1 + T3)*(-1 + T1*T3))/((1 + T1^2)*(1 + T3^2)*tS),
-((2*T1^2*T3 + 3*T1^4*T3 + 3*T1*T3^2 + 5*T1^3*T3^2 -
3*T1^5*T3^2 + 2*T1^2*T3^3 - 8*T1^4*T3^3 + 3*T1*T3^4 -
6*T1^3*T3^4 + T1^5*T3^4 - 4*T1^2*T3^5 + T1^4*T3^5 +
T1^3*T3^6 + T1^3*tS + T1^5*tS + T3*tS + 6*T1^2*T3*tS +
6*T1^4*T3*tS + 4*T1*T3^2*tS + 6*T1^3*T3^2*tS -
3*T1^5*T3^2*tS + 2*T3^3*tS + 6*T1^2*T3^3*tS -
6*T1^4*T3^3*tS + 3*T1*T3^4*tS - 7*T1^3*T3^4*tS + T3^5*tS -
4*T1^2*T3^5*tS - T1*T3^6*tS)/
(T1*(1 + T3^2)*(1 + T1^2 + T1*T3 + T3^2)*(-T3 + T1*T3^2 - T1*tS - T3*tS))),
(-4*R*T1*T3*(-1 + T1*T3))/((T1 + T3)*(1 + T3^2)*tS), (T1*T3 + tS)/T3},
{0, 0, (-T3 + T1*T3^2 - T1*tS - T3*tS)/(-1 + T1*T3), (4*R*T3)/(1 +T3^2),
(-3*T1*T3 - 2*T1^3*T3 + T1^2*T3^2 + T1^4*T3^2 -
2*T1*T3^3 + T1^3*T3^3 + T1^5*T3^3 + T1^2*T3^4 + T1^4*T3^4 +
T1^3*T3^5 - tS - T1^2*tS - 3*T1*T3*tS - 3*T1^3*T3*tS -
T1^5*T3*tS - T3^2*tS - T1^2*T3^2*tS - 3*T1*T3^3*tS -
T1^3*T3^3*tS - T1*T3^5* tS)/
((T1 + T3)*(-1 + T1*T3)*(1 + T1^2 + T1*T3 + T3^2)*(T1*T3 + tS)),
(4*R*T1)/(1 + T1^2)},
{0, 0, 0, (T1*T3 + tS)/T1,
(-4*R*T1*T3*(-1 + T1*T3))/((1 + T1^2)*(T1 + T3)*tS),
-((3*T1^2*T3 + 3*T1^4*T3 + 2*T1*T3^2 + 2*T1^3*T3^2 -
4*T1^5*T3^2 + 5*T1^2*T3^3 - 6*T1^4*T3^3 + T1^6*T3^3 +
3*T1*T3^4 - 8*T1^3*T3^4 + T1^5*T3^4 - 3*T1^2*T3^5 +
T1^4*T3^5 + T1*tS + 2*T1^3*tS + T1^5*tS + 4*T1^2*T3*tS +
3*T1^4*T3*tS - T1^6*T3*tS + 6*T1*T3^2*tS + 6*T1^3*T3^2*tS -
4*T1^5*T3^2*tS + T3^3*tS + 6*T1^2*T3^3*tS - 7*T1^4*T3^3*tS +
6*T1*T3^4*tS - 6*T1^3*T3^4*tS + T3^5*tS -
3*T1^2*T3^5*tS)/((1 + T1^2)*
T3*(1 + T1^2 + T1*T3 + T3^2)*(-T1 + T1^2*T3 - T1*tS - T3*tS)))},
{0, 0, 0, 0, -((-T1 + T1^2*T3 - T1*tS - T3*tS)/(T1*(T1 + T3))),
(-4*R*(T1 + T3)*(-1 + T1*T3))/((1 + T1^2)*(1 + T3^2))},
{0, 0, 0, 0, 0, -((-T3 + T1*T3^2 - T1*tS - T3*tS)/(T3*(T1 + T3)))},
{0, 0, 0, 0, 0, 0}};
check = Map[reducetSPowers, Map[FullSimplify,
Map[FullSimplify, Map[reducetSPowers, upperDM6d - upperDM6]] /.
R^2 -> circumRSFn[tS]]]
(* zero matrix *)
DM6 = upperDM6 + Transpose[upperDM6];
(* correct at regular *)
DM6reg= Map[f3Factor,
DM6 /. {T1 -> 1/Sqrt[3], T3 -> 1/Sqrt[3], tS -> 1/3, R -> 2/Sqrt[3]}];
MatrixForm[DM6reg]
sides = Append[Table[DM6[[j, j + 1]], {j, 1, 5}], DM6[[1, 6]]];
prodSides = reducetSPowers[Apply[Times, sides]]
detDM6 = reducetSPowers[Det[DM6] /.
{R^6 -> circumRSFn[tS]^3, R^4 -> circumRSFn[tS]^2, R^2 -> circumRSFn[tS]}];
detDM6a = reducetSPowers[detDM6 /.
{R^6 -> circumRSFn[tS]^3, R^4 -> circumRSFn[tS]^2, R^2 -> circumRSFn[tS]}];
check = reducetSPowers[Simplify[detDM6a + 16*prodSides]]
(* this checks Theorem thm:thmDM, Theorem 2 in paper *)
(* S3 Invariants *)
(* S1.6 invariant, also in S.3.2.1 *)
check = reducetSPowers[
sides[[1]]*sides[[3]]*sides[[5]]/(sides[[1]] + sides[[3]] + sides[[5]]) - tS*(1 + tS)]
sumSides = reducetSPowers[Apply[Plus, sides]]
check = FullSimplify[sumSides - 2*e1bi]
check = Factor[ reducetSPowers[4*prodSides/sumSides^2 - tS^2*(1 + tS)^2]]
(* S1.2 Theorem 1 invariant, also in S.3.2.1 *)
check = reducetSPowers[
sides[[1]]*sides[[4]]+sides[[2]]*sides[[5]] + sides[[3]]*sides[[6]] - 2*(1 + 3*tS)]
(* S3.2.2 Theorem 3 *)
diags2 = Map[reducetSPowers,
Join[Table[DM6[[j, j + 2]], {j, 1, 4}], {DM6[[5, 1]], DM6[[6, 2]]}]];
check = FullSimplify[
Map[reducetSPowers, diags2 - {d13, d24, d35, d46, d15, d26}]]
sum2diags6 = Collect[Factor[Apply[Plus, diags2]], tS, Factor];
inv62 = Factor[sum2diags6/e1bi]
check = Factor[inv62 - 8*R*(tS2/(tS*(1 - tS2) ))]
prod2diags6 = reducetSPowers[Apply[Times, diags2]];
check = reducetSPowers[prod2diags6- (4*R)^6*tS^5/(1-tS^2)^4]
(* S3.2.2. Theorem 4 *)
sum3diags6 =
reducetSPowers[((d14 + d25 + d36) /. R^2 -> circumRSFn[tS]) /. dSidesFromT];
check = reducetSPowers[sum3diags6 - (1 + tS)*sumSides/(2*(1 - tS))]
prod3diags6 =
reducetSPowers[((d14*d25*d36) /.
{R^4 -> circumRSFn[tS]^2,R^2 -> circumRSFn[tS]}) /.
dSidesFromT];
X= ((1 + tS)^3)/((1 - tS))
check = reducetSPowers[2*prod3diags6 - X*sumSides]
fuhrmannd= (d12*d45*dd36 + d23*d56*dd14 + d34*d16*dd25 +
d12*d34*d56 + d23*d45*d16 - dd14*dd25*dd36)
fuhrmann = reducetSPowers[((d12*d45*d36 + d23*d56*d14 + d34*d16*d25 +
d12*d34*d56 + d23*d45*d16 - d14*d25*d36) /. dSidesFromT) /.
{R^6 -> circumRSFn[tS]^3,R^4 -> circumRSFn[tS]^2,R^2 -> circumRSFn[tS]}]
(* 0 *)
check=reducetSPowers[(d12*d34*d56 - d23*d45*d16) /. dSidesFromT]
tmp = reducetSPowers[
reducetSPowers[(d12*d45*d36 + d23*d56*d14 + d34*d16*d25) /.
dSidesFromT] /. R^2 -> circumRSFn[tS]];
check=reducetSPowers[tmp - (X - 2*tS*(1 + tS))*e1bi]
(* S3.3 some done earlier *)
e5RS = Factor[ SymmetricReduction[
SymmetricPolynomial[5, Map[(1 + #^2) &, Tlisn[6]]], Tlisn[6],
elisn[6]][[1]] /. e[5] -> e[3] - e[1]]
e6RS = Factor[SymmetricReduction[
SymmetricPolynomial[6, Map[(1 + #^2) &, Tlisn[6]]], Tlisn[6],
elisn[6]][[1]] /. e[5] -> e[3] - e[1]]
sumRecipRS = removeeBraks[Factor[e5RS/e6RS]]
Simplify[Simplify[% /. toe1e2Rules] /. e2 -> 2 + 1/tS]
(* 4/(1-tS^2 *)
(* S3.4 some done earlier *)
Solve[S == 2*(1 + 3*tS), tS]
circumRSS = Factor[circumRSFn[(S - 2)/6]]
Sreg = 4; circumRSS /. S -> Sreg
(* As 0<tS<=1/3 we have 2<S<=4 *)
(* EXTRAS not in paper. There are more invariants *)
(Gregorac 1996 Feuerbach ... Geometry Dedicata ... based on equation 10 *)
gregorac10[DM_] := DM[[1, 5]]/(DM[[1, 6]]*DM[[5, 6]]) -
Sum[DM[[j, j + 1]]/(DM[[j, 6]]*DM[[6, j + 1]]), {j, 1, 4}];
reducetSPowers[FullSimplify[gregorac10[DM6]] /. R^2 -> circumRSFn[tS]]
(* give 0 *)
(* S3.5 *)
alis = Table[a[j], {j, 1, 6}];
a[5] = 2*Pi - a[1] - a[3];
a[6] = 2*Pi - a[2] - a[4];
a[7]= a[1]; a[8]= a[2];
cotIfy[u_] := reducetSPowers[Simplify[
u /. Join[Table[Cos[a[k]] -> (T6bi[[k]]^2 - 1)/(T6bi[[k]]^2 + 1), {k, 1, 6}],
Table[Sin[a[k]] -> 2*T6bi[[k]]/(T6bi[[k]]^2 + 1), {k, 1, 6}]]]];
reg6Check[u_] := Simplify[u /. Join[{T1->1/Sqrt[3],T3->1/Sqrt[3],tS->1/3},
Table[a[k] -> 2*Pi/3, {k, 1, 6}],
Table[T[k] -> 1/Sqrt[3], {k, 1, 6}], {tS -> 1/3}]];
sumCos1 = cotIfy[Apply[Plus, Map[Cos, alis]]]
check = Simplify[sumCos1 + 2*(1 + 3*tS2)/(1 - tS2)]
a2lis= alis+RotateLeft[alis]
sumCos2 = cotIfy[Apply[Plus, Map[TrigExpand, Map[Cos, a2lis]]]]
check = Simplify[sumCos2 - 6 + 4*(1 + 3*tS)/(1 - tS2)]
a3lis = alis + RotateLeft[alis] + RotateLeft[RotateLeft[alis]]
sumCos3 = cotIfy[Apply[Plus, Map[TrigExpand, Map[Cos, a3lis]]]]
check = Simplify[ sumCos3 - 6 - 8*((-1 + 5*tS2) + tS*(1 + 3*tS2))/(1 - tS2)^2]
(* END *)