(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 35528, 1150]*) (*NotebookOutlinePosition[ 36312, 1177]*) (* CellTagsIndexPosition[ 36268, 1173]*) (*WindowFrame->Normal*) Notebook[{ Cell["FreeGroupAutos.nb", "Title"], Cell["\<\ A notebook for computing automorphisms of free groups. It creates \ the package FreeGroupAutos.m which is called by the other notebooks. See \ Instructions at the bottom for examples\ \>", "Subtitle"], Cell["\<\ W.Goldman and Ryan Hoban, 3 March 2007\ \>", "Subsubtitle"], Cell[CellGroupData[{ Cell[TextData[StyleBox["Preliminaries", FontWeight->"Plain"]], "Section"], Cell[BoxData[ \(Off[General::"\"]; Off[General::"\"]; Off[Syntax::"\"]; Off[Solve::"\"]\)], "Input", InitializationCell->True], Cell["\<\ First, turn off the annoying warning messages. Also, here is a \ useful matrix output routine and some examples:\ \>", "Text"], Cell[BoxData[{ \(MF[l_List]\ := \ Map[MatrixForm, l]\), "\[IndentingNewLine]", \(\(MF::usage = "\";\)\)}], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[BoxData[ \(SampleMatrix = Map[Range[3] + 2\ # &, Range[3] - 1]\)], "Input"], Cell[BoxData[ \({{1, 2, 3}, {3, 4, 5}, {5, 6, 7}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MatrixForm[SampleMatrix]\)], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", "\[NoBreak]", GridBox[{ {"1", "2", "3"}, {"3", "4", "5"}, {"5", "6", "7"} }, RowSpacings->1, ColumnSpacings->1, ColumnAlignments->{Left}], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MF[SampleMatrix]\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"1"}, {"2"}, {"3"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], ",", TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"3"}, {"4"}, {"5"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], ",", TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"5"}, {"6"}, {"7"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(MF[Transpose[SampleMatrix]]\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"1"}, {"3"}, {"5"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], ",", TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"2"}, {"4"}, {"6"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]], ",", TagBox[ RowBox[{"(", "\[NoBreak]", TagBox[GridBox[{ {"3"}, {"5"}, {"7"} }, RowSpacings->1, ColumnAlignments->{Left}], Column], "\[NoBreak]", ")"}], Function[ BoxForm`e$, MatrixForm[ BoxForm`e$]]]}], "}"}]], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Definitions of words in a free group", "Section"], Cell[CellGroupData[{ Cell["The Word Datatype", "Subsubsection"], Cell[TextData[{ "We define a head ", StyleBox["Word", FontWeight->"Bold"], " which implements reduced words in a free group. The generators are given \ by positive integers, and their inverses are given by their negatives. For \ example ", StyleBox["Word[3]", FontWeight->"Bold"], " denotes the third generator and ", StyleBox["Word[-3] ", FontWeight->"Bold"], " denotes its inverse. The ", StyleBox["Dot", FontWeight->"Bold"], " function implements multiplication in the free group and ", StyleBox["Inverse ", FontWeight->"Bold"], " implements inversion: " }], "Text", FontFamily->"Helvetica"], Cell[BoxData[{ \(\(Word::usage = \*"\"\\"";\)\), "\[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];\)\)}], "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Words and Lists", FontWeight->"Plain"]], "Subsubsection", FontFamily->"Helvetica"], Cell[TextData[{ "Here are routines for converting between words (as defined above) and \ lists. The function ", StyleBox["toList[w] ", FontWeight->"Bold"], "drops the head ", StyleBox["Word ", FontWeight->"Bold"], "and returns the list of variables. The function ", StyleBox["toWord[l] ", FontWeight->"Bold"], "applies the head ", StyleBox["Word ", FontWeight->"Bold"], "to the list l." }], "Text"], Cell[BoxData[{ \(\(toList::usage = "\";\)\), "\n", \(\(toWord::usage = "\";\)\), "\n", \(\(toList[w_Word]\ := \ Apply[List, w];\)\), "\n", \(\(toWord[l_List]\ := \ Apply[Word, l];\)\)}], "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Applying Words to Other Words (substitution)", FontWeight->"Plain"]], "Subsubsection", FontFamily->"Helvetica"], Cell[BoxData[{ \(\(ApplyWord::usage = "\";\)\), "\[IndentingNewLine]", \(ApplyWord[Word[], l_List]\ := \ Word[]\), "\n", \(ApplyWord[Word[a_ /; a > \ 0, b___], l_List\ ]\ := \ l[\([a]\)]\ . \ ApplyWord\ [Word[b], l]\), "\n", \(ApplyWord[Word[a_ /; a < 0, b___], l_List]\ := \ Inverse[l[\([\(-a\)]\)]\ ]\ . \ ApplyWord[Word[b], l]\)}], "Input", InitializationCell->True] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Free group automorphisms", "Section", InitializationCell->True, FontFamily->"Helvetica"], Cell[TextData[{ "An endomorphism ", StyleBox["A", FontWeight->"Bold"], " of ", StyleBox["a free Fn group of rank n", FontWeight->"Bold"], " will be given by an n-tuple of words ", StyleBox["{W1,..., Wn}", FontWeight->"Bold"], " which list images of each of the generators", StyleBox[". ", FontWeight->"Bold"], " The elements of this list are ", StyleBox["W1 = A(Word[1]) ", FontWeight->"Bold"], "and ", StyleBox["Wn = A(Word[n]). ", FontWeight->"Bold"], StyleBox[" Clearly any n-tuple of words will determine some ", FontVariations->{"CompatibilityType"->0}], StyleBox["endomorphism.", FontWeight->"Bold", FontVariations->{"CompatibilityType"->0}] }], "Text", InitializationCell->True, FontFamily->"Helvetica"], Cell[BoxData[{ \(\(Basis::usage = "\";\)\), "\[IndentingNewLine]", \(\(Basis[n_] := \ Map[Word, Range[n]];\)\)}], "Input", InitializationCell->True], Cell[BoxData[{ \(\(ApplyAuto::usage = "\";\)\), "\[IndentingNewLine]", \(\(ApplyAuto[A_, W_Word]\ := \ ApplyWord[W, A];\)\), "\[IndentingNewLine]", \(\(ApplyEndo::usage = "\";\)\), "\[IndentingNewLine]", \(\(ApplyEndo[A_, W_Word]\ := \ ApplyWord[W, A];\)\), "\[IndentingNewLine]", \(Commutator[w1_Word, w2_Word] := w1 . w2 . Inverse[w1] . Inverse[w2]\), "\[IndentingNewLine]", \(\(Commutator::usage = "\";\)\)}], "Input", InitializationCell->True], Cell[TextData[{ "A word is ", StyleBox["Cyclically Reduced", FontWeight->"Bold"], " if its first letter is not the inverse of its last letter. Clearly ", StyleBox["every word is conjugate to one which is Cyclically Reduced.", FontWeight->"Bold"] }], "Text", InitializationCell->True], Cell[BoxData[{ StyleBox[\(CyclicReduceOnce[w_Word]\ := \n Module[{listw\ = \ toList[w]}, \n If[\ Last[listw]\ + \ First[listw]\ == \ 0, \n toWord[\ Drop[\ Drop[\ listw, \ \(-1\)], \ 1]], \nw\ ]\ ];\), FormatType->StandardForm], "\n", \(CyclicReduce[w_Word] := FixedPoint[CyclicReduceOnce, w]\), "\[IndentingNewLine]", StyleBox[\(CyclicReduce::usage = "\";\), FormatType->StandardForm]}], "Input", InitializationCell->True], Cell[TextData[{ "Nielsen's criterion for free generation of ", Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(.\)\)\)]] }], "Subsection", InitializationCell->True], Cell[TextData[{ "An endomorphism ", StyleBox["{W1,..., Wn}", FontWeight->"Bold"], " is an ", StyleBox["Automorphism ", FontWeight->"Bold"], StyleBox["if the set ", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ \(TraditionalForm\`{W\_1\)]], StyleBox[",..., ", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`\(\(W\_n\)\(\ \)\)\)]], StyleBox["}", FontWeight->"Bold"], StyleBox[" freely generate ", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalF]\_n\)]], StyleBox[". ", FontWeight->"Bold", FontVariations->{"CompatibilityType"->0}], StyleBox["This seems in general tough to decide if a given n-tuple of words \ generate ", FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalF]\_n\)]], StyleBox[", working on that below. However for rank 2 free groups, \n", FontVariations->{"CompatibilityType"->0}], StyleBox["Theorem (Nielsen): ", FontVariations->{"Underline"->True, "CompatibilityType"->0}], "A pair ", Cell[BoxData[ \(TraditionalForm\`\((W\_1, W\_2\)\)]], ") of elements of ", Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(\ \)\)\)]], "= generates ", Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(\ \)\)\)]], "(and thus is a free generating set, or basis) if and only if its \ commutator ", Cell[BoxData[ \(TraditionalForm\`\(\(W\_1\) \(W\_2\) \(W\_1\%\(-1\)\) \ \(W\_2\%\(-1\)\)\(\ \)\)\)]], "is conjugate to the commutator ", Cell[BoxData[ \(TraditionalForm\`\(XYX\^\(-1\)\) Y\^\(-1\)\)]], " of the two free generators X, Y (or its inverse ", Cell[BoxData[ \(TraditionalForm\`\(YXY\^\(-1\)\) X\^\(-1\)\)]], ")." }], "Text", InitializationCell->True], Cell[BoxData[{\(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]", RowBox[{\(KWordList::usage = \*"\"\\"";\), "\[IndentingNewLine]"}], "\[IndentingNewLine]", \(NielsenTest[{w1_Word, w2_Word}] := Apply[Or, Map[CyclicReduce[Commutator[w1, w2]] \[Equal] # &, KWordList]];\), "\[IndentingNewLine]", RowBox[{ RowBox[{\(NielsenTest::usage\), "=", "\"\\""}], ";"}]}], "Input", InitializationCell->True], Cell["Composing Automorphisms", "Subsection", InitializationCell->True, FontFamily->"Helvetica"], Cell[BoxData[{ \(\(ComposeAuto::usage = "\";\)\), "\n", \(ComposeAuto[A1_, A2_]\ := \ Map[ApplyWord[#, A2] &, A1]\), "\n", \(ComposeAuto[A1_, A2_, X__]\ := \ ComposeAuto[A1, ComposeAuto[A2, X]]\)}], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell["Inner Automorphisms ", "Subsection", InitializationCell->True, FontFamily->"Helvetica"], Cell[BoxData[{ \(\(InnerAutomorphism::usage = "\";\)\), "\n", \(\(Inn::usage = \*"\"\\"";\)\), "\n", \(InnerAutomorphism[w1_Word, w2_Word]\ \ := \ w1\ . \ w2\ . \ Inverse[w1]\), "\n", \(Inn[w_Word, n_]\ := \ Map[InnerAutomorphism[w, #] &, Basis[n]]\)}], "Input", InitializationCell->True] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Sets of words", "Section"], Cell[TextData[StyleBox["To obtain a list of all words in specified generators \ whose lengths are less than a specified length we use the following:", FontWeight->"Plain"]], "Subsubsection"], Cell[BoxData[{ StyleBox[\(SymmetrizeWordList[a_]\ := \ Union[a, \ Map[Inverse, \ a]];\), FormatType->StandardForm], "\n", RowBox[{ StyleBox[\(SymmetrizeWordList::usage\ = \ "\";\), FormatType->StandardForm], "\[IndentingNewLine]"}], "\[IndentingNewLine]", \ \(GenerateWordsInFreeGroup[gens_, 0] := {Word[]};\), "\n", RowBox[{\(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 = \*"\"\\"";\)}], \ "Input", InitializationCell->True], Cell[TextData[{ StyleBox["Test if a given set of words for a ", FontWeight->"Plain"], "Nielsen Set" }], "Subsubsection"], Cell[BoxData[{ RowBox[{ StyleBox[\(NielsenTest1[w1_Word, \n w2_Word]\ := \ \((w1\ == Inverse[ w2])\)\ || \ \((\((Length[w1 . w2]\ >= \ Length[w1])\)\ && \ \((Length[w1 . w2]\ >= Length[w2])\))\)\), FormatType->StandardForm], "\n"}], "\[IndentingNewLine]", StyleBox[\(NielsenSet1[list_]\ := \n Apply[And, Flatten[Outer[NielsenTest1, \ SymmetrizeWordList[list], SymmetrizeWordList[list]]]]\), FormatType->StandardForm], "\n", StyleBox[\(NielsenTest2[w1_Word, \ w2_Word, w3_Word]\ := \ \((w1\ == \ Inverse[w2])\)\ || \ \((w2\ == Inverse[w3])\)\ || \ \((Length[w1 . w2 . w3]\ >= \ Length[w1]\ - \ Length[w2]\ + \ Length[w3])\)\), FormatType->StandardForm], "\n", StyleBox[\(NielsenSet2[list_]\ := Apply[And, Flatten[Outer[NielsenTest2, \ SymmetrizeWordList[list], SymmetrizeWordList[list], \ SymmetrizeWordList[list]]]]\), FormatType->StandardForm], "\n", StyleBox[\(NielsenSet[list_]\ := \ NielsenSet1[list]\ && \ NielsenSet2[list]\), FormatType->StandardForm], "\n", StyleBox[\(NielsenSet::usage\ = \ "\";\), FormatType->StandardForm]}], "Input", InitializationCell->True] }, Closed]], Cell["Instructions For Use- Expand each section below for Examples", "Section"], Cell[CellGroupData[{ Cell["Words and Operations on Words", "Subsection"], Cell[TextData[{ StyleBox["We define a head ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Word", FontVariations->{"CompatibilityType"->0}], StyleBox[" which implements reduced words in a free group. The generators \ are given by positive integers, and their inverses are given by their \ negatives. For example ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Word[3]", FontVariations->{"CompatibilityType"->0}], StyleBox[" denotes the third generator and ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Word[-3]", FontVariations->{"CompatibilityType"->0}], StyleBox[" denotes its inverse. The ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Dot function", FontVariations->{"CompatibilityType"->0}], StyleBox[" implements multiplication in the free group and ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Inverse", FontVariations->{"CompatibilityType"->0}], StyleBox[" implements inversion.", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection"], Cell[TextData[StyleBox["Examples:", FontVariations->{"Underline"->True}]], "Text"], Cell["Reduced words:", "Text", FontFamily->"Helvetica"], Cell[CellGroupData[{ Cell[BoxData[ \(Word[1, 2, \(-2\), 3]\)], "Input"], Cell[BoxData[ \(Word[1, 3]\)], "Output"] }, Open ]], Cell["Multiplication of reduced words:", "Text", FontFamily->"Helvetica"], Cell[CellGroupData[{ Cell[BoxData[ \(Word[1]\ . \ Word[2]\)], "Input"], Cell[BoxData[ \(Word[1, 2]\)], "Output"] }, Open ]], Cell["Inversion of reduced words:", "Text", FontFamily->"Helvetica"], Cell[BoxData[ \(Inverse[Word[1, 2, 3, \(-4\)]]\)], "Input"], Cell[BoxData[ \(Word[4, \(-3\), \(-2\), \(-1\)]\)], "Output"], Cell[TextData[{ "Commutators are found with the ", StyleBox["Commutator:", FontWeight->"Bold"] }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Commutator[Word[1], Word[2]]\)], "Input"], Cell[BoxData[ \(Word[1, 2, \(-1\), \(-2\)]\)], "Output"] }, Open ]], Cell[TextData[{ "The functions ", StyleBox["Equal (==) ", FontWeight->"Bold"], " or ", StyleBox["Unequal(!=)", FontWeight->"Bold"], " both work appropriately for words: " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(Word[1, 2] == Word[1, 2]\), "\[IndentingNewLine]", \(Word[1, 2] != Word[1, 2]\), "\[IndentingNewLine]", \(Word[1] \[Equal] Word[1, 2]\), "\[IndentingNewLine]", \(Word[1] \[NotEqual] Word[1, 2]\)}], "Input"], Cell[BoxData[ \(True\)], "Output"], Cell[BoxData[ \(False\)], "Output"], Cell[BoxData[ \(False\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Sometimes it is convenient to work with the list of generators \ for a given word. The function ", FontWeight->"Plain"], "toList[w]", StyleBox[" drops the head Word and returns the list of variables. The \ function ", FontWeight->"Plain"], "toWord[l] ", StyleBox["applies the head Word to the list l.", FontWeight->"Plain"] }], "Subsubsection"], Cell[TextData[StyleBox["Example:", FontVariations->{"Underline"->True}]], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(toList[Word[2, 3, 4, 1, 2, 3, 2]]\)], "Input"], Cell[BoxData[ \({2, 3, 4, 1, 2, 3, 2}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(toWord[{2, 3, 4, 1, 2, 4}]\)], "Input"], Cell[BoxData[ \(Word[2, 3, 4, 1, 2, 4]\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Substitution is accomplished by Applying Words to Other Words. \ For example, ", FontWeight->"Plain"], "ApplyWord[Word[1,2,-1,-2],{ W1,W2}]", StyleBox[" returns the commutator of W1 and W2.", FontWeight->"Plain"] }], "Subsubsection", FontFamily->"Helvetica"], Cell[CellGroupData[{ Cell[BoxData[ \(ApplyWord[Word[1, 2, \(-1\), \(-2\)], {Word[3], Word[4, 5]}]\)], "Input"], Cell[BoxData[ \(Word[3, 4, 5, \(-3\), \(-5\), \(-4\)]\)], "Output"] }, Open ]], Cell[BoxData[ \(Word[3, 4, 5, \(-3\), \(-5\), \(-4\)]\)], "Output", GeneratedCell->False, CellAutoOverwrite->False], Cell[TextData[{ StyleBox["Finally we note that ", FontWeight->"Plain"], "any word is conjuagte to one which is", StyleBox[" ", FontWeight->"Plain"], "Cyclically Reduced", StyleBox[", that is to say that the first letter is not the inverse of the \ last letter. This is accomplished by:", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[ \(CyclicReduce[Word[1, 2, 3, \(-1\)]]\)], "Input"], Cell[BoxData[ \(Word[2, 3]\)], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Free Group Automorphisms", "Subsection"], Cell[TextData[{ StyleBox["An ", FontWeight->"Plain"], "endomorphism A of a free group Fn ", StyleBox["of rank n will be given by an n-tuple of words ", FontWeight->"Plain"], "{W1,..., Wn} ", StyleBox["which list images of each of the generators. The elements of \ this list are ", FontWeight->"Plain"], "W1 = A(Word[1]) and Wn = A(Word[n])", StyleBox[". ", FontWeight->"Plain"], StyleBox[" Clearly any n-tuple of words will determine some endomorphism. \ ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["ApplyEndo[{W1,...,Wn},W] ", FontVariations->{"CompatibilityType"->0}], StyleBox["applies the and endomorphism to a word ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["W.i", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection", InitializationCell->True, FontFamily->"Helvetica"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\( (*A\ permutation\ endomorphism*) \)\(\[IndentingNewLine]\)\(perm = \ {Word[2], Word[1]}\[IndentingNewLine] ApplyEndo[perm, Word[1]]\)\)\)], "Input"], Cell[BoxData[ \({Word[2], Word[1]}\)], "Output"], Cell[BoxData[ \(Word[2]\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Basis[n] ", FontWeight->"Bold"], StyleBox["returns the standard basis for a free group of rank n", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection", FontFamily->"Helvetica"], Cell[CellGroupData[{ Cell[BoxData[ \(Basis[3]\)], "Input"], Cell[BoxData[ \({Word[1], Word[2], Word[3]}\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["An endomorphism ", FontWeight->"Plain"], "{W1,..., Wn}", StyleBox[" is an Automorphism ", FontWeight->"Plain"], StyleBox["if the set ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], "{W1,..., Wn}", StyleBox[" freely generate ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Fn", FontVariations->{"CompatibilityType"->0}], StyleBox[". This seems in general tough to decide if a given n-tuple of \ words generate ", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}], StyleBox["Fn", FontVariations->{"CompatibilityType"->0}], StyleBox[", working on that below. However for free groups of Rank 2, we \ have the following theorem of Nielsen:", FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}] }], "Subsubsection"], Cell[TextData[{ StyleBox["Theorem (Nielsen)", FontWeight->"Bold", FontVariations->{"Underline"->True, "CompatibilityType"->0}], StyleBox[": ", FontVariations->{"Underline"->True, "CompatibilityType"->0}], StyleBox["A pair of elements of ", FontWeight->"Plain"], Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(\ \)\)\)], FontWeight->"Plain"], StyleBox["generates ", FontWeight->"Plain"], Cell[BoxData[ \(TraditionalForm\`\(\(\[DoubleStruckCapitalF]\_2\)\(\ \)\)\)], FontWeight->"Plain"], StyleBox["(and thus is a free generating set, or basis) if and only if its \ commutator is\nconjugate to the commutator of the two free generators (or its \ inverse).", FontWeight->"Plain"] }], "Text", Background->GrayLevel[0.900008]], Cell[TextData[{ StyleBox["This is implemented using ", FontWeight->"Plain"], "NielsenTest[{W1,W2}]" }], "Text"], Cell[TextData[{ StyleBox["Example 1:", FontVariations->{"Underline"->True}], " Both examples below are generating sets for ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalF]\_2\)], FontWeight->"Plain"] }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(perm = {Word[2], Word[1]};\)\), "\[IndentingNewLine]", \(\(nielsentrans = {Word[1, 2], Word[2]};\)\), "\[IndentingNewLine]", \(NielsenTest[perm]\), "\[IndentingNewLine]", \(NielsenTest[nielsentrans]\)}], "Input"], Cell[BoxData[ \(True\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Example 2:", FontVariations->{"Underline"->True}], " This sets do not generate ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalF]\_2\)], FontWeight->"Plain"], ", thus they determine an endomorphism which is not an automorphism" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(endo = {Word[1, 2, 1], Word[2]};\)\), "\[IndentingNewLine]", \(NielsenTest[endo]\)}], "Input"], Cell[BoxData[ \(False\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["The Composotion of Automorphisms is of course an automorpishm \ given by", FontWeight->"Plain"], " ", StyleBox["ComposeAuto[A1,A2,...,Ak]", FontWeight->"Bold"] }], "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[{ \(newauto = ComposeAuto[perm, nielsentrans, nielsentrans]\), "\[IndentingNewLine]", \(NielsenTest[newauto]\)}], "Input"], Cell[BoxData[ \({Word[2], Word[1, 2, 2]}\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Closed]], Cell[TextData[{ "Inner Automorphisms", StyleBox[" are simply conjugation. ", FontWeight->"Plain"], "InnerAutomorphism[W1,W2]", StyleBox[" applies the inner automorphism determined by", FontWeight->"Plain"], " ", StyleBox["the word ", FontWeight->"Plain"], "W1", StyleBox[" to the word ", FontWeight->"Plain"], "W2. \nInn[W,rank]", StyleBox[" returns the Inner Automorphism determined by ", FontWeight->"Plain"], "W", StyleBox[" on the standard basis for the Free Group of the given rank", FontWeight->"Plain"] }], "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[{ \(InnerAutomorphism[Word[2], Word[1]]\), "\[IndentingNewLine]", \(Inn[Word[2, 1], 2]\)}], "Input"], Cell[BoxData[ \(Word[2, 1, \(-2\)]\)], "Output"], Cell[BoxData[ \({Word[2, 1, \(-2\)], Word[2, 1, 2, \(-1\), \(-2\)]}\)], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Sets of Words", "Subsection"], Cell[TextData[{ StyleBox["To generate a complete list of all reduced words up to a fixed \ length, use", FontWeight->"Plain"], " ", StyleBox["GenerateWordsInFreeGroup[generatorlist,wordlength]", FontWeight->"Bold"], ". ", StyleBox[" For example to generate a list of all words with length \ \[LessEqual]3 in ", FontWeight->"Plain"], Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalF]\_2\)], FontWeight->"Plain"], ":" }], "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[ \(GenerateWordsInFreeGroup[{Word[1], Word[2]}, 2]\)], "Input"], Cell[BoxData[ \({Word[], Word[\(-2\)], Word[\(-1\)], Word[1], Word[2], Word[\(-2\), \(-2\)], Word[\(-2\), \(-1\)], Word[\(-2\), 1], Word[\(-1\), \(-2\)], Word[\(-1\), \(-1\)], Word[\(-1\), 2], Word[1, \(-2\)], Word[1, 1], Word[1, 2], Word[2, \(-1\)], Word[2, 1], Word[2, 2]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(GenerateWordsInFreeGroup[ PantsBasis = {Word[1], Word[2], Word[\(-2\), \(-1\)]}, 2]\)], "Input"], Cell[BoxData[ \({Word[], Word[\(-2\)], Word[\(-1\)], Word[1], Word[2], Word[\(-2\), \(-2\)], Word[\(-2\), \(-1\)], Word[\(-2\), 1], Word[\(-1\), \(-2\)], Word[\(-1\), \(-1\)], Word[\(-1\), 2], Word[1, \(-2\)], Word[1, 1], Word[1, 2], Word[2, \(-1\)], Word[2, 1], Word[2, 2], Word[\(-2\), \(-2\), \(-1\)], Word[\(-2\), \(-1\), \(-2\)], Word[\(-2\), \(-1\), \(-1\)], Word[\(-2\), \(-1\), 2], Word[\(-2\), 1, 2], Word[\(-1\), \(-2\), \(-1\)], Word[1, \(-2\), \(-1\)], Word[1, 1, 2], Word[1, 2, \(-1\)], Word[1, 2, 1], Word[1, 2, 2], Word[2, 1, 2], Word[\(-2\), \(-1\), \(-2\), \(-1\)], Word[1, 2, 1, 2]}\)], "Output"] }, Open ]], Cell["Nielsen Sets", "Subsubsection"], Cell[TextData[{ "A ", StyleBox["Nielsen Set (", FontWeight->"Bold"], "or ", StyleBox["Nielsen-reduced set)", FontWeight->"Bold"], " is a set of words which is, in some sense, a minimal generating set for a \ subgroup. More preciesly:" }], "Text"], Cell[TextData[{ StyleBox["Definition:", FontVariations->{"Underline"->True}], " A set ", StyleBox["S", FontWeight->"Bold"], " is a ", StyleBox["Nielsen Set", FontWeight->"Bold"], " if ", StyleBox["S\[Union]", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`S\^\(-1\)\)]], "=\[Diameter] ", "and", StyleBox[" ", FontWeight->"Bold"], "the following two conditions are satisfied:\n1) If u,v \[Epsilon] ", StyleBox["S\[Union]", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`S\^\(-1\)\)]], " with u\[NotEqual] ", Cell[BoxData[ \(TraditionalForm\`v\^\(-1\)\)]], ",then |u.v| >|u|+|v|\n2) If u,v,w \[Epsilon] ", StyleBox["S\[Union]", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`S\^\(-1\)\)]], "with u \[NotEqual] ", Cell[BoxData[ \(TraditionalForm\`w\^\(-1\)\)]], "and v\[NotEqual]", Cell[BoxData[ \(TraditionalForm\`w\^\(-1\)\)]], ", then |u.w.v| > |u|+|v|-|w|" }], "Text", CellDingbat->None, Background->GrayLevel[0.900008]], Cell[TextData[{ "The function ", StyleBox["NielsenSet[{W1,...,Wn}]", FontWeight->"Bold"], " determines whether or not a given set of words forms a Nielsen Set." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(NielsenSet[{Word[1, \ 2, \ 1], \ Word[2, \ 2], \ Word[1, \ 1], \ Word[2, \ 1, \ 1, \ 1, \ 2], \n Word[2, \ 1, \ 2, \ 1, \ 2]}]\)], "Input"], Cell[BoxData[ \(True\)], "Output"] }, Open ]] }, Closed]] }, FrontEndVersion->"5.2 for Microsoft Windows", ScreenRectangle->{{0, 1072}, {0, 937}}, AutoGeneratedPackage->Automatic, CellGrouping->Manual, WindowSize->{1016, 651}, WindowMargins->{{-3, Automatic}, {Automatic, -5}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, ShowSelection->True ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 34, 0, 95, "Title"], Cell[1791, 53, 213, 4, 109, "Subtitle"], Cell[2007, 59, 69, 3, 50, "Subsubtitle"], Cell[CellGroupData[{ Cell[2101, 66, 75, 1, 72, "Section"], Cell[2179, 69, 171, 3, 70, "Input", InitializationCell->True], Cell[2353, 74, 136, 3, 70, "Text"], Cell[2492, 79, 220, 4, 70, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[2737, 87, 84, 1, 70, "Input"], Cell[2824, 90, 67, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[2928, 96, 57, 1, 70, "Input"], Cell[2988, 99, 357, 11, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[3382, 115, 49, 1, 70, "Input"], Cell[3434, 118, 1185, 38, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[4656, 161, 60, 1, 70, "Input"], Cell[4719, 164, 1185, 38, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[5953, 208, 55, 0, 43, "Section"], Cell[CellGroupData[{ Cell[6033, 212, 42, 0, 70, "Subsubsection"], Cell[6078, 214, 640, 20, 70, "Text"], Cell[6721, 236, 1690, 29, 70, "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[8448, 270, 110, 2, 70, "Subsubsection"], Cell[8561, 274, 432, 15, 70, "Text"], Cell[8996, 291, 364, 7, 70, "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell[9397, 303, 139, 2, 70, "Subsubsection"], Cell[9539, 307, 470, 8, 70, "Input", InitializationCell->True] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[10058, 321, 98, 2, 43, "Section", InitializationCell->True], Cell[10159, 325, 778, 26, 70, "Text", InitializationCell->True], Cell[10940, 353, 223, 4, 70, "Input", InitializationCell->True], Cell[11166, 359, 846, 15, 70, "Input", InitializationCell->True], Cell[12015, 376, 302, 8, 70, "Text", InitializationCell->True], Cell[12320, 386, 563, 10, 70, "Input", InitializationCell->True], Cell[12886, 398, 195, 5, 70, "Subsection", InitializationCell->True], Cell[13084, 405, 1889, 56, 70, "Text", InitializationCell->True], Cell[14976, 463, 1280, 22, 70, "Input", InitializationCell->True], Cell[16259, 487, 100, 2, 70, "Subsection", InitializationCell->True], Cell[16362, 491, 359, 6, 70, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[16746, 501, 97, 2, 70, "Subsection", InitializationCell->True], Cell[16846, 505, 530, 10, 70, "Input", InitializationCell->True] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[17425, 521, 32, 0, 43, "Section"], Cell[17460, 523, 192, 2, 70, "Subsubsection"], Cell[17655, 527, 1225, 23, 70, "Input", InitializationCell->True], Cell[18883, 552, 128, 4, 70, "Subsubsection"], Cell[19014, 558, 1798, 35, 70, "Input", InitializationCell->True] }, Closed]], Cell[20827, 596, 79, 0, 43, "Section"], Cell[CellGroupData[{ Cell[20931, 600, 51, 0, 38, "Subsection"], Cell[20985, 602, 1215, 31, 70, "Subsubsection"], Cell[22203, 635, 84, 1, 70, "Text"], Cell[22290, 638, 57, 1, 70, "Text"], Cell[CellGroupData[{ Cell[22372, 643, 54, 1, 70, "Input"], Cell[22429, 646, 44, 1, 70, "Output"] }, Open ]], Cell[22488, 650, 75, 1, 70, "Text"], Cell[CellGroupData[{ Cell[22588, 655, 54, 1, 70, "Input"], Cell[22645, 658, 44, 1, 70, "Output"] }, Open ]], Cell[22704, 662, 70, 1, 70, "Text"], Cell[22777, 665, 63, 1, 70, "Input"], Cell[22843, 668, 65, 1, 70, "Output"], Cell[22911, 671, 114, 4, 70, "Text"], Cell[CellGroupData[{ Cell[23050, 679, 61, 1, 70, "Input"], Cell[23114, 682, 60, 1, 70, "Output"] }, Open ]], Cell[23189, 686, 200, 8, 70, "Text"], Cell[CellGroupData[{ Cell[23414, 698, 242, 4, 70, "Input"], Cell[23659, 704, 38, 1, 70, "Output"], Cell[23700, 707, 39, 1, 70, "Output"], Cell[23742, 710, 39, 1, 70, "Output"], Cell[23784, 713, 38, 1, 70, "Output"] }, Open ]], Cell[23837, 717, 393, 11, 70, "Subsubsection"], Cell[24233, 730, 83, 1, 70, "Text"], Cell[CellGroupData[{ Cell[24341, 735, 66, 1, 70, "Input"], Cell[24410, 738, 55, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[24502, 744, 59, 1, 70, "Input"], Cell[24564, 747, 56, 1, 70, "Output"] }, Open ]], Cell[24635, 751, 301, 8, 70, "Subsubsection"], Cell[CellGroupData[{ Cell[24961, 763, 93, 1, 70, "Input"], Cell[25057, 766, 71, 1, 70, "Output"] }, Open ]], Cell[25143, 770, 123, 3, 70, "Output"], Cell[25269, 775, 398, 11, 70, "Subsubsection"], Cell[CellGroupData[{ Cell[25692, 790, 68, 1, 70, "Input"], Cell[25763, 793, 44, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[25856, 800, 46, 0, 30, "Subsection"], Cell[25905, 802, 916, 26, 63, "Subsubsection", InitializationCell->True], Cell[CellGroupData[{ Cell[26846, 832, 177, 3, 70, "Input"], Cell[27026, 837, 52, 1, 29, "Output"], Cell[27081, 840, 41, 1, 29, "Output"] }, Open ]], Cell[27137, 844, 251, 7, 29, "Subsubsection"], Cell[CellGroupData[{ Cell[27413, 855, 41, 1, 30, "Input"], Cell[27457, 858, 61, 1, 29, "Output"] }, Open ]], Cell[27533, 862, 877, 25, 46, "Subsubsection"], Cell[28413, 889, 810, 23, 68, "Text"], Cell[29226, 914, 119, 4, 33, "Text"], Cell[29348, 920, 242, 7, 33, "Text"], Cell[CellGroupData[{ Cell[29615, 931, 250, 4, 90, "Input"], Cell[29868, 937, 38, 1, 29, "Output"], Cell[29909, 940, 38, 1, 29, "Output"] }, Open ]], Cell[29962, 944, 296, 8, 33, "Text"], Cell[CellGroupData[{ Cell[30283, 956, 122, 2, 50, "Input"], Cell[30408, 960, 39, 1, 29, "Output"] }, Open ]], Cell[30462, 964, 220, 7, 29, "Subsubsection"], Cell[CellGroupData[{ Cell[30707, 975, 160, 4, 50, "Input"], Cell[30870, 981, 58, 1, 29, "Output"], Cell[30931, 984, 38, 1, 29, "Output"] }, Closed]], Cell[30984, 988, 580, 19, 40, "Subsubsection"], Cell[CellGroupData[{ Cell[31589, 1011, 122, 2, 50, "Input"], Cell[31714, 1015, 52, 1, 29, "Output"], Cell[31769, 1018, 85, 1, 29, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[31903, 1025, 35, 0, 30, "Subsection"], Cell[31941, 1027, 479, 15, 46, "Subsubsection"], Cell[CellGroupData[{ Cell[32445, 1046, 80, 1, 30, "Input"], Cell[32528, 1049, 320, 5, 48, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[32885, 1059, 122, 2, 30, "Input"], Cell[33010, 1063, 681, 10, 86, "Output"] }, Open ]], Cell[33706, 1076, 37, 0, 29, "Subsubsection"], Cell[33746, 1078, 265, 9, 33, "Text"], Cell[34014, 1089, 1059, 40, 87, "Text"], Cell[35076, 1131, 182, 5, 33, "Text"], Cell[CellGroupData[{ Cell[35283, 1140, 176, 3, 50, "Input"], Cell[35462, 1145, 38, 1, 29, "Output"] }, Open ]] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)