1############################################################################
2##
3#W  consist.gi 			LPRES				René Hartung
4##
5
6############################################################################
7##
8#F  LPRES_CheckConsistencyRelations ( <coll> , <weights> )
9##
10## This function checks the local confluence (or consistency) of a weighted
11## nilpotent presentation. It implements the check from Nickel: "Computing
12## nilpotent quotients of finitely presented groups"
13##
14##	k ( j i ) = ( k j ) i,	          i < j < k, w_i=1, w_i+w_j+w_k <= c
15##          j^m i = j^(m-1) ( j i ),      i < j, j in I,   w_j+w_i <= c
16##          j i^m = ( j i ) i^(m-1),      i < j, i in I,   w_j+w_i <= c
17##          i i^m = i^m i,                i in I, 2 w_i <= c
18##            j   = ( j i^-1 ) i,         i < j, i not in I, w_i+w_j <= c
19##
20InstallGlobalFunction( LPRES_CheckConsistencyRelations,
21  function( coll, weights )
22  local   HNF,		# Hermite normal form of the inconsistencies
23   	  n, 		# number of generators of coll
24	  k,j,i, 	# loop variables
25	  ev1, ev2,	# exponent vectors (rhs and lhs)
26	  c,		# nilpotency class
27  	  w,		# loop variable (object representation)
28	  I;		# set of indices of generators with power relation
29
30  # number of generators
31  n := coll![ PC_NUMBER_OF_GENERATORS ];
32
33  # Those generators with a power relation
34  I:=Filtered([1..n],x->IsBound(coll![PC_EXPONENTS][x]));
35
36  # nilpotency class
37  c:=Maximum(weights);
38
39  # initialize the Hermite normal form
40  HNF:=rec(mat:=[],Heads:=[]);
41
42  # k (j i) = (k j) i
43  for k in [n,n-1..1] do
44    for j in [k-1,k-2..1] do
45      for i in [1..j-1] do
46        if weights[i]+weights[j]+weights[k]<=c then
47          repeat
48            ev1 := ListWithIdenticalEntries( n, 0 );
49          until CollectWordOrFail( coll, ev1, [j,1,i,1] ) <> fail;
50
51          w := ObjByExponents( coll, ev1 );
52          repeat
53              ev1 := ExponentsByObj( coll, [k,1] );
54          until CollectWordOrFail( coll, ev1, w )<>fail;
55
56          repeat
57            ev2 := ListWithIdenticalEntries( n, 0 );
58          until CollectWordOrFail( coll, ev2, [k,1,j,1,i,1] )<>fail;
59
60          LPRES_AddRow(HNF,ev1-ev2);
61        else
62          # the weight function is an increasing function!
63          break;
64        fi;
65      od;
66    od;
67  od;
68
69  # j^m i = j^(m-1) (j i)
70# for j in [n,n-1..1] do
71#   if IsBound(coll![ PC_EXPONENTS ][j]) then
72  for j in Reversed( I ) do
73      for i in [1..j-1] do
74        if weights[j]+weights[i]<=c then
75          repeat
76            ev1 := ListWithIdenticalEntries( n, 0 );
77          until CollectWordOrFail( coll, ev1, [j, coll![ PC_EXPONENTS ][j]-1,
78                                               j, 1, i,1] )<>fail;
79
80          repeat
81            ev2 := ListWithIdenticalEntries( n, 0 );
82          until CollectWordOrFail( coll, ev2, [j,1,i,1] )<>fail;
83
84          w := ObjByExponents( coll, ev2 );
85          repeat
86            ev2 := ExponentsByObj( coll, [j,coll![ PC_EXPONENTS ][j]-1] );
87          until CollectWordOrFail( coll, ev2, w )<>fail;
88
89          LPRES_AddRow(HNF,ev1-ev2);
90        else
91          break;
92        fi;
93      od;
94#   fi;
95  od;
96
97  # j i^m = (j i) i^(m-1)
98# for i in [1..n] do
99#   if IsBound(coll![ PC_EXPONENTS ][i]) then
100  for i in I do
101      for j in [i+1..n] do
102        if weights[i]+weights[j]<=c then
103          if IsBound( coll![ PC_POWERS ][i] ) then
104            repeat
105              ev1 := ExponentsByObj( coll, [j,1] );
106            until CollectWordOrFail( coll, ev1, coll![ PC_POWERS ][i] );
107          else
108            ev1 := ExponentsByObj( coll, [j,1] );
109          fi;
110
111          repeat
112            ev2 := ListWithIdenticalEntries( n, 0 );
113          until CollectWordOrFail(coll,ev2,[j,1,i,coll![PC_EXPONENTS][i]] )
114		 <>fail;
115
116          LPRES_AddRow(HNF,ev1-ev2);
117        else
118          break;
119        fi;
120      od;
121#   fi;
122  od;
123
124  # i^m i = i i^m
125  for i in [1..n] do
126    if IsBound( coll![ PC_EXPONENTS ][i] ) then
127      if 2*weights[i]<=c then
128        repeat
129          ev1 := ListWithIdenticalEntries( n, 0 );
130        until CollectWordOrFail(coll,ev1,[i,coll![ PC_EXPONENTS ][i]+1])<>fail;
131
132        if IsBound( coll![ PC_POWERS ][i] ) then
133          repeat
134          ev2 := ExponentsByObj( coll, [i,1] );
135          until CollectWordOrFail( coll, ev2, coll![ PC_POWERS ][i] )<>fail;
136        else
137          ev2 := ExponentsByObj( coll, [i,1] );
138        fi;
139
140        LPRES_AddRow(HNF,ev1-ev2);
141      else
142        break;
143      fi;
144    fi;
145  od;
146
147  # j = (j -i) i
148  for i in [1..n] do
149    if not IsBound( coll![ PC_EXPONENTS ][i] ) then
150      for j in [i+1..n] do
151        if weights[i]+weights[j]<=c then
152          repeat
153            ev1 := ListWithIdenticalEntries( n, 0 );
154          until CollectWordOrFail( coll, ev1, [j,1,i,-1,i,1] )<>fail;
155
156          ev1[j] := ev1[j] - 1;
157          LPRES_AddRow(HNF,ev1);
158        else
159          break;
160        fi;
161      od;
162    fi;
163  od;
164
165  # i = -j (j i)
166  for j in [1..n] do
167    if not IsBound( coll![ PC_EXPONENTS ][j] ) then
168      for i in [1..j-1] do
169        if weights[i]+weights[j]<=c then
170          repeat
171            ev1 := ListWithIdenticalEntries( n, 0 );
172          until CollectWordOrFail( coll, ev1, [ j,1,i,1 ] )<>fail;
173
174          w := ObjByExponents( coll, ev1 );
175          repeat
176            ev1 := ExponentsByObj( coll, [j,-1] );
177          until CollectWordOrFail( coll, ev1, w )<>fail;
178
179          LPRES_AddRow(HNF, ev1 - ExponentsByObj( coll, [i,1] ));
180
181          # -i = -j (j -i)
182          if not IsBound( coll![ PC_EXPONENTS ][i] ) then
183            repeat
184              ev1 := ListWithIdenticalEntries( n, 0 );
185            until CollectWordOrFail( coll, ev1, [ j,1,i,-1 ] )<>fail;
186
187            w := ObjByExponents( coll, ev1 );
188            repeat
189              ev1 := ExponentsByObj( coll, [j,-1] );
190            until CollectWordOrFail( coll, ev1, w )<>fail;
191
192            LPRES_AddRow( HNF, ExponentsByObj( coll, [i,-1] ) - ev1);
193          fi;
194        else
195          break;
196        fi;
197      od;
198    fi;
199  od;
200
201  return(HNF);
202  end);
203