File: Whitehd.gi

package info (click to toggle)
gap-fga 1.4.0-2
  • links: PTS
  • area: main
  • in suites: bookworm, bullseye
  • size: 588 kB
  • sloc: makefile: 106; sh: 12
file content (227 lines) | stat: -rw-r--r-- 7,105 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
#############################################################################
##
#W  Whitehd.gi               FGA package                    Christian Sievers
##
##  Computations with Whitehead automorphisms
##
#Y  2004 - 2012
##

InstallMethod( FGA_WhiteheadAutomorphisms,
    "for finitely generated free groups",
    [ CanComputeWithInverseAutomaton ],
    function( G )
    local ngens, ngen, combs, auts, L, R;
    ngens := [ 1 .. RankOfFreeGroup( G ) ];
    auts := [];
    for ngen in ngens do
        combs := Combinations( Difference( ngens, [ngen] ));
        for L in combs do
            for R in combs do
                if  L <> []  or  R <> []  then
                    Add( auts, FGA_WhiteheadAutomorphism( G, ngen, L, R ));
                fi;
            od;
        od;
    od;
    return auts;
    end );


InstallMethod( FGA_NielsenAutomorphisms,
    "for finitely generated free groups",
    [ CanComputeWithInverseAutomaton ],
    G -> Filtered( f -> FGA_WhiteheadParams(f).isnielsen )  );


InstallGlobalFunction( FGA_WhiteheadAutomorphism,
    function( G, ngen, L, R )
    local gens, gen, ng, g, img, imginv, imgs, imgsinv, aut, autinv;
    imgs := [];
    imgsinv := [];
    gens := GeneratorsOfGroup( G );
    gen  := gens[ngen];
    for ng in [ 1 .. RankOfFreeGroup( G ) ] do
        img := gens[ng];
        imginv := img;
        if ng in L then
            img := LeftQuotient( gen, img );
            imginv := gen * imginv;
        fi;
        if ng in R then
            img := img * gen;
            imginv := imginv / gen;
        fi;
        Add( imgs, img );
        Add( imgsinv, imginv);
    od;
    aut    := GroupHomomorphismByImagesNC( G, G, GeneratorsOfGroup(G), imgs );
    autinv := GroupHomomorphismByImagesNC( G, G, GeneratorsOfGroup(G), imgsinv );
    SetInverse( aut, autinv );
    SetInverse( autinv, aut );
    SetFGA_WhiteheadParams( aut , rec( gen := ngen, L := L, R := R,
                                       isnielsen := Length(L)+Length(R)=1 ) );
    SetFGA_WhiteheadParams( autinv, true );
    return aut;
    end );


InstallGlobalFunction( FGA_WhiteheadAnalyse,
    function( whs, elm, act      , len      , val, comb     , combrest )
#            [w] * e  * (e*w->e) * (e->Int) * v  * (v*w->v) * (v*e->r)   -> r
    local l, newl, wh, bestwh , newelm, bestnewelm;
#         Int    , w , Maybe w, e
    l := len( elm );
    while true do
        bestwh := fail;
        for wh in whs do
            newelm := act( elm, wh );
            newl := len( newelm );
            if newl < l then
                l := newl;
                bestwh := wh;
                bestnewelm := newelm;
            fi;
        od;
        if bestwh=fail then
            return combrest( val, elm );
        fi;
        val := comb( val, bestwh );
        elm := bestnewelm;
    od;
    # not reached
    end );


########################################################################
# Equation numbers and pages refer to
#   Jakob Nielsen:  Die Isomorphismengruppe der freien Gruppen
# see ../doc/manual.bib
########################################################################

