(* :Title: 3bridge3braids.nb, Version 1, 2015 *)
(* :Author: Christopher Cornwell *)
(* :Notes: 
0. Be sure to run the package transverse.m found at http://www.math.duke.edu/~ng .
1. For some of the knots, the braid representative may actually represent the mirror of the knot. This does not affect existence of augmentations of a given rank.
2. The efficiency of the GroebnerBasis calculation is highly dependent on ordering of variables and monomial ordering. It may be that orderings used in this notebook are not optimal.
3. To shorten calculation time for those knots between 10_109 and 10_123 we added relations: a[1,2] = a[2,1], a[1,3] = a[3,1], and a[2,3] = a[3,2]. It may be that this excludes some augmentations.
4. The case of 10_109 seems to take an exceptionally long time. Using other methods we found a particular solution to PhiL[β] == IdentityMatrix[3].
 *)
(* :Summary: For each 3-bridge knot K with braid index 3 and at most 10 crossings, this notebook computes a Groebner basis for an ideal which is relevant to rank 3 augmentations of the knot contact homology of K. More specifically, a 3-braid β representing K is chosen. In most cases, the braid is taken directly from KnotInfo (www.indiana.edu/~knotinfo). Using the package transverse.m, we compute PhiL[β], which is the representation (SuperStar[(Subscript[ϕ, β])]) ∈ Aut((Subscript[A, 4])) of Ng considered as a 3x3 matrix over the algebra generated by {a[i,j] | 1≤ i≠j ≤3}. Then, by work in KCH representations, augmentations, and A-polynomials, C.R. Cornwell, (see paper on arXiv: 1310.7526 [math.GT]). An augmentation is determined by a common zero (in C) of the polynomial entries (made commutative) of 
PhiL[β]-IdentityMatrix[3]. Moreover, there is a rank 3 augmentation for K if and only if the ideal generated by these polynomials has a reduced Groebner basis different from {1}.
*)

(** 8_16 **)
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,2,-1,-1,2,-1,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]

(** 8_17 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,-2,1,-2,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]

(** 10_91 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,-2,-2,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

(** 10_94 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,1,-2,-2,1,-2}]]-IdentityMatrix[3]],{a[2,3],a[3,2],a[1,2],a[1,3],a[2,1],a[3,1]}]

(** in order: 8_5, 8_10, 8_18, 8_19, 8_20, 8_21, 9_16, 10_46, 10_47, 10_48, 10_62, 10_64, 10_79, 10_82, 10_85, 10_99 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,1,1,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,2,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

GroebnerBasis[Flatten[CE[PhiL[{1,-2,1,-2,1,-2,1,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,1,1,1,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,-1,-1,-1,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,2,2,-1,2,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,1,-2,1,1,1,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,-1,2,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,2,2,-1,2,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,2,-1,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,1,1,-2,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,-2,1,1,-2,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,-2,1,-2,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,2,-1,-1,2,-1,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

GroebnerBasis[Flatten[CE[PhiL[{1,1,-2,1,1,-2,-2,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

(** 10_100, 10_104, 10_106 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,1,-2,1,1,-2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,-2,1,-2,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,-2,1,-2,1,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

(** 10_109 **)
GroebnerBasis[Flatten[(CE[PhiL[{1,1,-2,1,-2,-2,1,1,-2,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]}/.{a[3,1]->2((a[2,1])^4)-((a[2,1])^5)-a[3,2]-1})],{a[2,1],a[3,2]},MonomialOrder->DegreeLexicographic]

(CE[PhiL[{1,1,-2,1,-2,-2,1,1,-2,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]})/.{a[2,1]->Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1],a[3,1]->Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1]+((Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1])^2)+((Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1])^4)-((Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1])^5),a[3,2]->-1-Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1]-((Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1])^2)+((Root[1-((#1)^2)-((#1)^3)-((#1)^4)+((#1)^6)&,1])^4)}//FullSimplify

(** 10_112, 10_116, 10_118, 10_123 **)
GroebnerBasis[Flatten[(CE[PhiL[{1,1,1,-2,1,-2,1,-2,1,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]})],{a[2,1],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[(CE[PhiL[{1,1,-2,1,1,-2,1,-2,1,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]})],{a[2,1],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[(CE[PhiL[{1,1,-2,1,-2,1,-2,-2,1,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]})],{a[2,1],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[(CE[PhiL[{1,-2,1,-2,1,-2,1,-2,1,-2}]]-IdentityMatrix[3]/.{a[1,2]->a[2,1],a[1,3]->a[3,1],a[2,3]->a[3,2]})],{a[2,1],a[3,2],a[3,1]}]

(** 10_124, 10_125, 10_126, 10_127 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,1,2,1,1,1,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,-1,2,1,1,1,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,-1,-2,1,1,1,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,1,2,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

(** 10_139, 10_141, 10_143 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,2,1,1,1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,2,1,1,1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{-1,-1,-1,-1,-2,1,1,1,-2,-2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]

(** 10_148 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,2,-1,-1,2,-1,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]

(** 10_149, 10_152, 10_155, 10_157, 10_159, 10_161 **)
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,1,2,-1,2,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[1,3],a[2,1],a[2,3],a[3,1],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,2,1,1,2,2,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,-2,1,1,-2,-1,-1,-1,-2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,2,-1,2,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,-1,2,-1,-1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]
GroebnerBasis[Flatten[CE[PhiL[{1,1,1,2,-1,2,1,1,2,2}]]-IdentityMatrix[3]],{a[1,2],a[2,1],a[1,3],a[3,1],a[2,3],a[3,2]}]