Contact
CoCalc Logo Icon
StoreFeaturesDocsShareSupport News AboutSign UpSign In
| Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

Path: gap4r8 / src / dt.c
Views: 415065
1
/****************************************************************************
2
**
3
*W dt.c GAP source Wolfgang Merkwitz
4
**
5
**
6
*Y Copyright (C) 1996, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
7
*Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
8
*Y Copyright (C) 2002 The GAP Group
9
**
10
** This file implements the part of the deep thought package which deals
11
** with computing the deep thought polynomials.
12
**
13
** Deep Thought deals with trees. A tree <tree> is a concatenation of
14
** several nodes where each node is a 5-tuple of immediate integers. If
15
** <tree> is an atom it contains only one node, thus it is itself a
16
** 5-tuple. If <tree> is not an atom we obtain its list representation by
17
**
18
** <tree> := topnode(<tree>) concat left(<tree>) concat right(<tree>) .
19
**
20
** Let us denote the i-th node of <tree> by (<tree>, i) and the tree rooted
21
** at (<tree>, i) by tree(<tree>, i). Let <a> be tree(<tree>, i)
22
** The first entry of (<tree>, i) is pos(a),
23
** and the second entry is num(a). The third entry of (<tree>, i) gives a
24
** mark.(<tree>, i)[3] = 1 means that (<tree>, i) is marked,
25
** (<tree>, i)[3] = 0 means that (<tree>, i) is not marked. The fourth entry
26
** of (<tree>, i) contains the number of knodes of tree(<tree>, i). The
27
** fifth entry of (<tree>, i) finally contains a boundary for
28
** pos( tree(<tree>, i) ). (<tree>, i)[5] <= 0 means that
29
** pos( tree(<tree>, i) ) is unbounded. If tree(<tree>, i) is an atom we
30
** already know that pos( tree(<tree>, i) ) is unbound. Thus we then can
31
** use the fifth component of (<tree>, i) to store the side. In this case
32
** (<tree>, i)[5] = -1 means that tree(<tree>, i) is an atom from the
33
** right hand word, and (<tree>, i)[5] = -2 means that tree(<tree>, i) is
34
** an atom from the left hand word.
35
**
36
** A second important data structure deep thought deals with is a deep
37
** thought monomial. A deep thought monomial g_<tree> is a product of
38
** binomial coefficients with a coefficient c. Deep thought monomials
39
** are represented in this implementation by formula
40
** vectors, which are lists of integers. The first entry of a formula
41
** vector is 0, to distinguish formula vectors from trees. The second
42
** entry is the coefficient c, and the third and fourth entries are
43
** num( left(tree) ) and num( right(tree) ). The remaining part of the
44
** formula vector is a concatenation of pairs of integers. A pair (i, j)
45
** with i > 0 represents binomial(x_i, j). A pair (0, j) represents
46
** binomial(y_gen, j) when word*gen^power is calculated.
47
**
48
** Finally deep thought has to deal with pseudorepresentatives. A
49
** pseudorepresentative <a> is stored in list of length 4. The first entry
50
** stores left( <a> ), the second entry contains right( <a> ), the third
51
** entry contains num( <a> ) and the last entry finally gives a boundary
52
** for pos( <b> ) for all trees <b> which are represented by <a>.
53
*/
54
#include "system.h"
55
56
57
58
#include "gasman.h" /* garbage collector */
59
#include "objects.h" /* objects */
60
#include "scanner.h" /* scanner */
61
#include "bool.h" /* booleans */
62
#include "calls.h" /* generic call mechanism */
63
#include "gap.h" /* error handling, initialisation */
64
#include "gvars.h" /* global variables */
65
#include "integer.h" /* integers */
66
67
#include "dt.h" /* deep thought */
68
69
#include "records.h" /* generic records */
70
#include "precord.h" /* plain records */
71
72
#include "lists.h" /* generic lists */
73
#include "listfunc.h" /* functions for generic lists */
74
#include "plist.h" /* plain lists */
75
#include "string.h" /* strings */
76
77
#include "code.h" /* coder */
78
#include "thread.h" /* threads */
79
#include "tls.h" /* thread-local storage */
80
81
82
/****************************************************************************
83
**
84
85
*F DT_POS(tree, index) . . . . . . . . . . . . . position of (<tree>, index)
86
**
87
** 'DT_POS' returns pos(<a>) where <a> is the subtree of <tree> rooted at
88
** (<tree>, index). <index> has to be a positive integer less or equal than
89
** the number of nodes of <tree>.
90
*/
91
#define DT_POS(tree, index) \
92
(ELM_PLIST(tree, (index-1)*5 + 1 ) )
93
94
95
/***************************************************************************
96
**
97
*F SET_DT_POS(tree, index, obj) . . . assign the position of(<tree>, index)
98
**
99
** 'SET_DT_POS sets pos(<a>) to the object <obj>, where <a> is the subtree
100
** of <tree>, rooted at (<tree>, index). <index> has to be an positive
101
** integer less or equal to the number of nodes of <tree>
102
*/
103
#define SET_DT_POS(tree, index, obj) \
104
SET_ELM_PLIST(tree, (index-1)*5 + 1, obj)
105
106
107
/***************************************************************************
108
**
109
*F DT_GEN(tree, index) . . . . . . . . . . . . . generator of (<tree>, index)
110
**
111
** 'DT_GEN' returns num(<a>) where <a> is the subtree of <tree> rooted at
112
** (<tree>, index). <index> has to be a positive integer less or equal than
113
** the number of nodes of <tree>.
114
*/
115
#define DT_GEN(tree, index) \
116
(ELM_PLIST(tree, (index-1)*5 + 2) )
117
118
119
/**************************************************************************
120
**
121
*F SET_DT_GEN(tree, index, obj) . . . assign the generator of(<tree>, index)
122
**
123
** 'SET_DT_GEN sets num(<a>) to the object <obj>, where <a> is the subtree
124
** of <tree>, rooted at (<tree>, index). <index> has to be an positive
125
** integer less or equal to the number of nodes of <tree>
126
*/
127
#define SET_DT_GEN(tree, index, obj) \
128
(SET_ELM_PLIST(tree, (index-1)*5 + 2, obj) )
129
130
131
/**************************************************************************
132
**
133
*F DT_IS_MARKED(tree, index) . . . . . . tests if (<tree>, index) is marked
134
**
135
** 'DT_IS_MARKED' returns 1 (as C integer) if (<tree>, index) is marked, and
136
** 0 otherwise. <index> has to be a positive integer less or equal to the
137
** number of nodes of <tree>.
138
*/
139
#define DT_IS_MARKED(tree, index) \
140
(INT_INTOBJ (ELM_PLIST(tree, (index-1)*5 + 3) ) )
141
142
143
/**************************************************************************
144
**
145
*F DT_MARK(tree, index) . . . . . . . . . . . . . . . . . . . . mark a node
146
**
147
** 'DT_MARK' marks the node (<tree>, index). <index> has to be a positive
148
** integer less or equal to the number of nodes of <tree>.
149
*/
150
#define DT_MARK(tree, index) \
151
SET_ELM_PLIST(tree, (index-1)*5 + 3, INTOBJ_INT(1) )
152
153
154
/**************************************************************************
155
**
156
*F DT_UNMARK(tree, index) . . . . . . . . . . . remove the mark from a node
157
**
158
** 'DT_UNMARK' removes the mark from the node (<tree>, index). <index> has
159
** has to be a positive integer less or equal to the number of nodes of
160
** <tree>.
161
*/
162
#define DT_UNMARK(tree, index) \
163
SET_ELM_PLIST(tree, (index-1)*5 + 3, INTOBJ_INT(0) )
164
165
166
/****************************************************************************
167
**
168
*F DT_RIGHT(tree, index) . . . .determine the right subnode of (<tree>, index)
169
*F DT_LEFT(tree, index) . . . . determine the left subnode of (<tree>, index)
170
**
171
** 'DT_RIGHT' returns the right subnode of (<tree>, index). That means if
172
** DT_RIGHT(tree, index) = index2, then (<tree>, index2) is the right
173
** subnode of (<tree>, index).
174
**
175
** 'DT_LEFT' returns the left subnode of (<tree>, index). That means if
176
** DT_LEFT(tree, index) = index2, then (<tree>, index2) is the left
177
** subnode of (<tree>, index).
178
**
179
** Before calling 'DT_RIGHT' or 'DT_LEFT' it should be ensured, that
180
** (<tree>, index) is not an atom. <index> has to be a positive integer
181
** less or equal to the number of nodes of <tree>.
182
*/
183
#define DT_RIGHT(tree, index) \
184
( INT_INTOBJ(ELM_PLIST(tree, index*5 + 4) ) + index + 1)
185
#define DT_LEFT(tree, index) \
186
( index + 1 )
187
188
189
/****************************************************************************
190
**
191
*F DT_SIDE(tree, index) . . . . . . . determine the side of (<tree>, index)
192
*V RIGHT. . . . . . . . . . . . . . . integer describing "right"
193
*V LEFT . . . . . . . . . . . . . . . integer describing "left"
194
**
195
** 'DT_SIDE' returns 'LEFT' if (<tree>, index) is an atom from the Left-hand
196
** word, and 'RIGHT' if (<tree>, index) is an atom of the Right-hand word.
197
** Otherwise 'DT_SIDE' returns an integer bigger than 1. <index> has to be
198
** a positive integer less or equal to the number of nodes of <tree>.
199
*/
200
#define RIGHT -1
201
#define LEFT -2
202
#define DT_SIDE(tree, index) \
203
(INT_INTOBJ( ELM_PLIST(tree, (index-1)*5 + 5 ) ) )
204
205
206
/****************************************************************************
207
**
208
*F DT_LENGTH(tree, index) . . . . . . . . number of nodes of (<tree>, index)
209
**
210
** 'DT_LENGTH' returns the number of nodes of (<tree>, index). <index> has
211
** to be a positive integer less or equal to the number of nodes of <tree>.
212
*/
213
#define DT_LENGTH(tree, index) \
214
( INT_INTOBJ(ELM_PLIST(tree, (index-1)*5 + 4) ) )
215
216
217
/***************************************************************************
218
**
219
*F DT_MAX(tree, index) . . . . . . . . . . . . . . . . boundary of a node
220
**
221
** 'DT_MAX(tree, index)' returns a boundary for 'DT_POS(tree, index)'.
222
** 'DT_MAX(tree, index) = 0 ' means that 'DT_POS(tree, index)' is unbound.
223
** <index> has to be a positive integer less or equal to the number of nodes
224
** of tree.
225
*/
226
#define DT_MAX(tree, index) \
227
(ELM_PLIST(tree, (index-1)*5 + 5 ) )
228
229
230
/****************************************************************************
231
**
232
*F CELM(list, pos) . . . . . . . . . . element of a plain list as C integer
233
**
234
** 'CELM' returns the <pos>-th element of the plain list <list>. <pos> has
235
** to be a positive integer less or equal to the physical length of <list>.
236
** Before calling 'CELM' it should be ensured that the <pos>-th entry of
237
** <list> is an immediate integer object.
238
*/
239
#define CELM(list, pos) ( INT_INTOBJ(ELM_PLIST(list, pos) ) )
240
241
242
/****************************************************************************
243
**
244
*V Dt_add
245
**
246
** Dt_add is used to store the library function dt_add.
247
*/
248
249
Obj Dt_add;
250
extern Obj ShallowCopyPlist( Obj list );
251
252
/****************************************************************************
253
**
254
*F UnmarkTree( <tree> ) . . . . . . . remove the marks of all nodes of <tree>
255
**
256
** 'UnmarkTree' removes all marks of all nodes of the tree <tree>.
257
*/
258
void UnmarkTree(
259
Obj tree )
260
{
261
UInt i, len; /* loop variable */
262
263
len = DT_LENGTH(tree, 1);
264
for (i=1; i <= len; i++ )
265
DT_UNMARK(tree, i);
266
}
267
268
269
/****************************************************************************
270
**
271
*F FuncUnmarkTree(<self>, <tree>) . . remove the marks of all nodes of <tree>
272
**
273
** 'FuncUnmarkTree' implements the internal function 'UnmarkTree'.
274
**
275
** 'UnmarkTree( <tree> )'
276
**
277
** 'UnmarkTree' removes all marks of all nodes of the tree <tree>.
278
*/
279
Obj FuncUnmarkTree(
280
Obj self,
281
Obj tree )
282
{
283
UnmarkTree(tree);
284
return 0;
285
}
286
287
288
/*****************************************************************************
289
**
290
*F Mark(<tree>, <reftree>, <index>) . . . . . . . . find all nodes of <tree>
291
** which are almost equal
292
** to (<reftree>, index)
293
**
294
** 'Mark' determines all nodes of the tree <tree>, rooting subtrees almost
295
** equal to the tree rooted at (<reftree>, index). 'Mark' marks these nodes
296
** and returns the number of different nodes among these nodes. Since it
297
** is assumed that the set {pos(a) | a almost equal to (<reftree>, index) }
298
** is equal to {1,...,n} for a positive integer n, 'Mark' actually returns
299
** the Maximum of {pos(a) | a almost equal to (<reftree>, index)}.
300
*/
301
UInt Mark(
302
Obj tree,
303
Obj reftree,
304
Int indexx )
305
{
306
UInt i, /* loop variable */
307
m, /* integer to return */
308
len;
309
Obj refgen;
310
311
m = 0;
312
i = 1;
313
len = DT_LENGTH(tree, 1);
314
refgen = DT_GEN(reftree, indexx);
315
while ( i <= len )
316
{
317
/* skip all nodes (<tree>, i) with
318
** num(<tree>, i) > num(<reftree>, indexx) */
319
while( i < len &&
320
DT_GEN(tree, i) > refgen )
321
i++;
322
if ( AlmostEqual(tree, i, reftree, indexx) )
323
{
324
DT_MARK(tree, i);
325
if ( m < INT_INTOBJ( DT_POS(tree, i) ) )
326
m = INT_INTOBJ( DT_POS(tree, i) );
327
}
328
/* Since num(a) < num(b) holds for all subtrees <a> of an arbitrary
329
** tree <b> we can now skip the whole tree rooted at (<tree>, i).
330
** If (<tree>, i) is the left subnode of another node we can even
331
** skip the tree rooted at that node, because of
332
** num( right(a) ) < num( left(a) ) for all trees <a>.
333
** Note that (<tree>, i) is the left subnode of another node, if and
334
** only if the previous node (<tree>, i-1) is not an atom. in this
335
** case (<tree>, i) is the left subnode of (<tree>, i-1). */
336
if ( DT_LENGTH(tree, i-1) == 1 )
337
/* skip the tree rooted at (<tree>, i). */
338
i = i + DT_LENGTH(tree, i);
339
else
340
/* skip the tree rooted at (<tree>, i-1) */
341
i = i - 1 + DT_LENGTH(tree, i-1);
342
}
343
return m;
344
}
345
346
347
/****************************************************************************
348
**
349
*F AmostEqual(<tree1>,<index1>,<tree2>,<index2>) . . test of almost equality
350
**
351
** 'AlmostEqual' tests if tree(<tree1>, index1) is almost equal to
352
** tree(<tree2>, index2). 'AlmostEqual' returns 1
353
** if these trees are almost equal, and 0 otherwise. <index1> has to be
354
** a positive integer less or equal to the number of nodes of <tree1>,
355
** and <index2> has to be a positive integer less or equal to the number of
356
** nodes of <tree2>.
357
*/
358
Int AlmostEqual(
359
Obj tree1,
360
Int index1,
361
Obj tree2,
362
Int index2 )
363
{
364
UInt k, schranke; /* loop variable */
365
/* First the two top nodes of tree(<tree1>, index1) and
366
** tree(<tree2>, index2) (that are (<tree1>, index1) and
367
** (<tree2, index2) ) are compared by testing the equality of the 2-nd,
368
** 5-th and 6-th entries the nodes. */
369
if ( DT_GEN(tree1, index1) != DT_GEN(tree2, index2) )
370
return 0;
371
if ( DT_SIDE(tree1, index1) != DT_SIDE(tree2, index2) )
372
return 0;
373
if ( DT_LENGTH(tree1, index1) != DT_LENGTH(tree2, index2) )
374
return 0;
375
/* For the comparison of the remaining nodes of tree(<tree1>, index1)
376
** and tree(<tree2>, index2) it is also necessary to compare the first
377
** entries of the nodes. Note that we know at this point, that
378
** tree(<tree1>, index1) and tree(<tree2>, index2) have the same number
379
** of nodes */
380
schranke = index1 + DT_LENGTH(tree1, index1);
381
for (k = index1 + 1; k < schranke; k++ )
382
{
383
if ( DT_GEN(tree1, k) != DT_GEN(tree2, k + index2 - index1 ) )
384
return 0;
385
if ( DT_POS(tree1, k) != DT_POS(tree2, k + index2 - index1 ) )
386
return 0;
387
if ( DT_SIDE(tree1, k) !=
388
DT_SIDE(tree2, k + index2 - index1) )
389
return 0;
390
if ( DT_LENGTH(tree1, k) != DT_LENGTH(tree2, k + index2 - index1) )
391
return 0;
392
}
393
return 1;
394
}
395
396
397
/*****************************************************************************
398
**
399
*F Equal(<tree1>,<index1>,<tree2>,<index2>) . . . . . . . . test of equality
400
**
401
** 'Equal' tests if tree(<tree1>, index1) is equal to
402
** tree(<tree2>, index2). 'Equal' returns 1
403
** if these trees are equal, and 0 otherwise. <index1> has to be
404
** a positive integer less or equal to the number of nodes of <tree1>,
405
** and <index2> has to be a positive integer less or equal to the number of
406
** nodes of <tree2>.
407
*/
408
Int Equal(
409
Obj tree1,
410
Int index1,
411
Obj tree2,
412
Int index2 )
413
{
414
UInt k, schranke; /* loop variable */
415
416
/* Each node of tree(<tree1>, index1) is compared to the corresponding
417
** node of tree(<tree2>, index2) by testing the equality of the 1-st,
418
** 2-nd, 5-th and 6-th nodes. */
419
schranke = index1 + DT_LENGTH(tree1, index1);
420
for (k=index1; k < schranke; k++)
421
{
422
if ( DT_GEN(tree1, k) != DT_GEN(tree2, k + index2 - index1 ) )
423
return 0;
424
if ( DT_POS(tree1, k) != DT_POS(tree2, k + index2 - index1 ) )
425
return 0;
426
if ( DT_SIDE(tree1, k) !=
427
DT_SIDE(tree2, k + index2 - index1) )
428
return 0;
429
if ( DT_LENGTH(tree1, k) != DT_LENGTH(tree2, k + index2 - index1) )
430
return 0;
431
}
432
return 1;
433
}
434
435
436
/****************************************************************************
437
**
438
*F Mark2(<tree>,<index1>,<reftree>,<index2>) . . find all subtrees of
439
** tree(<tree>, index1) which
440
** are almost equal to
441
** tree(<reftree>, index2)
442
**
443
** 'Mark2' determines all subtrees of tree(<tree>, index1) that are almost
444
** equal to tree(<reftree>, index2). 'Mark2' marks the top nodes of these
445
** trees and returns a list of lists <list> such that <list>[i]
446
** for each subtree <a> of <tree> which is almost equal to
447
** tree(<reftree>, index2) and for which pos(<a>) = i holds contains an
448
** integer describing the position of the top node of <a> in <tree>.
449
** For example <list>[i] = [j, k] means that tree(<tree>, j) and
450
** tree(<tree>, k) are almost equal to tree(<reftree>, index2) and
451
** that pos(tree(<tree>, j) = pos(tree(<tree>, k) = i holds.
452
**
453
** <index1> has to be a positive integer less or equal to the number of nodes
454
** of <tree>, and <index2> has to be a positive integer less or equal to
455
** the number of nodes of <reftree>.
456
*/
457
Obj Mark2(
458
Obj tree,
459
Int index1,
460
Obj reftree,
461
Int index2 )
462
{
463
UInt i, /* loop variable */
464
len;
465
Obj new,
466
list, /* list to return */
467
refgen;
468
469
/* initialize <list> */
470
list = NEW_PLIST(T_PLIST, 0);
471
SET_LEN_PLIST(list, 0);
472
i = index1;
473
len = index1 + DT_LENGTH(tree, index1) - 1;
474
refgen = DT_GEN(reftree, index2);
475
while( i <= len )
476
{
477
/* skip all nodes (<tree>, i) with
478
** num(<tree>, i) > num(<reftree>, index) */
479
while( i < len &&
480
DT_GEN(tree, i) > refgen )
481
i++;
482
if ( AlmostEqual(tree, i, reftree, index2) )
483
{
484
DT_MARK(tree, i);
485
/* if <list> is too small grow it appropriately */
486
if ( LEN_PLIST(list) < INT_INTOBJ( DT_POS(tree, i) ) )
487
{
488
GROW_PLIST(list, INT_INTOBJ( DT_POS(tree, i) ) );
489
SET_LEN_PLIST(list, INT_INTOBJ( DT_POS(tree, i) ) );
490
}
491
/* if <list> has no entry at position pos(tree(<tree>, i))
492
** create a new list <new>, assign it to list at position
493
** pos(tree(<tree>, i)), and add i to <new> */
494
if ( ELM_PLIST(list, INT_INTOBJ( DT_POS(tree, i) ) ) == 0)
495
{
496
new = NEW_PLIST( T_PLIST, 1);
497
SET_LEN_PLIST(new, 1);
498
SET_ELM_PLIST(new, 1, INTOBJ_INT(i) );
499
SET_ELM_PLIST(list, INT_INTOBJ( DT_POS(tree, i) ), new);
500
/* tell gasman that list has changed */
501
CHANGED_BAG(list);
502
}
503
/* add i to <list>[ pos(tree(<tree>, i)) ] */
504
else
505
{
506
new = ELM_PLIST(list, INT_INTOBJ( DT_POS(tree, i) ) );
507
GROW_PLIST(new, LEN_PLIST(new) + 1);
508
SET_LEN_PLIST(new, LEN_PLIST(new) + 1);
509
SET_ELM_PLIST(new, LEN_PLIST(new), INTOBJ_INT(i) );
510
/* tell gasman that new has changed */
511
CHANGED_BAG(new);
512
}
513
}
514
/* Since num(a) < num(b) holds for all subtrees <a> of an arbitrary
515
** tree <b> we can now skip the whole tree rooted at (<tree>, i).
516
** If (<tree>, i) is the left subnode of another node we can even
517
** skip the tree rooted at that node, because of
518
** num( right(a) ) < num( left(a) ) for all trees <a>.
519
** Note that (<tree>, i) is the left subnode of another node, if and
520
** only if the previous node (<tree>, i-1) is not an atom. In this
521
** case (<tree>, i) is the left subnode of (<tree>, i-1). */
522
if ( DT_LENGTH(tree, i-1) == 1 )
523
/* skip tree(<tree>, i) */
524
i = i + DT_LENGTH(tree, i);
525
else
526
/* skip tree(<tree>, i-1) */
527
i = i - 1 + DT_LENGTH(tree, i-1);
528
}
529
return list;
530
}
531
532
533
/*****************************************************************************
534
**
535
*F FindTree(<tree>, <index>)
536
**
537
** 'FindTree' looks for a subtree <a> of tree(<tree>, index) such that
538
** the top node of
539
** <a> is not marked but all the other nodes of <a> are marked. It is
540
** assumed that if the top node of a subtree <b> of tree(<tree>, index)
541
** is marked, all
542
** nodes of of <b> are marked. Hence it suffices to look for a subtree <a>
543
** of <tree> such that the top node of <a> is unmarked and the left and the
544
** right node of <a> are marked. 'FindTree' returns an integer <i> such
545
** that tree(<tree> ,i) has the properties mentioned above. If such a tree
546
** does not exist 'Findtree' returns 0 (as C integer). Note that this holds
547
** if and only if tree(<tree>, index) is marked.
548
*/
549
UInt FindTree(
550
Obj tree,
551
Int indexx )
552
{
553
UInt i; /* loop variable */
554
555
/* return 0 if (<tree>, indexx) is marked */
556
if ( DT_IS_MARKED(tree, indexx) )
557
return 0;
558
i = indexx;
559
/* loop over all nodes of tree(<tree>, indexx) to find a tree with the
560
** properties described above. */
561
while( i < indexx + DT_LENGTH(tree, indexx) )
562
{
563
/* skip all nodes that are unmarked and rooting non-atoms */
564
while( !( DT_IS_MARKED(tree, i) ) && DT_LENGTH(tree, i) > 1 )
565
i++;
566
/* if (<tree>, i) is unmarked we now know that tree(<tree>, i) is
567
** an atom and we can return i. Note that an unmarked atom has the
568
** desired properties. */
569
if ( !( DT_IS_MARKED(tree, i) ) )
570
return i;
571
/* go to the previous node */
572
i--;
573
/* If the right node of tree(<tree>, i) is marked return i.
574
** Else go to the right node of tree(<tree>, i). */
575
if ( DT_IS_MARKED(tree, DT_RIGHT(tree, i) ) )
576
return i;
577
i = DT_RIGHT(tree, i);
578
}
579
return 0;
580
}
581
582
583
/****************************************************************************
584
**
585
*F MakeFormulaVector(<tree>, <pr>) . . . . . . . . . compute the polynomial
586
** g_<tree> for <tree>
587
**
588
** 'MakeFormulaVector' returns the polynomial g_<tree> for a tree <tree>
589
** and a pc-presentation <pr> of a nilpotent group. This polynomial g_<tree>
590
** is a product of binomial coefficients with a coefficient c ( see the
591
** header of this file ).
592
**
593
** For the calculation of the coefficient c the top node of <tree> is ignored
594
** because it can happen that trees are equal except for the top node.
595
** Hence it suffices to compute the formula vector for one of these trees.
596
** Then we get the "correct" coefficient for the polynomial for each <tree'>
597
** of those trees by multiplying the coefficient given by the formula vector
598
** with c_( num(left(<tree'>)), num(right(<tree'>)); num(<tree'>) ). This
599
** is also the reason for storing num(left(<tree>)) and num(right(<tree>))
600
** in the formula vector.
601
**
602
** 'MakeFormulaVector' only returns correct results if all nodes of <tree>
603
** are unmarked.
604
*/
605
Obj MakeFormulaVector(
606
Obj tree,
607
Obj pr )
608
{
609
UInt i, /* denominator of a binomial coefficient */
610
j, /* loop variable */
611
u; /* node index */
612
Obj rel, /* stores relations of <pr> */
613
vec, /* stores formula vector to return */
614
prod,/* stores the product of two integers */
615
gen;
616
617
/* initialize <vec> and set the first four elements */
618
vec = NEW_PLIST(T_PLIST, 4);
619
SET_LEN_PLIST(vec, 4);
620
SET_ELM_PLIST(vec, 1, INTOBJ_INT(0) );
621
SET_ELM_PLIST(vec, 2, INTOBJ_INT(1) );
622
SET_ELM_PLIST(vec, 3, DT_GEN(tree, DT_LEFT(tree, 1) ) );
623
SET_ELM_PLIST(vec, 4, DT_GEN(tree, DT_RIGHT(tree, 1) ) );
624
/* loop over all almost equal classes of subtrees of <tree> except for
625
** <tree> itself. */
626
u = FindTree(tree, 1);
627
while( u > 1 )
628
{
629
/* mark all subtrees of <tree> almost equal to tree(<tree>, u) and
630
** get the number of different trees in this almost equal class */
631
i = Mark(tree, tree, u);
632
/* if tree(<tree>, u) is an atom from the Right-hand word append
633
** [ 0, i ] to <vec> */
634
if ( DT_SIDE(tree, u) == RIGHT )
635
{
636
GROW_PLIST(vec, LEN_PLIST(vec)+2);
637
SET_LEN_PLIST(vec, LEN_PLIST(vec)+2);
638
SET_ELM_PLIST(vec, LEN_PLIST(vec)-1, INTOBJ_INT(0) );
639
SET_ELM_PLIST(vec, LEN_PLIST(vec), INTOBJ_INT(i) );
640
}
641
/* if tree(<tree>, u) is an atom from the Left-hand word append
642
** [ num(tree(<tree>, u)), i ] to <vec> */
643
else if ( DT_SIDE(tree, u) == LEFT)
644
{
645
GROW_PLIST(vec, LEN_PLIST(vec)+2);
646
SET_LEN_PLIST(vec, LEN_PLIST(vec)+2);
647
SET_ELM_PLIST(vec, LEN_PLIST(vec)-1, DT_GEN(tree, u) );
648
SET_ELM_PLIST(vec, LEN_PLIST(vec), INTOBJ_INT(i) );
649
}
650
/* if tree(<tree>, u) is not an atom multiply
651
** <vec>[2] with binomial(d, i) where
652
** d = c_(num(left(<tree>,u)), num(right(<tree>,u)); num(<tree>,u)) */
653
else
654
{
655
j = 3;
656
rel = ELM_PLIST( ELM_PLIST(pr, INT_INTOBJ( DT_GEN(tree,
657
DT_LEFT(tree, u) ) ) ),
658
INT_INTOBJ( DT_GEN(tree, DT_RIGHT(tree, u) ) ) );
659
gen = DT_GEN(tree, u);
660
while ( 1 )
661
{
662
if ( ELM_PLIST(rel, j) == gen )
663
{
664
prod = ProdInt(ELM_PLIST(vec, 2),
665
binomial(ELM_PLIST(rel, j+1),
666
INTOBJ_INT(i) ) );
667
SET_ELM_PLIST(vec, 2, prod);
668
/* tell gasman that vec has changed */
669
CHANGED_BAG(vec);
670
break;
671
}
672
j+=2;
673
}
674
}
675
u = FindTree(tree, 1);
676
}
677
return vec;
678
}
679
680
681
/**************************************************************************
682
**
683
*F FuncMakeFormulaVector(<self>,<tree>,<pr>) . . . . . compute the formula
684
** vector for <tree>
685
**
686
** 'FuncMakeFormulaVector' implements the internal function
687
** 'MakeFormulaVector(<tree>, <pr>)'.
688
**
689
** 'MakeFormulaVector(<tree>, <pr>)'
690
**
691
** 'MakeFormulaVector' returns the formula vector for the tree <tree> and
692
** the pc-presentation <pr>.
693
*/
694
Obj FuncMakeFormulaVector(
695
Obj self,
696
Obj tree,
697
Obj pr )
698
{
699
if (LEN_PLIST(tree) == 5)
700
ErrorReturnVoid("<tree> has to be a non-atom", 0L, 0L,
701
"you can 'return;'");
702
return MakeFormulaVector(tree, pr);
703
}
704
705
706
/*****************************************************************************
707
**
708
*F binomial(<n>, <k>) . . . . . . . . . binomial coefficient of <n> and <k>
709
**
710
** 'binomial' returns the binomial coefficient of the integers <n> and <k>.
711
*/
712
Obj binomial( Obj n,
713
Obj k )
714
{
715
UInt j, kc;
716
Obj bin, help;
717
718
if ( LtInt( INTOBJ_INT(0), n) && LtInt(n, k) )
719
return INTOBJ_INT(0);
720
if ( IS_INTOBJ(n) && n == k )
721
return INTOBJ_INT(1);
722
kc = INT_INTOBJ(k);
723
bin = INTOBJ_INT(1);
724
help = DiffInt(n, k);
725
for (j=1; j<=kc; j++)
726
bin = ProdInt( bin, SumInt(help, INTOBJ_INT(j) ) );
727
for (j=1; j<=kc; j++)
728
bin = QuoInt(bin, INTOBJ_INT(j) );
729
return bin;
730
}
731
732
733
734
/****************************************************************************
735
**
736
*F Leftof(<tree1>,<index1>,<tree2>,<index2>) . . . . test if one tree is left
737
** of another tree
738
**
739
** 'Leftof' returns 1 if tree(<tree1>, index1) is left of tree(<tree2>,index2)
740
** in the word being collected at the first instance, that
741
** tree(<tree1>, index1) and tree(<tree2>, index2) both occur. It is assumed
742
** that tree(<tree1>, index1) is not equal to tree(<tree2>, index2).
743
*/
744
Int Leftof(
745
Obj tree1,
746
Int index1,
747
Obj tree2,
748
Int index2 )
749
{
750
if ( DT_LENGTH(tree1, index1) == 1 && DT_LENGTH(tree2, index2) == 1 ) {
751
if (DT_SIDE(tree1, index1) == LEFT && DT_SIDE(tree2, index2) == RIGHT)
752
return 1;
753
else if (DT_SIDE(tree1, index1) == RIGHT &&
754
DT_SIDE(tree2, index2) == LEFT )
755
return 0;
756
else if (DT_GEN(tree1, index1) == DT_GEN(tree2, index2) )
757
return ( DT_POS(tree1, index1) < DT_POS(tree2, index2) );
758
else
759
return ( DT_GEN(tree1, index1) < DT_GEN(tree2, index2) );
760
}
761
if ( DT_LENGTH(tree1, index1) > 1 &&
762
DT_LENGTH(tree2, index2) > 1 &&
763
Equal( tree1, DT_RIGHT(tree1, index1) ,
764
tree2, DT_RIGHT(tree2, index2) ) )
765
{
766
if ( Equal( tree1, DT_LEFT(tree1, index1),
767
tree2, DT_LEFT(tree2, index2) ) ) {
768
if ( DT_GEN(tree1, index1) == DT_GEN(tree2, index2) )
769
return ( DT_POS(tree1, index1) < DT_POS(tree2, index2) );
770
else
771
return ( DT_GEN(tree1, index1) < DT_GEN(tree2, index2) );
772
}
773
}
774
if( Earlier(tree1, index1, tree2, index2) )
775
return !Leftof2( tree2, index2, tree1, index1);
776
else
777
return Leftof2( tree1, index1, tree2, index2);
778
}
779
780
781
/*****************************************************************************
782
**
783
*F Leftof2(<tree1>,<index1>,<tree2>,<index2>) . . . . . test if one tree is
784
** left of another tree
785
**
786
** 'Leftof2' returns 1 if tree(<tree1>, index1) is left of
787
** tree(<tree2>,index2)in the word being collected at the first instance,
788
** that tree(<tree1>, index1) and tree(<tree2>, index2) both occur. It is
789
** assumed that tree(<tree2>, index2) occurs earlier than
790
** tree(<tree1>,index1). Furthermore it is assumed that if both
791
** tree(<tree1>, index1) and tree(<tree2>, index2) are non-atoms, then their
792
** right trees and their left trees are not equal.
793
*/
794
Int Leftof2(
795
Obj tree1,
796
Int index1,
797
Obj tree2,
798
Int index2 )
799
{
800
if ( DT_GEN(tree2, index2) < DT_GEN(tree1, DT_RIGHT(tree1, index1) ) )
801
return 0;
802
else if (Equal(tree1, DT_RIGHT(tree1, index1), tree2, index2 ) )
803
return 0;
804
else if (DT_GEN(tree2, index2) == DT_GEN(tree1, DT_RIGHT(tree1, index1)) )
805
return Leftof(tree1, DT_RIGHT(tree1, index1), tree2, index2 );
806
else if (Equal(tree1, DT_LEFT(tree1, index1), tree2, index2) )
807
return 0;
808
else
809
return Leftof(tree1, DT_LEFT(tree1, index1), tree2, index2);
810
}
811
812
813
/****************************************************************************
814
**
815
*F Earlier(<tree1>,<index1>,<tree2>,<index2>) . . . test if one tree occurs
816
** earlier than another
817
**
818
** 'Earlier' returns 1 if tree(<tree1>, index1) occurs strictly earlier than
819
** tree(<tree2>, index2). It is assumed that at least one of these trees
820
** is a non-atom. Furthermore it is assumed that if both of these trees are
821
** non-atoms, right(tree(<tree1>, index1) ) does not equal
822
** right(tree(<tree2>, index2) ) or left(tree(<tree1>, index1) ) does not
823
** equal left(tree(<tree2>, index2) ).
824
*/
825
Int Earlier(
826
Obj tree1,
827
Int index1,
828
Obj tree2,
829
Int index2 )
830
{
831
if ( DT_LENGTH(tree1, index1) == 1 )
832
return 1;
833
if ( DT_LENGTH(tree2, index2) == 1 )
834
return 0;
835
if ( Equal(tree1, DT_RIGHT(tree1, index1),
836
tree2, DT_RIGHT(tree2, index2) ) )
837
return Leftof(tree1, DT_LEFT(tree2, index2),
838
tree2, DT_LEFT(tree1, index1) );
839
if ( DT_GEN(tree1, DT_RIGHT(tree1, index1) ) ==
840
DT_GEN(tree2, DT_RIGHT(tree2, index2) ) )
841
return Leftof( tree1, DT_RIGHT(tree1, index1) ,
842
tree2, DT_RIGHT(tree2, index2) );
843
return (DT_GEN(tree1, DT_RIGHT(tree1, index1) ) <
844
DT_GEN(tree2, DT_RIGHT(tree2, index2) ) );
845
}
846
847
848
/****************************************************************************
849
**
850
** GetPols( <list>, <pr>, <pols> )
851
**
852
** GetPols computes all representatives which are represented by the
853
** pseudorepresentative <list>, converts them all into the corresponding
854
** deep thought monomial and stores all these monomials in the list <pols>.
855
*/
856
857
/* See below: */
858
void GetReps( Obj list, Obj reps );
859
void FindNewReps2( Obj tree, Obj reps, Obj pr);
860
861
void GetPols(
862
Obj list,
863
Obj pr,
864
Obj pols )
865
{
866
Obj lreps,
867
rreps,
868
tree,
869
tree1;
870
UInt i,j,k,l, lenr, lenl, len;
871
872
lreps = NEW_PLIST(T_PLIST, 2);
873
rreps = NEW_PLIST(T_PLIST, 2);
874
SET_LEN_PLIST(lreps, 0);
875
SET_LEN_PLIST(rreps, 0);
876
/* get the representatives that are represented by <list>[1] and those
877
** which are represented by <list>[2]. */
878
GetReps( ELM_PLIST(list, 1), lreps );
879
GetReps( ELM_PLIST(list, 2), rreps );
880
lenr = LEN_PLIST(rreps);
881
lenl = LEN_PLIST(lreps);
882
for (i=1; i<=lenl; i++)
883
for (j=1; j<=lenr; j++)
884
{
885
/* now get all representatives, which can be constructed from
886
** <lreps>[<i>] and <rreps>[<j>] and add the corresponding
887
** deep thought monomials to <pols> */
888
k = LEN_PLIST( ELM_PLIST(lreps, i) )
889
+ LEN_PLIST( ELM_PLIST(rreps, j) ) + 5;/* m"ogliche Inkom-*/
890
tree = NEW_PLIST(T_PLIST, k); /* patibilit"at nach*/
891
SET_LEN_PLIST(tree, k); /*"Anderung der Datenstruktur */
892
SET_ELM_PLIST(tree, 1, INTOBJ_INT(1) );
893
SET_ELM_PLIST(tree, 2, ELM_PLIST( list, 3) );
894
SET_ELM_PLIST(tree, 3, INTOBJ_INT(0) );
895
SET_ELM_PLIST(tree, 4, INTOBJ_INT((int)(k/5)) );
896
SET_ELM_PLIST(tree, 5, INTOBJ_INT(0) );
897
tree1 = ELM_PLIST(lreps, i);
898
len = LEN_PLIST( tree1 );
899
for (l=1; l<=len; l++)
900
SET_ELM_PLIST(tree, l+5, ELM_PLIST(tree1, l) );
901
k = LEN_PLIST(tree1) + 5;
902
tree1 = ELM_PLIST(rreps, j);
903
len = LEN_PLIST( tree1 );
904
for (l=1; l<=len; l++)
905
SET_ELM_PLIST(tree, l+k, ELM_PLIST(tree1, l) );
906
UnmarkTree(tree);
907
FindNewReps2(tree, pols, pr);
908
}
909
}
910
911
912
913
/****************************************************************************
914
**
915
*F FuncGetPols( <self>, <list>, <pr>, <pols> )
916
**
917
** FuncGetPols implements the internal function GetPols.
918
*/
919
920
Obj FuncGetPols(
921
Obj self,
922
Obj list,
923
Obj pr,
924
Obj pols )
925
{
926
if (LEN_PLIST(list) != 4)
927
ErrorReturnVoid("<list> must be a generalised representative not a tree"
928
,0L, 0L, "you can 'return;'");
929
GetPols(list, pr, pols);
930
return (Obj) 0;
931
}
932
933
934
935
/****************************************************************************
936
**
937
*F GetReps( <list>, <reps> )
938
**
939
** GetReps computes all representatives which are represented by the
940
** pseudorepresentative <list> and adds them to the list <reps>.
941
*/
942
943
/* See below: */
944
void FindNewReps1( Obj tree, Obj reps);
945
946
void GetReps(
947
Obj list,
948
Obj reps )
949
{
950
Obj lreps,
951
rreps,
952
tree,
953
tree1;
954
UInt i,j,k,l, lenr, lenl, len;;
955
956
if ( LEN_PLIST(list) != 4 )
957
{
958
SET_ELM_PLIST(reps, 1, list);
959
SET_LEN_PLIST(reps, 1);
960
return;
961
}
962
lreps = NEW_PLIST(T_PLIST, 2);
963
rreps = NEW_PLIST(T_PLIST, 2);
964
SET_LEN_PLIST(lreps, 0);
965
SET_LEN_PLIST(rreps, 0);
966
/* now get all representatives which are represented by <list>[1] and
967
** all representatives which are represented by <list>[2]. */
968
GetReps( ELM_PLIST(list, 1), lreps );
969
GetReps( ELM_PLIST(list, 2), rreps );
970
lenl = LEN_PLIST( lreps );
971
lenr = LEN_PLIST( rreps );
972
for (i=1; i<=lenl; i++)
973
for (j=1; j<=lenr; j++)
974
{
975
/* compute all representatives which can be constructed from
976
** <lreps>[<i>] and <rreps>[<j>] and add them to <reps>. */
977
k = LEN_PLIST( ELM_PLIST(lreps, i) )
978
+ LEN_PLIST( ELM_PLIST(rreps, j) ) + 5;/* m"ogliche Inkom-*/
979
tree = NEW_PLIST(T_PLIST, k); /* patibilit"at nach*/
980
SET_LEN_PLIST(tree, k); /*"Anderung der Datenstruktur */
981
SET_ELM_PLIST(tree, 1, INTOBJ_INT(1) );
982
SET_ELM_PLIST(tree, 2, ELM_PLIST( list, 3) );
983
SET_ELM_PLIST(tree, 3, INTOBJ_INT(0) );
984
SET_ELM_PLIST(tree, 4, INTOBJ_INT((int)(k/5)) );
985
if ( TNUM_OBJ( ELM_PLIST(list, 4) ) == T_INT &&
986
CELM(list, 4) < 100 &&
987
CELM(list, 4) > 0 )
988
SET_ELM_PLIST(tree, 5, ELM_PLIST(list, 4) );
989
else
990
SET_ELM_PLIST(tree, 5, INTOBJ_INT(0) );
991
tree1 = ELM_PLIST(lreps, i);
992
len = LEN_PLIST( tree1 );
993
for (l=1; l<=len; l++)
994
SET_ELM_PLIST(tree, l+5, ELM_PLIST(tree1, l) );
995
k = LEN_PLIST(tree1) + 5;
996
tree1 = ELM_PLIST(rreps, j);
997
len = LEN_PLIST( tree1 );
998
for (l=1; l<=len; l++)
999
SET_ELM_PLIST(tree, l+k, ELM_PLIST(tree1, l) );
1000
UnmarkTree(tree);
1001
FindNewReps1(tree, reps);
1002
}
1003
}
1004
1005
1006
/**************************************************************************
1007
**
1008
*F FindNewReps(<tree>,<reps>,<pr>,<max>) . . construct new representatives
1009
**
1010
** 'FindNewReps' constructs all trees <tree'> with the following properties.
1011
** 1) left(<tree'>) is equivalent to left(<tree>).
1012
** right(<tree'>) is equivalent to right(<tree>).
1013
** num(<tree'>) = num(<tree>)
1014
** 2) <tree'> is the least tree in its equivalence class.
1015
** 3) for each marked node of (<tree>, i) of <tree> tree(<tree>, i) is equal
1016
** to tree(<tree'>, i).
1017
** There are three versions of FindNewReps. FindNewReps1 adds all found
1018
** trees to the list <reps>. This version is called by GetReps.
1019
** FindNewReps2 computes for each found tree the corresponding deep thought
1020
** monomial adds these deep thought monomials to <reps>. This version
1021
** is called from GetPols.
1022
** The third version FindNewReps finally assumes that <reps> is the list of
1023
** pseudorepresentatives. This Version adds all found trees to <reps> and
1024
** additionally all trees, that fulfill 1), 2) and 3) except for
1025
** num(<tree'>) = num(<tree>). This version is called from the library
1026
** function calrepsn.
1027
** It is assumed that both left(<tree>) and right(<tree>) are the least
1028
** elements in their equivalence class.
1029
*/
1030
1031
/* See below: */
1032
void FindSubs1( Obj tree, Int x, Obj list1, Obj list2, Obj a, Obj b,
1033
Int al, Int ar, Int bl, Int br, Obj reps );
1034
1035
void FindNewReps1(
1036
Obj tree,
1037
Obj reps
1038
)
1039
{
1040
Obj y, /* stores a copy of <tree> */
1041
lsubs, /* stores pos(<subtree>) for all subtrees of
1042
** left(<tree>) in a given almost equal class */
1043
1044
rsubs, /* stores pos(<subtree>) for all subtrees of
1045
** right(<tree>) in the same almost equal class */
1046
1047
llist, /* stores all elements of an almost equal class
1048
** of subtrees of left(<tree>) */
1049
1050
rlist; /* stores all elements of the same almost equal
1051
** class of subtrees of right(<tree>) */
1052
Int a, /* stores a subtree of right((<tree>) */
1053
n, /* Length of lsubs */
1054
m, /* Length of rsubs */
1055
i; /* loop variable */
1056
1057
/* get a subtree of right(<tree>) which is unmarked but whose
1058
** subtrees are all marked */
1059
a = FindTree(tree, DT_RIGHT(tree, 1) );
1060
/* If we do not find such a tree we at the bottom of the recursion.
1061
** If leftof(left(<tree>), right(<tree>) ) holds we add all <tree>
1062
** to <reps>. */
1063
if ( a == 0 )
1064
{
1065
if ( Leftof(tree, DT_LEFT(tree, 1), tree, DT_RIGHT(tree, 1) ) )
1066
{
1067
y = ShallowCopyPlist(tree);
1068
GROW_PLIST(reps, LEN_PLIST(reps) + 1);
1069
SET_LEN_PLIST(reps, LEN_PLIST(reps) + 1);
1070
SET_ELM_PLIST(reps, LEN_PLIST(reps), y);
1071
/* tell gasman that <reps> has changed */
1072
CHANGED_BAG(reps);
1073
}
1074
return;
1075
}
1076
/* get all subtrees of left(<tree>) which are almost equal to
1077
** tree(<tree>, a) and mark them */
1078
llist = Mark2(tree, DT_LEFT(tree, 1), tree, a);
1079
/* get all subtrees of right(<tree>) which are almost equal to
1080
** tree(<tree>, a) and mark them */
1081
rlist = Mark2(tree, DT_RIGHT(tree, 1), tree, a);
1082
n = LEN_PLIST(llist);
1083
m = LEN_PLIST(rlist);
1084
/* if no subtrees of left(<tree>) almost equal to
1085
** tree(<tree>, a) have been found there is no possibility
1086
** to change the pos-argument in the trees stored in llist and
1087
** rlist, so call FindNewReps without changing any pos-arguments.
1088
*/
1089
if ( n == 0 )
1090
{
1091
FindNewReps1(tree, reps);
1092
/* unmark all top nodes of the trees stored in rlist */
1093
UnmarkAEClass(tree, rlist);
1094
return;
1095
}
1096
/* store all pos-arguments that occur in the trees of llist.
1097
** Note that the set of the pos-arguments in llist actually
1098
** equals {1,...,n}. */
1099
lsubs = NEW_PLIST( T_PLIST, n );
1100
SET_LEN_PLIST(lsubs, n);
1101
for (i=1; i<=n; i++)
1102
SET_ELM_PLIST(lsubs, i, INTOBJ_INT(i) );
1103
/* store all pos-arguments that occur in the trees of rlist.
1104
** Note that the set of the pos-arguments in rlist actually
1105
** equals {1,...,m}. */
1106
rsubs = NEW_PLIST( T_PLIST, m );
1107
SET_LEN_PLIST(rsubs, m);
1108
for (i=1; i<=m; i++)
1109
SET_ELM_PLIST(rsubs, i, INTOBJ_INT(i) );
1110
/* find all possibilities for lsubs and rsubs such that
1111
** lsubs[1] < lsubs[2] <...<lsubs[n],
1112
** rsubs[1] < rsubs[2] <...<rsubs[n],
1113
** and set(lsubs concat rsubs) equals {1,...,k} for a positiv
1114
** integer k. For each found lsubs and rsubs 'FindSubs' changes
1115
** pos-arguments of the subtrees in llist and rlist accordingly
1116
** and then calls 'FindNewReps' with the changed tree <tree>.
1117
*/
1118
FindSubs1(tree, a, llist, rlist, lsubs, rsubs, 1, n, 1, m, reps);
1119
/* Unmark the subtrees of <tree> in llist and rlist and reset
1120
** pos-arguments to the original state. */
1121
UnmarkAEClass(tree, rlist);
1122
UnmarkAEClass(tree, llist);
1123
}
1124
1125
/* See below: */
1126
void FindSubs2( Obj tree, Int x, Obj list1, Obj list2, Obj a, Obj b,
1127
Int al, Int ar, Int bl, Int br, Obj reps, Obj pr );
1128
1129
void FindNewReps2(
1130
Obj tree,
1131
Obj reps,
1132
Obj pr /* pc-presentation for a
1133
** nilpotent group <G> */
1134
)
1135
{
1136
Obj lsubs, /* stores pos(<subtree>) for all subtrees of
1137
** left(<tree>) in a given almost equal class */
1138
1139
rsubs, /* stores pos(<subtree>) for all subtrees of
1140
** right(<tree>) in the same almost equal class */
1141
1142
llist, /* stores all elements of an almost equal class
1143
** of subtrees of left(<tree>) */
1144
1145
rlist; /* stores all elements of the same almost equal
1146
** class of subtrees of right(<tree>) */
1147
Int a, /* stores a subtree of right((<tree>) */
1148
n, /* Length of lsubs */
1149
m, /* Length of rsubs */
1150
i; /* loop variable */
1151
1152
/* get a subtree of right(<tree>) which is unmarked but whose
1153
** subtrees are all marked */
1154
a = FindTree(tree, DT_RIGHT(tree, 1) );
1155
/* If we do not find such a tree we at the bottom of the recursion.
1156
** If leftof(left(<tree>), right(<tree>) ) holds we convert <tree>
1157
** into the corresponding deep thought monomial and add that to
1158
** <reps>. */
1159
if ( a == 0 )
1160
{
1161
if ( Leftof(tree, DT_LEFT(tree, 1), tree, DT_RIGHT(tree, 1) ) )
1162
{
1163
/* get the formula vector of tree and add it to
1164
** reps[ rel[1] ]. */
1165
UnmarkTree(tree);
1166
tree = MakeFormulaVector( tree, pr);
1167
CALL_3ARGS(Dt_add, tree, reps, pr);
1168
}
1169
return;
1170
}
1171
/* get all subtrees of left(<tree>) which are almost equal to
1172
** tree(<tree>, a) and mark them */
1173
llist = Mark2(tree, DT_LEFT(tree, 1), tree, a);
1174
/* get all subtrees of right(<tree>) which are almost equal to
1175
** tree(<tree>, a) and mark them */
1176
rlist = Mark2(tree, DT_RIGHT(tree, 1), tree, a);
1177
n = LEN_PLIST(llist);
1178
m = LEN_PLIST(rlist);
1179
/* if no subtrees of left(<tree>) almost equal to
1180
** tree(<tree>, a) have been found there is no possibility
1181
** to change the pos-argument in the trees stored in llist and
1182
** rlist, so call FindNewReps without changing any pos-arguments.
1183
*/
1184
if ( n == 0 )
1185
{
1186
FindNewReps2(tree, reps, pr);
1187
/* unmark all top nodes of the trees stored in rlist */
1188
UnmarkAEClass(tree, rlist);
1189
return;
1190
}
1191
/* store all pos-arguments that occur in the trees of llist.
1192
** Note that the set of the pos-arguments in llist actually
1193
** equals {1,...,n}. */
1194
lsubs = NEW_PLIST( T_PLIST, n );
1195
SET_LEN_PLIST(lsubs, n);
1196
for (i=1; i<=n; i++)
1197
SET_ELM_PLIST(lsubs, i, INTOBJ_INT(i) );
1198
/* store all pos-arguments that occur in the trees of rlist.
1199
** Note that the set of the pos-arguments in rlist actually
1200
** equals {1,...,m}. */
1201
rsubs = NEW_PLIST( T_PLIST, m );
1202
SET_LEN_PLIST(rsubs, m);
1203
for (i=1; i<=m; i++)
1204
SET_ELM_PLIST(rsubs, i, INTOBJ_INT(i) );
1205
/* find all possibilities for lsubs and rsubs such that
1206
** lsubs[1] < lsubs[2] <...<lsubs[n],
1207
** rsubs[1] < rsubs[2] <...<rsubs[n],
1208
** and set(lsubs concat rsubs) equals {1,...,k} for a positiv
1209
** integer k. For each found lsubs and rsubs 'FindSubs' changes
1210
** pos-arguments of the subtrees in llist and rlist accordingly
1211
** and then calls 'FindNewReps' with the changed tree <tree>.
1212
*/
1213
FindSubs2(tree, a, llist, rlist, lsubs, rsubs, 1, n, 1, m, reps, pr);
1214
/* Unmark the subtrees of <tree> in llist and rlist and reset
1215
** pos-arguments to the original state. */
1216
UnmarkAEClass(tree, rlist);
1217
UnmarkAEClass(tree, llist);
1218
}
1219
1220
1221
void FindNewReps(
1222
Obj tree,
1223
Obj reps,
1224
Obj pr, /* pc-presentation for a
1225
** nilpotent group <G> */
1226
1227
Obj max /* every generator <g_i> of <G> with
1228
** i > max lies in the center of <G> */
1229
)
1230
{
1231
Obj y, /* stores a copy of <tree> */
1232
lsubs, /* stores pos(<subtree>) for all subtrees of
1233
** left(<tree>) in a given almost equal class */
1234
1235
rsubs, /* stores pos(<subtree>) for all subtrees of
1236
** right(<tree>) in the same almost equal class */
1237
1238
llist, /* stores all elements of an almost equal class
1239
** of subtrees of left(<tree>) */
1240
1241
rlist, /* stores all elements of the same almost equal
1242
** class of subtrees of right(<tree>) */
1243
list1, /* stores a sublist of <reps> */
1244
rel; /* stores a commutator relation from <pr> */
1245
Int a; /* stores a subtree of right((<tree>) */
1246
UInt n, /* Length of lsubs */
1247
m, /* Length of rsubs */
1248
i, lenrel; /* loop variable */
1249
1250
/* get a subtree of right(<tree>) which is unmarked but whose
1251
** subtrees are all marked */
1252
a = FindTree(tree, DT_RIGHT(tree, 1) );
1253
/* If we do not find such a tree we at the bottom of the recursion.
1254
** If leftof(left(<tree>), right(<tree>) ) holds we add all trees
1255
** <tree'> with left(<tree'>) = left(<tree>),
1256
** right(<tree'>) = right(<tree>) to <reps>, and <tree'> is the
1257
** least element in its equivalence calss. Note that for such a
1258
** tree we have pos(<tree'>) = 1 and num(<tree'>) = j where j is a
1259
** positive integer for which
1260
** c_( num(left(<tree>), num(right(<tree>)), j ) does not equal
1261
** 0. These integers are contained in the list
1262
** pr[ num(left(<tree>)) ][ num(right(<tree>)) ]. */
1263
if ( a == 0 )
1264
{
1265
if ( Leftof(tree, DT_LEFT(tree, 1), tree, DT_RIGHT(tree, 1) ) )
1266
{
1267
/* get pr[ num(left(<tree>)) ][ num(right(<tree>)) ] */
1268
rel = ELM_PLIST( ELM_PLIST(pr, INT_INTOBJ( DT_GEN(tree,
1269
DT_LEFT(tree, 1)))) ,
1270
INT_INTOBJ( DT_GEN(tree, DT_RIGHT(tree, 1) ) ) );
1271
if ( ELM_PLIST(rel, 3) > max )
1272
{
1273
UnmarkTree(tree);
1274
tree = MakeFormulaVector(tree, pr);
1275
list1 = ELM_PLIST(reps, CELM(rel, 3) );
1276
GROW_PLIST(list1, LEN_PLIST(list1) + 1 );
1277
SET_LEN_PLIST(list1, LEN_PLIST(list1) + 1 );
1278
SET_ELM_PLIST(list1, LEN_PLIST(list1), tree);
1279
CHANGED_BAG(list1);
1280
}
1281
else
1282
{
1283
y = ShallowCopyPlist(tree);
1284
lenrel = LEN_PLIST(rel);
1285
for ( i=3;
1286
i < lenrel &&
1287
ELM_PLIST(rel, i) <= max;
1288
i+=2 )
1289
{
1290
list1 = ELM_PLIST(reps, CELM(rel, i) );
1291
GROW_PLIST(list1, LEN_PLIST(list1) + 1);
1292
SET_LEN_PLIST(list1, LEN_PLIST(list1) + 1);
1293
SET_ELM_PLIST(list1, LEN_PLIST(list1), y);
1294
/* tell gasman that <list1> has changed */
1295
CHANGED_BAG(list1);
1296
}
1297
}
1298
}
1299
return;
1300
}
1301
/* get all subtrees of left(<tree>) which are almost equal to
1302
** tree(<tree>, a) and mark them */
1303
llist = Mark2(tree, DT_LEFT(tree, 1), tree, a);
1304
/* get all subtrees of right(<tree>) which are almost equal to
1305
** tree(<tree>, a) and mark them */
1306
rlist = Mark2(tree, DT_RIGHT(tree, 1), tree, a);
1307
n = LEN_PLIST(llist);
1308
m = LEN_PLIST(rlist);
1309
/* if no subtrees of left(<tree>) almost equal to
1310
** tree(<tree>, a) have been found there is no possibility
1311
** to change the pos-argument in the trees stored in llist and
1312
** rlist, so call FindNewReps without changing any pos-arguments.
1313
*/
1314
if ( n == 0 )
1315
{
1316
FindNewReps(tree, reps, pr, max);
1317
/* unmark all top nodes of the trees stored in rlist */
1318
UnmarkAEClass(tree, rlist);
1319
return;
1320
}
1321
/* store all pos-arguments that occur in the trees of llist.
1322
** Note that the set of the pos-arguments in llist actually
1323
** equals {1,...,n}. */
1324
lsubs = NEW_PLIST( T_PLIST, n );
1325
SET_LEN_PLIST(lsubs, n);
1326
for (i=1; i<=n; i++)
1327
SET_ELM_PLIST(lsubs, i, INTOBJ_INT(i) );
1328
/* store all pos-arguments that occur in the trees of rlist.
1329
** Note that the set of the pos-arguments in rlist actually
1330
** equals {1,...,m}. */
1331
rsubs = NEW_PLIST( T_PLIST, m );
1332
SET_LEN_PLIST(rsubs, m);
1333
for (i=1; i<=m; i++)
1334
SET_ELM_PLIST(rsubs, i, INTOBJ_INT(i) );
1335
/* find all possibilities for lsubs and rsubs such that
1336
** lsubs[1] < lsubs[2] <...<lsubs[n],
1337
** rsubs[1] < rsubs[2] <...<rsubs[n],
1338
** and set(lsubs concat rsubs) equals {1,...,k} for a positiv
1339
** integer k. For each found lsubs and rsubs 'FindSubs' changes
1340
** pos-arguments of the subtrees in llist and rlist accordingly
1341
** and then calls 'FindNewReps' with the changed tree <tree>.
1342
*/
1343
FindSubs(tree, a, llist, rlist, lsubs, rsubs, 1, n, 1, m, reps, pr, max);
1344
/* Unmark the subtrees of <tree> in llist and rlist and reset
1345
** pos-arguments to the original state. */
1346
UnmarkAEClass(tree, rlist);
1347
UnmarkAEClass(tree, llist);
1348
}
1349
1350
1351
/***************************************************************************
1352
**
1353
*F FuncFindNewReps(<self>,<args>) . . . . . . construct new representatives
1354
**
1355
** 'FuncFindNewReps' implements the internal function 'FindNewReps'.
1356
*/
1357
1358
Obj FuncFindNewReps(
1359
Obj self,
1360
Obj tree,
1361
Obj reps,
1362
Obj pr,
1363
Obj max )
1364
{
1365
1366
/* test if <tree> is really a tree */
1367
/* TestTree(tree); */
1368
if ( LEN_PLIST(tree) < 15 )
1369
ErrorReturnVoid("<tree> must be a tree not a plain list", 0L, 0L,
1370
"you can 'return;'");
1371
FindNewReps(tree, reps, pr, max);
1372
return 0;
1373
}
1374
1375
1376
/***************************************************************************
1377
**
1378
*F TestTree(<obj>) . . . . . . . . . . . . . . . . . . . . . . test a tree
1379
**
1380
** 'TestTree' tests if <tree> is a tree. If <tree> is not a tree 'TestTree'
1381
** signals an error.
1382
*/
1383
void TestTree(
1384
Obj tree)
1385
{
1386
1387
if ( TNUM_OBJ(tree) != T_PLIST || LEN_PLIST(tree) % 7 != 0)
1388
ErrorReturnVoid("<tree> must be a plain list, whose length is a multiple of 7", 0L, 0L, "you can 'return;'");
1389
if ( DT_LENGTH(tree, 1) != LEN_PLIST(tree)/7 )
1390
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1391
"you can 'return;'");
1392
if ( DT_SIDE(tree, 1) >= DT_LENGTH(tree, 1) )
1393
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1394
"you can 'return;'");
1395
if ( DT_LENGTH(tree, 1) == 1)
1396
{
1397
if ( DT_SIDE(tree, 1) != LEFT && DT_SIDE(tree, 1) != RIGHT )
1398
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1399
"you can 'return;'");
1400
return;
1401
}
1402
if ( DT_SIDE(tree, 1) <= 1 )
1403
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1404
"you can 'return;'");
1405
if (DT_LENGTH(tree, 1) !=
1406
DT_LENGTH(tree, DT_LEFT(tree, 1)) +
1407
DT_LENGTH(tree, DT_RIGHT(tree, 1)) +
1408
1 )
1409
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1410
"you can 'return;'");
1411
if ( DT_SIDE(tree, 1) != DT_LENGTH(tree, DT_LEFT(tree, 1) ) + 1 )
1412
ErrorReturnVoid("<tree> must be a tree, not a plain list.", 0L, 0L,
1413
"you can 'return;'");
1414
TestTree( Part(tree, (DT_LEFT(tree, 1) - 1)*7,
1415
(DT_RIGHT(tree, 1) - 1)*7 ) );
1416
TestTree( Part(tree, (DT_RIGHT(tree, 1) - 1)*7, LEN_PLIST(tree) ) );
1417
}
1418
1419
1420
/****************************************************************************
1421
**
1422
*F Part(<list>, <pos1>, <pos2> . . . . . . . . . . . . return a part of list
1423
**
1424
** 'Part' returns <list>{ [<pos1>+1 .. <pos2>] }.
1425
*/
1426
Obj Part(
1427
Obj list,
1428
Int pos1,
1429
Int pos2 )
1430
{
1431
Int i, length;
1432
Obj part;
1433
1434
length = pos2 - pos1;
1435
part = NEW_PLIST(T_PLIST, length);
1436
SET_LEN_PLIST(part, length);
1437
for (i=1; i <= length; i++)
1438
{
1439
SET_ELM_PLIST(part, i, ELM_PLIST(list, pos1+i) );
1440
}
1441
return part;
1442
}
1443
1444
1445
/***************************************************************************
1446
**
1447
*F FindSubs(<tree>,<x>,<list1>,<list2>,<a>,<b>,<al>,<ar>,<bl>,<br>,<reps>,
1448
** <pr>,<max> ) . . . . . . . . . find possible pos-arguments for
1449
** the trees in <list1> and <list2>
1450
**
1451
** 'FindSubs' finds all possibilities for a and b such that
1452
** 1) a[1] < a[2] <..< a[ ar ]
1453
** b[1] < b[2] <..< b[ br ]
1454
** 2) set( a concat b ) = {1,..,k} for a positiv integer k.
1455
** 3) a[1],...,a[ al-1 ] and b[1],..,b[ bl-1 ] remain unchanged.
1456
** For each found possibility 'FindSubs' sets the pos-arguments in the
1457
** trees of <list1> and <list2> according to the entries of <a> and
1458
** <b>. Then it calls 'FindNewReps' with the changed tree <tree> as
1459
v** argument.
1460
**
1461
** It is assumed that the conditions 1) and 2) hold for a{ [1..al-1] } and
1462
** b{ [1..bl-1] }.
1463
**
1464
** There are three versions of FindSubs according to the three versions of
1465
** FindNewReps. FindSubs1 is called from FindNewReps1 and calls
1466
** FindNewReps1. FindSubs2 is called from FindNewReps2 and calls
1467
** FindNewReps2. FindSubs is called from FindNewReps and calls FindNewReps.
1468
*/
1469
1470
void FindSubs1(
1471
Obj tree,
1472
Int x, /* subtree of <tree> */
1473
Obj list1, /* list containing all subtrees of
1474
** left(<tree>) almost equal to
1475
** tree(<tree>, x) */
1476
1477
Obj list2, /* list containing all subtrees of
1478
** right(<tree>) almost equal to
1479
** tree(<tree>, x) */
1480
1481
Obj a, /* list to change, containing the
1482
** pos-arguments of the trees in list1 */
1483
1484
Obj b, /* list to change, containing tthe
1485
** pos-arguments of the trees in list2 */
1486
Int al,
1487
Int ar,
1488
Int bl,
1489
Int br,
1490
Obj reps /* list of representatives for all trees */
1491
)
1492
{
1493
Int i; /* loop variable */
1494
1495
/* if <al> > <ar> or <bl> > <br> nothing remains to change. */
1496
if ( al > ar || bl > br )
1497
{
1498
/* Set the pos-arguments of the trees in <list1> and <list2>
1499
** according to the entries of <a> and <b>. */
1500
SetSubs( list1, a, tree);
1501
SetSubs( list2, b, tree);
1502
FindNewReps1(tree, reps);
1503
return;
1504
}
1505
/* If a[ ar] is bigger or equal to the boundary of pos(tree(<tree>, x)
1506
** the execution of the statements in the body of this if-statement
1507
** would have the consequence that some subtrees of <tree> in <list1>
1508
** would get a pos-argument bigger than the boundary of
1509
** pos(tree<tree>, x). But since the trees in <list1> are almost
1510
** equal to tree(<tree>, x) they have all the same boundary for their
1511
** pos-argument as tree(<tree>, x). So these statements are only
1512
** executed when <a>[ar] is less than the boundary of
1513
** pos(tree(<tree>, x).
1514
*/
1515
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1516
ELM_PLIST(a, ar) < DT_MAX(tree, x) )
1517
{
1518
for (i=al; i<=ar; i++)
1519
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a,i) + 1 ) );
1520
FindSubs1(tree, x, list1, list2, a, b, al, ar, bl+1, br, reps);
1521
for (i=al; i<=ar; i++)
1522
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a, i) - 1 ) );
1523
}
1524
FindSubs1(tree, x, list1, list2, a, b, al+1, ar, bl+1, br, reps);
1525
/* If b[ br] is bigger or equal to the boundary of pos(tree(<tree>, x)
1526
** the execution of the statements in the body of this if-statement
1527
** would have the consequence that some subtrees of <tree> in <list2>
1528
** would get a pos-argument bigger than the boundary of
1529
** pos(tree<tree>, x). But since the trees in <list2> are almost
1530
** equal to tree(<tree>, x) they have all the same boundary for their
1531
** pos-argument as tree(<tree>, x). So these statements are only
1532
** executed when <b>[br] is less than the boundary of
1533
** pos(tree(<tree>, x).
1534
*/
1535
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1536
ELM_PLIST(b, br) < DT_MAX(tree, x) )
1537
{
1538
for (i=bl; i<=br; i++)
1539
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) + 1 ) );
1540
FindSubs1(tree, x, list1, list2, a, b, al+1, ar, bl, br, reps);
1541
for (i=bl; i<=br; i++)
1542
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) - 1 ) );
1543
}
1544
}
1545
1546
1547
void FindSubs2(
1548
Obj tree,
1549
Int x, /* subtree of <tree> */
1550
Obj list1, /* list containing all subtrees of
1551
** left(<tree>) almost equal to
1552
** tree(<tree>, x) */
1553
1554
Obj list2, /* list containing all subtrees of
1555
** right(<tree>) almost equal to
1556
** tree(<tree>, x) */
1557
1558
Obj a, /* list to change, containing the
1559
** pos-arguments of the trees in list1 */
1560
1561
Obj b, /* list to change, containing the
1562
** pos-arguments of the trees in list2 */
1563
Int al,
1564
Int ar,
1565
Int bl,
1566
Int br,
1567
Obj reps, /* list of representatives for all trees */
1568
Obj pr /* pc-presentation */
1569
)
1570
{
1571
Int i; /* loop variable */
1572
1573
/* if <al> > <ar> or <bl> > <br> nothing remains to change. */
1574
if ( al > ar || bl > br )
1575
{
1576
/* Set the pos-arguments of the trees in <list1> and <list2>
1577
** according to the entries of <a> and <b>. */
1578
SetSubs( list1, a, tree);
1579
SetSubs( list2, b, tree);
1580
FindNewReps2(tree, reps, pr);
1581
return;
1582
}
1583
/* If a[ ar] is bigger or equal to the boundary of pos(tree(<tree>, x)
1584
** the execution of the statements in the body of this if-statement
1585
** would have the consequence that some subtrees of <tree> in <list1>
1586
** would get a pos-argument bigger than the boundary of
1587
** pos(tree<tree>, x). But since the trees in <list1> are almost
1588
** equal to tree(<tree>, x) they have all the same boundary for their
1589
** pos-argument as tree(<tree>, x). So these statements are only
1590
** executed when <a>[ar] is less than the boundary of
1591
** pos(tree(<tree>, x).
1592
*/
1593
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1594
ELM_PLIST(a, ar) < DT_MAX(tree, x) )
1595
{
1596
for (i=al; i<=ar; i++)
1597
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a,i) + 1 ) );
1598
FindSubs2(tree, x, list1, list2, a, b, al, ar, bl+1, br, reps, pr);
1599
for (i=al; i<=ar; i++)
1600
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a, i) - 1 ) );
1601
}
1602
FindSubs2(tree, x, list1, list2, a, b, al+1, ar, bl+1, br, reps, pr);
1603
/* If b[ br] is bigger or equal to the boundary of pos(tree(<tree>, x)
1604
** the execution of the statements in the body of this if-statement
1605
** would have the consequence that some subtrees of <tree> in <list2>
1606
** would get a pos-argument bigger than the boundary of
1607
** pos(tree<tree>, x). But since the trees in <list2> are almost
1608
** equal to tree(<tree>, x) they have all the same boundary for their
1609
** pos-argument as tree(<tree>, x). So these statements are only
1610
** executed when <b>[br] is less than the boundary of
1611
** pos(tree(<tree>, x).
1612
*/
1613
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1614
ELM_PLIST(b, br) < DT_MAX(tree, x) )
1615
{
1616
for (i=bl; i<=br; i++)
1617
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) + 1 ) );
1618
FindSubs2(tree, x, list1, list2, a, b, al+1, ar, bl, br, reps, pr);
1619
for (i=bl; i<=br; i++)
1620
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) - 1 ) );
1621
}
1622
}
1623
1624
1625
void FindSubs(
1626
Obj tree,
1627
Int x, /* subtree of <tree> */
1628
Obj list1, /* list containing all subtrees of
1629
** left(<tree>) almost equal to
1630
** tree(<tree>, x) */
1631
1632
Obj list2, /* list containing all subtrees of
1633
** right(<tree>) almost equal to
1634
** tree(<tree>, x) */
1635
1636
Obj a, /* list to change, containing the
1637
** pos-arguments of the trees in list1 */
1638
1639
Obj b, /* list to change, containing the
1640
** pos-arguments of the trees in list2 */
1641
Int al,
1642
Int ar,
1643
Int bl,
1644
Int br,
1645
Obj reps, /* list of representatives for all trees */
1646
Obj pr, /* pc-presentation */
1647
Obj max /* needed to call 'FindNewReps' */
1648
)
1649
{
1650
Int i; /* loop variable */
1651
1652
/* if <al> > <ar> or <bl> > <br> nothing remains to change. */
1653
if ( al > ar || bl > br )
1654
{
1655
/* Set the pos-arguments of the trees in <list1> and <list2>
1656
** according to the entries of <a> and <b>. */
1657
SetSubs( list1, a, tree);
1658
SetSubs( list2, b, tree);
1659
FindNewReps(tree, reps, pr, max);
1660
return;
1661
}
1662
/* If a[ ar] is bigger or equal to the boundary of pos(tree(<tree>, x)
1663
** the execution of the statements in the body of this if-statement
1664
** would have the consequence that some subtrees of <tree> in <list1>
1665
** would get a pos-argument bigger than the boundary of
1666
** pos(tree<tree>, x). But since the trees in <list1> are almost
1667
** equal to tree(<tree>, x) they have all the same boundary for their
1668
** pos-argument as tree(<tree>, x). So these statements are only
1669
** executed when <a>[ar] is less than the boundary of
1670
** pos(tree(<tree>, x).
1671
*/
1672
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1673
ELM_PLIST(a, ar) < DT_MAX(tree, x) )
1674
{
1675
for (i=al; i<=ar; i++)
1676
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a,i) + 1 ) );
1677
FindSubs(tree, x, list1, list2, a, b, al, ar, bl+1, br, reps, pr, max);
1678
for (i=al; i<=ar; i++)
1679
SET_ELM_PLIST(a, i, INTOBJ_INT( CELM(a, i) - 1 ) );
1680
}
1681
FindSubs(tree, x, list1, list2, a, b, al+1, ar, bl+1, br, reps, pr, max);
1682
/* If b[ br] is bigger or equal to the boundary of pos(tree(<tree>, x)
1683
** the execution of the statements in the body of this if-statement
1684
** would have the consequence that some subtrees of <tree> in <list2>
1685
** would get a pos-argument bigger than the boundary of
1686
** pos(tree<tree>, x). But since the trees in <list2> are almost
1687
** equal to tree(<tree>, x) they have all the same boundary for their
1688
** pos-argument as tree(<tree>, x). So these statements are only
1689
** executed when <b>[br] is less than the boundary of
1690
** pos(tree(<tree>, x).
1691
*/
1692
if ( INT_INTOBJ( DT_MAX(tree, x) ) <= 0 ||
1693
ELM_PLIST(b, br) < DT_MAX(tree, x) )
1694
{
1695
for (i=bl; i<=br; i++)
1696
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) + 1 ) );
1697
FindSubs(tree, x, list1, list2, a, b, al+1, ar, bl, br, reps, pr, max);
1698
for (i=bl; i<=br; i++)
1699
SET_ELM_PLIST(b, i, INTOBJ_INT( CELM(b, i) - 1 ) );
1700
}
1701
}
1702
1703
1704
/****************************************************************************
1705
**
1706
*F SetSubs(<list>, <a>, <tree>) . . . . . . . . . . .. . set pos-arguments
1707
**
1708
** 'SetSubs' sets the pos-arguments of the subtrees of <tree>, contained
1709
** in <list> according to the entries in the list <a>.
1710
*/
1711
void SetSubs(
1712
Obj list,
1713
Obj a,
1714
Obj tree )
1715
{
1716
UInt i,j; /* loop variables */
1717
UInt len, len2;
1718
1719
len = LEN_PLIST(list);
1720
for (i=1; i <= len; i++)
1721
{
1722
len2 = LEN_PLIST( ELM_PLIST(list, i) );
1723
for (j=1; j <= len2; j++)
1724
SET_DT_POS(tree, CELM( ELM_PLIST(list, i), j), ELM_PLIST(a, i) );
1725
}
1726
}
1727
1728
1729
/****************************************************************************
1730
**
1731
*F UnmarkAEClass(<tree>, <list>) . . . . . . . . . . . . reset pos-arguments
1732
**
1733
** 'UnmarkAEClass' resets the pos arguments of the subtrees of <tree>,
1734
** contained in <list> to the original state. Furthermore it unmarks the
1735
** top node of each of those trees.
1736
*/
1737
1738
void UnmarkAEClass(
1739
Obj tree,
1740
Obj list )
1741
{
1742
UInt i,j, len, len2;
1743
1744
len = LEN_PLIST(list);
1745
for (i=1; i <= len; i++)
1746
{
1747
len2 = LEN_PLIST( ELM_PLIST(list, i) );
1748
for (j=1; j <= len2; j++)
1749
{
1750
DT_UNMARK(tree, CELM( ELM_PLIST(list, i), j) );
1751
SET_DT_POS(tree, CELM( ELM_PLIST(list, i), j), INTOBJ_INT(i) );
1752
}
1753
}
1754
}
1755
1756
1757
/****************************************************************************
1758
**
1759
*F FuncDT_evaluation( <self>, <vector> )
1760
**
1761
** FuncDT_evaluation implements the internal function
1762
**
1763
** DT_evaluation( <vector> ).
1764
**
1765
** DT_evaluation returns a positive integer which is used to sort the deep
1766
** monomials. DT_evaluation is called from the library function dt_add.
1767
*/
1768
1769
Obj FuncDT_evaluation(Obj self,
1770
Obj vector)
1771
{
1772
UInt res,i;
1773
1774
res = CELM(vector, 6)*CELM(vector, 6);
1775
for (i=7; i < LEN_PLIST(vector); i+=2)
1776
res += CELM(vector, i)*CELM(vector, i+1)*CELM(vector, i+1);
1777
return INTOBJ_INT(res);
1778
}
1779
1780
1781
1782
/****************************************************************************
1783
**
1784
1785
*F * * * * * * * * * * * * * initialize package * * * * * * * * * * * * * * *
1786
*/
1787
1788
1789
/****************************************************************************
1790
**
1791
1792
*V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1793
*/
1794
static StructGVarFunc GVarFuncs [] = {
1795
1796
{ "MakeFormulaVector", 2, "tree, presentation",
1797
FuncMakeFormulaVector, "src/dt.c:MakeFormulaVector" },
1798
1799
{ "FindNewReps", 4, "tree, representatives, presentation, maximum",
1800
FuncFindNewReps, "src/dt.c:FindNewReps" },
1801
1802
{ "UnmarkTree", 1, "tree",
1803
FuncUnmarkTree, "src/dt.c:UnmarkTree" },
1804
1805
{ "GetPols", 3, "list, presentation, polynomial",
1806
FuncGetPols, "src/dt.c:GetPols" },
1807
1808
{ "DT_evaluation", 1, "vector",
1809
FuncDT_evaluation, "src/dt.c:DT_evaluation" },
1810
1811
{ 0 }
1812
1813
};
1814
1815
1816
/****************************************************************************
1817
**
1818
1819
*F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1820
*/
1821
static Int InitKernel (
1822
StructInitInfo * module )
1823
{
1824
InitFopyGVar( "Dt_add" , &Dt_add );
1825
1826
/* init filters and functions */
1827
InitHdlrFuncsFromTable( GVarFuncs );
1828
1829
/* return success */
1830
return 0;
1831
}
1832
1833
1834
/****************************************************************************
1835
**
1836
*F InitLibrary( <module> ) . . . . . . . initialise library data structures
1837
*/
1838
static Int InitLibrary (
1839
StructInitInfo * module )
1840
{
1841
/* init filters and functions */
1842
InitGVarFuncsFromTable( GVarFuncs );
1843
1844
/* return success */
1845
return 0;
1846
}
1847
1848
1849
/****************************************************************************
1850
**
1851
*F InitInfoDeepThought() . . . . . . . . . . . . . . table of init functions
1852
*/
1853
static StructInitInfo module = {
1854
MODULE_BUILTIN, /* type */
1855
"dt", /* name */
1856
0, /* revision entry of c file */
1857
0, /* revision entry of h file */
1858
0, /* version */
1859
0, /* crc */
1860
InitKernel, /* initKernel */
1861
InitLibrary, /* initLibrary */
1862
0, /* checkInit */
1863
0, /* preSave */
1864
0, /* postSave */
1865
0 /* postRestore */
1866
};
1867
1868
StructInitInfo * InitInfoDeepThought ( void )
1869
{
1870
return &module;
1871
}
1872
1873
1874
/****************************************************************************
1875
**
1876
1877
*E dt.c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
1878
**
1879
*/
1880
1881