InstallGlobalFunction( FGA_WhiteheadToPQOU,
    function ( w , p , q , o , u )
    #          w * g * g * g * g   -> g

    local n ,g, whp, word, sign, nik;

    n := RankOfFreeGroup( Source ( w ) );
    if FGA_WhiteheadParams(w) = true then
        w := Inverse(w);
        sign := -1;
    else
        sign := 1;
    fi;
    whp:= FGA_WhiteheadParams(w);   
    word := One(p);
    for g in [ 1 .. n ] do
        if g in whp.L or g in whp.R then
            # using and possibly combining eq. (12) and (11)
            # for V_{g,gen}^-1 and U_{g,gen}
            nik := FGA_NikToPQ( g, whp.gen, p, q );
            word := word * nik^-1;
            if g in whp.L then
                word := word * o * u^sign * o;
                # eq. (7)
            fi;
            if g in whp.R then
                word := word * u^sign;
            fi;
            word := word * nik;
        fi;
    od;
    return word;
    end );

InstallGlobalFunction( FGA_NikToPQ,
    function( i   , k , p , q )
    #         Int * g * g * g   -> g
    # eq. (8)

    local l;
    l := k-i;
    if i<k then
        l := l-1;
    fi;
    return (q*p)^l * q^(i-1);
    end );

InstallGlobalFunction( FGA_TiToPQ,
    function( i   , p , q )
    #         Int * g * g   -> g
    # follows from eq. at the middle of page 171

    return q^(2-i)*p*(q*p)^(i-2);
    end );

InstallGlobalFunction( FGA_ExtSymListRepToPQO,
    function( target, p , q , o )
#             [Int] * g * g * g   -> g
    local rank, word1, word2, lastshift, i, t,
          f2, P, Q, Pperm, Qperm, homperm, homrep, perm;

    f2 := FreeGroup("P","Q");
    P := f2.1;  Q := f2.2;

    word1 := One(p);
    word2 := word1;
    rank := Length( target );
    Pperm := (1,2);
    Qperm := PermList(Concatenation([2..rank],[1]));
    homperm := GroupHomomorphismByImagesNC( f2,
                                            SymmetricGroup( rank ), 
                                            GeneratorsOfGroup(f2),
                                            [ Pperm, Qperm ] );
    homrep  := GroupHomomorphismByImagesNC( f2,
                                            Group( p, q ),
                                            GeneratorsOfGroup( f2 ),
                                            [ p, q ] );

    # first get rid of extendedness, using o and q
    lastshift := 1;
    for i in [ 1 .. rank ] do
        if not IsPosInt( target[i] ) then
            word1 := word1 * q^(lastshift-i) * o;
            lastshift := i;
            target[i] := AbsInt(target[i]);
        fi;
    od;
    word1 := word1 * q^(lastshift-1);

    # now target is a permutation, represent it as such
    target := SortingPerm(target);

    # decompose it as product of powers of T_i, compare p. 171
    while  not IsOne( target )  do
        i := LargestMovedPoint( target );
        t := i^target;
        perm := FGA_TiToPQ( i, P, Q );
        word2 := (perm^homrep)^(t-i) * word2;
        target := target * (perm^homperm)^(i-t);
    od;
    return word1*word2;
    end );

InstallGlobalFunction( FGA_CurryAutToPQOU,
    function( p, q, o, u)
        return 
            function( aut )
            local fg, words, wh;
            fg := Source( aut );
            words := List( GeneratorsOfGroup( fg ), gen -> gen ^ aut );
            wh := FGA_WhiteheadAutomorphisms( fg );
            # use Nielsen generators only
            wh := Filtered( wh, f -> FGA_WhiteheadParams(f).isnielsen );
            wh := Concatenation( wh, List( wh, Inverse ));
            return FGA_WhiteheadAnalyse( wh, words, OnTuples,
                l -> Sum( l, Length ),
                One( p ),
                function( v, w ) 
                    return FGA_WhiteheadToPQOU( Inverse(w), p, q, o, u ) * v;
                end,
                function( v, e )
                    e := List( e, g -> LetterRepAssocWord(g)[1] );
                    return FGA_ExtSymListRepToPQO( e, p, q, o ) * v;
                end );
            end;
    end );