1#############################################################################
2##
3#F CollectedTwoCR( A, u, v )
4##
5InstallGlobalFunction( CollectedTwoCR, function( A, u, v )
6    local n, word, tail, rels, wstack, tstack, p, c, l, g, e, mat, s, t, r, i;
7
8    # set up and push u into result
9    n    := Length( A.mats );
10    word := ShallowCopy( u.word );
11    tail := ShallowCopy( u.tail );
12    rels := RelativeOrdersOfPcp( A.factor );
13
14    # catch a trivial case
15    if v.word = 0 * v.word then
16        AddTailVectorsCR( tail, v.tail );
17        return rec( word := word, tail := tail );
18    fi;
19
20    # create stacks and put v onto stack
21    wstack := [WordOfVectorCR( v.word )];
22    tstack := [v.tail];
23    p := [1];
24    c := [1];
25
26    # run until stacks are empty
27    l := 1;
28    while l > 0 do
29
30        # take a generator and its exponent
31        g := wstack[l][p[l]][1];
32        e := wstack[l][p[l]][2];
33
34        # take operation mat
35        if e < 0 then
36            mat := A.invs[g];
37        else
38            mat := A.mats[g];
39        fi;
40
41        # push g through module tail
42        for i in [1..Length(tail)] do
43            if IsBound( tail[i] ) then
44                tail[i] := tail[i] * mat;
45            fi;
46        od;
47
48        # correct the stacks
49        c[l] := c[l] + 1;
50        if AbsInt(e) < c[l] then                # exponent overflow
51            c[l] := 1;
52            p[l] := p[l] + 1;
53            if Length(wstack[l]) < p[l]  then   # word overflow - add tail
54                AddTailVectorsCR( tail, tstack[l] );
55                tstack[l] := 0;
56                l := l - 1;
57            fi;
58        fi;
59
60        # push g through word
61        for i  in [ n, n-1 .. g+1 ]  do
62
63            if word[i] <> 0 then
64
65                # get relator and tail
66                t := [];
67                if e > 0 then
68                    s := Position( A.enumrels, [i, g] );
69                    r := PowerWord( A, A.relators[i][g], word[i] );
70                    t[s] := PowerTail( A, A.relators[i][g], word[i] );
71                elif e < 0 then
72                    s := Position( A.enumrels, [i, i+g] );
73                    r := PowerWord( A, A.relators[i][i+g], word[i] );
74                    t[s] := PowerTail( A, A.relators[i][i+g], word[i] );
75                fi;
76
77                # add to stacks
78                AddTailVectorsCR( tail, t );
79                l := l+1;
80                wstack[l] := r;
81                tstack[l] := tail;
82                tail := [];
83                c[l] := 1;
84                p[l] := 1;
85            fi;
86
87            # reset
88            word[i] := 0;
89        od;
90
91        # increase exponent
92        if e < 0 then
93            word[g] := word[g] - 1;
94        else
95            word[g] := word[g] + 1;
96        fi;
97
98        # insert power relators if exponent has reached rel order
99        if rels[g] > 0 and word[g] = rels[g]  then
100            word[g] := 0;
101            r := A.relators[g][g];
102            s := Position( A.enumrels, [g, g] );
103            for i  in [1..Length(r)] do
104                word[r[i][1]] := r[i][2];
105            od;
106            t := []; t[s] := A.one;
107            AddTailVectorsCR( tail, t );
108
109        # insert power relators if exponent is negative
110        elif rels[g] > 0 and word[g] < 0 then
111            word[g] := rels[g] + word[g];
112            if Length(A.relators[g][g]) <= 1 then
113                r := A.relators[g][g];
114                for i  in [1..Length(r)] do
115                    word[r[i][1]] := -r[i][2];
116                od;
117                s := Position( A.enumrels, [g, g] );
118                t := []; t[s] := - MappedWordCR( r, A.mats, A.invs );
119                AddTailVectorsCR( tail, t );
120
121            else
122                r := InvertWord( A.relators[g][g] );
123                s := Position( A.enumrels, [g, g] );
124                t := []; t[s] := - MappedWordCR( r, A.mats, A.invs );
125                AddTailVectorsCR( tail, t );
126                l := l+1;
127                wstack[l] := r;
128                tstack[l] := tail;
129                tail := [];
130                c[l] := 1;
131                p[l] := 1;
132            fi;
133        fi;
134    od;
135
136    return rec( word := word,  tail := tail );
137end );
138
139#############################################################################
140##
141#F TwoCocyclesCR( A )
142##
143InstallGlobalFunction( TwoCocyclesCR, function( A )
144    local C, n, e, id, l, gn, gp, gi, eq, pairs, i, j, k, w1, w2, d, sys, h;
145
146    # set up system of length d
147    n := Length( A.mats );
148    e := RelativeOrdersOfPcp( A.factor );
149    l := Length( A.enumrels );
150
151    if IsBound(A.endosys) then
152        sys := List( A.endosys, x -> CRSystem( x[2], l, 0 ) );
153        for i in [1..Length(sys)] do sys[i].full := true; od;
154    else
155        sys := CRSystem( A.dim, l, A.char );
156    fi;
157
158    # set up for equations
159    id := IdentityMat(n);
160    gn := List( id, x -> rec( word := x, tail := [] ) );
161
162    # precompute (ij) for i > j
163    pairs := List( [1..n], x -> [] );
164    for i  in [1..n]  do
165        if e[i] > 0 then
166            h := rec( word := (e[i] - 1) * id[i], tail := [] );
167            pairs[i][i] := CollectedTwoCR( A, h, gn[i] );
168        fi;
169        for j  in [1..i-1]  do
170            pairs[i][j] := CollectedTwoCR( A, gn[i], gn[j] );
171        od;
172    od;
173
174    # consistency 1:  k(ji) = (kj)i
175    for i  in [ n, n-1 .. 1 ]  do
176        for j  in [ n, n-1 .. i+1 ]  do
177            for k  in [ n, n-1 .. j+1 ]  do
178                w1 := CollectedTwoCR( A, gn[k], pairs[j][i] );
179                w2 := CollectedTwoCR( A, pairs[k][j], gn[i] );
180                if w1.word <> w2.word  then
181                    Error( "k(ji) <> (kj)i" );
182                else
183                    AddEquationsCR( sys, w1.tail, w2.tail, true );
184                fi;
185            od;
186        od;
187    od;
188
189    # consistency 2: j^(p-1) (ji) = j^p i
190    for i  in [n,n-1..1]  do
191        for j  in [n,n-1..i+1]  do
192            if e[j] > 0 then
193                h := rec( word := (e[j] - 1) * id[j], tail := [] );
194                w1 := CollectedTwoCR( A, h, pairs[j][i]);
195                w2 := CollectedTwoCR( A, pairs[j][j], gn[i]);
196                if w1.word <> w2.word  then
197                    Error( "j^(p-1) (ji) <> j^p i" );
198                else
199                    AddEquationsCR( sys, w1.tail, w2.tail, true );
200                fi;
201            fi;
202        od;
203    od;
204
205    # consistency 3: k (i i^(p-1)) = (ki) i^p-1
206    for i  in [n,n-1..1]  do
207        if e[i] > 0 then
208            h := rec( word := (e[i] - 1) * id[i], tail := [] );
209            l := CollectedTwoCR( A, gn[i], h );
210            for k  in [n,n-1..i+1]  do
211                w1 := CollectedTwoCR( A, gn[k], l );
212                w2 := CollectedTwoCR( A, pairs[k][i], h );
213                if w1.word <> w2.word  then
214                    Error( "k i^p <> (ki) i^(p-1)" );
215                else
216                    AddEquationsCR( sys, w1.tail, w2.tail, true );
217                fi;
218            od;
219        fi;
220    od;
221
222    # consistency 4: (i i^(p-1)) i = i (i^(p-1) i)
223    for i  in [ n, n-1 .. 1 ]  do
224        if e[i] > 0 then
225            h := rec( word := (e[i] - 1) * id[i], tail := [] );
226            l := CollectedTwoCR( A, gn[i], h );
227            w1 := CollectedTwoCR( A, l, gn[i] );
228            w2 := CollectedTwoCR( A, gn[i], pairs[i][i] );
229            if w1.word <> w2.word  then
230                Error( "i i^p-1 <> i^p" );
231            else
232                AddEquationsCR( sys, w1.tail, w2.tail, true );
233            fi;
234         fi;
235    od;
236
237    # consistency 5: j = (j -i) i
238    gi := List( id, x -> rec( word := -x, tail := [] ) );
239    for i  in [n,n-1..1]  do
240        for j  in [n,n-1..i+1]  do
241            if e[i] = 0 then
242                w1 := CollectedTwoCR( A, gn[j], gi[i] );
243                w2 := CollectedTwoCR( A, w1, gn[i] );
244                if w2.word <> id[j] then
245                    Error( "j <> (j -i) i" );
246                else
247                    AddEquationsCR( sys, w2.tail, [], true );
248                fi;
249            fi;
250        od;
251    od;
252
253    # consistency 6: i = -j (j i)
254    for i  in [n,n-1..1]  do
255        for j  in [n,n-1..i+1]  do
256            if e[j] = 0 then
257                w1 := CollectedTwoCR( A, gi[j], pairs[j][i] );
258                if w1.word <> id[i] then
259                    Error( "i <> -j (j i)" );
260                else
261                    AddEquationsCR( sys, w1.tail, [], true );
262                fi;
263            fi;
264        od;
265    od;
266
267    # consistency 7: -i = -j (j -i)
268    for i  in [n,n-1..1]  do
269        for j  in [n,n-1..i+1]  do
270            if e[i] = 0 and e[j] = 0 then
271                w1 := CollectedTwoCR( A, gn[j], gi[i] );
272                w1 := CollectedTwoCR( A, gi[j], w1 );
273                if w1.word <> -id[i] then
274                    Error( "-i <> -j (j -i)" );
275                else
276                    AddEquationsCR( sys, w1.tail, [], true );
277                fi;
278            fi;
279        od;
280    od;
281
282    # add a check ((j ^ i) ^-i ) = j
283    for i in [1..n] do
284        for j in [1..i-1] do
285            w1 := CollectedTwoCR( A, gi[j], pairs[i][j] );
286            w1 := CollectedTwoCR( A, gn[j], w1 );
287            w1 := CollectedTwoCR( A, w1, gi[j] );
288            if w1.word <> id[i] then
289                Error("in rel check ");
290            elif not IsZeroTail( w2.tail ) then
291               # Error("relations bug");
292                AddEquationsCR( sys, w1.tail, [], true );
293            fi;
294        od;
295    od;
296
297    # and return solution
298    return KernelCR( A, sys );
299end );
300
301#############################################################################
302##
303#F TwoCoboundariesCR( A )
304##
305InstallGlobalFunction( TwoCoboundariesCR, function( A )
306    local n, e, l, sys, R, c, tail, i, t, j;
307
308    # set up system of length d
309    n := Length( A.mats );
310    e := RelativeOrdersOfPcp( A.factor );
311    l := Length( A.enumrels );
312
313    if IsBound(A.endosys) then
314        sys := List( A.endosys, x -> CRSystem( x[2], l, 0 ) );
315        for i in [1..Length(sys)] do sys[i].full := true; od;
316    else
317        sys := CRSystem( A.dim, l, A.char );
318    fi;
319
320    # loop over relators
321    R := [];
322    for c in A.enumrels do
323        tail := CollectedRelatorCR( A, c[1], c[2] );
324        SubtractTailVectors( tail[1], tail[2] );
325        Add( R, tail[1] );
326    od;
327
328    # shift into system
329    for i in [1..n] do
330        t := [];
331        for j in [1..l] do
332            if IsBound(R[j][i]) then t[j] := TransposedMat(R[j][i]); fi;
333        od;
334        if IsList(sys) then
335            AddEquationsCREndo( sys, t );
336        else
337            AddEquationsCRNorm( sys, t, true );
338        fi;
339    od;
340
341    # return
342    return ImageCR( A, sys ).basis;
343end );
344
345#############################################################################
346##
347#F TwoCohomologyCR( A )
348##
349InstallGlobalFunction( TwoCohomologyCR, function( A )
350    local cc, cb, exp, l, B, b, Q, U, V, i;
351    cc := TwoCocyclesCR( A );
352    cb := TwoCoboundariesCR( A );
353    if not IsBound(A.endosys) then
354        return rec( gcc := cc, gcb := cb,
355                    factor := AdditiveFactorPcp( cc, cb, A.char ));
356    fi;
357
358    Q := [];
359    for i in [1..Length(cc)] do
360        if Length(cc[i]) = 0 then Add( Q, AbelianPcpGroup([])); fi;
361        exp := A.mats[1][i]!.exp;
362        l := Length(cc[i][1])/Length(exp);
363        B := AbelianPcpGroup( Concatenation(List([1..l], x -> exp)) );
364        b := Igs(B);
365        U := Subgroup( B, List(cc[i], x -> MappedVector(x,b)));
366        V := Subgroup( B, List(cb[i], x -> MappedVector(x,b)));
367        Add(Q, U/V);
368     od;
369     return Q;
370end );
371
372#############################################################################
373##
374#F TwoCohomologyTrivialModule( G, d[, p] )
375##
376TwoCohomologyTrivialModule := function(arg)
377    local G, d, m, C, c;
378
379    # catch arguments
380    G := arg[1];
381    d := arg[2];
382    if Length(arg)=2 then
383        m := List(Igs(G), x -> IdentityMat(d));
384    elif Length(arg)=3 then
385        m := List(Igs(G), x -> IdentityMat(d,arg[3]));
386    fi;
387
388    # construct H^2
389    C := CRRecordByMats(G, m);
390    c := TwoCohomologyCR(C);
391
392    return c.factor.rels;
393end;
394
395#############################################################################
396##
397#F CheckTrivialCohom( G )
398##
399CheckTrivialCohom := function(G)
400    local mats, C, cb, cc, c, E;
401
402    # compute cohom
403    Print("compute cohomology \n");
404    mats := List( Pcp(G), x -> IdentityMat( 1 ) );
405    C := CRRecordByMats( G, mats );
406    cb := TwoCoboundariesCR( C );
407    Print("cb has length ", Length(cb)," \n");
408    cc := TwoCocyclesCR( C );
409    Print("cc has length ", Length(cc)," \n");
410
411    # first check
412    Print("check cb in cc \n");
413    c  := First( cb, x -> IsBool( SolutionMat( cc,x ) ) );
414    if not IsBool( c ) then
415        Print("  coboundary is not contained in cc \n");
416        return c;
417    fi;
418
419    # second check
420    Print("check cc \n");
421    for c in cc do
422        E := ExtensionCR( C, c );
423    od;
424end;
425
426