(*******************************************************************
This file was generated automatically by the Mathematica front end.
It contains Initialization cells from a Notebook file, which
typically will have the same name as this file except ending in
".nb" instead of ".m".

This file is intended to be loaded into the Mathematica kernel using
the package loading commands Get or Needs.  Doing so is equivalent
to using the Evaluate Initialization Cells menu command in the front
end.

DO NOT EDIT THIS FILE.  This entire file is regenerated
automatically each time the parent Notebook file is saved in the
Mathematica front end.  Any changes you make to this file will be
overwritten.
***********************************************************************)









Off[General::"spell1"];Off[General::"spell"];Off[Syntax::"tsntxi"];Off[Solve::"svars"]



MF[l_List] := Map[MatrixForm,l]
MF::usage="MF[l] maps the formatting function MatrixForm over the list l.";























\!\(\(Word::usage = \*"\"\<Word[\!\(n\_1\),...,\!\(n\_k\)] represents the element of the free group generated by Word[1], ..., Word[N]. Word[-i] represents the inverse of Word[i]. The expression Word[\!\(n\_1\),...,\!\(n\_k\)] represents the product     Word[\!\(n\_1\)]...Word[\!\(n\_k\)] and is directly converted to reduced form. Multiplication is implemented by the Dot function. Inversion by the Inverse function.\>\"";\)\[IndentingNewLine]
  \(Unprotect[Word, Dot, Inverse, Equal, Unequal];\)\n
  Word[a___, m_Integer, n_Integer, b___]\  := \ Word[a, b]\  /; \ m\  + \ n\  == \ 0\n
  Dot[Word[], Word[]]\  := \ Word[]\n
  Dot[Word[], Word[a__]]\  := \ Word[a]\n
  Dot[Word[a__], Word[]]\  := \ Word[a]\n
  Dot[Word[a___], Word[b___]]\  := \ Word[a, b]\n
  Word[a___, 0, b___]\  := \ Word[a, b]\n
  Inverse[Word[]]\  := \ Word[]\n
  Inverse[Word[n_Integer]]\  := \ Word[\(-\ n\)]\n
  Inverse[Word[a___, n_Integer]]\  := \ Word[\(-\ n\)]\  . \ Inverse[Word[a]]\[IndentingNewLine]
  \(Equal[Word[], Word[]] = True;\)\n
  Equal[Word[a__], Word[]] := False\[IndentingNewLine]
  Equal[Word[], Word[a__]] := False\[IndentingNewLine]
  \(\(Equal[Word[a__], Word[b__]] := \ Equal[Word[], Word[a] . Inverse[Word[b]]]\)\(\[IndentingNewLine]\)
  \)\[IndentingNewLine]
  Unequal[Word[a___], Word[b___]] := Not[Equal[Word[a], Word[b]]]\[IndentingNewLine]
  \(Protect[Dot, Word, Inverse, Equal, Unequal];\)\)





toList::usage="toList[w] returns the list of generators in the word w.";
toWord::usage="toWord[l] returns the word corresponding to the list l.";
toList[w_Word] := Apply[List,w];
toWord[l_List] := Apply[Word,l];



ApplyWord::usage="ApplyWord[w,list] applies the word w to a list of words.";
ApplyWord[Word[],l_List] := Word[]
ApplyWord[Word[a_/;a> 0,b___],l_List ] := l[[a]] . ApplyWord [Word[b],l]
ApplyWord[Word[a_/;a<0,b___],l_List] := 
  Inverse[l[[-a]] ] . ApplyWord[Word[b],l]





Basis::usage="Basis[n] gives the standard basis of the rank n free group.";
Basis[n_]:= Map[Word,Range[n]];

ApplyAuto::usage="ApplyAuto[A,W] applies the free group automorphism (given as a list of n words in the rank n free group, to the word W.";\

ApplyAuto[A_,W_Word] := ApplyWord[W,A];
ApplyEndo::usage="ApplyEndo[A,W] applies the free group automorphism (given as a list of n words in the rank n free group, to the word W.";\

ApplyEndo[A_,W_Word] := ApplyWord[W,A];
Commutator[w1_Word,w2_Word]:=w1.w2.Inverse[w1].Inverse[w2]
Commutator::usage="Commutator[w1,w2] returns the commutator w1.w2.Inverse[w1].Inverse[w2] of w1 and w2.";



CyclicReduceOnce[w_Word] :=
Module[{listw = toList[w]},
If[ Last[listw] + First[listw] == 0,
toWord[ Drop[ Drop[ listw, -1], 1]],
w ] ];
CyclicReduce[w_Word]:=FixedPoint[CyclicReduceOnce,w]
CyclicReduce::usage="CyclicReduce[w] returns the cyclically reduced form of the Word w.";





