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 a fast access function for structure constants tables
11 ** and the multiplication of two elements using a structure constants table.
12 **
13 ** Structure constants tables in GAP have the following layout
14 **
15 ** [ [ 1 ],
16 ** ...
17 ** [ i ], ---> [ [ 1 ], ..., [ j ], ..., [ n ] ]
18 ** ... |
19 ** [ n ], |
20 ** flag, |
21 ** zero ] V
22 ** [ [ k , ... ],
23 ** [ c_{ij}^k , ... ] ]
24 **
25 ** where the two outer lists for i and j are full lists of the dimension of
26 ** the underlying vectorspace, and the lists for k and c_{ij}^k are stored
27 ** sparsely, that is, only for those k with non-zero c_{ij}^k.
28 **
29 ** The last two elements of the outermost list have a special meaning.
30 **
31 ** The flag is an integer that indicates whether the product defined by the
32 ** table is commutative (+1) or anti-commutative (-1) or neither (0).
33 **
34 ** zero is the zero element of the coefficient ring/field of the algebra.
35 **
36 ** NOTE: most of the code consists of dimension- and type checks, as a user
37 ** can fool around with SCTables as s/he likes.
38 */
39
40 #include "sctable.h"
41
42 #include "ariths.h"
43 #include "error.h"
44 #include "lists.h"
45 #include "modules.h"
46 #include "plist.h"
47
48
49 /****************************************************************************
50 **
51 *F SCTableEntry( <table>, <i>, <j>, <k> ) . . . . entry of structure table
52 **
53 ** 'SCTableEntry' returns the coefficient $c_{i,j}^{k}$ from the structure
54 ** constants table <table>.
55 */
FuncSC_TABLE_ENTRY(Obj self,Obj table,Obj i,Obj j,Obj k)56 static Obj FuncSC_TABLE_ENTRY(Obj self, Obj table, Obj i, Obj j, Obj k)
57 {
58 Obj tmp; /* temporary */
59 Obj basis; /* basis list */
60 Obj coeffs; /* coeffs list */
61 Int dim; /* dimension */
62 Int len; /* length of basis/coeffs lists */
63 Int l; /* loop variable */
64
65 /* check the table */
66 RequireSmallList("SCTableEntry", table);
67 dim = LEN_LIST(table) - 2;
68 if ( dim <= 0 ) {
69 ErrorMayQuit(
70 "SCTableEntry: <table> must be a list with at least 3 elements",
71 0, 0);
72 }
73
74 /* check <i> */
75 RequirePositiveSmallInt("SCTableEntry", i, NICE_ARGNAME(i));
76 if (dim < INT_INTOBJ(i)) {
77 ErrorMayQuit(
78 "SCTableEntry: <i> must be an integer between 1 and %d but is %d",
79 dim, INT_INTOBJ(i));
80 }
81
82 /* get and check the relevant row */
83 tmp = ELM_LIST( table, INT_INTOBJ(i) );
84 if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != dim ) {
85 ErrorMayQuit(
86 "SCTableEntry: <table>[%d] must be a list with %d elements",
87 INT_INTOBJ(i), dim);
88 }
89
90 /* check <j> */
91 RequirePositiveSmallInt("SCTableEntry", j, NICE_ARGNAME(j));
92 if (dim < INT_INTOBJ(j)) {
93 ErrorMayQuit(
94 "SCTableEntry: <j> must be an integer between 1 and %d but is %d",
95 dim, INT_INTOBJ(j));
96 }
97
98 /* get and check the basis and coefficients list */
99 tmp = ELM_LIST( tmp, INT_INTOBJ(j) );
100 if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != 2 ) {
101 ErrorMayQuit(
102 "SCTableEntry: <table>[%d][%d] must be a basis/coeffs list",
103 INT_INTOBJ(i), INT_INTOBJ(j));
104 }
105
106 /* get and check the basis list */
107 basis = ELM_LIST( tmp, 1 );
108 if ( ! IS_SMALL_LIST(basis) ) {
109 ErrorMayQuit("SCTableEntry: <table>[%d][%d][1] must be a basis list",
110 INT_INTOBJ(i), INT_INTOBJ(j));
111 }
112
113 /* get and check the coeffs list */
114 coeffs = ELM_LIST( tmp, 2 );
115 if ( ! IS_SMALL_LIST(coeffs) ) {
116 ErrorMayQuit("SCTableEntry: <table>[%d][%d][2] must be a coeffs list",
117 INT_INTOBJ(i), INT_INTOBJ(j));
118 }
119
120 /* check that they have the same length */
121 len = LEN_LIST(basis);
122 if ( LEN_LIST(coeffs) != len ) {
123 ErrorMayQuit(
124 "SCTableEntry: <table>[%d][%d][1], ~[2] must have equal length",
125 INT_INTOBJ(i), INT_INTOBJ(j));
126 }
127
128 /* check <k> */
129 RequirePositiveSmallInt("SCTableEntry", k, NICE_ARGNAME(k));
130 if (dim < INT_INTOBJ(k)) {
131 ErrorMayQuit(
132 "SCTableEntry: <k> must be an integer between 1 and %d but is %d",
133 dim, INT_INTOBJ(k));
134 }
135
136 /* look for the (i,j,k) entry */
137 for ( l = 1; l <= len; l++ ) {
138 if ( EQ( ELM_LIST( basis, l ), k ) )
139 break;
140 }
141
142 /* return the coefficient of zero */
143 if ( l <= len ) {
144 return ELM_LIST( coeffs, l );
145 }
146 else {
147 return ELM_LIST( table, dim+2 );
148 }
149 }
150
151
152 /****************************************************************************
153 **
154 *F SCTableProduct( <table>, <list1>, <list2> ) . product wrt structure table
155 **
156 ** 'SCTableProduct' returns the product of the two elements <list1> and
157 ** <list2> with respect to the structure constants table <table>.
158 */
SCTableProdAdd(Obj res,Obj coeff,Obj basis_coeffs,Int dim)159 static void SCTableProdAdd(Obj res, Obj coeff, Obj basis_coeffs, Int dim)
160 {
161 Obj basis;
162 Obj coeffs;
163 Int len;
164 Obj k;
165 Obj c1, c2;
166 Int l;
167
168 basis = ELM_LIST( basis_coeffs, 1 );
169 coeffs = ELM_LIST( basis_coeffs, 2 );
170 len = LEN_LIST( basis );
171 if ( LEN_LIST( coeffs ) != len ) {
172 ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
173 }
174 for ( l = 1; l <= len; l++ ) {
175 k = ELM_LIST( basis, l );
176 if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
177 ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
178 }
179 c1 = ELM_LIST( coeffs, l );
180 c1 = PROD( coeff, c1 );
181 c2 = ELM_PLIST( res, INT_INTOBJ(k) );
182 c2 = SUM( c2, c1 );
183 SET_ELM_PLIST( res, INT_INTOBJ(k), c2 );
184 CHANGED_BAG( res );
185 }
186 }
187
FuncSC_TABLE_PRODUCT(Obj self,Obj table,Obj list1,Obj list2)188 static Obj FuncSC_TABLE_PRODUCT(Obj self, Obj table, Obj list1, Obj list2)
189 {
190 Obj res; /* result list */
191 Obj row; /* one row of sc table */
192 Obj zero; /* zero from sc table */
193 Obj ai, aj; /* elements from list1 */
194 Obj bi, bj; /* elements from list2 */
195 Obj c, c1, c2; /* products of above */
196 Int dim; /* dimension of vectorspace */
197 Int i, j; /* loop variables */
198
199 /* check the arguments a bit */
200 if ( ! IS_SMALL_LIST(table) ) {
201 ErrorMayQuit("SCTableProduct: <table> must be a list (not a %s)",
202 (Int)TNAM_OBJ(table), 0);
203 }
204 dim = LEN_LIST(table) - 2;
205 if ( dim <= 0 ) {
206 ErrorMayQuit(
207 "SCTableProduct: <table> must be a list with at least 3 elements",
208 0, 0);
209 }
210 zero = ELM_LIST( table, dim+2 );
211 if ( ! IS_SMALL_LIST(list1) || LEN_LIST(list1) != dim ) {
212 ErrorMayQuit(
213 "SCTableProduct: <list1> must be a list with %d elements", dim,
214 0);
215 }
216 if ( ! IS_SMALL_LIST(list2) || LEN_LIST(list2) != dim ) {
217 ErrorMayQuit(
218 "SCTableProduct: <list2> must be a list with %d elements", dim,
219 0);
220 }
221
222 /* make the result list */
223 res = NEW_PLIST( T_PLIST, dim );
224 SET_LEN_PLIST( res, dim );
225 for ( i = 1; i <= dim; i++ ) {
226 SET_ELM_PLIST( res, i, zero );
227 }
228 CHANGED_BAG( res );
229
230 /* general case */
231 if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(0) ) ) {
232 for ( i = 1; i <= dim; i++ ) {
233 ai = ELM_LIST( list1, i );
234 if ( EQ( ai, zero ) ) continue;
235 row = ELM_LIST( table, i );
236 for ( j = 1; j <= dim; j++ ) {
237 bj = ELM_LIST( list2, j );
238 if ( EQ( bj, zero ) ) continue;
239 c = PROD( ai, bj );
240 if ( ! EQ( c, zero ) ) {
241 SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
242 }
243 }
244 }
245 }
246
247 /* commutative case */
248 else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(1) ) ) {
249 for ( i = 1; i <= dim; i++ ) {
250 ai = ELM_LIST( list1, i );
251 bi = ELM_LIST( list2, i );
252 if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
253 row = ELM_LIST( table, i );
254 c = PROD( ai, bi );
255 if ( ! EQ( c, zero ) ) {
256 SCTableProdAdd( res, c, ELM_LIST( row, i ), dim );
257 }
258 for ( j = i+1; j <= dim; j++ ) {
259 bj = ELM_LIST( list2, j );
260 aj = ELM_LIST( list1, j );
261 if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
262 c1 = PROD( ai, bj );
263 c2 = PROD( aj, bi );
264 c = SUM( c1, c2 );
265 if ( ! EQ( c, zero ) ) {
266 SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
267 }
268 }
269 }
270 }
271
272 /* anticommutative case */
273 else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(-1) ) ) {
274 for ( i = 1; i <= dim; i++ ) {
275 ai = ELM_LIST( list1, i );
276 bi = ELM_LIST( list2, i );
277 if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
278 row = ELM_LIST( table, i );
279 for ( j = i+1; j <= dim; j++ ) {
280 bj = ELM_LIST( list2, j );
281 aj = ELM_LIST( list1, j );
282 if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
283 c1 = PROD( ai, bj );
284 c2 = PROD( aj, bi );
285 c = DIFF( c1, c2 );
286 if ( ! EQ( c, zero ) ) {
287 SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
288 }
289 }
290 }
291 }
292
293 /* return the result */
294 return res;
295 }
296
297
298 /****************************************************************************
299 **
300 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
301 */
302
303 /****************************************************************************
304 **
305 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
306 */
307 static StructGVarFunc GVarFuncs [] = {
308
309 GVAR_FUNC(SC_TABLE_ENTRY, 4, "table, i, j, k"),
310 GVAR_FUNC(SC_TABLE_PRODUCT, 3, "table, list1, list2"),
311 { 0, 0, 0, 0, 0 }
312
313 };
314
315
316 /****************************************************************************
317 **
318 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
319 */
InitKernel(StructInitInfo * module)320 static Int InitKernel (
321 StructInitInfo * module )
322 {
323 /* init filters and functions */
324 InitHdlrFuncsFromTable( GVarFuncs );
325
326 /* return success */
327 return 0;
328 }
329
330
331 /****************************************************************************
332 **
333 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
334 */
InitLibrary(StructInitInfo * module)335 static Int InitLibrary (
336 StructInitInfo * module )
337 {
338 /* init filters and functions */
339 InitGVarFuncsFromTable( GVarFuncs );
340
341 /* return success */
342 return 0;
343 }
344
345
346 /****************************************************************************
347 **
348 *F InitInfoSCTable() . . . . . . . . . . . . . . . . table of init functions
349 */
350 static StructInitInfo module = {
351 // init struct using C99 designated initializers; for a full list of
352 // fields, please refer to the definition of StructInitInfo
353 .type = MODULE_BUILTIN,
354 .name = "sctable",
355 .initKernel = InitKernel,
356 .initLibrary = InitLibrary,
357 };
358
InitInfoSCTable(void)359 StructInitInfo * InitInfoSCTable ( void )
360 {
361 return &module;
362 }
363