(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' 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[ 235774, 4416]*) (*NotebookOutlinePosition[ 237032, 4459]*) (* CellTagsIndexPosition[ 236913, 4452]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ "Implementing mathematical concepts in ", StyleBox["Mathematica", FontSlant->"Italic"], ": \nQuotients in permutation groups." }], "Subtitle"], Cell["\<\ Ivan Cnop Vrije Universiteit Brussell Pleinlaan 2, B 1050 Brussels, Belgium icnop @ vnet3.vub.ac.be Presented at the Koblenz ICTMT3 Conference,1997\ \>", "Subsubtitle", FontSize->12], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "Understanding quotients poses problems for the average student. This is \ the case even for discrete and finite structures. A quotient is a set of \ equivalence classes under some equivalence relation. In some cases the \ quotient inherits the operations on the original structure and the properties \ thereof. Here color coding can help understanding how quotients work. Such \ color codings are quite natural and readily available in the ", StyleBox["Mathematica", FontSlant->"Italic"], " documentation. The Color wheel is the most obvious example: its Hues \ correspond to equal arguments and saturation corresponds to moduli. Coloring \ polar coordinates is the simplest example of coloring in the ComplexMap \ Package. Along the same idea, a ContourPlot or DensityPlot of a function \ shows the equivalence relating points with nearby values by coloring or \ shades of grey. In this case little algebraic or geometric structure is \ involved, except for some very special functions.\n\nIn other cases, it is \ possible to get useful information by coloring objects in the right way. \ Coloring a sphere or a torus according to meridians (longitude) and latitudes \ explains how they relate to rectangles in the plane. These colorings are done \ using the parameters in the ParmetricPlot command. Spherical coordinates blow \ up near the poles on a sphere. They do not blow up on a torus. Thus we find \ that identifying opposite sides of a rectangle with periodic coloring, this \ rectangle can be rolled into a tube which can then be turned into a torus. \ Rolling first in either direction gives the same final result. If one tries \ to do a similar coloring on the Klein Bottle according to the longitude and \ latitude parameters it will lead to the surprising result that in one \ direction the coloring must be symmetric around the axis. The portion next to \ this axis is turned into a Mobius strip.\n\nSubstantial information about \ finite groups can be derived from appropriate colorings of the geometric \ objects under consideration. Choosing an appropriate coloring of the \ Dodecahedron exhibits an inscribed cube (or an inscribed tetrahedron) and \ enables us to investigate which rotations of the Dodecahedron preserve the \ inscribed cube (or the inscribed tetrahedron), showing interesting subgroups. \ Rotations or order five preserve neither of these. Coloring the four \ diagonals of the cube will then show that mappings of a cube onto itself are \ all permutations on four elements. This brings us to the abstract setting of \ permutation groups.\n\nAbstract groups require some care. Here is a setup of \ input lines for obtaining quotients by a subgroup in the group of \ permutations on a set of n elements. In this text user-defined functions are \ not capitalised." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Permutation subgroups", "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"permutation subgroups"], Cell[CellGroupData[{ Cell["\<\ Lists of permutations [includes package, objects, perms, \ comp]\ \>", "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell["<True], Cell["\<\ In this example, we consider permutations on a set with four \ elements \ \>", "Text"], Cell["\<\ n=4; objects=Table[j,{j,n}];\ \>", "Input", AspectRatioFixed->True], Cell["perms=Permutations[objects];", "Input", AspectRatioFixed->True], Cell["\<\ Each permutation is given by listing the images of 1,2,3,4 . This \ group can be visualised by numbering from 1 to 4 the diagonals of a cube (or \ a octahedron) and following the positions of the diagonals after rotating the \ cube in all possible ways. But this will not be done here since it is not the \ purpose of this lesson, and it is not easy to visualise permutation groups \ for bigger n by some geometric action. Permutations are automatically \ ordered and can be recalled by the index [[ ]] . For viewing the \ lexicographic ordering of permutations, leave out the last semicolon. Here \ is one permutation:\ \>", "Text"], Cell[CellGroupData[{ Cell["perms[[9]]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({2, 3, 1, 4}\)], "Output"] }, Closed]], Cell["\<\ The composition law for permutations is given by indirect adressing \ of images\ \>", "Text"], Cell["\<\ comp[perm2_,perm1_]:= \t\tTable[perm2[[perm1[[j]]]],{j,n}]\ \>", "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell["comp[perms[[7]],perms[[7]]]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({1, 2, 3, 4}\)], "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ control if subset is subgroup [includes sub, subGroupQ, gener1, \ generated, subg]\ \>", "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ Selecting a nonempty set of elements in the permutation group\ \>", "Text"], Cell[CellGroupData[{ Cell["indices={1,8,17,24}", "Input", AspectRatioFixed->True], Cell[BoxData[ \({1, 8, 17, 24}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell["sub=Table[perms[[indices[[j]]]],{j,Length[indices]}]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({{1, 2, 3, 4}, {2, 1, 4, 3}, {3, 4, 1, 2}, {4, 3, 2, 1}}\)], "Output"] }, Closed]], Cell["\<\ one has to verify that these permutations form a subgroup by \ checking that the composition law is internal (unit element and inverses come \ for free in the case of finite groups): \ \>", "Text"], Cell["\<\ subGroupQ[sub_]:= \t\tUnion[ \t\t\tFlatten[ \t\t\t\tOuter[ \t\t\t\t\tcomp,sub,sub,1 \t\t\t\t\t] \t\t\t\t,1] \t\t\t]\t==sub\ \>", "Input", AspectRatioFixed->True], Cell["\<\ The Flatten operation has its level specified since permutations \ are themselves lists (with four elements each). The Union operation filters out doubles. The above choice of sub is indeed a subgroup:\ \>", "Text"], Cell[CellGroupData[{ Cell["subGroupQ[sub]", "Input", AspectRatioFixed->True], Cell[BoxData[ \(True\)], "Output"] }, Closed]], Cell["\<\ If this returns False, one can look for the subgroup generated by \ the subset by Nesting Outer[comp[\t]] or finding its FixedPoint : \ \>", "Text"], Cell[BoxData[{ \(gener1[sub_] := Union[sub, \n\t\t\t\tFlatten[Outer[comp, sub, sub, 1]\n\t\t\t\t\t, 1]\n\t\t\t\t]\n\), "\n", \(generated[sub_] := FixedPoint[gener1, sub]\)}], "Input"], Cell["and replacing sub by this generated[sub]", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(subg = \ If[subGroupQ[sub], sub, generated[sub]]\)], "Input"], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(subg\)\" is similar to \ existing symbol \"\!\(sub\)\"."\)], "Message"], Cell[BoxData[ \({{1, 2, 3, 4}, {2, 1, 4, 3}, {3, 4, 1, 2}, {4, 3, 2, 1}}\)], "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ finding cosets and ordering along this partition [includes coset, \ add, l, ordering]\ \>", "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ It is now possible to find all left cosets of this subgroup (if it \ is a subgroup!)\t\ \>", "Text"], Cell["\<\ coset[j_]:=Flatten[ \t\t\tOuter[comp,{perms[[j]]},subg,1] \t\t\t,1]\ \>", "Input", AspectRatioFixed->True], Cell["\<\ which may be repeated to form a table of all cosets. The problem is \ that these are not disjoint. Some cosets contain elements from other cosets, \ but listed in a different order. Therefore, one has to consider only new cosets, which can be added one by one \ by\ \>", "Text"], Cell["\<\ add[j_]:= \tSort[ \t\tFlatten[ \t\t\tTable[ \t\t\t\tPosition[perms,coset[j][[k]]] \t\t\t\t,{k,Length[subg]} \t\t\t\t] \t\t\t] \t\t]\ \>", "Input", AspectRatioFixed->True], Cell["after the original subgroup. Try this out by performing:", "Text"], Cell[CellGroupData[{ Cell["add[7]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({2, 7, 18, 23}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell["perms[[add[7]]]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({{1, 2, 4, 3}, {2, 1, 3, 4}, {3, 4, 2, 1}, {4, 3, 1, 2}}\)], "Output"] }, Closed]], Cell["\<\ Repeating this step, we obtain an ordering of the elements in the \ group which reflects the partition into cosets. We start with the original \ subgroup\ \>", "Text"], Cell[CellGroupData[{ Cell["\<\ l=Flatten[ \t\tTable[Position[perms,subg[[k]]] \t\t\t\t,{k,Length[subg]} \t\t]]\ \>", "Input", AspectRatioFixed->True], Cell[BoxData[ \({1, 8, 17, 24}\)], "Output"] }, Closed]], Cell["and add new cosets", "Text"], Cell[CellGroupData[{ Cell["\<\ ordering= \tDo[ \t\tl=If[ \t\t\tUnion[Join[l,add[j]]]==Union[l],l,Join[l,add[j]] \t\t\t] \t\t,{j,Factorial[n]} \t];l \t\ \>", "Input", AspectRatioFixed->True], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(ordering\)\" is similar \ to existing symbol \"\!\(Ordering\)\"."\)], "Message"], Cell[BoxData[ \({1, 8, 17, 24, 2, 7, 18, 23, 3, 11, 14, 22, 4, 12, 13, 21, 5, 9, 16, 20, 6, 10, 15, 19}\)], "Output"] }, Closed]], Cell[TextData[ "This is somewhat tricky since checking equality of cosets requires sorting \ elements, and the elements in the final list should never be sorted by the \ lexicographic ordering built into Mathematica\:2122. "], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Colorcoding cosets [includes: colors, mult, m, g, grid]", "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell["Now the coloring of elements is straightforward:", "Text"], Cell["\<\ colors[m_]:=Hue[ \tN[ \tFloor[(m-1)/Length[subg]]/Length[perms] Length[subg] \t] \t] \ \>", "Input", AspectRatioFixed->True], Cell["\<\ if the order of elements is taken to be that of the list l :\ \>", "Text"], Cell["\<\ mult[pos1_,pos2_]:= \tFirst[First[Position[perms, \t\tcomp[ perms[[l[[pos1]]]],perms[[l[[pos2]]]] ] \t\t\t\t\t]]]\ \>", "Input", AspectRatioFixed->True], Cell["\<\ m[pos1_,pos2_]:= \tFirst[ \t\tFirst[ \t\t\tPosition[l,mult[pos1,pos2]] \t\t] \t]\ \>", "Input", AspectRatioFixed->True], Cell["Finally all elements are colored ", "Text"], Cell["\<\ g=Table[colors[m[pos1,pos2]],{pos1,Length[l]},{pos2,Length[l]}];\ \>\ ", "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell["\<\ Show[Graphics[ \tRasterArray[g]] \t,AspectRatio->Automatic \t,GridLines->None]\ \>", "Input", AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.0238095 0.0396825 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath % Start of colorimage (RGB) p .02381 .02381 translate .95238 .95238 scale 72 string 24 24 8 [24 0 0 24 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } false 3 Mcolorimage FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 288}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {287, 0}} -> {-0.600126, -0.600126, 0.0878058, \ 0.0878058}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]], Cell["\<\ It may be surprising that we did not check the normality of the \ subgroup. If the subgroup is not normal this RasterArray is messy since \ multiplication of the cosets is not independent of their representing \ elements. The subgroup is normal if and only if the RasterArray shows a neat \ square block structure. In many cases it will be easy to recognise the \ structure of the quotient group by this pattern. The above 6 by 6 block table \ is the multiplication table of permutations on 3 elements.\ \>", "Text"], Cell[TextData[{ "Getting back to the nice case of the 24 permutations on n=4 objects, with \ the Klein four-group its subgroup, all elements are ordered and colored into \ 6 colors by the raster above. The Klein four-group is the single red (Hue \ zero) block in the lower left hand corner. The whole table is really a 24 by \ 24 square table. This fact can be made clear by adding some options while \ rendering the ", StyleBox["Graphics", FontWeight->"Bold"], ": first define a ticks grid and then add the following options in ", StyleBox["Show", FontFamily->"Courier", FontWeight->"Bold"], ": " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(grid = Table[i, {i, 0, Length[perms]}];\)\)], "Input"], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(grid\)\" is similar to \ existing symbol \"\!\(Grid\)\"."\)], "Message"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(Show[Graphics[RasterArray[g]]\n\t\t, GridLines \[Rule] {grid, grid}\n\t\t, AspectRatio \[Rule] Automatic]\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.0238095 0.0396825 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 .5 r .25 Mabswid [ ] 0 setdash .02381 0 m .02381 1 L s .06349 0 m .06349 1 L s .10317 0 m .10317 1 L s .14286 0 m .14286 1 L s .18254 0 m .18254 1 L s .22222 0 m .22222 1 L s .2619 0 m .2619 1 L s .30159 0 m .30159 1 L s .34127 0 m .34127 1 L s .38095 0 m .38095 1 L s .42063 0 m .42063 1 L s .46032 0 m .46032 1 L s .5 0 m .5 1 L s .53968 0 m .53968 1 L s .57937 0 m .57937 1 L s .61905 0 m .61905 1 L s .65873 0 m .65873 1 L s .69841 0 m .69841 1 L s .7381 0 m .7381 1 L s .77778 0 m .77778 1 L s .81746 0 m .81746 1 L s .85714 0 m .85714 1 L s .89683 0 m .89683 1 L s .93651 0 m .93651 1 L s .97619 0 m .97619 1 L s 0 .02381 m 1 .02381 L s 0 .06349 m 1 .06349 L s 0 .10317 m 1 .10317 L s 0 .14286 m 1 .14286 L s 0 .18254 m 1 .18254 L s 0 .22222 m 1 .22222 L s 0 .2619 m 1 .2619 L s 0 .30159 m 1 .30159 L s 0 .34127 m 1 .34127 L s 0 .38095 m 1 .38095 L s 0 .42063 m 1 .42063 L s 0 .46032 m 1 .46032 L s 0 .5 m 1 .5 L s 0 .53968 m 1 .53968 L s 0 .57937 m 1 .57937 L s 0 .61905 m 1 .61905 L s 0 .65873 m 1 .65873 L s 0 .69841 m 1 .69841 L s 0 .7381 m 1 .7381 L s 0 .77778 m 1 .77778 L s 0 .81746 m 1 .81746 L s 0 .85714 m 1 .85714 L s 0 .89683 m 1 .89683 L s 0 .93651 m 1 .93651 L s 0 .97619 m 1 .97619 L s 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath % Start of colorimage (RGB) p .02381 .02381 translate .95238 .95238 scale 72 string 24 24 8 [24 0 0 24 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } false 3 Mcolorimage FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00000000FF0000FF0000FF0000FF FF00FFFF00FFFF00FFFF00FF00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFFFF0000FF0000FF0000FF0000 FFFF00FFFF00FFFF00FFFF00FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00FF00FFFF00FFFF00FFFF00FF 0000FF0000FF0000FF0000FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FFFFFF00FFFF00FFFF00FFFF00 FF0000FF0000FF0000FF000000FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF00 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 FF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF 00FF0000FF0000FF0000FF00FFFF00FFFF00FFFF00FFFF00FF0000FF0000FF0000FF0000 pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 288}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, AnimationDisplayTime->0.353448, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {287, 0}} -> {-0.600126, -0.600126, 0.0878058, \ 0.0878058}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]], Cell["\<\ Another striking result is obtained if one makes a coloring for the \ elements in \"perms\" according to their position in the list \" l \" , by \ replacing Length[subg] by 1 in the coloring function: this means that we \ take a quotient by the one-element subgroup. It is then possible to toggle \ between this 24 by 24 coloring and the quotient blocks obtained above, and \ one sees even better how the elements get grouped into cosets: reddish \ elements in the red coset, yellowish elements in the yellow coset, and so on. \ \ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Original colorcoding elements [ ]", "Subsection", Evaluatable->False, AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell[CellGroupData[{ Cell["Programming", "Subsubsection"], Cell["\<\ originalcolors[m_]:=Hue[(m-1)/Length[perms]] \ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell["\<\ The order of elements is again taken to be that of the list l :\ \ \>", "Text", AnimationDisplayTime->0.353448], Cell["\<\ mult[pos1_,pos2_]:= \tFirst[First[Position[perms, \t\tcomp[ perms[[l[[pos1]]]],perms[[l[[pos2]]]] ] \t\t\t\t\t]]]\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell["\<\ m[pos1_,pos2_]:= \tFirst[ \t\tFirst[ \t\t\tPosition[l,mult[pos1,pos2]] \t\t] \t]\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell["Finally all elements are colored individually", "Text", AnimationDisplayTime->0.353448], Cell["\<\ g1=Table[ \toriginalcolors[m[pos1,pos2]] \t,{pos1,Length[l]},{pos2,Length[l]} \t];\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell[CellGroupData[{ Cell["\<\ Show[Graphics[ \tRasterArray[g1]] \t,AspectRatio->Automatic \t,GridLines\[Rule]{grid,grid}]\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.0238095 0.0396825 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 .5 r .25 Mabswid [ ] 0 setdash .02381 0 m .02381 1 L s .06349 0 m .06349 1 L s .10317 0 m .10317 1 L s .14286 0 m .14286 1 L s .18254 0 m .18254 1 L s .22222 0 m .22222 1 L s .2619 0 m .2619 1 L s .30159 0 m .30159 1 L s .34127 0 m .34127 1 L s .38095 0 m .38095 1 L s .42063 0 m .42063 1 L s .46032 0 m .46032 1 L s .5 0 m .5 1 L s .53968 0 m .53968 1 L s .57937 0 m .57937 1 L s .61905 0 m .61905 1 L s .65873 0 m .65873 1 L s .69841 0 m .69841 1 L s .7381 0 m .7381 1 L s .77778 0 m .77778 1 L s .81746 0 m .81746 1 L s .85714 0 m .85714 1 L s .89683 0 m .89683 1 L s .93651 0 m .93651 1 L s .97619 0 m .97619 1 L s 0 .02381 m 1 .02381 L s 0 .06349 m 1 .06349 L s 0 .10317 m 1 .10317 L s 0 .14286 m 1 .14286 L s 0 .18254 m 1 .18254 L s 0 .22222 m 1 .22222 L s 0 .2619 m 1 .2619 L s 0 .30159 m 1 .30159 L s 0 .34127 m 1 .34127 L s 0 .38095 m 1 .38095 L s 0 .42063 m 1 .42063 L s 0 .46032 m 1 .46032 L s 0 .5 m 1 .5 L s 0 .53968 m 1 .53968 L s 0 .57937 m 1 .57937 L s 0 .61905 m 1 .61905 L s 0 .65873 m 1 .65873 L s 0 .69841 m 1 .69841 L s 0 .7381 m 1 .7381 L s 0 .77778 m 1 .77778 L s 0 .81746 m 1 .81746 L s 0 .85714 m 1 .85714 L s 0 .89683 m 1 .89683 L s 0 .93651 m 1 .93651 L s 0 .97619 m 1 .97619 L s 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath % Start of colorimage (RGB) p .02381 .02381 translate .95238 .95238 scale 72 string 24 24 8 [24 0 0 24 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } false 3 Mcolorimage FF0000FF4000FF8000FFC000FFFF00C0FF0080FF0040FF0000FF0000FF4000FF8000FFC0 00FFFF00C0FF0080FF0040FF0000FF4000FF8000FFC000FFFF00FFFF00C0FF0080FF0040 FF4000FF0000FFC000FF8000C0FF00FFFF0040FF0080FF0000FF4000FF0000FFC000FF80 00C0FF00FFFF0040FF0080FF4000FF0000FFC000FF8000FFFF00C0FF00FFFF0040FF0080 FF8000FFC000FF0000FF400080FF0040FF00FFFF00C0FF0000FF8000FFC000FF0000FF40 0080FF0040FF00FFFF00C0FF8000FFC000FF0000FF4000FFFF0080FF0040FF00FFFF00C0 FFC000FF8000FF4000FF000040FF0080FF00C0FF00FFFF0000FFC000FF8000FF4000FF00 0040FF0080FF00C0FF00FFFFC000FF8000FF4000FF0000FFFF0040FF0080FF00C0FF00FF FFFF00C0FF0040FF0080FF00FF0000FF4000FFC000FF80000000FF4000FFC000FF8000FF FF00FFFF00C0FF0040FF008000FF0000FF4000FFC000FF8000FFFF00C0FF0040FF0080FF C0FF00FFFF0080FF0040FF00FF4000FF0000FF8000FFC0004000FF0000FF8000FFC000FF FF00C0FF00FFFF0080FF004000FF4000FF0000FF8000FFC000C0FF00FFFF0080FF0040FF 80FF0040FF00C0FF00FFFF00FF8000FFC000FF4000FF00008000FFC000FF4000FF0000FF FF0080FF0040FF00C0FF00FF00FF8000FFC000FF4000FF000080FF0040FF00C0FF00FFFF 40FF0080FF00FFFF00C0FF00FFC000FF8000FF0000FF4000C000FF8000FF0000FF4000FF FF0040FF0080FF00FFFF00C000FFC000FF8000FF0000FF400040FF0080FF00FFFF00C0FF 00FF0000FF8000FF4000FFC000FFFF0080FF00C0FF0040FFFF0000FF8000FF4000FFC000 FFFF0080FF00C0FF0040FF00FF00FFFF0080FF00C0FF00400000FF8000FF4000FFC000FF 00FF4000FFC000FF0000FF8000C0FF0040FF00FFFF0080FFFF4000FFC000FF0000FF8000 C0FF0040FF00FFFF0080FF00FF00C0FF0040FF00FFFF00804000FFC000FF0000FF8000FF 00FF8000FF0000FFC000FF400080FF00FFFF0040FF00C0FFFF8000FF0000FFC000FF4000 80FF00FFFF0040FF00C0FF00FF0080FF00FFFF0040FF00C08000FF0000FFC000FF4000FF 00FFC000FF4000FF8000FF000040FF00C0FF0080FF00FFFFFFC000FF4000FF8000FF0000 40FF00C0FF0080FF00FFFF00FF0040FF00C0FF0080FF00FFC000FF4000FF8000FF0000FF 00FFFF0080FF0040FF00C0FF00FF0000FF8000FFC000FF40FF00FFFF0080FF0040FF00C0 0000FF8000FFC000FF4000FFFF0000FF8000FFC000FF4000FFFF0080FF0040FF00C0FF00 00C0FF0040FF0080FF00FFFF00FF4000FFC000FF8000FF00FF00C0FF0040FF0080FF00FF 4000FFC000FF8000FF0000FFFF4000FFC000FF8000FF0000C0FF0040FF0080FF00FFFF00 0080FF00FFFF00C0FF0040FF00FF8000FF0000FF4000FFC0FF0080FF00FFFF00C0FF0040 8000FF0000FF4000FFC000FFFF8000FF0000FF4000FFC00080FF00FFFF00C0FF0040FF00 0040FF00C0FF00FFFF0080FF00FFC000FF4000FF0000FF80FF0040FF00C0FF00FFFF0080 C000FF4000FF0000FF8000FFFFC000FF4000FF0000FF800040FF00C0FF00FFFF0080FF00 0000FFC000FF4000FF8000FFFF00FFFF0040FF00C0FF0080FFFF0040FF00C0FF0080FF00 FF0000FFC000FF4000FF800000FFFF0040FF00C0FF0080FF00FF0000FFC000FF4000FF80 4000FF8000FF0000FFC000FFFF00C0FF0080FF00FFFF0040C0FF0080FF00FFFF0040FF00 FF4000FF8000FF0000FFC00000C0FF0080FF00FFFF0040FF00FF4000FF8000FF0000FFC0 8000FF4000FFC000FF0000FFFF0080FF00C0FF0040FF00FF80FF00C0FF0040FF00FFFF00 FF8000FF4000FFC000FF00000080FF00C0FF0040FF00FFFF00FF8000FF4000FFC000FF00 C000FF0000FF8000FF4000FFFF0040FF00FFFF0080FF00C040FF00FFFF0080FF00C0FF00 FFC000FF0000FF8000FF40000040FF00FFFF0080FF00C0FF00FFC000FF0000FF8000FF40 FF00FFFF0040FF0080FF00C00000FFC000FF8000FF4000FF00FFFF0040FF0080FF00C0FF 00FF0000FFC000FF8000FF40FFFF0040FF0080FF00C0FF00FF0000FFC000FF8000FF4000 FF00C0FF0080FF0040FF00FF4000FF8000FFC000FF0000FF00C0FF0080FF0040FF00FFFF 00FF4000FF8000FFC000FF00C0FF0080FF0040FF00FFFF00FF4000FF8000FFC000FF0000 FF0080FF00C0FF00FFFF00408000FF4000FF0000FFC000FF0080FF00C0FF00FFFF0040FF 00FF8000FF4000FF0000FFC080FF00C0FF00FFFF0040FF00FF8000FF4000FF0000FFC000 FF0040FF00FFFF00C0FF0080C000FF0000FF4000FF8000FF0040FF00FFFF00C0FF0080FF 00FFC000FF0000FF4000FF8040FF00FFFF00C0FF0080FF00FFC000FF0000FF4000FF8000 pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 288}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, AnimationDisplayTime->0.353448, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {287, 0}} -> {-0.600126, -0.600126, 0.0878058, \ 0.0878058}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]], Cell["\<\ The best result is seen when we toggle between this last picture \ and the one with the quotient: it is clear which elements fall in which \ coset.\ \>", "Text", AnimationDisplayTime->0.353448], Cell["g=Table[colors[m[pos1,pos2]],{pos1,1},{pos2,Length[l]}];", "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell["\<\ Show[Graphics[ \tRasterArray[g]] \t,AspectRatio->Automatic \t,GridLines->None]\ \>", "Input", AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .04167 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.000992063 0.0396825 [ [ 0 0 0 0 ] [ 1 .04167 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 .04167 L 0 .04167 L closepath clip newpath % Start of colorimage (RGB) p .02381 .00099 translate .95238 .03968 scale 72 string 24 1 8 [24 0 0 1 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } false 3 Mcolorimage FF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FF00 00FFFF00FFFF00FFFF00FFFF0000FF0000FF0000FF0000FFFF00FFFF00FFFF00FFFF00FF pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 12}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {11, 0}} -> {-1.69896, -0.0250053, 0.0954632, \ 0.0954632}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["A subgroup which is not normal [ ]", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell["\<\ That we do not get a neat block structure for all choices of \ subgroups is shown by trying out the above inputs starting with\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(indices = {1, 2, 7, 8}\)], "Input"], Cell[BoxData[ \({1, 2, 7, 8}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell["sub=Table[perms[[indices[[j]]]],{j,Length[indices]}]", "Input", AspectRatioFixed->True], Cell[BoxData[ \({{1, 2, 3, 4}, {1, 2, 4, 3}, {2, 1, 3, 4}, {2, 1, 4, 3}}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ \(subg = \ If[subGroupQ[sub], sub, generated[sub]]\)], "Input"], Cell[BoxData[ \({{1, 2, 3, 4}, {1, 2, 4, 3}, {2, 1, 3, 4}, {2, 1, 4, 3}}\)], "Output"] }, Closed]], Cell["\<\ which defines a subgroup which is not normal. The block structure \ gets ruined in the sense that some square 4 x 4 blocks are replaced by four \ line stripes. \ \>", "Text"], Cell[CellGroupData[{ Cell["\<\ l=Flatten[ \t\tTable[Position[perms,subg[[k]]] \t\t\t\t,{k,Length[subg]} \t\t]]\ \>", "Input", AspectRatioFixed->True], Cell[BoxData[ \({1, 2, 7, 8}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell["\<\ ordering= \tDo[ \t\tl=If[ \t\t\tUnion[Join[l,add[j]]]==Union[l],l,Join[l,add[j]] \t\t\t] \t\t,{j,Factorial[n]} \t];l \t\ \>", "Input", AspectRatioFixed->True], Cell[BoxData[ \({1, 2, 7, 8, 3, 4, 13, 14, 5, 6, 19, 20, 9, 10, 15, 16, 11, 12, 21, 22, 17, 18, 23, 24}\)], "Output"] }, Closed]], Cell["\<\ g1=Table[ \toriginalcolors[m[pos1,pos2]] \t,{pos1,Length[l]},{pos2,Length[l]} \t];\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell[CellGroupData[{ Cell["\<\ Show[Graphics[ \tRasterArray[g1]] \t,AspectRatio->Automatic \t,GridLines\[Rule]{grid,grid}]\ \>", "Input", AspectRatioFixed->True, AnimationDisplayTime->0.353448], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.0238095 0.0396825 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 .5 r .25 Mabswid [ ] 0 setdash .02381 0 m .02381 1 L s .06349 0 m .06349 1 L s .10317 0 m .10317 1 L s .14286 0 m .14286 1 L s .18254 0 m .18254 1 L s .22222 0 m .22222 1 L s .2619 0 m .2619 1 L s .30159 0 m .30159 1 L s .34127 0 m .34127 1 L s .38095 0 m .38095 1 L s .42063 0 m .42063 1 L s .46032 0 m .46032 1 L s .5 0 m .5 1 L s .53968 0 m .53968 1 L s .57937 0 m .57937 1 L s .61905 0 m .61905 1 L s .65873 0 m .65873 1 L s .69841 0 m .69841 1 L s .7381 0 m .7381 1 L s .77778 0 m .77778 1 L s .81746 0 m .81746 1 L s .85714 0 m .85714 1 L s .89683 0 m .89683 1 L s .93651 0 m .93651 1 L s .97619 0 m .97619 1 L s 0 .02381 m 1 .02381 L s 0 .06349 m 1 .06349 L s 0 .10317 m 1 .10317 L s 0 .14286 m 1 .14286 L s 0 .18254 m 1 .18254 L s 0 .22222 m 1 .22222 L s 0 .2619 m 1 .2619 L s 0 .30159 m 1 .30159 L s 0 .34127 m 1 .34127 L s 0 .38095 m 1 .38095 L s 0 .42063 m 1 .42063 L s 0 .46032 m 1 .46032 L s 0 .5 m 1 .5 L s 0 .53968 m 1 .53968 L s 0 .57937 m 1 .57937 L s 0 .61905 m 1 .61905 L s 0 .65873 m 1 .65873 L s 0 .69841 m 1 .69841 L s 0 .7381 m 1 .7381 L s 0 .77778 m 1 .77778 L s 0 .81746 m 1 .81746 L s 0 .85714 m 1 .85714 L s 0 .89683 m 1 .89683 L s 0 .93651 m 1 .93651 L s 0 .97619 m 1 .97619 L s 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath % Start of colorimage (RGB) p .02381 .02381 translate .95238 .95238 scale 72 string 24 24 8 [24 0 0 24 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } false 3 Mcolorimage FF0000FF4000FF8000FFC000FFFF00C0FF0080FF0040FF0000FF0000FF4000FF8000FFC0 00FFFF00C0FF0080FF0040FF0000FF4000FF8000FFC000FFFF00FFFF00C0FF0080FF0040 FF4000FF0000FFC000FF800000FF0000FF4000FF8000FFC0FFFF00C0FF0080FF0040FF00 0000FF4000FF8000FFC000FF00FFFF00C0FF0080FF0040FFFF0080FF0040FF00FFFF00C0 FF8000FFC000FF0000FF400000FFFF00C0FF0080FF0040FF0000FF4000FF8000FFC000FF FFFF00C0FF0080FF0040FF0000FF0000FF4000FF8000FFC0FF00C0FF00FFFF0040FF0080 FFC000FF8000FF4000FF00000000FF4000FF8000FFC000FF00FFFF00C0FF0080FF0040FF 00FF0000FF4000FF8000FFC0FFFF00C0FF0080FF0040FF00FF0040FF0080FF00C0FF00FF FFFF00C0FF0080FF0040FF00FF0000FF4000FF8000FFC00000FF4000FF0000FFC000FF80 0080FF0040FF00FFFF00C0FFFF00FFFF00C0FF0080FF00400000FF4000FF8000FFC000FF C0FF00FFFF0040FF0080FF0000FF4000FF0000FFC000FF80FF0000FF4000FF8000FFC000 FF00FFFF00C0FF0080FF00400080FF0040FF00FFFF00C0FF8000FFC000FF0000FF4000FF 80FF0040FF00FFFF00C0FF000080FF0040FF00FFFF00C0FFFF00FFFF00C0FF0080FF0040 FF0000FF4000FF8000FFC00000FF4000FF0000FFC000FF804000FF0000FFC000FF8000FF 40FF0080FF00C0FF00FFFF00FF00FFFF00C0FF0080FF00400080FF0040FF00FFFF00C0FF 00FF4000FF0000FFC000FF80FF0000FF4000FF8000FFC000C000FF8000FF4000FF0000FF 00FF0000FF4000FF8000FFC0FF4000FF0000FFC000FF8000C0FF00FFFF0040FF0080FF00 8000FFC000FF0000FF4000FFFF0080FF0040FF00FFFF00C000FFFF00C0FF0080FF0040FF 00FF4000FF0000FFC000FF80C0FF00FFFF0040FF0080FF00FF4000FF0000FFC000FF8000 FF0080FF0040FF00FFFF00C08000FFC000FF0000FF4000FF0080FF0040FF00FFFF00C0FF 00FF8000FFC000FF0000FF408000FFC000FF0000FF4000FFFF0080FF0040FF00FFFF00C0 FF4000FF0000FFC000FF8000C0FF00FFFF0040FF0080FF0000C0FF00FFFF0040FF0080FF 00FFC000FF8000FF4000FF00FF0080FF0040FF00FFFF00C08000FFC000FF0000FF4000FF C0FF00FFFF0040FF0080FF00FF4000FF0000FFC000FF80000040FF0080FF00C0FF00FFFF 00FFFF00C0FF0080FF0040FFFF8000FFC000FF0000FF40004000FF0000FFC000FF8000FF 80FF0040FF00FFFF00C0FF00FF00C0FF00FFFF0040FF008000FF0000FF4000FF8000FFC0 00C0FF00FFFF0040FF0080FF4000FF0000FFC000FF8000FFFF8000FFC000FF0000FF4000 FF00C0FF00FFFF0040FF008080FF0040FF00FFFF00C0FF0000FF8000FFC000FF0000FF40 0080FF0040FF00FFFF00C0FF80FF0040FF00FFFF00C0FF00FF00C0FF00FFFF0040FF0080 FF8000FFC000FF0000FF40004000FF0000FFC000FF8000FF00FF4000FF0000FFC000FF80 0040FF0080FF00C0FF00FFFFFF00C0FF00FFFF0040FF008080FF0040FF00FFFF00C0FF00 4000FF0000FFC000FF8000FFFF8000FFC000FF0000FF400000FFC000FF8000FF4000FF00 0000FF4000FF8000FFC000FFFFC000FF8000FF4000FF000000C0FF00FFFF0040FF0080FF 00FF8000FFC000FF0000FF40FF0040FF0080FF00C0FF00FFFFFF00C0FF0080FF0040FF00 4000FF0000FFC000FF8000FF00C0FF00FFFF0040FF0080FFFFC000FF8000FF4000FF0000 FF0040FF0080FF00C0FF00FF00FF8000FFC000FF0000FF4080FF0040FF00FFFF00C0FF00 8000FFC000FF0000FF4000FF00FF8000FFC000FF0000FF40FF0040FF0080FF00C0FF00FF FFC000FF8000FF4000FF000000C0FF00FFFF0040FF0080FFC0FF00FFFF0040FF0080FF00 C000FF8000FF4000FF0000FFFF0040FF0080FF00C0FF00FF00FF8000FFC000FF0000FF40 00C0FF00FFFF0040FF0080FFFFC000FF8000FF4000FF000040FF0080FF00C0FF00FFFF00 FF00FFFF00C0FF0080FF004040FF0080FF00C0FF00FFFF000040FF0080FF00C0FF00FFFF 00FFC000FF8000FF4000FF00C000FF8000FF4000FF0000FFFF0000FF4000FF8000FFC000 FF00C0FF00FFFF0040FF00800040FF0080FF00C0FF00FFFF40FF0080FF00C0FF00FFFF00 C000FF8000FF4000FF0000FF00FFC000FF8000FF4000FF00FF8000FFC000FF0000FF4000 FF0080FF0040FF00FFFF00C000FFC000FF8000FF4000FF00C000FF8000FF4000FF0000FF 40FF0080FF00C0FF00FFFF000040FF0080FF00C0FF00FFFFFF4000FF0000FFC000FF8000 FF0040FF0080FF00C0FF00FFC000FF8000FF4000FF0000FF00FFC000FF8000FF4000FF00 0040FF0080FF00C0FF00FFFF40FF0080FF00C0FF00FFFF00FFC000FF8000FF4000FF0000 pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 288}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {287, 0}} -> {-0.600126, -0.600126, 0.0878058, \ 0.0878058}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]], Cell["\<\ This reflects that multiplication is faithful on cosets only in one \ of the two possible orders, depending on which way cosets were defined: as \ left cosets or as right cosets. The theory of these homogeneous spaces is not \ standard in the algebra curriculum. \ \>", "Text"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["Grayscoding [includes: colors, gbw]", "Subsection"], Cell["\<\ On a black and white screen or for the sake of printing purposes, \ the colors can be replaced by corresponding GrayLevel[ ] s) .\ \>", "Text"], Cell["\<\ Clear[colors]; colors[m_]:=GrayLevel[ \tN[ \tFloor[(m-1)/Length[subg]]/Length[perms] Length[subg] \t] \t] \ \>", "Input", AspectRatioFixed->True], Cell["\<\ Multiplication is then done according to the following table. The \ subgroup is the darkest block in the lower left corner:\ \>", "Text"], Cell["\<\ gbw=Table[ \tcolors[m[pos1,pos2]],{pos1,Length[l]},{pos2,Length[l]} \t];\ \>", "Input", AspectRatioFixed->True], Cell[CellGroupData[{ Cell["\<\ Show[Graphics[ \tRasterArray[gbw]] \t,AspectRatio->Automatic \t,GridLines->{grid,grid}]\ \>", "Input", AspectRatioFixed->True], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.0396825 0.0238095 0.0396825 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 .5 r .25 Mabswid [ ] 0 setdash .02381 0 m .02381 1 L s .06349 0 m .06349 1 L s .10317 0 m .10317 1 L s .14286 0 m .14286 1 L s .18254 0 m .18254 1 L s .22222 0 m .22222 1 L s .2619 0 m .2619 1 L s .30159 0 m .30159 1 L s .34127 0 m .34127 1 L s .38095 0 m .38095 1 L s .42063 0 m .42063 1 L s .46032 0 m .46032 1 L s .5 0 m .5 1 L s .53968 0 m .53968 1 L s .57937 0 m .57937 1 L s .61905 0 m .61905 1 L s .65873 0 m .65873 1 L s .69841 0 m .69841 1 L s .7381 0 m .7381 1 L s .77778 0 m .77778 1 L s .81746 0 m .81746 1 L s .85714 0 m .85714 1 L s .89683 0 m .89683 1 L s .93651 0 m .93651 1 L s .97619 0 m .97619 1 L s 0 .02381 m 1 .02381 L s 0 .06349 m 1 .06349 L s 0 .10317 m 1 .10317 L s 0 .14286 m 1 .14286 L s 0 .18254 m 1 .18254 L s 0 .22222 m 1 .22222 L s 0 .2619 m 1 .2619 L s 0 .30159 m 1 .30159 L s 0 .34127 m 1 .34127 L s 0 .38095 m 1 .38095 L s 0 .42063 m 1 .42063 L s 0 .46032 m 1 .46032 L s 0 .5 m 1 .5 L s 0 .53968 m 1 .53968 L s 0 .57937 m 1 .57937 L s 0 .61905 m 1 .61905 L s 0 .65873 m 1 .65873 L s 0 .69841 m 1 .69841 L s 0 .7381 m 1 .7381 L s 0 .77778 m 1 .77778 L s 0 .81746 m 1 .81746 L s 0 .85714 m 1 .85714 L s 0 .89683 m 1 .89683 L s 0 .93651 m 1 .93651 L s 0 .97619 m 1 .97619 L s 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath % Start of gray image p .02381 .02381 translate .95238 .95238 scale 24 string 24 24 8 [24 0 0 24 0 0] { \tcurrentfile \t1 index \treadhexstring \tpop } Mimage 000000002A2A2A2A5555555580808080AAAAAAAAD5D5D5D5 00000000555555552A2A2A2AAAAAAAAA80808080D5D5D5D5 0000000080808080AAAAAAAA2A2A2A2A55555555D5D5D5D5 00000000AAAAAAAA80808080555555552A2A2A2AD5D5D5D5 2A2A2A2A000000005555555580808080D5D5D5D5AAAAAAAA 2A2A2A2A5555555500000000D5D5D5D580808080AAAAAAAA 2A2A2A2A80808080D5D5D5D50000000055555555AAAAAAAA 2A2A2A2AD5D5D5D5808080805555555500000000AAAAAAAA 55555555000000002A2A2A2AAAAAAAAAD5D5D5D580808080 555555552A2A2A2A00000000D5D5D5D5AAAAAAAA80808080 55555555AAAAAAAAD5D5D5D5000000002A2A2A2A80808080 55555555D5D5D5D5AAAAAAAA2A2A2A2A0000000080808080 8080808000000000AAAAAAAA2A2A2A2AD5D5D5D555555555 80808080AAAAAAAA00000000D5D5D5D52A2A2A2A55555555 808080802A2A2A2AD5D5D5D500000000AAAAAAAA55555555 80808080D5D5D5D52A2A2A2AAAAAAAAA0000000055555555 AAAAAAAA000000008080808055555555D5D5D5D52A2A2A2A AAAAAAAA8080808000000000D5D5D5D5555555552A2A2A2A AAAAAAAA55555555D5D5D5D500000000808080802A2A2A2A AAAAAAAAD5D5D5D55555555580808080000000002A2A2A2A D5D5D5D52A2A2A2A8080808055555555AAAAAAAA00000000 D5D5D5D5808080802A2A2A2AAAAAAAAA5555555500000000 D5D5D5D555555555AAAAAAAA2A2A2A2A8080808000000000 D5D5D5D5AAAAAAAA55555555808080802A2A2A2A00000000 pop P % End of image % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 288}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 287}, {287, 0}} -> {-0.600126, -0.600126, 0.0878058, \ 0.0878058}}], Cell[BoxData[ TagBox[\(\[SkeletonIndicator] Graphics \[SkeletonIndicator]\), False, Editable->False]], "Output"] }, Closed]], Cell["\<\ It is also possible to make up a multiplication table with all \ group elements named (with colored text) in a similar way according to the \ same partition into cosets. This however will put restrictions on the size of \ the groups under consideration and a lot of formatting has to be done to \ avoid misaligned tables. Misaligned tables are likely to occur if different \ string lengths are involved in the naming of group elements.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Recognition of this quotient [includes: order]", "Subsection"], Cell["\<\ The above reasoning can handle rather large groups. If the subgroup \ is sufficiently large the quotient has a small number of elements and brute \ application of all possible permutations on the elements of known groups will \ yield a group that is similar to the one obtained above. But this is \ certainly not the fastest way to proceed in all cases.\ \>", "Text"], Cell["\<\ It may not be easy to see what the structure of a quotient is in \ the case of a large group with a small subgroup. Pictures get bad if the \ size of the blocks gets down to a few pixels. The number of blocks will be \ large and the coloring will be somewhat hazy. Different techniques will be \ necessary to recognize the structure of the quotient. One technique is to consider the order of the elements. The order of an \ element in a group is defined by the number of elements in the subgroup \ generated by it:\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(order[element_] := \ Length[generated[{element}\ ]]\)], "Input"], Cell[BoxData[ \(General::"spell1" \(\(:\)\(\ \)\) "Possible spelling error: new symbol name \"\!\(order\)\" is similar to \ existing symbol \"\!\(Order\)\"."\)], "Message"] }, Closed]], Cell["\<\ If the orders of elements do not agree with the order of the \ elements a known group it is impossible that this known group is isomorphic \ to the quotient obtained above. If permutations are applied to the elements, \ it will be faster to apply only those permutations that mix the elements of \ same order.\ \>", "Text"], Cell["\<\ One more possibility is to take a subgroup of the quotient and try \ to get some information by repeating the quotient operation, thus mimicking \ the theory of solvable groups. A cascade of quotients may give the Jordan \ decomposition. One has to be careful to start building cosets from the \ smallest subgroup on. An animation running over successive quotients is very \ instructive.\ \>", "Text"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Dihedral and other groups", "Section", CellTags->"dihedral"], Cell[TextData[ "If we want to consider a quotient of a subgroup of all permutations it is \ sufficient to replace \[OpenCurlyDoubleQuote]perms\[CloseCurlyDoubleQuote] by \ permsNew which denotes a selection of it according to some Boolean condition, \ before repeating the above inputs."], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(permsNew = \ Select[perms, condition\ ]\)], "Input", Evaluatable->False], Cell[BoxData[ \({}\)], "Output"] }, Open ]], Cell[TextData[ "If we have a group defined in another way it is sufficient to replace in the \ above input lines \[OpenCurlyDoubleQuote]perms\[CloseCurlyDoubleQuote] by the \ list of elements in the group and \[OpenCurlyDoubleQuote]comp\ \[CloseCurlyDoubleQuote] by the law of composition under consideration. For \ instance we can take a dihedral group, i.e. the group of mappings of a \ regular n -gon generated by its rotations and a reflection, together with its \ composition law:"], "Text"], Cell[BoxData[{ \(diGroup[n_] := Flatten[Table[{j, refl}, {j, 0, n - 1}, {refl, 0, 1}], 1]\n\), \(comp[{j_, refl1_}, {k_, refl2_}] := \n\t\t\t\t If[refl1 == 0, {Mod[j + k, n], refl2}\n \t\t\t\t\t\t, {Mod[j - k, n], Mod[refl1 + refl2, 2]}\n\t\t\t\t]\)}], "Input", Evaluatable->False], Cell["\<\ In case we have all movements of a regular octogon, we specify\ \>", "Text"], Cell[BoxData[ \(n = 8; \ \nperms = diGroup[n]; \)], "Input", Evaluatable->False], Cell["together with some subset", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sub = {{4, 0}, {4, 1}}\)], "Input", Evaluatable->False], Cell[BoxData[ \({{4, 0}, {4, 1}}\)], "Output"] }, Open ]], Cell["\<\ and continue inputs to generate a (hopefully normal) subgroup and \ obtain the quotient. \ \>", "Text"], Cell[TextData[{ "It is even easier if we have a commutative group such as the group of \ units (invertible elements) modulo some fixed positive number n . This is \ easy to write down since ", StyleBox["Mathematica", FontSlant->"Italic"], " has very fast computations modulo n built-in.\nThe only change in the \ above inputs will be that the Flatten operations are not restricted to first \ level since the elements of the group correspond to atoms and no double \ bracketing is necessary for writing objects such as sub, coset[ ], etc." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Conclusions", "Subsubtitle"], Cell["\<\ The set of inputs developed in the examples above could be \ organised into a Package form if sufficient interest develops. Here we begin \ by grouping inputs as separate functions, such as \ \>", "Text"], Cell[BoxData[{ RowBox[{ RowBox[{\(subgroup[group_, indices_]\), ":=", "\n", StyleBox["or", FontFamily->"Times", FontWeight->"Plain"]}], "\t\t"}], \(subgroup[group_, subset_] := \)}], "Input", Evaluatable->False], Cell[BoxData[ \(\(ordering[group_, subset_] := \)\)], "Input", Evaluatable->False], Cell["in an appropriate context format.", "Text"], Cell[TextData[{ "It can further be extended into a full electronic abstract algebra course, \ but I would prefer such a project to be realised by specialists in the field. \ They have at their disposal a lot of theorems which can be implemented. \nIf \ such a project gets under way, the authors will find hints for programming in \ the above input lines.\n\nPersonally, I would refrain from starting such a \ program for several reasons. First, special-purpose packages for doing \ abstract algebra in groups already exist and it is not easy to surpass their \ quality without sustained input of manpower over a longer period of time. \ Secondly, creating too many special purpose packages may end up hiding the \ main advantage of Mathematica\:2122 , i.e. its universal usability. A package \ may be very useful, but in many cases is optimization makes it rigid and less \ straightforward to understand and to modify than would be a step-by-step \ developed lesson such as the one above. Last but not least: most of the fun \ resides in doing the exercise of getting mathematical ideas organised in the \ right way so that Mathematica\:2122 can handle them. \n\nThis is also what \ we finally hope to achieve with our students: that they understand the \ mathematics sufficiently well in order to develop the setup and make \ discoveries for themselves, rather than substituting variables for blank \ spaces in some ready-made function or package.\n\nThe unifying idea behind \ the implementations of different mathematical concepts is to offer to the \ mathematics learners an environment which is highly visual, but which does \ not hide the mathematical content of what is presented. Having at our \ disposal such techniques will\n", StyleBox["\[Bullet] ", FontFamily->"Symbol"], "enhance interest in mathematics as a topic\n", StyleBox["\[Bullet] ", FontFamily->"Symbol"], "improve retention, and speed up the learning curve\n", StyleBox["\[Bullet] ", FontFamily->"Symbol"], "facilitate the task of the teacher.\nIt seems essential to realise this in \ a short term given the increasingly difficult situation of mathematics in \ education in many countries.\n" }], "Text"] }, Closed]] }, Open ]] }, FrontEndVersion->"5.0 for Macintosh", ScreenRectangle->{{0, 1115}, {0, 746}}, WindowToolbars->{}, WindowSize->{617, 670}, WindowMargins->{{36, Automatic}, {Automatic, 1}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, CharacterEncoding->"MacintoshAutomaticEncoding", Magnification->1 ] (******************************************************************* 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->{ "permutation subgroups"->{ Cell[5078, 118, 125, 3, 39, "Section", Evaluatable->False, CellTags->"permutation subgroups"]}, "dihedral"->{ Cell[230417, 4275, 68, 1, 69, "Section", CellTags->"dihedral"]} } *) (*CellTagsIndex CellTagsIndex->{ {"permutation subgroups", 236685, 4441}, {"dihedral", 236813, 4445} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 168, 5, 112, "Subtitle"], Cell[1947, 60, 195, 7, 90, "Subsubtitle"], Cell[CellGroupData[{ Cell[2167, 71, 31, 0, 69, "Section"], Cell[2201, 73, 2840, 40, 554, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[5078, 118, 125, 3, 39, "Section", Evaluatable->False, CellTags->"permutation subgroups"], Cell[CellGroupData[{ Cell[5228, 125, 142, 5, 38, "Subsection", Evaluatable->False], Cell[5373, 132, 71, 1, 27, "Input"], Cell[5447, 135, 96, 3, 32, "Text"], Cell[5546, 140, 79, 4, 42, "Input"], Cell[5628, 146, 71, 1, 27, "Input"], Cell[5702, 149, 646, 10, 122, "Text"], Cell[CellGroupData[{ Cell[6373, 163, 53, 1, 27, "Input"], Cell[6429, 166, 46, 1, 27, "Output"] }, Closed]], Cell[6490, 170, 103, 3, 32, "Text"], Cell[6596, 175, 109, 4, 42, "Input"], Cell[CellGroupData[{ Cell[6730, 183, 70, 1, 27, "Input"], Cell[6803, 186, 46, 1, 27, "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[6898, 193, 160, 5, 48, "Subsection", Evaluatable->False], Cell[7061, 200, 88, 3, 32, "Text"], Cell[CellGroupData[{ Cell[7174, 207, 62, 1, 27, "Input"], Cell[7239, 210, 48, 1, 27, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[7324, 216, 95, 1, 27, "Input"], Cell[7422, 219, 90, 1, 27, "Output"] }, Closed]], Cell[7527, 223, 207, 4, 50, "Text"], Cell[7737, 229, 174, 10, 132, "Input"], Cell[7914, 241, 227, 5, 68, "Text"], Cell[CellGroupData[{ Cell[8166, 250, 57, 1, 27, "Input"], Cell[8226, 253, 38, 1, 27, "Output"] }, Closed]], Cell[8279, 257, 164, 4, 50, "Text"], Cell[8446, 263, 210, 4, 107, "Input"], Cell[8659, 269, 57, 0, 32, "Text"], Cell[CellGroupData[{ Cell[8741, 273, 81, 1, 27, "Input"], Cell[8825, 276, 180, 3, 35, "Message"], Cell[9008, 281, 90, 1, 27, "Output"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[9147, 288, 164, 5, 48, "Subsection", Evaluatable->False], Cell[9314, 295, 111, 3, 32, "Text"], Cell[9428, 300, 118, 5, 57, "Input"], Cell[9549, 307, 289, 6, 68, "Text"], Cell[9841, 315, 182, 11, 147, "Input"], Cell[10026, 328, 72, 0, 32, "Text"], Cell[CellGroupData[{ Cell[10123, 332, 49, 1, 27, "Input"], Cell[10175, 335, 48, 1, 27, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[10260, 341, 58, 1, 27, "Input"], Cell[10321, 344, 90, 1, 27, "Output"] }, Closed]], Cell[10426, 348, 177, 4, 50, "Text"], Cell[CellGroupData[{ Cell[10628, 356, 130, 6, 72, "Input"], Cell[10761, 364, 48, 1, 27, "Output"] }, Closed]], Cell[10824, 368, 34, 0, 32, "Text"], Cell[CellGroupData[{ Cell[10883, 372, 176, 10, 132, "Input"], Cell[11062, 384, 189, 3, 35, "Message"], Cell[11254, 389, 128, 2, 43, "Output"] }, Closed]], Cell[11397, 394, 234, 3, 50, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11668, 402, 125, 2, 30, "Subsection", Evaluatable->False], Cell[11796, 406, 64, 0, 32, "Text"], Cell[11863, 408, 136, 8, 102, "Input"], Cell[12002, 418, 89, 3, 32, "Text"], Cell[12094, 423, 165, 6, 72, "Input"], Cell[12262, 431, 131, 8, 102, "Input"], Cell[12396, 441, 49, 0, 32, "Text"], Cell[12448, 443, 117, 4, 27, "Input"], Cell[CellGroupData[{ Cell[12590, 451, 129, 6, 72, "Input"], Cell[12722, 459, 20315, 301, 296, 4284, 98, "GraphicsData", "PostScript", \ "Graphics"], Cell[33040, 762, 130, 3, 27, "Output"] }, Closed]], Cell[33185, 768, 526, 8, 104, "Text"], Cell[33714, 778, 631, 14, 104, "Text"], Cell[CellGroupData[{ Cell[34370, 796, 76, 1, 27, "Input"], Cell[34449, 799, 181, 3, 35, "Message"] }, Closed]], Cell[CellGroupData[{ Cell[34667, 807, 152, 3, 59, "Input"], Cell[34822, 812, 30247, 562, 296, 5495, 251, "GraphicsData", "PostScript", \ "Graphics"], Cell[65072, 1376, 130, 3, 27, "Output"] }, Closed]], Cell[65217, 1382, 558, 9, 104, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[65812, 1396, 137, 3, 30, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[65974, 1403, 36, 0, 28, "Subsubsection"], Cell[66013, 1405, 130, 5, 42, "Input"], Cell[66146, 1412, 125, 4, 32, "Text"], Cell[66274, 1418, 199, 7, 72, "Input"], Cell[66476, 1427, 165, 9, 102, "Input"], Cell[66644, 1438, 95, 1, 32, "Text"], Cell[66742, 1441, 167, 7, 72, "Input"], Cell[CellGroupData[{ Cell[66934, 1452, 176, 7, 72, "Input"], Cell[67113, 1461, 63416, 971, 296, 5495, 251, "GraphicsData", "PostScript", \ "Graphics"], Cell[130532, 2434, 130, 3, 27, "Output"] }, Closed]], Cell[130677, 2440, 205, 5, 47, "Text"], Cell[130885, 2447, 99, 1, 27, "Input"], Cell[CellGroupData[{ Cell[131009, 2452, 129, 6, 72, "Input"], Cell[131141, 2460, 1811, 67, 20, 946, 52, "GraphicsData", "PostScript", \ "Graphics"], Cell[132955, 2529, 130, 3, 27, "Output"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[133134, 2538, 141, 3, 22, "Subsubsection", Evaluatable->False], Cell[133278, 2543, 150, 3, 50, "Text"], Cell[CellGroupData[{ Cell[133453, 2550, 55, 1, 27, "Input"], Cell[133511, 2553, 46, 1, 27, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[133594, 2559, 95, 1, 24, "Input"], Cell[133692, 2562, 90, 1, 27, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[133819, 2568, 81, 1, 24, "Input"], Cell[133903, 2571, 90, 1, 27, "Output"] }, Closed]], Cell[134008, 2575, 184, 4, 47, "Text"], Cell[CellGroupData[{ Cell[134217, 2583, 130, 6, 72, "Input"], Cell[134350, 2591, 46, 1, 27, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[134433, 2597, 176, 10, 129, "Input"], Cell[134612, 2609, 128, 2, 43, "Output"] }, Closed]], Cell[134755, 2614, 167, 7, 69, "Input"], Cell[CellGroupData[{ Cell[134947, 2625, 176, 7, 72, "Input"], Cell[135126, 2634, 63382, 970, 296, 5495, 251, "GraphicsData", "PostScript", \ "Graphics"], Cell[198511, 3606, 130, 3, 27, "Output"] }, Closed]], Cell[198656, 3612, 288, 6, 83, "Text"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[198993, 3624, 57, 0, 30, "Subsection"], Cell[199053, 3626, 153, 3, 50, "Text"], Cell[199209, 3631, 157, 9, 117, "Input"], Cell[199369, 3642, 147, 3, 50, "Text"], Cell[199519, 3647, 123, 5, 57, "Input"], Cell[CellGroupData[{ Cell[199667, 3656, 138, 6, 72, "Input"], Cell[199808, 3664, 27866, 537, 296, 3148, 227, "GraphicsData", "PostScript", \ "Graphics"], Cell[227677, 4203, 130, 3, 27, "Output"] }, Closed]], Cell[227822, 4209, 459, 7, 86, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[228318, 4221, 68, 0, 30, "Subsection"], Cell[228389, 4223, 377, 6, 68, "Text"], Cell[228769, 4231, 541, 10, 122, "Text"], Cell[CellGroupData[{ Cell[229335, 4245, 84, 1, 27, "Input"], Cell[229422, 4248, 183, 3, 35, "Message"] }, Closed]], Cell[229620, 4254, 334, 6, 68, "Text"], Cell[229957, 4262, 411, 7, 86, "Text"] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[230417, 4275, 68, 1, 69, "Section", CellTags->"dihedral"], Cell[230488, 4278, 297, 4, 68, "Text"], Cell[CellGroupData[{ Cell[230810, 4286, 94, 2, 27, "Input", Evaluatable->False], Cell[230907, 4290, 36, 1, 27, "Output"] }, Open ]], Cell[230958, 4294, 496, 7, 86, "Text"], Cell[231457, 4303, 316, 7, 123, "Input", Evaluatable->False], Cell[231776, 4312, 89, 3, 32, "Text"], Cell[231868, 4317, 86, 2, 43, "Input", Evaluatable->False], Cell[231957, 4321, 41, 0, 32, "Text"], Cell[CellGroupData[{ Cell[232023, 4325, 77, 2, 27, "Input", Evaluatable->False], Cell[232103, 4329, 50, 1, 27, "Output"] }, Open ]], Cell[232168, 4333, 113, 4, 50, "Text"], Cell[232284, 4339, 564, 10, 122, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[232885, 4354, 34, 0, 30, "Subsubtitle"], Cell[232922, 4356, 214, 4, 50, "Text"], Cell[233139, 4362, 255, 7, 59, "Input", Evaluatable->False], Cell[233397, 4371, 88, 2, 27, "Input", Evaluatable->False], Cell[233488, 4375, 49, 0, 32, "Text"], Cell[233540, 4377, 2206, 35, 503, "Text"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)