\!\(\*
  RowBox[{\(KWordList = {Word[1, 2, \(-1\), \(-2\)], Word[1, \(-2\), \(-1\), 2], Word[\(-1\), \(-2\), 1, 2], Word[\(-1\), 2, 1, \(-2\)], Word[2, 1, \(-2\), \(-1\)], Word[2, \(-1\), \(-2\), 1], Word[\(-2\), 1, 2, \(-1\)], \[IndentingNewLine]Word[\(-2\), \(-1\), 2, 1]};\), "\[IndentingNewLine]", \(KWordList::usage = \*"\"\<KWordList lists the 8 cyclicly reduced commutators of the two generators Word[1] and Word[2] of \!\(\[DoubleStruckCapitalF]\_2\).\>\"";\), "\[IndentingNewLine]", "\[IndentingNewLine]", \(NielsenTest[{w1_Word, w2_Word}] := Apply[Or, Map[CyclicReduce[Commutator[w1, w2]] \[Equal] # &, KWordList]];\), "\[IndentingNewLine]", 
    RowBox[{
      RowBox[{\(NielsenTest::usage\), "=", "\"\<NielsenTest[{w1,w2}] returns True if the elements w1 and w2 of \!\(TraditionalForm\`\[DoubleStruckCapitalF]\_2\\\ generate, \\\ and\\\ false\\\ otherwise . \\\ \\\ In\\\ the\\\ case\\\ they\\\ generate, \\\ then\\\ {w1, w2}\\\ is\\\ a\\\ basis\\\ and\\\ defines\\\ an\\\ automorphism\\\ of\\\ \\\ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(\\\ \)\)\)\)\>\""}], ";"}]}]\)



ComposeAuto::usage="ComposeAuto[A1,A2,...,Ak, X] applies the composition of automorphisms A1, A2, ..., Ak to word X.";\

ComposeAuto[A1_,A2_] := Map[ApplyWord[#,A2]&,A1]
ComposeAuto[A1_,A2_,X__] := ComposeAuto[A1,ComposeAuto[A2,X]]



\!\(\(InnerAutomorphism::usage = "\<InnerAutomorphism[w1,w2] conjugates w2 by w1.\>";\)\n
  \(Inn::usage = \*"\"\<Inn[w,n] returns the image of the inner automorphism determined by w (conjugation by w) on the standard basis of \!\(\[DoubleStruckCapitalF]\_n\).\>\"";\)\n
  InnerAutomorphism[w1_Word, w2_Word]\ \  := \ w1\  . \ w2\  . \ Inverse[w1]\n
  Inn[w_Word, n_]\  := \ Map[InnerAutomorphism[w, #] &, Basis[n]]\)





\!\(\*
  RowBox[{
    StyleBox[\(SymmetrizeWordList[a_]\  := \ Union[a, \ Map[Inverse, \ a]];\),
      FormatType->StandardForm], "\n", 
    StyleBox[\(SymmetrizeWordList::usage\  = \ "\<SymmetrizeWordList[a] returns the union of a and the list of inverses of elements of a.\>";\),
      FormatType->StandardForm], "\[IndentingNewLine]", "\[IndentingNewLine]", \(GenerateWordsInFreeGroup[gens_, 0] := {Word[]};\), "\n", \(GenerateWordsInFreeGroup[gens_, n_] := \[IndentingNewLine]Union[\[IndentingNewLine]Flatten[\[IndentingNewLine]Outer[\[IndentingNewLine]Dot, SymmetrizeWordList[Prepend[gens, Word[]]], GenerateWordsInFreeGroup[gens, n - 1]\[IndentingNewLine]]\[IndentingNewLine]]\[IndentingNewLine]];\), "\[IndentingNewLine]", "\[IndentingNewLine]", \(GenerateWordsInFreeGroup::usage = \*"\"\<GenerateWordsInFreeGroup[Gens,n] returns a list of words in the Free Group of length <= n.  Gens must be a  list of generators: \nGenerateWordsInFreeGroup[{Word[1],Word[2]},3]  outputs all words in \!\(\[DoubleStruckCapitalF]\_2\) of length <=3.\>\"";\)}]\)



NielsenTest1[w1_Word,
w2_Word] := (w1 ==
        Inverse[w2]) || ((Length[w1.w2] >= Length[w1]) && (Length[w1.w2] >=
            Length[w2]))

NielsenSet1[list_] :=
  Apply[And,
    Flatten[Outer[NielsenTest1, SymmetrizeWordList[list],
        SymmetrizeWordList[list]]]]
NielsenTest2[w1_Word, w2_Word,
    w3_Word] := (w1 == Inverse[w2]) || (w2 ==
        Inverse[w3]) || (Length[w1.w2.w3] >= 
        Length[w1] - Length[w2] + Length[w3])
NielsenSet2[list_] :=
  Apply[And,
    Flatten[Outer[NielsenTest2, SymmetrizeWordList[list],
        SymmetrizeWordList[list], SymmetrizeWordList[list]]]]
NielsenSet[list_] := NielsenSet1[list] && NielsenSet2[list]
NielsenSet::usage = "NielsenSet[l] returns True if the list l of words is a Nielsen set, False otherwise. A Nielsen set (or a Nielsen-reduced set) is a collection of words such that no two words in l (or their inverses) cancel more than half of their respective lengths when multiplied together, and if when three words in l (or their inverses) are multiplied, at least one letter of the middle one survives after free cancellation.";