1############################################################################### 2## 3#F Collect.gi The SymbCompCC package Dörte Feichtenschlager 4## 5 6############################################################################### 7## 8## G = <h_1, ..., h_n+d+m> = <g_1, .., g_n, t_1, .., t_d, c_1, .., c_m> 9## words: [[i_1,f_1],.., [i_j, f_j]], wobei i_1, .., i_j in [1..n+d+m] und 10## f_k in Z, falls i_k <= n, sonst in Q_p^0[p^x] 11## relations: c_i are central 12## rel[i][j] gives the relation h_i^h_j, where j<i 13## rel[i][i] gives the power relation of h_i 14## 15 16############################################################################### 17## 18## Reduce_ci_ppowerpolypcp( c_i_in, div_i_in, i, expo_vec ) 19## 20## [ IsPPowerPoly, IsPosInt, IsPosInt, IsList ] 21## 22## Comment: technical function (reduce c) 23## 24InstallGlobalFunction( Reduce_ci_ppowerpolypcp, 25 function( c_i_in, div_i_in, i, expo_vec ) 26 local Zero0, c_i, div_i, list, p, div, help; 27 28 Zero0 := PPP_ZeroNC( c_i_in ); 29 p := Zero0[1]; 30 31 c_i := StructuralCopy( c_i_in ); 32 div_i := StructuralCopy( div_i_in ); 33 34 ## check if c_i >= expo_vec[i] if so then reduce 35 if not PPP_Equal( expo_vec[i], Zero0 ) and ( not PPP_Smaller( c_i, expo_vec[i] ) or not PPP_Smaller( PPP_AdditiveInverse( c_i ), expo_vec[i] ) ) then 36 list := PPP_QuotientRemainder( c_i, expo_vec[i], false ); 37 c_i := list[2]; 38 39 ## if div_i <> 1 then test if list[2] is integer 40 if div_i <> 1 then 41 if Length( c_i[2] ) = 1 then 42 ## c_i is an integer, doesn't depend on x -> can divide by div_i 43 help := EvaluatePPowerPoly( c_i , 1 ); 44 if (help mod div_i) <> 0 then 45 Error( "Something went wrong with dividing by 2." ); 46 else 47 help := help / div_i; 48 c_i := Int2PPowerPoly( p, help ); 49 div_i := 1; 50 fi; 51 fi; 52 fi; 53 54 ## check that c_i is positive 55 if PPP_Smaller( c_i, Zero0 ) then 56 c_i := PPP_Add( c_i, expo_vec[i] ); 57 fi; 58 59 return [c_i, div_i]; 60 else 61 ## check if we can divide 62 if not PPP_Equal( expo_vec[i], Zero0 ) and div_i <> 1 then 63 list := PPP_QuotientRemainder( c_i, expo_vec[i], false ); 64 c_i := list[2]; 65 66 if Length( c_i[2] ) = 1 then 67 ## c_i is an integer, doesn't depend on x -> can divide by div_i 68 help := EvaluatePPowerPoly( c_i , 1 ); 69 if (help mod div_i) <> 0 then 70 Error( "Something went wrong with dividing by 2." ); 71 else 72 help := help / div_i; 73 c_i := Int2PPowerPoly( p, help ); 74 div_i := 1; 75 fi; 76 fi; 77 fi; 78 79 return [c_i,div_i]; 80 fi; 81 end); 82 83############################################################################### 84## 85## Add_ci_c_ppowerpolypcp( i, c_i, c_j, div_i, div_j, expo_vec ) 86## 87## [ IsPosInt, IsPPowerPoly, IsPPowerPoly, IsPosInt, IsPosInt, IsList ] 88## 89## Comment: technical function (add tails, paying attention to div) 90## 91InstallGlobalFunction( Add_ci_c_ppowerpolypcp, 92 function( i, c_i, c_j, div_i, div_j, expo_vec ) 93 local p, c, div_c, elm_i, elm_j, m_i, m_j, list; 94 95 p := c_i[1]; 96 97 if p <> c_j[1] then 98 Error( "Wrong input, the underlying primes have to be the same." ); 99 fi; 100 101 ## add and reduce, paying attention to the different possible divs 102 ## both divs are 1, so nothing to do 103 if (div_i = 1) and (div_j = 1) then 104 c := PPP_Add( c_i, c_j ); 105 div_c := 1; 106 list := Reduce_ci_ppowerpolypcp( c, div_c, i, expo_vec ); 107 c := list[1]; 108 div_c := list[2]; 109 elif div_i = 1 then 110 ## only one div is 1, so fractional arithmetic 111 elm_i := Int2PPowerPoly( p, div_j ); 112 c := PPP_Add( PPP_Mult(elm_i, c_i ), c_j ); 113 div_c := div_j; 114 list := Reduce_ci_ppowerpolypcp( c, div_c, i, expo_vec ); 115 c := list[1]; 116 div_c := list[2]; 117 elif div_j = 1 then 118 ## same as last 119 elm_j := Int2PPowerPoly( p, div_i ); 120 c := PPP_Add( c_i, PPP_Mult(elm_j, c_j ) ); 121 div_c := div_i; 122 list := Reduce_ci_ppowerpolypcp( c, div_c, i, expo_vec ); 123 c := list[1]; 124 div_c := list[2]; 125 else 126 ## both divs > 1, so get lcm and use frational arithmetic 127 div_c := LcmInt( div_i, div_j ); 128 m_i := div_c / div_i; 129 m_j := div_c / div_j; 130 elm_i := Int2PPowerPoly( p, m_i ); 131 elm_j := Int2PPowerPoly( p, m_j ); 132 c := PPP_Add( PPP_Mult(elm_i, c_i ), PPP_Mult(elm_j, c_j ) ); 133 list := Reduce_ci_ppowerpolypcp( c, div_c, i, expo_vec ); 134 c := list[1]; 135 div_c := list[2]; 136 fi; 137 138 return [ c, div_c ]; 139 end); 140 141############################################################################### 142## 143## Mult_ci_c_ppowerpolypcp( i, c_i, c_j, div_i, div_j, expo_vec ) 144## 145## [ IsPosInt, IsPPowerPoly, IsPPowerPoly, IsInt, IsInt, IsList ] 146## 147## Comment: technical function (multiply tails, paying attention to *.div) 148## 149InstallGlobalFunction( Mult_ci_c_ppowerpolypcp, 150 function( i, c_i, c_j, div_i, div_j, expo_vec ) 151 local p, c, div_c, list; 152 153 p := c_i[1]; 154 155 if p <> c_j[1] then 156 Error( "Wrong input, the underlying primes have to be the same." ); 157 fi; 158 159 ## multiply 160 c := PPP_Mult( c_i, c_j ); 161 div_c := div_i * div_j; 162 ## reduce c 163 list := Reduce_ci_ppowerpolypcp( c, div_c, i, expo_vec ); 164 c := list[1]; 165 div_c := list[2]; 166 167 return [ c, div_c ]; 168 end); 169 170############################################################################### 171## 172## Reduce_word_gi_ppowerpolypcp( word_in, c_in, div_in, ParPres ) 173## 174## [ IsList, IsList, IsList, IsPPPPcpGroups ] 175## 176## Comment: reduce word * g_u^e 177## note that the word is in collected form until g_u, i.e. 178## word = [[j,e_j],[u,e]] and j < u 179## 180InstallGlobalFunction( Reduce_word_gi_ppowerpolypcp, 181 function( word_in, c_in, div_in, ParPres ) 182 local div, word, l_word, stack, l_st, c, p, Zero0, One1, j, k, n, 183 d, rel, new_word, pos, i, u, e, help, l_help, list, expo_vec; 184 185 word := StructuralCopy( word_in ); 186 l_word := Length( word ); 187 pos := ShallowCopy( l_word ); 188 div := StructuralCopy( div_in ); 189 c := StructuralCopy( c_in ); 190 u := word[pos][1]; 191 e := word[pos][2]; 192 193 p := ParPres!.prime; 194 n := ParPres!.n; 195 d := ParPres!.d; 196 rel := ParPres!.rel; 197 expo_vec := ParPres!.expo_vec; 198 199 if u > n then 200 Error( "Wrong input." ); 201 fi; 202 203 stack := []; 204 l_st := 0; 205 206 Zero0 := Int2PPowerPoly( p, 0 ); 207 One1 := Int2PPowerPoly( p, 1 ); 208 209 ## if exponent of g is greater than p, then we have to reduce g 210 if e >= p then 211 ## get the relation 212 help := MakeMutableCopyListPPP( rel[u][u] ); 213 l_help := Length( help ); 214 ## reduce g until exponent is < p 215 while e >= p do 216 e := e - p; 217 ## put relation on stack 218 for j in [l_help,l_help-1..1] do 219 if help[j][1] > n+d then 220 list := Add_ci_c_ppowerpolypcp( help[j][1]-n-d, c[help[j][1]-n-d], help[j][2], div[help[j][1]-n-d], 1, expo_vec ); 221 c[help[j][1]-n-d] := list[1]; 222 div[help[j][1]-n-d] := list[2]; 223 elif help[j][1] > n then 224 if help[j][2] <> Zero0 then 225 l_st := l_st + 1; 226 stack[l_st] := help[j]; 227 fi; 228 elif help[j][2] <> 0 then 229 for k in [1..help[j][2]] do 230 l_st := l_st + 1; 231 stack[l_st] := [help[j][1],1]; 232 od; 233 fi; 234 od; 235 od; 236 fi; 237 238 ## check if e = 0, if so delete 239 if e = 0 then 240 new_word := []; 241 for j in [pos-1,pos-2..1] do 242 new_word[j] := word[j]; 243 od; 244 word := new_word; 245 else word[pos][2] := e; 246 fi; 247 248 ## empty stack 249 for j in [l_st,l_st-1..1] do 250 if stack[j][1] <= n then 251 for k in [1..stack[j][2]] do 252 list := Collect_word_gi_ppowerpolypcp( word, c, div, stack[j][1], ParPres ); 253 word := list[1]; 254 c := list[2]; 255 div := list[3]; 256 od; 257 else list := Collect_word_ti_ppowerpolypcp( stack[j][1], stack[j][2], word, c, div, ParPres ); 258 word := list[1]; 259 c := list[2]; 260 div := list[3]; 261 fi; 262 od; 263 264 return [ word, c, div ]; 265 end); 266 267############################################################################### 268## 269## Collect_word_ti_ppowerpolypcp( i, b, word_in, c_in, div_in, ParPres ) 270## 271## [ IsPosInt, IsPPowerPoly, IsList, IsList, IsList, IsPPPPcpGroups ] 272## 273## Comment: technical function (collecting word * t_i^b, assuming that 274## word is collected) 275## 276InstallGlobalFunction( Collect_word_ti_ppowerpolypcp, 277 function( i, b, word_in, c_in, div_in, ParPres ) 278 local p, m, d, n, rel, expo, expo_vec, c, word, div, Zero0, One1, l_w, 279 tstack, j, l_tst, k, list, help, div_help, l, new_word, new_help; 280 281 word := StructuralCopy( word_in ); 282 c := StructuralCopy( c_in ); 283 div := StructuralCopy( div_in ); 284 285 p := ParPres!.prime; 286 rel := ParPres!.rel; 287 expo := ParPres!.expo; 288 expo_vec := ParPres!.expo_vec; 289 m := ParPres!.m; 290 d := ParPres!.d; 291 n := ParPres!.n; 292 293 if i <= n or i > n+d then 294 Error( "Wrong input." ); 295 fi; 296 297 Zero0 := Int2PPowerPoly( p, 0 ); 298 One1 := Int2PPowerPoly( p, 1 ); 299 300 l_tst := 0; 301 tstack := []; 302 303 # start at the end of the word and conjugate until position is reached 304 l_w := Length( word ); 305 j := l_w; 306 while j > 0 and i < word[j][1] do 307 k := word[j][1]; 308 ## if the word which has to be conjugated is a tail, they commute 309 ## add the tails 310 if k > n+d then 311 list := Add_ci_c_ppowerpolypcp( k-n-d, c[k-n-d], PPP_Mult( b, word[j][2] ), div[k-n-d], div_in[k-n-d], expo_vec ); 312 c[k-n-d] := list[1]; 313 div[k-n-d] := list[2]; 314 l_w := l_w - 1; 315 ## case n<word[j][1]<=n+d and word[j][1] and i commute modulo tails 316 else l_tst := l_tst + 1; 317 tstack[l_tst] := word[j]; 318 l_w := l_w - 1; 319 help := MakeMutableCopyListPPP( rel[k][i] ); 320 ## if b <> One1 power 321 if not PPP_Equal( b, One1 ) then 322 div_help := []; 323 for k in [1..m] do 324 div_help[k] := 1; 325 od; 326 new_help := []; 327 ## power the tails in the relation immediately and add to others 328 for l in [1..Length( help )] do 329 if help[l][1] > n+d then 330 list := Add_ci_c_ppowerpolypcp( help[l][1]-n-d, c[help[l][1]-n-d], PPP_Mult( word[j][2], PPP_Mult( help[l][2], b ) ), div[help[l][1]-n-d], div_help[help[l][1]-n-d], expo_vec ); 331 c[help[l][1]-n-d] := list[1]; 332 div[help[l][1]-n-d] := list[2]; 333 else new_help[Length(new_help)+1] := help[l]; 334 fi; 335 od; 336 help := StructuralCopy( new_help ); 337 ## power the t's 338 if Length( help ) > 0 then 339 list := Collect_t_y_ppowerpolypcp( new_help,b,c,div_help,ParPres ); 340 help := list[1]; 341 div_help := list[2]; 342 fi; 343 fi; 344 ## using that the t's commute modulo the tails, it follows that 345 ## the relation consists of t_i and tails. Collect the tails 346 for l in [2..Length( help )] do 347 if not ( IsBound( div_help ) ) then 348 div_help := []; 349 for k in [1..m] do 350 div_help[k] := 1; 351 od; 352 fi; 353 list := Add_ci_c_ppowerpolypcp( help[l][1]-n-d, c[help[l][1]-n-d], PPP_Mult( help[l][2], word[j][2] ), div[help[l][1]-n-d], div_help[help[l][1]-n-d], expo_vec ); 354 c[help[l][1]-n-d] := list[1]; 355 div[help[l][1]-n-d] := list[2]; 356 od; 357 fi; 358 j := j - 1; 359 od; 360 361 ## if conjugated through then add 362 if j > 0 and i = word[j][1] then 363 word[j][2] := PPP_Add( word[j][2], b ); 364 else j := j + 1; 365 l_w := l_w + 1; 366 word[j] := []; 367 word[j][1] := i; 368 word[j][2] := b; 369 fi; 370 371 ## reduce t_i, careful this is a recursive call, so only if >= expo 372 ## furthermore add the elements from the t-stack 373 if not PPP_Smaller( word[j][2], expo ) then 374 new_word := []; 375 for k in [1..j] do 376 new_word[k] := word[k]; 377 od; 378 list := Reduce_word_ti_ppowerpolypcp( new_word, c, div, ParPres ); 379 word := list[1]; 380 l_w := Length( word ); 381 c := list[2]; 382 div := list[3]; 383 while l_tst > 0 and l_w > 0 and word[l_w][1] >= tstack[l_tst][1] do 384 list := Collect_word_ti_ppowerpolypcp( tstack[l_tst][1], tstack[l_tst][2], word, c, div, ParPres); 385 word := list[1]; 386 l_w := Length( word ); 387 c := list[2]; 388 div := list[3]; 389 l_tst := l_tst - 1; 390 od; 391 fi; 392 ## get the higher t's from the stack 393 for k in [l_tst,l_tst-1..1] do 394 l_w := l_w + 1; 395 word[l_w] := tstack[k]; 396 od; 397 398 return [ word, c, div ]; 399 end); 400 401############################################################################### 402## 403## Reduce_word_ti_ppowerpolypcp( word_in, c_in, div_in, ParPres ) 404## 405## [ IsList, IsList, IsList, IsPPPPcpGroups ] 406## 407## Comment: technical function (reduce t_i at the last position word 408## note that the word is in collected form until t_i, i.e. 409## word = [[j,e_j],[i,F]] ) 410## 411InstallGlobalFunction( Reduce_word_ti_ppowerpolypcp, 412 function( word_in, c_in, div_in, ParPres ) 413 local word, c, div, p, n, d, Zero0, list, new_word, i, j, help, 414 pos, expo, expo_vec, rel, quot; 415 416 word := StructuralCopy( word_in ); 417 c := StructuralCopy( c_in ); 418 div := StructuralCopy( div_in ); 419 420 p := ParPres!.prime; 421 n := ParPres!.n; 422 d := ParPres!.d; 423 rel := ParPres!.rel; 424 expo := ParPres!.expo; 425 expo_vec := ParPres!.expo_vec; 426 427 pos := Length( word ); 428 429 i := word[pos][1]; 430 431 if i <= n or i > n+d then 432 Error( "Wrong input." ); 433 fi; 434 435 Zero0 := Int2PPowerPoly( p, 0 ); 436 437 if not PPP_Smaller( word[pos][2], expo ) then 438 ## change the t 439 quot := PPP_QuotientRemainder( word[pos][2], expo ); 440 if PPP_Equal( quot[2], Zero0 ) then 441 new_word := []; 442 for j in [pos-1,pos-2..1] do 443 new_word[j] := word[j]; 444 od; 445 word := new_word; 446 else word[pos][2] := StructuralCopy( quot[2] ); 447 fi; 448 449 ## sort out the tails 450 help := MakeMutableCopyListPPP( rel[i][i] ); 451 if help <> [[i,Zero0]] then 452 for j in [1..Length( help )] do 453 list := Add_ci_c_ppowerpolypcp( help[j][1]-n-d, c[help[j][1]-n-d], PPP_Mult( quot[1], help[j][2] ), div[help[j][1]-n-d], 1, expo_vec ); 454 c[help[j][1]-n-d] := list[1]; 455 div[help[j][1]-n-d] := list[2]; 456 od; 457 fi; 458 fi; 459 460 return [ word, c, div ]; 461 end); 462 463############################################################################### 464## 465## Collect_t_y_ppowerpolypcp( word_in, y , c_in , div_in, ParPres ) 466## 467## [ IsList, IsPPowerPoly, IsList, IsList, IsPPPPcpGroups ] 468## 469## Comment: technical function (collecting t^y) 470## 471InstallGlobalFunction( Collect_t_y_ppowerpolypcp, 472 function( word_in, y , c_in , div_in, ParPres ) 473 local word, c, div, i, j, k, One1, Zero0, pos, elm, test, help, list, 474 help2, help3, new_y, eval, value, coeffs, new_word, p, n, d, 475 expo_vec, rel; 476 477 word := StructuralCopy( word_in ); 478 c := StructuralCopy( c_in ); 479 div := StructuralCopy( div_in ); 480 481 p := ParPres!.prime; 482 n := ParPres!.n; 483 d := ParPres!.d; 484 expo_vec := ParPres!.expo_vec; 485 rel := ParPres!.rel; 486 487 One1 := Int2PPowerPoly( p, 1 ); 488 Zero0 := Int2PPowerPoly( p, 0 ); 489 490 if InfoLevel( InfoCollectingPPPPcp ) = 1 then 491 Print("\n Doing t_y: word = ", word, " y = ", y, "\n"); 492 fi; 493 494 ## collect and power the tails 495 new_word := []; 496 for i in [1..Length( word )] do 497 if word[i][1] > n+d then 498 help := Mult_ci_c_ppowerpolypcp( word[i][1]-n-d, y, word[i][2], 1, div[word[i][1]-n-d], expo_vec ); 499 list := Add_ci_c_ppowerpolypcp( word[i][1]-n-d, help[1], c[word[i][1]-n-d], help[2], div[word[i][1]-n-d], expo_vec ); 500 c[word[i][1]-n-d] := list[1]; 501 div[word[i][1]-n-d] := list[2]; 502 else new_word[Length(new_word)+1] := word[i]; 503 fi; 504 od; 505 word := StructuralCopy( new_word ); 506 507 ## test whether y is an integer 508 test := 0; ## tests whether y is an integer, so if can divide by 2 509 if Length( y[2] ) = 1 then 510 ## now y is an integer, doesn't depend on m and can divide by 2 511 test := 1; 512 help := EvaluatePPowerPoly( y , 1 ); 513 elm := ( help - 1 ) * help / 2; 514 elm := Int2PPowerPoly( p, elm ); 515 fi; 516 if test = 0 then 517 if p = 2 then 518 test := 1; 519 help := StructuralCopy( PPP_Subtract( y, One1 ) ); 520 ## test if elm is even 521 eval := 1/2;; 522 value := 1;; 523 while not IsInt( eval ) do 524 eval := EvaluatePPowerPoly( help, value ); 525 value := value + 1;; 526 od; 527 if IsEvenInt( eval ) then 528 ## divide help by 2 529 new_y := y; 530 coeffs := StructuralCopy( help[2] ); 531 for i in [1..Length( coeffs )] do 532 coeffs[i] := coeffs[i] / 2 ; 533 od; 534 help := PPP_Check( [ p, coeffs ] ); 535 else ## divide y by 2; 536 coeffs := StructuralCopy( y[2] ); 537 for i in [1..Length( coeffs )] do 538 coeffs[i] := coeffs[i] / 2; 539 od; 540 new_y := PPP_Check( [ p, coeffs ] ); 541 fi; 542 elm := StructuralCopy( PPP_Mult( help, new_y ) ); 543 else 544 elm := StructuralCopy( PPP_Mult( PPP_Subtract(y, One1 ), y ) ); 545 fi; 546 fi; 547 548 ## collect the tails which arise from commuting the t's 549 for i in [1..Length( word )] do 550 for j in [i+1,i+2..Length( word )]do 551 ## collect the tails 552 help2 := PPP_Mult( word[i][2], PPP_Mult( word[j][2], elm ) ); 553 help := MakeMutableCopyListPPP( rel[word[j][1]][word[i][1]] ); 554 if help <> [[word[j][1], One1]] then 555 for k in [2..Length( help )] do 556 if test = 0 then 557 help3 := Mult_ci_c_ppowerpolypcp( help[k][1]-n-d, help[k][2], help2, 1, 2, expo_vec ); 558 else ## test = 1 559 help3 := Mult_ci_c_ppowerpolypcp( help[k][1]-n-d, help[k][2], help2, 1, 1, expo_vec ); 560 fi; 561 list := Add_ci_c_ppowerpolypcp( help[k][1]-n-d, c[help[k][1]-n-d], help3[1], div[help[k][1]-n-d], help3[2],expo_vec ); 562 c[help[k][1]-n-d] := list[1]; 563 div[help[k][1]-n-d] := list[2]; 564 od; 565 fi; 566 od; 567 od; 568 569 ## collect the t's 570 new_word := []; 571 if word <> [] then 572 new_word[1] := word[1]; 573 new_word[1][2] := PPP_Mult( new_word[1][2], y ); 574 list := Reduce_word_ti_ppowerpolypcp( new_word, c, div, ParPres ); 575 new_word := list[1]; 576 c := list[2]; 577 div := list[3]; 578 for i in [2..Length( word )] do 579 if word[i][1] <= n+d then 580 list := Collect_word_ti_ppowerpolypcp( word[i][1], PPP_Mult( word[i][2], y ), new_word, c, div, ParPres ); 581 new_word := list[1]; 582 c := list[2]; 583 div := list[3]; 584 else Add_ci_c_ppowerpolypcp( word[i][1]-n-d, c[word[i][1]-n-d], word[i][2], div[word[i][1]-n-d], div[word[i][1]-n-d],expo_vec ); 585 c[word[i][1]-n-d] := list[1]; 586 div[word[i][1]-n-d] := list[2]; 587 fi; 588 od; 589 fi; 590 591 return [ new_word , c , div ]; 592 end 593); 594 595############################################################################### 596## 597## Collect_word_gi_ppowerpolypcp( word_in, c_in, div_in, i, ParPres ) 598## 599## [ IsList, IsList, IsList, IsPosInt, IsPPPPcpGroups ] 600## 601## Comment: technical function (collecting word * g_i, assuming that word is 602## collected) 603## 604InstallGlobalFunction( Collect_word_gi_ppowerpolypcp, 605 function( word_in, c_in, div_in, i, ParPres ) 606 local p, n, d, rel, expo, expo_vec, word, c, div, stack, l_st, u, e, 607 l_w, l, j, k, list, help, Zero0, One1, s, new_word, new_help, 608 stack_2; 609 610 p := ParPres!.prime; 611 n := ParPres!.n; 612 d := ParPres!.d; 613 rel := ParPres!.rel; 614 expo := ParPres!.expo; 615 expo_vec := ParPres!.expo_vec; 616 617 if i > n then 618 Error( "Wrong input" ); 619 fi; 620 621 word := StructuralCopy( word_in ); 622 l_w := Length( word ); 623 c := StructuralCopy( c_in ); 624 div := StructuralCopy( div_in ); 625 626 if l_w = 0 then 627 return [ [[i,1]], c, div ]; 628 fi; 629 630 stack := [[i,1]]; 631 l_st := 1; 632 633 Zero0 := Int2PPowerPoly( p, 0 ); 634 One1 := Int2PPowerPoly( p, 1 ); 635 636 ## run until stacks are empty 637 while l_st > 0 do 638 ## for checking 639 if InfoLevel( InfoCollectingPPPPcp ) = 1 then 640 stack_2 := []; 641 for j in [1..l_st] do 642 stack_2[j] := stack[j]; 643 od; 644 Print( "\nword = ", word, "\n c = ", c, "\n stack = ", stack_2 ); 645 Print( "\n div = ", div, "\n" ); 646 fi; 647 648 ## take a generator and its exponent 649 u := stack[l_st][1]; 650 e := stack[l_st][2]; 651 652 if InfoLevel( InfoCollectingPPPPcp ) = 1 then 653 Print("\n u = ", u, " e = ", e, "\n" ); 654 fi; 655 656 ## correct stack length 657 ## if u <= n and e > 1 than keep [u,e-1] on stack, to do later 658 ## note: u <= n and e>1 should not occur 659 if u > n or e = 1 then 660 l_st := l_st - 1; 661 else stack[l_st][2] := stack[l_st][2] - 1; 662 fi; 663 664 if l_w = 0 then 665 l_w := l_w + 1; 666 word[l_w] := [u,e]; 667 else 668 j := word[l_w][1]; 669 ## if we take a g from the stack 670 if u <= n then 671 while u < j do 672 ## conjugate through higher, first c's 673 if j > n+d then 674 list := Add_ci_c_ppowerpolypcp( j-n-d, c[j-n-d], word[l_w][2], div[j-n-d], 1, expo_vec ); 675 c[j-n-d] := list[1]; 676 div[j-n-d] := list[2]; 677 l_w := l_w - 1; 678 ## .., then t's 679 elif j > n then 680 ## get the relation 681 help := MakeMutableCopyListPPP( rel[j][u] ); 682 ## possibly power relation 683 if word[l_w][2] <> One1 then 684 new_help := []; 685 for l in [1..Length( help )] do 686 if help[l][1] > n+d then 687 list := Add_ci_c_ppowerpolypcp( help[l][1]-n-d, c[help[l][1]-n-d], PPP_Mult( help[l][2], word[l_w][2] ), div[help[l][1]-n-d], 1, expo_vec ); 688 c[help[l][1]-n-d] := list[1]; 689 div[help[l][1]-n-d] := list[2]; 690 else new_help[Length(new_help)+1] := help[l]; 691 fi; 692 od; 693 help := StructuralCopy( new_help ); 694 if Length( help ) > 0 then 695 list := Collect_t_y_ppowerpolypcp( help, word[l_w][2], c, div, ParPres ); 696 help := list[1]; 697 c := list[2]; 698 div := list[3]; 699 fi; 700 fi; 701 ## put relation on stack 702 for k in [Length(help),Length(help)-1..1] do 703 if help[k][1] > n+d then 704 list := Add_ci_c_ppowerpolypcp( help[k][1]-n-d, c[help[k][1]-n-d], help[k][2], div[help[k][1]-n-d], 1, expo_vec ); 705 c[help[k][1]-n-d] := list[1]; 706 div[help[k][1]-n-d] := list[2]; 707 elif help[k][1] > n then 708 l_st := l_st + 1; 709 stack[l_st] := help[k]; 710 else 711 for l in [1..help[k][2]] do 712 l_st := l_st + 1; 713 stack[l_st] := [help[k][1], 1]; 714 od; 715 fi; 716 od; 717 l_w := l_w - 1; 718 ## .., and now higher g's 719 else 720 ## get relation 721 help := MakeMutableCopyListPPP( rel[j][u] ); 722 ## put relations word[l_w][2]-times on stack 723 for l in [1..word[l_w][2]] do 724 for k in [Length(help),Length(help)-1..1] do 725 if help[k][1] > n+d then 726 list := Add_ci_c_ppowerpolypcp( help[k][1]-n-d, c[help[k][1]-n-d], help[k][2], div[help[k][1]-n-d], 1, expo_vec ); 727 c[help[k][1]-n-d] := list[1]; 728 div[help[k][1]-n-d] := list[2]; 729 elif help[k][1] > n then 730 l_st := l_st + 1; 731 stack[l_st] := [help[k][1], help[k][2]]; 732 else 733 for s in [1..help[k][2]] do 734 l_st := l_st + 1; 735 stack[l_st] := [ help[k][1] , 1 ]; 736 od; 737 fi; 738 od; 739 od; 740 l_w := l_w - 1; 741 fi; 742 if l_w > 0 then 743 j := word[l_w][1]; 744 else j := 0; 745 fi; 746 od; 747 ## add [u,e] to the word, according to what is left 748 if l_w > 0 then 749 if word[l_w][1] = u then 750 if IsInt( word[l_w][2] ) and IsInt( e ) then 751 word[l_w][2] := word[l_w][2] + e; 752 else PPP_Add( word[l_w][2], e ); 753 fi; 754 else l_w := l_w + 1; 755 word[l_w] := [u,e]; 756 fi; 757 else l_w := l_w + 1; 758 word[l_w] := [u,e]; 759 fi; 760 new_word := []; 761 for k in [l_w,l_w-1..1] do 762 new_word[k] := word[k]; 763 od; 764 ## reduce the new add highest element in word 765 word := new_word; 766 list := Reduce_word_gi_ppowerpolypcp( word, c, div, ParPres ); 767 word := list[1]; 768 l_w := Length( word ); 769 c := list[2]; 770 div := list[3]; 771 ## if we take a t from the stack, collect 772 elif u <= n+d then 773 list := Collect_word_ti_ppowerpolypcp( u,e,word,c,div,ParPres ); 774 word := list[1]; 775 l_w := Length( word ); 776 c := list[2]; 777 div := list[3]; 778 ## if we take a tail from the stack add 779 else list := Add_ci_c_ppowerpolypcp( u-n-d, c[u-n-d], e, div[u-n-d], 1, expo_vec ); 780 c[u-n-d] := list[1]; 781 div[u-n-d] := list[2]; 782 fi; 783 fi; 784 od; 785 786 return [ word, c, div ]; 787 end); 788 789############################################################################### 790## 791## CollectPPPPcp( obj ) 792## 793## Input: a p-power-poly-pcp-groups element obj 794## 795## Output: obj in collected form 796## 797InstallMethod( CollectPPPPcp, 798 "collect a word in p-power-poly-pcp groups", 799 [ IsPPPPcpGroupsElement ], 800 function( obj ) 801 local word, ParPres, new_word, c, div, p, n, d, m, Zero0, i, list, 802 expo_vec, j, expo, test, c_test, k, quot, l, elm, rel, len_rel; 803 804 word := StructuralCopy( obj!.word ); 805 div := StructuralCopy( obj!.div ); 806 ParPres := obj!.grp_pres; 807 808 p := ParPres!.prime; 809 n := ParPres!.n; 810 d := ParPres!.d; 811 m := ParPres!.m; 812 expo := ParPres!.expo; 813 expo_vec := ParPres!.expo_vec; 814 815 Zero0 := Int2PPowerPoly( p, 0 ); 816 817 ## check input 818 for i in [1..Length( word )] do 819 if Length( word[i] ) <> 2 then 820 Error( "Wrong input." ); 821 elif word[i][1] < 1 or word[i][1] > n+d+m then 822 Error( "Wrong input." ); 823 elif word[i][1] <= n and not IsInt( word[i][2] ) then 824 Error( "Wrong input." ); 825 elif word[i][1] > n and not IsList( word[i][2] ) then 826 Error( "Wrong input." ); 827 elif word[i][1] > n and word[i][2][1] <> ParPres!.prime then 828 Error( "Wrong input." ); 829 fi; 830 od; 831 832 ## initialise the tails c 833 c := []; 834 for i in [m,m-1..1] do 835 c[i] := Zero0; 836 od; 837 838 c_test := StructuralCopy( c ); 839 840 ## ensure that all exponents are non-negative 841 i := 1; 842 while i <= Length( word ) do 843 new_word := []; 844 if word[i][1] <= n then 845 if word[i][2] < 0 then 846 for j in [1..i - 1] do 847 new_word[j] := word[j]; 848 od; 849 quot := QuotientRemainder( word[i][2], p ); 850 if quot[2] < 0 then 851 quot[1] := quot[1] + 1; 852 quot[2] := quot[2] + p; 853 fi; 854 new_word[i] := []; 855 new_word[i][1] := word[i][1]; 856 new_word[i][2] := quot[2]; 857 for j in [1..quot[1]] do 858 k := Length( new_word ); 859 rel := ParPres!.rel[word[i][1]][word[i][1]]; 860 len_rel := Length( rel ); 861 for l in [len_rel,len_rel-1..1] do 862 new_word[k+len_rel+1-l] := []; 863 if IsInt( rel[l][1] ) then 864 new_word[k+len_rel+1-l][1] := rel[l][1]; 865 else new_word[k+len_rel+1-l][1] := MakeMutableCopyListPPP( rel[l][1] ); 866 fi; 867 if IsInt( rel[l][2] ) then 868 new_word[k+len_rel+1-l][2] := - rel[l][2]; 869 else new_word[k+len_rel+1-l][2] := MakeMutableCopyListPPP( rel[l][2] ); 870 new_word[k+len_rel+1-l][2][2] := -new_word[k+len_rel+1-l][2][2]; 871 fi; 872 od; 873 od; 874 k := Length( new_word ); 875 for j in [i+1..Length( word )] do 876 new_word[k+j-i] := word[j]; 877 od; 878 word := StructuralCopy( new_word ); 879 i := i + 1; 880 else i := i + 1; 881 fi; 882 elif word[i][1] <= n+d then 883 if PPP_Smaller( word[i][2], Zero0 ) then 884 for j in [1..i-1] do 885 new_word[j] := word[j]; 886 od; 887 quot := PPP_QuotientRemainder( word[i][2], expo ); 888 if PPP_Smaller( quot[2], Zero0 ) then 889 quot[1] := quot[1] + 1; 890 quot[2] := PPP_Add( quot[2], expo ); 891 fi; 892 new_word[i] := []; 893 new_word[i][1] := word[i][1]; 894 new_word[i][2] := quot[2]; 895 if not PPP_Equal( quot[1], Zero0 ) then 896 elm := PPPPcpGroupsElement( ParPres, ParPres!.rel[word[i][1]][word[i][1]] ); 897 if elm <> One(elm) then 898 list := Collect_t_y_ppowerpolypcp( elm!.word, quot[1] , c , div , ParPres ); 899 elm := list[1]; 900 c := list[2]; 901 div := list[3]; 902 for j in [1..Length( elm )] do 903 k := Length( new_word ); 904 new_word[k+j] := elm[j]; 905 od; 906 fi; 907 fi; 908 k := Length( new_word ); 909 for j in [i+1..Length( word )] do 910 new_word[k+j-i] := word[j]; 911 od; 912 word := StructuralCopy( new_word ); 913 i := i + 1; 914 else i := i + 1; 915 fi; 916 elif not PPP_Equal( expo_vec[word[i][1]-n-d], Zero0 ) and PPP_Smaller( word[i][2], Zero0 ) then 917 for j in [1..i-1] do 918 new_word[j] := word[j]; 919 od; 920 quot := PPP_QuotientRemainder( word[i][2], expo_vec[word[i][1]-n-d] ); 921 if quot[2] < Zero0 then 922 quot[1] := quot[1] + 1; 923 quot[2] := PPP_Add( quot[2], expo_vec[word[i][1]-n-d] ); 924 fi; 925 new_word[i] := []; 926 new_word[i][1] := word[i][1]; 927 new_word[i][2] := quot[2]; 928 for j in [i+1..Length( word )] do 929 new_word[j] := word[j]; 930 od; 931 word := StructuralCopy( new_word ); 932 i := i + 1; 933 else i := i + 1; 934 fi; 935 od; 936 937 new_word := []; 938 j := 1; 939 ## find the first non-zero, non-tail entry 940 test := false; 941 while j <= Length( word ) and not test do 942 ## TODO < changed to <=. This is right, isn't it? 943 if ( word[j][1] <= n and word[j][2] = 0 ) or ( word[j][1] > n and PPP_Equal( word[j][2], Zero0 ) ) then 944 j := j + 1; 945 elif word[j][1] > n+d then 946 list := Add_ci_c_ppowerpolypcp( word[j][1]-n-d, c[word[j][1]-n-d], word[j][2], div[word[j][1]-n-d], 1, expo_vec ); 947 c[word[j][1]-n-d] := list[1]; 948 div[word[j][1]-n-d] := list[2]; 949 j := j + 1; 950 else test := true; 951 fi; 952 od; 953 954 ## if all elements are zero and no non-tail element, return empty word 955 if j > Length( word ) and ForAll( [1..m], x -> PPP_Equal( c[x], c_test[x] ) ) then 956 return PPPPcpGroupsElementNC( ParPres, [] ); 957 ## if there is non-trivial non-tail, add this to new_word and reduce 958 elif j <= Length( word ) then 959 new_word[1] := word[j]; 960 if new_word[1][1] <= n and new_word[1][2] >= p then 961 list := Reduce_word_gi_ppowerpolypcp( new_word, c, div, ParPres ); 962 new_word := list[1]; 963 c := list[2]; 964 div := list[3]; 965 elif new_word[1][1]>n and new_word[1][1]<=n+d and not PPP_Smaller( new_word[1][2], expo ) then 966 list := Reduce_word_ti_ppowerpolypcp( new_word, c, div, ParPres ); 967 new_word := list[1]; 968 c := list[2]; 969 div := list[3]; 970 elif new_word[1][1]>n+d and not PPP_Smaller( new_word[1][2], expo_vec[new_word[1][1]-n-d] ) then 971 list := Reduce_ci_ppowerpolypcp( new_word[1][2], div[new_word[1][1]], new_word[1][1]-n-d, expo_vec ); 972 new_word[1][2] := list[1]; 973 div[new_word[1][1]] := list[2]; 974 fi; 975 fi; 976 977 ## add the remaining non-trivial word parts to new_word 978 for i in [j+1..Length(word)] do 979 if word[i][1] > n+d then 980 if not PPP_Equal( word[i][2], Zero0 ) then 981 list := Add_ci_c_ppowerpolypcp( word[i][1]-n-d, c[word[i][1]-n-d], word[i][2], div[word[i][1]-n-d], 1, expo_vec ); 982 c[word[i][1]-n-d] := list[1]; 983 div[word[i][1]-n-d] := list[2]; 984 fi; 985 elif word[i][1] > n then 986 if not PPP_Equal( word[i][2], Zero0 ) then 987 list := Collect_word_ti_ppowerpolypcp( word[i][1], word[i][2], new_word, c, div, ParPres ); 988 new_word := list[1]; 989 c := list[2]; 990 div := list[3]; 991 fi; 992 else 993 for k in [1..word[i][2]] do 994 list := Collect_word_gi_ppowerpolypcp( new_word, c, div, word[i][1], ParPres ); 995 new_word := list[1]; 996 c := list[2]; 997 div := list[3]; 998 od; 999 fi; 1000 od; 1001 1002 ## check that div[i] = 1 if c[i] = 0 1003 for i in [1..m] do 1004 if div[i] <> 1 and PPP_Equal( c[i], Zero0 ) then 1005 div[i] := 1; 1006 fi; 1007 od; 1008 1009 ## add tails to new word 1010 for i in [1..m] do 1011 list := Reduce_ci_ppowerpolypcp( c[i], div[i], i, expo_vec ); 1012 c[i] := list[1]; 1013 div[i] := list[2]; 1014 1015 if not PPP_Equal( c[i], Zero0 ) then 1016 if not PPP_Equal( expo_vec[i], Zero0 ) and PPP_Smaller( c[i], Zero0 ) then 1017 new_word[Length(new_word)+1] := [n+d+i,expo_vec[i]+c[i]]; 1018 else new_word[Length(new_word)+1] := [n+d+i,c[i]]; 1019 fi; 1020 fi; 1021 od; 1022 1023 return PPPPcpGroupsElementNC( ParPres, new_word, div ); 1024 end); 1025 1026#E Collect.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here 1027