1 /****************************************************************************
2 **
3 *A eliminate.c ANUPQ source Eamonn O'Brien
4 **
5 *Y Copyright 1995-2001, Lehrstuhl D fuer Mathematik, RWTH Aachen, Germany
6 *Y Copyright 1995-2001, School of Mathematical Sciences, ANU, Australia
7 **
8 */
9
10 #include "pq_defs.h"
11 #include "pcp_vars.h"
12 #include "pq_functions.h"
13
14 /* eliminate all redundant generators to construct the consistent
15 power commutator presentation for the group to class current_class;
16
17 if middle_of_tails is TRUE, do not delete space set aside in
18 setup; in this case, only deallocate redundant generators */
19
eliminate(Logical middle_of_tails,struct pcp_vars * pcp)20 void eliminate(Logical middle_of_tails, struct pcp_vars *pcp)
21 {
22 register int *y = y_address;
23
24 register int i;
25 register int j;
26 register int k;
27 register int l;
28 register int p1;
29 register int ba;
30 register int lg;
31 register int length;
32 register int bound;
33
34 register int structure = pcp->structure;
35 register int current_class = pcp->cc;
36 register int lused = pcp->lused;
37 register int prime = pcp->p;
38 register int dgen = pcp->dgen;
39 register int ndgen = pcp->ndgen;
40 register int pointer;
41 register int value;
42
43 #include "access.h"
44
45 /* calculate new values for irredundant generators and set them up
46 in a renumbering table of length pcp->lastg - pcp->ccbeg + 1
47 which looks to compact like a normal exponent-generator string
48 pointed to by y[dgen] */
49
50 if (current_class != 1) {
51
52 if (is_space_exhausted(pcp->lastg - pcp->ccbeg + 3, pcp))
53 return;
54
55 structure = pcp->structure;
56 lused = pcp->lused;
57 y[lused + 1] = dgen;
58 y[dgen] = -(lused + 1);
59 y[lused + 2] = pcp->lastg - pcp->ccbeg + 1;
60 ba = lused + 3 - pcp->ccbeg;
61 pcp->lused += pcp->lastg - pcp->ccbeg + 3;
62 lused = pcp->lused;
63 lg = pcp->ccbeg - 1;
64 for (i = pcp->ccbeg, bound = pcp->lastg; i <= bound; i++) {
65 y[ba + i] = 0;
66 if (y[structure + i] > 0)
67 y[ba + i] = ++lg;
68 }
69
70 /* update pcp->first_pseudo */
71 bound = pcp->lastg;
72 for (i = pcp->first_pseudo; i <= bound && y[structure + i] <= 0; i++)
73 ;
74 pcp->first_pseudo = (i > pcp->lastg) ? lg + 1 : y[ba + i];
75
76 /* update the commutator tables */
77 p1 = y[pcp->ppcomm + 2];
78 for (i = 1, bound = pcp->ncomm; i <= bound; i++) {
79 update(p1 + i, pcp);
80 if (pcp->overflow)
81 return;
82 }
83
84 /* update the power tables */
85 for (i = 2, bound = pcp->ccbeg; i <= bound; i++) {
86 /* fix (i - 1)^p */
87 update(pcp->ppower + i - 1, pcp);
88 if (pcp->overflow)
89 return;
90 }
91
92 /* update the redundant defining generators and inverses */
93 for (i = 1; i <= ndgen; i++) {
94 update(dgen + i, pcp);
95 if (pcp->overflow)
96 return;
97 update(dgen - i, pcp);
98 if (pcp->overflow)
99 return;
100 }
101
102 /* finally update and move structure information */
103
104 if (middle_of_tails) {
105 pointer = pcp->structure + pcp->ccbeg - 1;
106 for (i = pcp->ccbeg; i <= pcp->lastg; ++i) {
107 if ((value = y[pcp->structure + i]) > 0)
108 y[++pointer] = value;
109 else if (value < 0)
110 y[-value] = 0;
111 }
112 } else {
113 k = pcp->ppower;
114 structure = pcp->structure;
115 for (i = pcp->lastg; i >= pcp->ccbeg; i--) {
116 if ((j = y[structure + i]) > 0) {
117 y[k] = j;
118 k--;
119 } else if (j < 0) {
120 /* deallocate equation for redundant generator i */
121 p1 = -j;
122 y[p1] = 0;
123 }
124 }
125
126 for (; i > 0; i--)
127 y[k--] = y[structure + i];
128 if (pcp->subgrp != structure)
129 delete_tables(0, pcp);
130 pcp->structure = k;
131 structure = pcp->structure;
132 pcp->words = k;
133 pcp->subgrp = k;
134 pcp->submlg = pcp->subgrp - lg;
135 }
136
137 pcp->lastg = lg;
138 y[pcp->clend + current_class] = pcp->lastg;
139
140 /* deallocate the renumbering table */
141 p1 = -y[dgen];
142 y[p1] = 0;
143 return;
144 }
145
146 /* class 1 */
147
148 pcp->lastg = 0;
149 for (i = 1; i <= ndgen; i++) {
150 if ((j = y[structure + i]) == 0) {
151 /* defining generator i is trivially redundant */
152 y[dgen + i] = 0;
153 if (y[dgen - i] < 0) {
154 /* deallocate old inverse */
155 p1 = -y[dgen - i];
156 y[p1] = 0;
157 /* set new inverse trivial */
158 y[dgen - i] = 0;
159 }
160 } else if (j < 0) {
161 /* defining generator i is redundant with value pointed
162 to by -y[structure + i] */
163 y[dgen + i] = y[structure + i];
164 p1 = -y[dgen + i];
165 length = y[p1 + 1];
166 y[p1] = dgen + i;
167
168 /* renumber value of defining generator i */
169 for (k = 1; k <= length; k++) {
170 l = FIELD2(y[p1 + k + 1]);
171 y[p1 + k + 1] += y[dgen + l] - l;
172 }
173
174 if (y[dgen - i] < 0) {
175 /* i inverse occurs in a defining relation, so recompute
176 the inverse and set up header block for inverse */
177 y[lused + 1] = dgen - i;
178 y[lused + 2] = length;
179
180 /* set up inverse */
181 for (j = 1; j <= length; j++) {
182 k = y[p1 + j + 1];
183 y[lused + 2 + j] = PACK2(prime - FIELD1(k), FIELD2(k));
184 }
185
186 /* deallocate old inverse */
187 p1 = -y[dgen - i];
188 y[p1] = 0;
189 y[dgen - i] = -(lused + 1);
190 pcp->lused += length + 2;
191 lused = pcp->lused;
192 }
193 } else {
194 /* i is an irredundant generator */
195 pcp->lastg++;
196 y[dgen + i] = pcp->lastg;
197 /* note that its weight is set to be 1 */
198 y[structure + pcp->lastg] = PACK3(1, 0, i);
199
200 /* check if inverse of i is required */
201 if (y[dgen - i] < 0) {
202 /* yes, so renumber previously set up inverse */
203 p1 = -y[dgen - i];
204 y[p1 + 2] += pcp->lastg - i;
205 }
206 }
207 }
208
209 if (pcp->lastg < 1) {
210 text(7, prime, 0, 0, 0);
211 pcp->complete = 1;
212 pcp->cc = 0;
213 } else {
214 y[pcp->clend + 1] = pcp->lastg;
215 pcp->submlg = pcp->subgrp - pcp->lastg;
216 }
217 }
218