1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This file contains the part of the deep thought package which uses the
11 ** deep thought polynomials to multiply in nilpotent groups.
12 **
13 ** The deep thought polynomials are stored in the list <dtpols> where
14 ** <dtpols>[i] contains the polynomials f_{i1},...,f_{in}.
15 ** <dtpols>[i] is a record consisting of the components <evlist> and
16 ** <evlistvec>. <evlist> is a list of all deep thought monomials occurring
17 ** in the polynomials f_{i1},...,f_{in}. <evlistvec>is a list of vectors
18 ** describing the coefficients of the corresponding deep thought monomials
19 ** in the polynomials f_{i1},..,f_{in}. For example when a pair [j,k]
20 ** occurs in <dtpols>[i].<evlistvec>[l] then the deep thought monomial
21 ** <dtpols>[i].<evlist>[l] occurs in f_{ij} with the coefficient k.
22 ** If the polynomials f_{i1},..,f_{in} are trivial i.e. f_{ii} = x_i + y_i
23 ** and f_{ij} = x_j (j<>i), then <dtpols>[i] is either 1 or 0. <dtpols>[i]
24 ** is 0 if also the polynomials f_{m1},...,f_{mn} for (m > i) are trivial .
25 */
26
27 #include "dteval.h"
28
29 #include "dt.h"
30 #include "integer.h"
31 #include "modules.h"
32 #include "objcftl.h"
33 #include "plist.h"
34 #include "precord.h"
35 #include "records.h"
36
37 #ifdef HPCGAP
38 #include "hpc/guards.h"
39 #endif
40
41 #define CELM(list, pos) ( INT_INTOBJ( ELM_PLIST(list, pos) ) )
42
43 static int evlist, evlistvec;
44
45
46 /****************************************************************************
47 **
48 *F MultGen( <xk>, <gen>, <power>, <dtpols> )
49 **
50 ** MultGen multiplies the word given by the exponent vector <xk> with
51 ** g_<gen>^<power> by evaluating the deep thought polynomials. The result
52 ** is an ordered word and stored in <xk>.
53 */
54
55 /* See below: */
56 static Obj Evaluation(Obj vec, Obj xk, Obj power);
57
MultGen(Obj xk,UInt gen,Obj power,Obj dtpols)58 static void MultGen(Obj xk, UInt gen, Obj power, Obj dtpols)
59 {
60 UInt i, j, len, len2;
61 Obj copy, sum, sum1, sum2, prod, ord, help;
62
63 if ( power == INTOBJ_INT(0) )
64 return;
65 sum = SumInt(ELM_PLIST(xk, gen), power);
66 if ( IS_INTOBJ( ELM_PLIST(dtpols, gen) ) )
67 {
68 /* if f_{<gen>1},...,f_{<gen>n} are trivial we only have to add
69 ** <power> to <xk>[ <gen> ]. */
70 SET_ELM_PLIST(xk, gen, sum);
71 CHANGED_BAG(xk);
72 return;
73 }
74 copy = ShallowCopyPlist(xk);
75 /* first add <power> to <xk>[ gen> ]. */
76 SET_ELM_PLIST(xk, gen, sum);
77 CHANGED_BAG(xk);
78 sum = ElmPRec( ELM_PLIST(dtpols, gen), evlist );
79 sum1 = ElmPRec( ELM_PLIST(dtpols, gen), evlistvec);
80 len = LEN_PLIST(sum);
81 for ( i=1;
82 i <= len;
83 i++ )
84 {
85 /* evaluate the deep thought monomial <sum>[<i>], */
86 ord = Evaluation( ELM_PLIST( sum, i), copy, power );
87 if ( ord != INTOBJ_INT(0) )
88 {
89 help = ELM_PLIST(sum1, i);
90 len2 = LEN_PLIST(help);
91 for ( j=1;
92 j < len2;
93 j+=2 )
94 {
95 /* and add the result multiplied by the right coefficient
96 ** to <xk>[ <help>[j] ]. */
97 prod = ProdInt( ord, ELM_PLIST( help, j+1 ) );
98 sum2 = SumInt(ELM_PLIST( xk, CELM( help,j ) ),
99 prod);
100 SET_ELM_PLIST(xk, CELM( help, j ),
101 sum2 );
102 CHANGED_BAG(xk);
103 }
104 }
105 }
106 }
107
108
109
110 /****************************************************************************
111 **
112 *F Evaluation( <vec>, <xk>, <power>)
113 **
114 ** Evaluation evaluates the deep thought monomial <vec> at the entries in
115 ** <xk> and at <power>.
116 */
117
Evaluation(Obj vec,Obj xk,Obj power)118 static Obj Evaluation(Obj vec, Obj xk, Obj power)
119 {
120 UInt i, len;
121 Obj prod, help;
122
123 if ( IS_INTOBJ(power) && INT_INTOBJ(power) > 0 &&
124 power < ELM_PLIST(vec, 6) )
125 return INTOBJ_INT(0);
126 prod = BinomialInt(power, ELM_PLIST(vec, 6) );
127 len = LEN_PLIST(vec);
128 for (i=7; i < len; i+=2)
129 {
130 help = ELM_PLIST(xk, CELM(vec, i) );
131 if ( IS_INTOBJ( help ) &&
132 ( INT_INTOBJ(help) == 0 ||
133 ( INT_INTOBJ(help) > 0 && help < ELM_PLIST(vec, i+1) ) ) )
134 return INTOBJ_INT(0);
135 prod = ProdInt( prod, BinomialInt(help, ELM_PLIST(vec, i+1) ) );
136 }
137 return prod;
138 }
139
140
141
142 /****************************************************************************
143 **
144 *F Multbound( <xk>, <y>, <anf>, <end>, <dtpols> )
145 **
146 ** Multbound multiplies the word given by the exponent vector <xk> with
147 ** <y>{ [<anf>..<end>] } by evaluating the deep thought polynomials <dtpols>
148 ** The result is an ordered word and is stored in <xk>.
149 */
150
Multbound(Obj xk,Obj y,Int anf,Int end,Obj dtpols)151 static void Multbound(Obj xk, Obj y, Int anf, Int end, Obj dtpols)
152 {
153 int i;
154
155 for (i=anf; i < end; i+=2)
156 MultGen(xk, CELM( y, i), ELM_PLIST( y, i+1) , dtpols);
157 }
158
159
160
161 /****************************************************************************
162 **
163 *F Multiplybound( <x>, <y>, <anf>, <end>, <dtpols> )
164 **
165 ** Multiplybound returns the product of the word <x> with the word
166 ** <y>{ [<anf>..<end>] } by evaluating the deep thought polynomials <dtpols>.
167 ** The result is an ordered word.
168 */
169
Multiplybound(Obj x,Obj y,Int anf,Int end,Obj dtpols)170 static Obj Multiplybound(Obj x, Obj y, Int anf, Int end, Obj dtpols)
171 {
172 UInt i, j, k, len, help;
173 Obj xk, res, sum;
174
175 if ( LEN_PLIST( x ) == 0 )
176 return y;
177 if ( anf > end )
178 return x;
179 /* first deal with the case that <y>{ [<anf>..<end>] } lies in the center
180 ** of the group defined by <dtpols> */
181 if ( IS_INTOBJ( ELM_PLIST(dtpols, CELM(y, anf) ) ) &&
182 CELM(dtpols, CELM(y, anf) ) == 0 )
183 {
184 res = NEW_PLIST( T_PLIST, 2*LEN_PLIST( dtpols ) );
185 len = LEN_PLIST(x);
186 j = 1;
187 k = anf;
188 i = 1;
189 while ( j<len && k<end )
190 {
191 if ( ELM_PLIST(x, j) == ELM_PLIST(y, k) )
192 {
193 sum = SumInt( ELM_PLIST(x, j+1), ELM_PLIST(y, k+1) );
194 SET_ELM_PLIST(res, i, ELM_PLIST(x, j) );
195 SET_ELM_PLIST(res, i+1, sum );
196 j+=2;
197 k+=2;
198 }
199 else if ( ELM_PLIST(x, j) < ELM_PLIST(y, k) )
200 {
201 SET_ELM_PLIST(res, i, ELM_PLIST(x, j) );
202 SET_ELM_PLIST(res, i+1, ELM_PLIST(x, j+1) );
203 j+=2;
204 }
205 else
206 {
207 SET_ELM_PLIST(res, i, ELM_PLIST(y, k) );
208 SET_ELM_PLIST(res, i+1, ELM_PLIST(y, k+1) );
209 k+=2;
210 }
211 CHANGED_BAG(res);
212 i+=2;
213 }
214 if ( j>=len )
215 while ( k<end )
216 {
217 SET_ELM_PLIST(res, i, ELM_PLIST(y, k) );
218 SET_ELM_PLIST(res, i+1, ELM_PLIST(y, k+1 ) );
219 CHANGED_BAG(res);
220 k+=2;
221 i+=2;
222 }
223 else
224 while ( j<len )
225 {
226 SET_ELM_PLIST(res, i, ELM_PLIST(x, j) );
227 SET_ELM_PLIST(res, i+1, ELM_PLIST(x, j+1) );
228 CHANGED_BAG(res);
229 j+=2;
230 i+=2;
231 }
232 SET_LEN_PLIST(res, i-1);
233 SHRINK_PLIST(res, i-1);
234 return res;
235 }
236 len = LEN_PLIST(dtpols);
237 help = LEN_PLIST(x);
238 /* convert <x> into a exponent vector */
239 xk = NEW_PLIST( T_PLIST, len );
240 SET_LEN_PLIST(xk, len );
241 j = 1;
242 for (i=1; i <= len; i++)
243 {
244 if ( j >= help || i < CELM(x, j) )
245 SET_ELM_PLIST(xk, i, INTOBJ_INT(0) );
246 else
247 {
248 SET_ELM_PLIST(xk, i, ELM_PLIST(x, j+1) );
249 j+=2;
250 }
251 }
252 /* let Multbound do the work */
253 Multbound(xk, y, anf, end, dtpols);
254 /* finally convert the result back into a word */
255 res = NEW_PLIST(T_PLIST, 2*len);
256 j = 0;
257 for (i=1; i <= len; i++)
258 {
259 if ( !( IS_INTOBJ( ELM_PLIST(xk, i) ) && CELM(xk, i) == 0 ) )
260 {
261 j+=2;
262 SET_ELM_PLIST(res, j-1, INTOBJ_INT(i) );
263 SET_ELM_PLIST(res, j, ELM_PLIST(xk, i) );
264 }
265 }
266 SET_LEN_PLIST(res, j);
267 SHRINK_PLIST(res, j);
268 return res;
269 }
270
271
272
273 /****************************************************************************
274 **
275 *F Power( <x>, <n>, <dtpols> )
276 **
277 ** Power returns the <n>-th power of the word <x> as ordered word by
278 ** evaluating the deep thought polynomials <dtpols>.
279 */
280
281 /* See below: */
282 static Obj Solution(Obj x, Obj y, Obj dtpols);
283
Power(Obj x,Obj n,Obj dtpols)284 static Obj Power(Obj x, Obj n, Obj dtpols)
285 {
286 Obj res, m, y;
287 UInt i,len;
288
289 if ( LEN_PLIST(x) == 0 )
290 return x;
291 /* first deal with the case that <x> lies in the centre of the group
292 ** defined by <dtpols> */
293 if ( IS_INTOBJ( ELM_PLIST( dtpols, CELM(x, 1) ) ) &&
294 CELM( dtpols, CELM(x, 1) ) == 0 )
295 {
296 len = LEN_PLIST(x);
297 res = NEW_PLIST( T_PLIST, len );
298 SET_LEN_PLIST(res, len );
299 for (i=2;i<=len;i+=2)
300 {
301 m = ProdInt( ELM_PLIST(x, i), n );
302 SET_ELM_PLIST(res, i, m );
303 SET_ELM_PLIST(res, i-1, ELM_PLIST(x, i-1) );
304 CHANGED_BAG( res );
305 }
306 return res;
307 }
308 /* if <n> is a negative integer compute ( <x>^-1 )^(-<n>) */
309 if ( IS_NEG_INT(n) )
310 {
311 y = NEW_PLIST( T_PLIST, 0);
312 return Power( Solution(x, y, dtpols), AInvInt(n), dtpols );
313 }
314 res = NEW_PLIST(T_PLIST, 2);
315 if ( n == INTOBJ_INT(0) )
316 return res;
317 /* now use the russian peasant rule to get the result */
318 while( LtInt(INTOBJ_INT(0), n) )
319 {
320 len = LEN_PLIST(x);
321 if ( ModInt(n, INTOBJ_INT(2) ) == INTOBJ_INT(1) )
322 res = Multiplybound(res, x, 1, len, dtpols);
323 if ( LtInt(INTOBJ_INT(1), n) )
324 x = Multiplybound(x, x, 1, len, dtpols);
325 n = QuoInt(n, INTOBJ_INT(2) );
326 }
327 return res;
328 }
329
330
331
332 /****************************************************************************
333 **
334 *F Solution( <x>, <y>, <dtpols> )
335 **
336 ** Solution returns a solution for the equation <x>*a = <y> by evaluating
337 ** the deep thought polynomials <dtpols>. The result is an ordered word.
338 */
339
Solution(Obj x,Obj y,Obj dtpols)340 static Obj Solution(Obj x, Obj y, Obj dtpols)
341
342 {
343 Obj xk, res, m;
344 UInt i,j,k, len1, len2;
345
346 if ( LEN_PLIST(x) == 0)
347 return y;
348 /* first deal with the case that <x> and <y> lie in the centre of the
349 ** group defined by <dtpols>. */
350 if ( IS_INTOBJ( ELM_PLIST( dtpols, CELM(x, 1) ) ) &&
351 CELM( dtpols, CELM(x, 1) ) == 0 &&
352 ( LEN_PLIST(y) == 0 ||
353 ( IS_INTOBJ( ELM_PLIST( dtpols, CELM(y, 1) ) ) &&
354 CELM( dtpols, CELM(y, 1) ) == 0 ) ) )
355 {
356 res = NEW_PLIST( T_PLIST, 2*LEN_PLIST( dtpols ) );
357 i = 1;
358 j = 1;
359 k = 1;
360 len1 = LEN_PLIST(x);
361 len2 = LEN_PLIST(y);
362 while ( j < len1 && k < len2 )
363 {
364 if ( ELM_PLIST(x, j) == ELM_PLIST(y, k) )
365 {
366 m = DiffInt( ELM_PLIST(y, k+1), ELM_PLIST(x, j+1) );
367 SET_ELM_PLIST( res, i, ELM_PLIST(x, j) );
368 SET_ELM_PLIST( res, i+1, m );
369 CHANGED_BAG( res );
370 i+=2; j+=2; k+=2;
371 }
372 else if ( CELM(x, j) < CELM(y, k) )
373 {
374 m = AInvInt( ELM_PLIST(x, j+1) );
375 SET_ELM_PLIST( res, i, ELM_PLIST(x, j) );
376 SET_ELM_PLIST( res, i+1, m );
377 CHANGED_BAG( res );
378 i+=2; j+=2;
379 }
380 else
381 {
382 SET_ELM_PLIST( res, i, ELM_PLIST(y, k) );
383 SET_ELM_PLIST( res, i+1, ELM_PLIST(y, k+1) );
384 CHANGED_BAG( res );
385 i+=2; k+=2;
386 }
387 }
388 if ( j < len1 )
389 while( j < len1 )
390 {
391 m = AInvInt( ELM_PLIST( x, j+1 ) );
392 SET_ELM_PLIST( res, i, ELM_PLIST(x, j) );
393 SET_ELM_PLIST( res, i+1, m );
394 CHANGED_BAG( res );
395 i+=2; j+=2;
396 }
397 else
398 while( k < len2 )
399 {
400 SET_ELM_PLIST( res, i ,ELM_PLIST(y, k) );
401 SET_ELM_PLIST( res, i+1, ELM_PLIST(y, k+1) );
402 CHANGED_BAG( res );
403 i+=2; k+=2;
404 }
405 SET_LEN_PLIST( res, i-1 );
406 SHRINK_PLIST( res, i-1);
407 return res;
408 }
409 /* convert <x> into an exponent vector */
410 xk = NEW_PLIST( T_PLIST, LEN_PLIST(dtpols) );
411 SET_LEN_PLIST(xk, LEN_PLIST(dtpols) );
412 j = 1;
413 for (i=1; i <= LEN_PLIST(dtpols); i++)
414 {
415 if ( j >= LEN_PLIST(x) || i < CELM(x, j) )
416 SET_ELM_PLIST(xk, i, INTOBJ_INT(0) );
417 else
418 {
419 SET_ELM_PLIST(xk, i, ELM_PLIST(x, j+1) );
420 j+=2;
421 }
422 }
423 res = NEW_PLIST( T_PLIST, 2*LEN_PLIST( xk ) );
424 j = 1;
425 k = 1;
426 len1 = LEN_PLIST(xk);
427 len2 = LEN_PLIST(y);
428 for (i=1; i <= len1; i++)
429 {
430 if ( k < len2 && i == CELM(y, k) )
431 {
432 if ( !EqInt( ELM_PLIST(xk, i), ELM_PLIST(y, k+1) ) )
433 {
434 m = DiffInt( ELM_PLIST(y, k+1), ELM_PLIST(xk, i) );
435 SET_ELM_PLIST(res, j, INTOBJ_INT(i) );
436 SET_ELM_PLIST(res, j+1, m);
437 CHANGED_BAG(res);
438 MultGen(xk, i, m, dtpols);
439 j+=2;
440 }
441 k+=2;
442 }
443 else if ( !IS_INTOBJ( ELM_PLIST(xk, i) ) || CELM( xk, i ) != 0 )
444 {
445 m = AInvInt( ELM_PLIST(xk, i) );
446 SET_ELM_PLIST( res, j, INTOBJ_INT(i) );
447 SET_ELM_PLIST( res, j+1, m );
448 CHANGED_BAG(res);
449 MultGen(xk, i, m, dtpols);
450 j+=2;
451 }
452 }
453 SET_LEN_PLIST(res, j-1);
454 SHRINK_PLIST(res, j-1);
455 return res;
456 }
457
458
459
460 /****************************************************************************
461 **
462 *F Commutator( <x>, <y>, <dtpols> )
463 **
464 ** Commutator returns the commutator of the word <x> and <y> by evaluating
465 ** the deep thought polynomials <dtpols>.
466 */
467
Commutator(Obj x,Obj y,Obj dtpols)468 static Obj Commutator(Obj x, Obj y, Obj dtpols)
469 {
470 Obj res, help;
471
472 res = Multiplybound(x, y, 1, LEN_PLIST(y), dtpols);
473 help = Multiplybound(y, x, 1, LEN_PLIST(x), dtpols);
474 res = Solution(help, res, dtpols);
475 return res;
476 }
477
478
479
480 /****************************************************************************
481 **
482 *F Conjugate( <x>, <y>, <dtpols> )
483 **
484 ** Conjugate returns <x>^<y> for the words <x> and <y> by evaluating the
485 ** deep thought polynomials <dtpols>. The result is an ordered word.
486 */
487
Conjugate(Obj x,Obj y,Obj dtpols)488 static Obj Conjugate(Obj x, Obj y, Obj dtpols)
489 {
490 Obj res;
491
492 res = Multiplybound(x, y, 1, LEN_PLIST(y), dtpols);
493 res = Solution(y, res, dtpols);
494 return res;
495 }
496
497
498
499 /****************************************************************************
500 **
501 *F Multiplyboundred( <x>, <y>, <anf>, <end>, <pcp> )
502 **
503 ** Multiplyboundred returns the product of the words <x> and <y>. The result
504 ** is an ordered word with the additional property that all word exponents
505 ** are reduced modulo the corresponding generator orders given by the
506 ** deep thought rewriting system <pcp>..
507 */
508
Multiplyboundred(Obj x,Obj y,UInt anf,UInt end,Obj pcp)509 static Obj Multiplyboundred(Obj x, Obj y, UInt anf, UInt end, Obj pcp)
510 {
511 Obj orders, res, mod, c;
512 UInt i, len, len2, help;
513
514 orders = ELM_PLIST(pcp, PC_ORDERS);
515 res = Multiplybound(x,y,anf, end, ELM_PLIST( pcp, PC_DEEP_THOUGHT_POLS) );
516 len = LEN_PLIST(res);
517 len2 = LEN_PLIST(orders);
518 for (i=2; i<=len; i+=2)
519 if ( (help=CELM(res, i-1)) <= len2 &&
520 ( c=ELM_PLIST( orders, help )) != 0 )
521 {
522 mod = ModInt( ELM_PLIST(res, i), c );
523 SET_ELM_PLIST( res, i, mod);
524 CHANGED_BAG(res);
525 }
526 return res;
527 }
528
529
530
531 /****************************************************************************
532 **
533 *F Powerred( <x>, <n>, <pcp>
534 **
535 ** Powerred returns the <n>-th power of the word <x>. The result is an
536 ** ordered word with the additional property that all word exponents are
537 ** reduced modulo the generator orders given by the deep thought rewriting
538 ** system <pcp>.
539 */
540
Powerred(Obj x,Obj n,Obj pcp)541 static Obj Powerred(Obj x, Obj n, Obj pcp)
542 {
543 Obj orders, res, mod, c;
544 UInt i, len, len2,help;
545
546 orders = ELM_PLIST(pcp, PC_ORDERS);
547 res = Power(x, n, ELM_PLIST( pcp, PC_DEEP_THOUGHT_POLS) );
548 len = LEN_PLIST(res);
549 len2 = LEN_PLIST(orders);
550 for (i=2; i<=len; i+=2)
551 if ( (help=CELM(res, i-1)) <= len2 &&
552 ( c=ELM_PLIST( orders, help )) != 0 )
553 {
554 mod = ModInt( ELM_PLIST(res, i), c );
555 SET_ELM_PLIST( res, i, mod);
556 CHANGED_BAG(res);
557 }
558 return res;
559 }
560
561
562
563 /****************************************************************************
564 **
565 *F Solutionred( <x>, <y>, <pcp> )
566 **
567 ** Solutionred returns the solution of the equation <x>*a = <y>. The result
568 ** is an ordered word with the additional property that all word exponents
569 ** are reduced modulo the generator orders given by the deep thought
570 ** rewriting system <pcp>.
571 */
572
Solutionred(Obj x,Obj y,Obj pcp)573 static Obj Solutionred(Obj x, Obj y, Obj pcp)
574 {
575 Obj orders, res, mod, c;
576 UInt i, len, len2, help;
577
578 orders = ELM_PLIST(pcp, PC_ORDERS);
579 res = Solution(x, y, ELM_PLIST( pcp, PC_DEEP_THOUGHT_POLS) );
580 len = LEN_PLIST(res);
581 len2 = LEN_PLIST(orders);
582 for (i=2; i<=len; i+=2)
583 if ( (help=CELM(res, i-1)) <= len2 &&
584 ( c=ELM_PLIST( orders, help )) != 0 )
585 {
586 mod = ModInt( ELM_PLIST(res, i), c );
587 SET_ELM_PLIST( res, i, mod);
588 CHANGED_BAG(res);
589 }
590 return res;
591 }
592
593
594
595 /****************************************************************************
596 **
597 ** Commutatorred( <x>, <y>, <pcp> )
598 **
599 ** Commutatorred returns the commutator of the words <x> and <y>. The result
600 ** is an ordered word with the additional property that all word exponents
601 ** are reduced modulo the corresponding generator orders given by the deep
602 ** thought rewriting system <pcp>.
603 */
604
Commutatorred(Obj x,Obj y,Obj pcp)605 static Obj Commutatorred(Obj x, Obj y, Obj pcp)
606 {
607 Obj orders, mod, c, res;
608 UInt i, len, len2, help;
609
610 orders = ELM_PLIST(pcp, PC_ORDERS);
611 res = Commutator(x, y, ELM_PLIST( pcp, PC_DEEP_THOUGHT_POLS) );
612 len = LEN_PLIST(res);
613 len2 = LEN_PLIST(orders);
614 for (i=2; i<=len; i+=2)
615 if ( (help=CELM(res, i-1)) <= len2 &&
616 ( c=ELM_PLIST( orders, help )) != 0 )
617 {
618 mod = ModInt( ELM_PLIST(res, i), c );
619 SET_ELM_PLIST( res, i, mod);
620 CHANGED_BAG(res);
621 }
622 return res;
623 }
624
625
626
627 /****************************************************************************
628 **
629 *F Conjugate( <x>, <y>, <pcp> )
630 **
631 ** Conjugate returns <x>^<y> for the words <x> and <y>. The result is an
632 ** ordered word with the additional property that all word exponents are
633 ** reduced modulo the corresponding generator orders given by the deep
634 ** thought rewriting system <pcp>.
635 */
636
Conjugatered(Obj x,Obj y,Obj pcp)637 static Obj Conjugatered(Obj x, Obj y, Obj pcp)
638 {
639 Obj orders, mod, c, res;
640 UInt i, len, len2, help;
641
642 orders = ELM_PLIST(pcp, PC_ORDERS);
643 res = Conjugate(x, y, ELM_PLIST( pcp, PC_DEEP_THOUGHT_POLS) );
644 len = LEN_PLIST(res);
645 len2 = LEN_PLIST(orders);
646 for (i=2; i<=len; i+=2)
647 if ( (help=CELM(res, i-1)) <= len2 &&
648 ( c=ELM_PLIST( orders, help )) != 0 )
649 {
650 mod = ModInt( ELM_PLIST(res, i), c );
651 SET_ELM_PLIST( res, i, mod);
652 CHANGED_BAG(res);
653 }
654 return res;
655 }
656
657
658
659 /****************************************************************************
660 **
661 ** compress( <list> )
662 **
663 ** compress removes pairs (n,0) from the list of GAP integers <list>.
664 */
665
compress(Obj list)666 static void compress(Obj list)
667 {
668 UInt i, skip, len;
669
670 skip = 0;
671 i = 2;
672 len = LEN_PLIST( list );
673 while ( i <= len )
674 {
675 while ( i<=len && CELM(list, i) == 0)
676 {
677 skip+=2;
678 i+=2;
679 }
680 if ( i <= len )
681 {
682 SET_ELM_PLIST(list, i-skip, ELM_PLIST(list, i) );
683 SET_ELM_PLIST(list, i-1-skip, ELM_PLIST( list, i-1 ) );
684 }
685 i+=2;
686 }
687 SET_LEN_PLIST( list, len-skip );
688 CHANGED_BAG( list );
689 SHRINK_PLIST( list, len-skip );
690 }
691
692
693
694 /****************************************************************************
695 **
696 *F FuncDTCompress( <self>, <list> )
697 **
698 ** FuncDTCompress implements the internal function DTCompress.
699 */
700
FuncDTCompress(Obj self,Obj list)701 static Obj FuncDTCompress(Obj self, Obj list)
702 {
703 compress(list);
704 return (Obj)0;
705 }
706
707
708
709 /****************************************************************************
710 **
711 *F ReduceWord( <x>, <pcp> )
712 **
713 ** ReduceWord reduces the ordered word <x> with respect to the deep thought
714 ** rewriting system <pcp> i.e after applying ReduceWord <x> is an ordered
715 ** word with exponents less than the corresponding relative orders given
716 ** by <pcp>.
717 */
718
ReduceWord(Obj x,Obj pcp)719 static void ReduceWord(Obj x, Obj pcp)
720 {
721 Obj powers, exponent;
722 Obj deepthoughtpols, help, potenz, quo, mod, prel;
723 UInt i,j,flag, len, gen, lenexp, lenpow;
724
725 powers = ELM_PLIST(pcp, PC_POWERS);
726 exponent = ELM_PLIST(pcp, PC_EXPONENTS);
727 deepthoughtpols = ELM_PLIST(pcp, PC_DEEP_THOUGHT_POLS);
728 len = LEN_PLIST(deepthoughtpols);
729 lenexp = LEN_PLIST(exponent);
730 lenpow = LEN_PLIST(powers);
731 GROW_PLIST(x, 2*len );
732 flag = LEN_PLIST(x);
733 for (i=1; i<flag; i+=2)
734 {
735 if ( (gen = CELM(x, i) ) <= lenexp &&
736 (potenz = ELM_PLIST(exponent, gen) ) != 0 )
737 {
738 quo = ELM_PLIST(x, i+1);
739 if ( !IS_INTOBJ(quo) || INT_INTOBJ(quo) >= INT_INTOBJ(potenz) ||
740 INT_INTOBJ(quo)<0 )
741 {
742 /* reduce the exponent of the generator <gen> */
743 mod = ModInt( quo, potenz );
744 SET_ELM_PLIST(x, i+1, mod);
745 CHANGED_BAG(x);
746 if ( gen <= lenpow &&
747 (prel = ELM_PLIST( powers, gen) ) != 0 )
748 {
749 if ( ( IS_INTOBJ(quo) && INT_INTOBJ(quo) >= INT_INTOBJ(potenz) ) ||
750 INT_INTOBJ(mod) == 0 ||
751 TNUM_OBJ(quo) == T_INTPOS )
752 {
753 quo = QuoInt(quo, potenz);
754 }
755 else
756 {
757 quo = QuoInt(quo, potenz);
758 quo = SumInt(quo, INTOBJ_INT(-1));
759 }
760 help = Powerred(prel, quo, pcp);
761 help = Multiplyboundred(help, x, i+2, flag, pcp);
762 len = LEN_PLIST(help);
763 for (j=1; j<=len; j++)
764 SET_ELM_PLIST(x, j+i+1, ELM_PLIST(help, j) );
765 CHANGED_BAG(x);
766 flag = i+len+1;
767 /*SET_LEN_PLIST(x, flag);*/
768 }
769 }
770 }
771 }
772 SET_LEN_PLIST(x, flag);
773 SHRINK_PLIST(x, flag);
774 /* remove all syllables with exponent 0 from <x>. */
775 compress(x);
776 }
777
778
779
780 /****************************************************************************
781 **
782 *F FuncDTMultiply( <self>, <x>, <y>, <pcp> )
783 **
784 ** FuncDTMultiply implements the internal function
785 **
786 *F DTMultiply( <x>, <y>, <pcp> ).
787 **
788 ** DTMultiply returns the product of <x> and <y>. The result is reduced
789 ** with respect to the deep thought rewriting system <pcp>.
790 */
791
FuncDTMultiply(Obj self,Obj x,Obj y,Obj pcp)792 static Obj FuncDTMultiply(Obj self, Obj x, Obj y, Obj pcp)
793 {
794 Obj res;
795
796 if ( LEN_PLIST(x) == 0 )
797 return y;
798 if ( LEN_PLIST(y) == 0 )
799 return x;
800 res = Multiplyboundred(x, y, 1, LEN_PLIST(y), pcp);
801 ReduceWord(res, pcp);
802 return res;
803 }
804
805
806
807 /****************************************************************************
808 **
809 *F FuncDTPower( <self>, <x>, <n>, <pcp> )
810 **
811 ** FuncDTPower implements the internal function
812 **
813 *F DTPower( <x>, <n>, <pcp> ).
814 **
815 ** DTPower returns the <n>-th power of the word <x>. The result is reduced
816 ** with respect to the deep thought rewriting system <pcp>.
817 */
818
FuncDTPower(Obj self,Obj x,Obj n,Obj pcp)819 static Obj FuncDTPower(Obj self, Obj x, Obj n, Obj pcp)
820 {
821 Obj res;
822
823 res = Powerred(x, n, pcp);
824 ReduceWord(res, pcp);
825 return res;
826 }
827
828
829
830 /****************************************************************************
831 **
832 *F FuncDTSolution( <self>, <x>, <y>, <pcp> )
833 **
834 ** FuncDTSolution implements the internal function
835 **
836 *F DTSolution( <x>, <y>, <pcp> ).
837 **
838 ** DTSolution returns the solution of the equation <x>*a = <y>. The result
839 ** is reduced with respect to the deep thought rewriting system <pcp>.
840 */
841
FuncDTSolution(Obj self,Obj x,Obj y,Obj pcp)842 static Obj FuncDTSolution(Obj self, Obj x, Obj y, Obj pcp)
843 {
844 Obj res;
845
846 if ( LEN_PLIST(x) == 0 )
847 return y;
848 res = Solutionred(x, y, pcp);
849 ReduceWord(res, pcp);
850 return res;
851 }
852
853
854
855 /****************************************************************************
856 **
857 *F FuncDTCommutator( <self>, <x>, <y>. <pcp> )
858 **
859 ** FuncDTCommutator implements the internal function
860 **
861 *F DTCommutator( <x>, <y>, <pcp> )
862 **
863 ** DTCommutator returns the commutator of the words <x> and <y>. The result
864 ** is reduced with respect to the deep thought rewriting system <pcp>.
865 */
866
FuncDTCommutator(Obj self,Obj x,Obj y,Obj pcp)867 static Obj FuncDTCommutator(Obj self, Obj x, Obj y, Obj pcp)
868 {
869 Obj res;
870
871 res = Commutatorred(x, y, pcp);
872 ReduceWord(res, pcp);
873 return res;
874 }
875
876
877
878 /****************************************************************************
879 **
880 *F FuncConjugate( <self>, <x>, <y>, <pcp> )
881 **
882 ** FuncConjugate implements the internal function
883 **
884 *F Conjugate( <x>, <y>, <pcp> ).
885 **
886 ** Conjugate returns <x>^<y> for the words <x> and <y>. The result is
887 ** reduced with respect to the deep thought rewriting system <pcp>.
888 */
889
FuncDTConjugate(Obj self,Obj x,Obj y,Obj pcp)890 static Obj FuncDTConjugate(Obj self, Obj x, Obj y, Obj pcp)
891 {
892 Obj res;
893
894 if ( LEN_PLIST(y) == 0 )
895 return x;
896 res = Conjugatered(x, y, pcp);
897 ReduceWord(res, pcp);
898 return res;
899 }
900
901
902
903 /****************************************************************************
904 **
905 *F FuncDTQuotient( <self>, <x>, <y>, <pcp> )
906 **
907 ** FuncDTQuotient implements the internal function
908 **
909 *F DTQuotient( <x>, <y>, <pcp> ).
910 **
911 *F DTQuotient returns the <x>/<y> for the words <x> and <y>. The result is
912 ** reduced with respect to the deep thought rewriting system <pcp>.
913 */
914
FuncDTQuotient(Obj self,Obj x,Obj y,Obj pcp)915 static Obj FuncDTQuotient(Obj self, Obj x, Obj y, Obj pcp)
916 {
917 Obj help, res;
918
919 if ( LEN_PLIST(y) == 0 )
920 return x;
921 help = NEW_PLIST( T_PLIST, 0 );
922 res = Solutionred(y, help, pcp);
923 res = Multiplyboundred(x, res, 1, LEN_PLIST(res), pcp);
924 ReduceWord(res, pcp);
925 return(res);
926 }
927
928
929
930 /****************************************************************************
931 **
932 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
933 */
934
935
936 /****************************************************************************
937 **
938 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
939 */
940 static StructGVarFunc GVarFuncs [] = {
941
942 GVAR_FUNC(DTCompress, 1, "list"),
943 GVAR_FUNC(DTMultiply, 3, "lword, rword, rws"),
944 GVAR_FUNC(DTPower, 3, "word, exponent, rws"),
945 GVAR_FUNC(DTSolution, 3, "lword, rword, rws"),
946 GVAR_FUNC(DTCommutator, 3, "lword, rword, rws"),
947 GVAR_FUNC(DTQuotient, 3, "lword, rword, rws"),
948 GVAR_FUNC(DTConjugate, 3, "lword, rword, rws"),
949 { 0, 0, 0, 0, 0 }
950
951 };
952
953
954 /****************************************************************************
955 **
956 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
957 */
InitKernel(StructInitInfo * module)958 static Int InitKernel (
959 StructInitInfo * module )
960 {
961 /* init filters and functions */
962 InitHdlrFuncsFromTable( GVarFuncs );
963
964 /* return success */
965 return 0;
966 }
967
968
969 /****************************************************************************
970 **
971 *F PostRestore( <module> ) . . . . . . . . . . . . . after restore workspace
972 */
PostRestore(StructInitInfo * module)973 static Int PostRestore (
974 StructInitInfo * module )
975 {
976 evlist = RNamName("evlist");
977 evlistvec = RNamName("evlistvec");
978
979 /* return success */
980 return 0;
981 }
982
983
984 /****************************************************************************
985 **
986 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
987 */
InitLibrary(StructInitInfo * module)988 static Int InitLibrary (
989 StructInitInfo * module )
990 {
991 /* init filters and functions */
992 InitGVarFuncsFromTable( GVarFuncs );
993
994 /* return success */
995 return PostRestore( module );
996 }
997
998
999 /****************************************************************************
1000 **
1001 *F InitInfoDTEvaluation() . . . . . . . . . . . . . table of init functions
1002 */
1003 static StructInitInfo module = {
1004 // init struct using C99 designated initializers; for a full list of
1005 // fields, please refer to the definition of StructInitInfo
1006 .type = MODULE_BUILTIN,
1007 .name = "dteval",
1008 .initKernel = InitKernel,
1009 .initLibrary = InitLibrary,
1010 .postRestore = PostRestore
1011 };
1012
InitInfoDTEvaluation(void)1013 StructInitInfo * InitInfoDTEvaluation ( void )
1014 {
1015 return &module;
1016 }
1017