1#############################################################################
2##
3#A  color.gi                  Cryst library                      Bettina Eick
4#A                                                              Franz G"ahler
5#A                                                              Werner Nickel
6##
7#Y  Copyright 1997-1999  by  Bettina Eick,  Franz G"ahler  and  Werner Nickel
8##
9##  Cryst - the crystallographic groups package for GAP (color groups)
10##
11
12#############################################################################
13##
14#M  IsColorGroup( G ) . . . . . . . . . . . . . . . . . .is it a color group?
15##
16
17# Subgroups of ColorGroups are ColorGroups
18InstallSubsetMaintenance( IsColorGroup, IsGroup, IsCollection );
19
20# ColorGroups always know that they are ColorGroups
21InstallMethod( IsColorGroup,
22    "fallback method", true, [ IsGroup ], 0, G -> false );
23
24#############################################################################
25##
26#M  ColorSubgroup( G ) . . . . . . . . . . . . . . extract the color subgroup
27##
28InstallMethod( ColorSubgroup,
29    "for subgroups", true, [ IsColorGroup and HasParent ], 0,
30function( G )
31    local P;
32    P := Parent( G );
33    while HasParent( P ) and P <> Parent( P ) do
34        P := Parent( P );
35    od;
36    return Intersection( ColorSubgroup( P ), G );
37#    return Stabilizer( G, ColorCosetList( P )[1], OnRight );
38end );
39
40#############################################################################
41##
42#M  ColorCosetList( G ) . . . . . . . . . . . . . .color labelling coset list
43##
44InstallMethod( ColorCosetList,
45    "generic", true, [ IsColorGroup ], 0,
46    G -> RightCosets( G, ColorSubgroup( G ) ) );
47
48#############################################################################
49##
50#M  ColorOfElement( G, elm ) . . . . . . . . . . . . . . .color of an element
51##
52InstallGlobalFunction( ColorOfElement, function( G, elm )
53    local P, cos, i;
54    P := G;
55    while HasParent( P ) and Parent( P ) <> P do
56        P := Parent( P );
57    od;
58    cos := ColorCosetList( P );
59    for i in [1..Length( cos )] do
60        if elm in cos[i] then
61            return i;
62        fi;
63    od;
64    Error("elm must be an element of G");
65end );
66
67
68#############################################################################
69##
70#F  ColorPermGroupHomomorphism( G ) . . . . .color PermGroup and homomorphism
71##
72ColorPermGroupHomomorphism := function( G )
73    local P, pmg, hom;
74    P := G;
75    while HasParent( P ) and P <> Parent( P ) do
76        P := Parent( P );
77    od;
78    pmg := Action( G, ColorCosetList( P ), OnRight );
79    hom := ActionHomomorphism( G, pmg );
80    return [ pmg, hom ];
81end;
82
83
84#############################################################################
85##
86#M  ColorPermGroup( G ) . . . . . . . . . . . . . . . . . . . color PermGroup
87##
88InstallMethod( ColorPermGroup,
89    "generic", true, [ IsColorGroup ], 0,
90function( G )
91    local tmp;
92    tmp := ColorPermGroupHomomorphism( G );
93    SetColorHomomorphism( G, tmp[2] );
94    return tmp[1];
95end );
96
97
98#############################################################################
99##
100#M  ColorHomomorphism( G ) . . . . . . . . . .homomorphism to color PermGroup
101##
102InstallMethod( ColorHomomorphism,
103    "generic", true, [ IsColorGroup ], 0,
104function( G )
105    local tmp;
106    tmp := ColorPermGroupHomomorphism( G );
107    SetColorPermGroup( G, tmp[1] );
108    return tmp[2];
109end );
110
111
112#############################################################################
113##
114#M  PointGroup( G ) . . . . . . . . . . . . . . . . . . . . .color PointGroup
115##
116InstallMethod( PointGroup, "for colored AffineCrystGroups",
117    true, [ IsColorGroup and IsAffineCrystGroupOnLeftOrRight ], 0,
118function( G )
119
120    local tmp, P, hom, H, reps;
121
122    tmp := PointGroupHomomorphism( G );
123    P   := tmp[1];
124    hom := tmp[2];
125    SetPointGroup( G, P );
126    SetPointHomomorphism( G, hom );
127
128    # color the point group if possible
129    H := ColorSubgroup( G );
130    if TranslationBasis( G ) = TranslationBasis( H ) then
131        H := PointGroup( H );
132        SetIsColorGroup( P, true );
133        SetColorSubgroup( P, H );
134        reps := List( ColorCosetList( G ),
135                x -> ImagesRepresentative( hom, Representative( x ) ) );
136        SetColorCosetList( P, List( reps, x -> RightCoset( H, x ) ) );
137    fi;
138
139    return P;
140
141end );
142
143
144#############################################################################
145##
146#M  ColorGroup( G, H ) . . . . . . . . . . . . . . . . . . make a color group
147##
148InstallGlobalFunction( ColorGroup, function( G, H )
149
150    local C, U, P, reps;
151
152    # H must be a subgroup of G
153    if not IsSubgroup( G, H ) then
154        Error("H must be contained in G");
155    fi;
156
157    # since G may contain uncolored information components, make a new group
158    C := GroupByGenerators( GeneratorsOfGroup( G ), One( G ) );
159    U := GroupByGenerators( GeneratorsOfGroup( H ), One( H ) );
160
161    # make C a color group
162    SetIsColorGroup( C, true );
163    SetColorSubgroup( C, U );
164
165    # if G is an AffineCrystGroup, make C am AffineCrystGroup
166    if IsCyclotomicMatrixGroup( G ) then
167        if IsAffineCrystGroupOnRight( G ) then
168            SetIsAffineCrystGroupOnRight( C, true );
169            SetIsAffineCrystGroupOnRight( U, true );
170            if HasTranslationBasis( H ) then
171                AddTranslationBasis( U, TranslationBasis( H ) );
172            fi;
173            if HasTranslationBasis( G ) then
174                AddTranslationBasis( C, TranslationBasis( G ) );
175            fi;
176        fi;
177        if IsAffineCrystGroupOnLeft( G ) then
178            SetIsAffineCrystGroupOnLeft( C, true );
179            SetIsAffineCrystGroupOnLeft( U, true );
180            if HasTranslationBasis( H ) then
181                AddTranslationBasis( U, TranslationBasis( H ) );
182            fi;
183            if HasTranslationBasis( G ) then
184                AddTranslationBasis( C, TranslationBasis( G ) );
185            fi;
186        fi;
187    fi;
188
189    SetParent( C, C );
190    return C;
191
192end );
193
194