1 /* CLASSICAL.C module:
2
3 Symmetrica routines to calculate dimensions, standard tableaux and
4 characters for the classical groups GL(n), Sp(n), O(n) and SO(n);
5 including the spin representations of the orthogonal groups.
6 In each case, the user supplies the n and the partition (in certain
7 SO(n) cases, an extra parameter is needed).
8 In each case the partition is checked to be valid for the group
9 concerned. See the DIMENSION.DOC file for a full description.
10
11 Each dimension routine uses a variant of the hook length formula.
12 For the GL(n)/SL(n) case, this was given by Robinson (1958).
13 For the Sp(2r)/O(n) and their spin cases this was given by
14 El-Samra and King (1979).
15 Efforts are made here to allow n (the size of the matrices which
16 define the group) to be an INTEGER or a LONGINT object,
17 although the number of parts and the length of each part are
18 assumed to fit comfortably in an INTEGER (reasonable, I feel).
19
20 The standard tableaux which are generated were first described by:
21 King for Sp(2r) and spin O(n) and SO(n) cases and by King and Welsh
22 for ordinary O(n) and SO(n) cases. The standard tableaux for GL(n)
23 are the well-known "semi-standard" tableaux.
24
25 The characters are obtained in each case by first enumerating
26 the standard tableaux, forming a monomial from each, and
27 summing over all the standard tableaux. In the spin cases
28 the exponents are twice their actual values, since in general
29 they are half integer values.
30
31 All the above aspects of the representation theory of the classical
32 groups is described in detail in my PhD thesis (Southampton 1992).
33
34 Trevor Welsh, Bayreuth, April 1996
35 */
36
37
38 #include <stdio.h>
39
40 #include "def.h"
41 #include "macro.h"
42
43
44 static INT gl_generate();
45 static INT sp_generate ();
46 static INT or_generate ();
47 static INT pn_generate ();
48
49 /*************************************************************************
50 Routines to calculate dimensions of the classical groups
51 *************************************************************************/
52
53
gl_dimension(n,partition,dim)54 INT gl_dimension (n,partition,dim) OP n; OP partition; OP dim;
55
56 /* general linear group */
57
58 {
59 INT i,j,no_rows,no_cols;
60 INT erg = OK;
61 OP part,conj;
62 OP top,bot,nc,nob,hook;
63
64 if (partition==NULL || s_o_k(partition)!=PARTITION
65 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
66 { printf("gl_dimension() did not receive the correct objects!\n");
67 m_i_i(0L,dim);
68 return(ERROR);
69 }
70
71 no_rows=s_pa_li(partition);
72 if (!no_rows)
73 { m_i_i(1L,dim);
74 return(OK);
75 }
76 no_cols=s_pa_ii(partition,no_rows-1);
77
78 if (no_rows > s_i_i(n))
79 { printf("The partition passed to gl_dimension() has tooo many parts!\n");
80 m_i_i(0L,dim);
81 return(ERROR);
82 }
83
84 /* put the parts in decreasing order and construct the conjugate */
85
86 m_il_v(no_rows,part=callocobject());
87 m_il_v(no_cols,conj=callocobject());
88
89 for (i=0;i<no_rows;i++)
90 m_i_i(s_pa_ii(partition,no_rows-1-i),s_v_i(part,i));
91
92 for (j=no_cols-1,i=1;j>=0;j--)
93 { while (i<no_rows && s_v_ii(part,i)>j) i++;
94 m_i_i(i,s_v_i(conj,j));
95 }
96
97 /* initialise a few things for the hook length calculation */
98
99 m_i_i(1L,top=callocobject());
100 m_i_i(1L,bot=callocobject());
101 m_i_i(0L,hook=callocobject());
102 nob=callocobject();
103 copy(n,nc=callocobject());
104
105 /* visit all the boxes of Young diagram, accumulating hook
106 length factors and numerator factors */
107
108 for (i=0;i<no_rows;i++)
109 { copy(nc,nob);
110
111 for (j=0;j<s_v_ii(part,i);j++)
112 {
113 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
114 mult_apply(hook,bot);
115
116 mult_apply(nob,top);
117 inc(nob);
118 }
119 dec(nc);
120 }
121
122 div(top,bot,dim);
123
124 freeall(part); freeall(conj);
125 freeall(nob); freeall(hook); freeall(nc);
126 freeall(top); freeall(bot);
127
128 ENDR("gl_dimension");
129 }
130
131
sp_dimension(n,partition,dim)132 INT sp_dimension (n,partition,dim) OP n; OP partition; OP dim;
133
134 /* symplectic group */
135
136 { INT i,j,no_rows,no_cols,square,first,last;
137 OP r,res,dum;
138 OP part,conj;
139 OP top,bot,nob,hook;
140
141 if (partition==NULL || s_o_k(partition)!=PARTITION
142 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
143 { printf("sp_dimension() did not receive the correct objects!\n");
144 m_i_i(0L,dim);
145 return(ERROR);
146 }
147
148 no_rows=s_pa_li(partition);
149 if (!no_rows)
150 { m_i_i(1L,dim);
151 return(OK);
152 }
153 no_cols=s_pa_ii(partition,no_rows-1);
154 m_i_i(2L,dum=callocobject());
155 quores(n,dum,r=callocobject(),res=callocobject());
156
157 if (no_rows > s_i_i(r)+(nullp(res)?0:1) )
158 /* allow one extra part for odd dimensions! */
159 { printf("The partition passed to sp_dimension() has tooo many parts!\n");
160 m_i_i(0L,dim);
161 return(ERROR);
162 }
163
164 if (!nullp(res))
165 { printf("Warning! sp_dimension received odd group specification!\n");
166 }
167
168 freeall(r); freeall(res);
169
170 /* put the parts in decreasing order and construct the conjugate:
171 we need to make them longer with enough zeros. */
172
173 square=no_rows>no_cols?no_rows:no_cols;
174 m_il_v(square,part=callocobject());
175 m_il_v(square,conj=callocobject());
176
177 for (i=0;i<no_rows;i++)
178 m_i_i(s_pa_ii(partition,no_rows-1-i),s_v_i(part,i));
179 for (;i<square;i++)
180 m_i_i(0,s_v_i(part,i));
181
182 for (j=square-1;j>=no_cols;j--)
183 m_i_i(0,s_v_i(conj,j));
184 for (i=1;j>=0;j--)
185 { while (i<no_rows && s_v_ii(part,i)>j) i++;
186 m_i_i(i,s_v_i(conj,j));
187 }
188
189 /* initialise a few things for the hook length calculation */
190
191 m_i_i(1L,top=callocobject());
192 m_i_i(1L,bot=callocobject());
193 m_i_i(0L,hook=callocobject());
194 nob=callocobject();
195
196 /* visit all the boxes of Young diagram, accumulating hook
197 length factors and numerator factors */
198
199 for (i=0;i<no_rows;i++)
200 { last=s_v_ii(part,i);
201 first=last<i ? last : i;
202
203 for (j=0;j<first;j++)
204 {
205 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
206 mult_apply(hook,bot);
207
208 copy(n,nob);
209 c_i_i(dum,-i-j);
210 add_apply(dum,nob);
211 add_apply(s_v_i(part,i),nob);
212 add_apply(s_v_i(part,j),nob);
213 mult_apply(nob,top);
214 }
215
216 for (;j<last;j++)
217 {
218 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
219 mult_apply(hook,bot);
220
221 copy(n,nob);
222 c_i_i(dum,i+j+2);
223 add_apply(dum,nob);
224 copy(s_v_i(conj,i),dum);
225 addinvers_apply(dum);
226 add_apply(dum,nob);
227 copy(s_v_i(conj,j),dum);
228 addinvers_apply(dum);
229 add_apply(dum,nob);
230 mult_apply(nob,top);
231 }
232 }
233
234 div(top,bot,dim);
235
236 freeall(part); freeall(conj);
237 freeall(nob); freeall(hook); freeall(dum);
238 freeall(top); freeall(bot);
239
240 return(OK);
241 }
242
243
or_dimension(n,partition,dim)244 INT or_dimension (n,partition,dim) OP n; OP partition; OP dim;
245
246 /* orthogonal group */
247
248 { INT i,j,no_rows,no_cols,bal,square,first,last;
249 OP dum;
250 OP part,conj;
251 OP top,bot,nob,hook;
252
253 if (partition==NULL || s_o_k(partition)!=PARTITION
254 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
255 { printf("or_dimension() did not receive the correct objects!\n");
256 m_i_i(0L,dim);
257 return(ERROR);
258 }
259
260 no_rows=s_pa_li(partition);
261 if (!no_rows)
262 { m_i_i(1L,dim);
263 return(OK);
264 }
265 no_cols=s_pa_ii(partition,no_rows-1);
266 m_i_i(no_rows,dum=callocobject());
267 addinvers_apply(dum);
268 add_apply(n,dum);
269 if (s_o_k(dum)==INTEGER)
270 bal=s_i_i(dum);
271
272 if (s_o_k(dum)==INTEGER && (bal<0 ||
273 (bal<no_rows && s_pa_ii(partition,no_rows-1-bal)>1)) )
274 { printf("The partition passed to or_dimension() has tooo many parts!\n");
275 m_i_i(0L,dim);
276 return(ERROR);
277 }
278
279 /* put the parts in decreasing order and construct the conjugate:
280 we need to make them longer with enough zeros. */
281
282 if (s_o_k(dum)!=INTEGER || bal>no_rows)
283 bal=no_rows;
284
285 square=bal>no_cols?bal:no_cols;
286 m_il_v(square,part=callocobject());
287 m_il_v(square,conj=callocobject());
288
289 for (i=0;i<bal;i++)
290 m_i_i(s_pa_ii(partition,no_rows-1-i),s_v_i(part,i));
291 for (;i<square;i++)
292 m_i_i(0,s_v_i(part,i));
293
294 for (j=square-1;j>=no_cols;j--)
295 m_i_i(0,s_v_i(conj,j));
296 for (i=1;j>=0;j--)
297 { while (i<bal && s_v_ii(part,i)>j) i++;
298 m_i_i(i,s_v_i(conj,j));
299 }
300
301 /* initialise a few things for the hook length calculation */
302
303 m_i_i(1L,top=callocobject());
304 m_i_i(1L,bot=callocobject());
305 m_i_i(0L,hook=callocobject());
306 nob=callocobject();
307
308 /* visit all the boxes of Young diagram, accumulating hook
309 length factors and numerator factors */
310
311 for (i=0;i<bal;i++)
312 { last=s_v_ii(part,i);
313 first=last<i ? last : i;
314
315 for (j=0;j<first;j++)
316 {
317 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
318 mult_apply(hook,bot);
319
320 copy(n,nob);
321 c_i_i(dum,i+j);
322 add_apply(dum,nob);
323 copy(s_v_i(conj,i),dum);
324 addinvers_apply(dum);
325 add_apply(dum,nob);
326 copy(s_v_i(conj,j),dum);
327 addinvers_apply(dum);
328 add_apply(dum,nob);
329 mult_apply(nob,top);
330 }
331
332 for (;j<last;j++)
333 {
334 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
335 mult_apply(hook,bot);
336
337 copy(n,nob);
338 c_i_i(dum,-i-j-2);
339 add_apply(dum,nob);
340 add_apply(s_v_i(part,i),nob);
341 add_apply(s_v_i(part,j),nob);
342 mult_apply(nob,top);
343 }
344 }
345
346 div(top,bot,dim);
347
348 freeall(part); freeall(conj);
349 freeall(nob); freeall(hook); freeall(dum);
350 freeall(top); freeall(bot);
351
352 return(OK);
353 }
354
355
356
so_dimension(n,partition,dim)357 INT so_dimension (n,partition,dim) OP n; OP partition; OP dim;
358
359 /* special orthogonal group */
360
361 { INT no_rows,bal;
362 OP dum;
363
364 if (partition==NULL || s_o_k(partition)!=PARTITION
365 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
366 { printf("so_dimension() did not receive the correct objects!\n");
367 m_i_i(0L,dim);
368 return(ERROR);
369 }
370
371 no_rows=s_pa_li(partition);
372 if (!no_rows)
373 { m_i_i(1L,dim);
374 return(OK);
375 }
376 m_i_i(no_rows,dum=callocobject());
377 addinvers_apply(dum);
378 add_apply(n,dum);
379 if (s_o_k(dum)==INTEGER)
380 bal=s_i_i(dum);
381
382 if (s_o_k(dum)==INTEGER && bal<no_rows )
383 { printf("The partition passed to so_dimension() has tooo many parts!\n");
384 m_i_i(0L,dim);
385 return(ERROR);
386 }
387
388 or_dimension(n,partition,dim);
389 if (s_o_k(dum)==INTEGER && bal==no_rows)
390 { c_i_i(dum,2L);
391 div(dim,dum,dim);
392 }
393
394 freeall(dum);
395
396 return(OK);
397 }
398
399
pn_dimension(n,partition,dim)400 INT pn_dimension (n,partition,dim) OP n; OP partition; OP dim;
401
402 /* spin orthogonal group (pin group) */
403
404 { INT i,j,no_rows,no_cols,bal,square,first,last;
405 OP dum,nm;
406 OP part,conj;
407 OP top,bot,nob,hook;
408
409 if (partition==NULL || s_o_k(partition)!=PARTITION
410 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
411 { printf("or_dimension() did not receive the correct objects!\n");
412 m_i_i(0L,dim);
413 return(ERROR);
414 }
415
416 no_rows=s_pa_li(partition);
417 if (!no_rows) /* empty partition: need to return 2^rank */
418 { m_i_i(1L,dim);
419 copy(n,nm=callocobject());
420 m_i_i(2L,dum=callocobject());
421 ganzdiv_apply(dum,nm);
422 for (;!nullp(nm);dec(nm))
423 mult_apply(dum,dim);
424 freeall(nm); freeall(dum);
425 return(OK);
426 }
427 no_cols=s_pa_ii(partition,no_rows-1);
428 m_i_i(no_rows,dum=callocobject());
429 addinvers_apply(dum);
430 add_apply(n,dum);
431 if (s_o_k(dum)==INTEGER)
432 bal=s_i_i(dum);
433
434 if (s_o_k(dum)==INTEGER && bal<no_rows )
435 { printf("The partition passed to pn_dimension() has tooo many parts!\n");
436 m_i_i(0L,dim);
437 return(ERROR);
438 }
439
440 /* put the parts in decreasing order and construct the conjugate:
441 we need to make them longer with enough zeros. */
442
443 if (s_o_k(dum)!=INTEGER || bal>no_rows)
444 bal=no_rows;
445
446 square=bal>no_cols?bal:no_cols;
447 m_il_v(square,part=callocobject());
448 m_il_v(square,conj=callocobject());
449
450 for (i=0;i<bal;i++)
451 m_i_i(s_pa_ii(partition,no_rows-1-i),s_v_i(part,i));
452 for (;i<square;i++)
453 m_i_i(0,s_v_i(part,i));
454
455 for (j=square-1;j>=no_cols;j--)
456 m_i_i(0,s_v_i(conj,j));
457 for (i=1;j>=0;j--)
458 { while (i<bal && s_v_ii(part,i)>j) i++;
459 m_i_i(i,s_v_i(conj,j));
460 }
461
462 /* initialise a few things for the hook length calculation */
463
464 m_i_i(1L,top=callocobject());
465 m_i_i(1L,bot=callocobject());
466 m_i_i(0L,hook=callocobject());
467 nob=callocobject();
468 copy(n,nm=callocobject());
469 dec(nm);
470
471 /* visit all the boxes of Young diagram, accumulating hook
472 length factors and numerator factors.
473 for spin cases, use symplectic formula! */
474
475 for (i=0;i<bal;i++)
476 { last=s_v_ii(part,i);
477 first=last<i ? last : i;
478
479 for (j=0;j<first;j++)
480 {
481 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
482 mult_apply(hook,bot);
483
484 copy(nm,nob);
485 c_i_i(dum,-i-j);
486 add_apply(dum,nob);
487 add_apply(s_v_i(part,i),nob);
488 add_apply(s_v_i(part,j),nob);
489 mult_apply(nob,top);
490 }
491
492 for (;j<last;j++)
493 {
494 c_i_i(hook,s_v_ii(part,i)+s_v_ii(conj,j)-i-j-1);
495 mult_apply(hook,bot);
496
497 copy(nm,nob);
498 c_i_i(dum,i+j+2);
499 add_apply(dum,nob);
500 copy(s_v_i(conj,i),dum);
501 addinvers_apply(dum);
502 add_apply(dum,nob);
503 copy(s_v_i(conj,j),dum);
504 addinvers_apply(dum);
505 add_apply(dum,nob);
506 mult_apply(nob,top);
507 }
508 }
509
510 div(top,bot,dim);
511
512 /* now multiply by a power of 2 */
513
514 inc(nm);
515 c_i_i(dum,2L);
516 ganzdiv_apply(dum,nm);
517 for (;!nullp(nm);dec(nm))
518 mult_apply(dum,dim);
519
520 freeall(part); freeall(conj);
521 freeall(nob); freeall(hook); freeall(dum);
522 freeall(top); freeall(bot); freeall(nm);
523
524 return(OK);
525 }
526
527
sn_dimension(n,partition,dim)528 INT sn_dimension (n,partition,dim) OP n; OP partition; OP dim;
529
530 /* spin special orthogonal group (spin group) */
531
532 { INT no_rows,bal;
533 OP dum,r,res;
534
535 if (partition==NULL || s_o_k(partition)!=PARTITION
536 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
537 { printf("sn_dimension() did not receive the correct objects!\n");
538 m_i_i(0L,dim);
539 return(ERROR);
540 }
541
542 no_rows=s_pa_li(partition);
543 m_i_i(no_rows,dum=callocobject());
544 addinvers_apply(dum);
545 add_apply(n,dum);
546 if (s_o_k(dum)==INTEGER)
547 bal=s_i_i(dum);
548
549 if (s_o_k(dum)==INTEGER && bal<no_rows )
550 { printf("The partition passed to sn_dimension() has tooo many parts!\n");
551 m_i_i(0L,dim);
552 return(ERROR);
553 }
554
555 pn_dimension(n,partition,dim);
556
557 /* must divide by two if n is even */
558
559 c_i_i(dum,2L);
560 quores(n,dum,r=callocobject(),res=callocobject());
561 if (nullp(res))
562 div(dim,dum,dim);
563
564 freeall(dum); freeall(r); freeall(res);
565
566 return(OK);
567 }
568
569
570 /*************************************************************************
571 Routines to calculate standard tableaux for the classical groups
572 *************************************************************************/
573
574
575 static OP standard;
576 static OP spin;
577 static INT ni,ri,no_rows,no_cols,level,count;
578 static INT *part;
579
580
gl_tableaux(n,partition,list)581 INT gl_tableaux (n,partition,list) OP n; OP partition; OP list;
582
583 /* generates standard tableaux for the general linear group GL(n) */
584
585 { INT i;
586 INT *filling;
587 OP empty_tab;
588
589 if (partition==NULL || s_o_k(partition)!=PARTITION
590 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
591 { printf("gl_tableaux() did not receive the correct objects!\n");
592 init(LIST,list);
593 return(ERROR);
594 }
595
596 no_rows=s_pa_li(partition);
597
598 if (!no_rows) /* If the partition is 0, then create a single
599 1x1 tableau with entry 0. */
600 { OP vec,par,tab;
601 m_il_v(1L,vec=callocobject());
602 m_i_i(1L,s_v_i(vec,0L));
603 b_ks_pa(VECTOR,vec,par=callocobject());
604 m_u_t(par,tab=callocobject());
605 m_i_i(0L,s_t_ij(tab,0L,0L));
606 b_sn_l(tab,NULL,list);
607 freeall(par);
608 return(1L);
609 }
610
611 if (no_rows > s_i_i(n))
612 { printf("The partition passed to gl_tableaux() has tooo many parts!\n");
613 init(LIST,list);
614 return(ERROR);
615 }
616
617 /* put the parts in decreasing order: append a zero part */
618
619 part=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
620 filling=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
621
622 for (i=0;i<no_rows;i++)
623 part[i]=s_pa_ii(partition,no_rows-1-i);
624 part[i]=0;
625
626 /* start the recursive tableaux generation process */
627
628 m_u_t(partition,empty_tab=callocobject());
629 standard=NULL;
630 count=level=0;
631 gl_generate(empty_tab,part,filling,s_i_i(n),no_rows-1);
632
633 /* put the tableaux list into the argument to this routine */
634
635 if (standard==NULL)
636 init(LIST,list);
637 else
638 { b_ks_o(s_o_k(standard),s_o_s(standard),list);
639 SYM_free(standard);
640 }
641
642 SYM_free(part);
643 SYM_free(filling);
644
645 freeall(empty_tab);
646
647 return(count);
648 }
649
650
gl_generate(skew_tab,un_part,filling,entry,row)651 static INT gl_generate (skew_tab,un_part,filling,entry,row)
652 OP skew_tab; INT *un_part; INT *filling; INT entry; INT row;
653
654 /* recursive function to generate standard tableaux for the general linear
655 group GL(n). skew_tab is a partially filled tableaux. One iteration
656 of this function puts a number of _entry into the row _row.
657 un_part gives the shape of the unfilled part of the tableau before
658 ANY _entry was placed. filling is the changed unfilled part after
659 _entry s are included, but only for rows below that currently
660 being considered.
661 */
662
663 { INT j,i;
664 INT *new_fill;
665 OP new_tab,new_part,ext;
666
667 copy_tableaux(skew_tab,new_tab=callocobject());
668
669 if (row==entry-1) /* fill up the current row */
670 { for (j=0;j<un_part[row];j++)
671 m_i_i(entry,s_t_ij(new_tab,row,j));
672 filling[row]=0;
673
674 if (row==0) /* store completely filled tableau in list */
675 { b_sn_l(new_tab,standard,ext=callocobject());
676 standard=ext;
677 count++;
678 }
679 else /* resubmit, filling a higher row */
680 {
681 gl_generate (new_tab,un_part,filling,entry,row-1);
682 freeall(new_tab);
683 }
684 }
685 else /* there is a range of the number of entries to fill */
686 {
687 filling[row]=un_part[row];
688 for (j=un_part[row];j>=un_part[row+1];j--)
689 {
690 /* start with 0 of entry in the current row - up to
691 up_part[row+1]-up_part[row] */
692
693 if (j<un_part[row])
694 { m_i_i(entry,s_t_ij(new_tab,row,j));
695 filling[row]--;
696 }
697
698 /* and now resubmit to recursion */
699
700 if (row>0)
701 gl_generate(new_tab,un_part,filling,entry,row-1);
702 else
703 /* start putting in a different entry:
704 must update the unfilled bit */
705 {
706 /* find lowest unfilled row */
707
708 for (i=no_rows-1;filling[i]==0;i--);
709 if (i>=0)
710 { new_fill=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
711 gl_generate(new_tab,filling,new_fill,entry-1,i);
712 SYM_free(new_fill);
713 }
714 else /* tableau is full: need to store it. */
715 {
716 b_sn_l(new_tab,standard,ext=callocobject());
717 standard=ext;
718 count++;
719 return(OK);
720 }
721 }
722 }
723
724 freeall(new_tab);
725 }
726
727 return(OK);
728 }
729
730
sp_tableaux(n,partition,list)731 INT sp_tableaux (n,partition,list) OP n; OP partition; OP list;
732
733 /* generates standard tableaux for the symplectic group Sp(n) */
734
735 { INT i;
736 INT *filling;
737 OP empty_tab;
738
739 if (partition==NULL || s_o_k(partition)!=PARTITION
740 || n==NULL || !(s_o_k(n)==INTEGER || s_o_k(n)==LONGINT) )
741 { printf("sp_tableaux() did not receive the correct objects!\n");
742 init(LIST,list);
743 return(ERROR);
744 }
745
746 ni=s_i_i(n);
747 ri=ni/2;
748 no_rows=s_pa_li(partition);
749
750 if (!no_rows) /* If the partition is 0, then create a single
751 1x1 tableau with entry 0. */
752 { OP vec,par,tab;
753 m_il_v(1L,vec=callocobject());
754 m_i_i(1L,s_v_i(vec,0L));
755 b_ks_pa(VECTOR,vec,par=callocobject());
756 m_u_t(par,tab=callocobject());
757 m_i_i(0L,s_t_ij(tab,0L,0L));
758 b_sn_l(tab,NULL,list);
759 freeall(par);
760 return(1L);
761 }
762
763 if (no_rows > ri+(ni&1))
764 /* allow one extra part for odd dimensions! */
765 { printf("The partition passed to sp_tableaux() has tooo many parts!\n");
766 init(LIST,list);
767 return(ERROR);
768 }
769
770 if (ni&1)
771 { printf("Warning! sp_tableaux received odd group specification!\n");
772 }
773
774 /* put the parts in decreasing order: append a zero part */
775
776 part=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
777 filling=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
778
779 for (i=0;i<no_rows;i++)
780 part[i]=s_pa_ii(partition,no_rows-1-i);
781 part[i]=0;
782
783 /* start the recursive tableaux generation process - if n is
784 even then the first entrys are r. Otherwise 0. */
785
786 m_u_t(partition,empty_tab=callocobject());
787 standard=NULL;
788 count=level=0;
789 sp_generate(empty_tab,part,filling,ni&1?0:ri,no_rows-1);
790
791 /* put the tableaux list into the argument to this routine */
792
793 if (standard==NULL)
794 init(LIST,list);
795 else
796 { b_ks_o(s_o_k(standard),s_o_s(standard),list);
797 SYM_free(standard);
798 }
799
800 SYM_free(part);
801 SYM_free(filling);
802
803 freeall(empty_tab);
804
805 return(count);
806 }
807
808
sp_generate(skew_tab,un_part,filling,entry,row)809 static INT sp_generate (skew_tab,un_part,filling,entry,row)
810 OP skew_tab; INT *un_part; INT *filling; INT entry; INT row;
811
812 /* recursive function to generate standard tableaux for the symplectic
813 group Sp(n). skew_tab is a partially filled tableaux. One iteration
814 of this function puts a number of _entry into the row _row.
815 un_part gives the shape of the unfilled part of the tableau before
816 ANY _entry was placed. filling is the changed unfilled part after
817 _entry s are included, but only for rows below that currently
818 being considered.
819 */
820
821 { INT j,i;
822 INT *new_fill;
823 OP new_tab,new_part,ext;
824
825 copy_tableaux(skew_tab,new_tab=callocobject());
826
827 if (row+entry+1==0 || row==ri) /* fill up the current row */
828 { for (j=0;j<un_part[row];j++)
829 m_i_i(entry,s_t_ij(new_tab,row,j));
830 filling[row]=0;
831
832 if (row==0) /* store completely filled tableau in list */
833 { b_sn_l(new_tab,standard,ext=callocobject());
834 standard=ext;
835 count++;
836 }
837 else /* resubmit, filling a higher row */
838 {
839 sp_generate (new_tab,un_part,filling,entry,row-1);
840 freeall(new_tab);
841 }
842 }
843 else /* there is a range of the number of entries to fill */
844 {
845 filling[row]=un_part[row];
846 for (j=un_part[row];j>=un_part[row+1];j--)
847 {
848 /* start with 0 of entry in the current row - up to
849 up_part[row+1]-up_part[row] */
850
851 if (j<un_part[row])
852 { m_i_i(entry,s_t_ij(new_tab,row,j));
853 filling[row]--;
854 }
855
856 /* and now resubmit to recursion */
857
858 if (row>0)
859 sp_generate(new_tab,un_part,filling,entry,row-1);
860 else
861 /* start putting in a different entry:
862 must update the unfilled bit */
863 {
864 /* find lowest unfilled row */
865
866 for (i=no_rows-1;filling[i]==0;i--);
867 if (i>=0)
868 { new_fill=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
869 if (entry>0)
870 sp_generate(new_tab,filling,new_fill,-entry,i);
871 else if (entry<0)
872 sp_generate(new_tab,filling,new_fill,-entry-1,i);
873 else
874 sp_generate(new_tab,filling,new_fill,ri,i);
875 SYM_free(new_fill);
876 }
877 else /* tableau is full: need to store it. */
878 {
879 b_sn_l(new_tab,standard,ext=callocobject());
880 standard=ext;
881 count++;
882 return(OK);
883 }
884 }
885 }
886
887 freeall(new_tab);
888 }
889
890 return(OK);
891 }
892
893
or_tableaux(n,partition,list)894 INT or_tableaux (n,partition,list) OP n; OP partition; OP list;
895
896 /* generates standard tableaux for the orthogonal group O(n) */
897
898 { INT i;
899 INT *filling;
900 OP empty_tab;
901
902 if (partition==NULL || s_o_k(partition)!=PARTITION
903 || n==NULL || s_o_k(n)!=INTEGER )
904 { printf("or_tableaux() did not receive the correct objects!\n");
905 init(LIST,list);
906 return(ERROR);
907 }
908
909 ni=s_i_i(n);
910 ri=ni/2;
911 no_rows=s_pa_li(partition);
912
913 if (!no_rows) /* If the partition is 0, then create a single
914 1x1 tableau with entry 0. */
915 { OP vec,par,tab;
916 m_il_v(1L,vec=callocobject());
917 m_i_i(1L,s_v_i(vec,0L));
918 b_ks_pa(VECTOR,vec,par=callocobject());
919 m_u_t(par,tab=callocobject());
920 m_i_i(0L,s_t_ij(tab,0L,0L));
921 b_sn_l(tab,NULL,list);
922 freeall(par);
923 return(1L);
924 }
925
926 if (ni<no_rows
927 || (ni<2*no_rows && s_pa_ii(partition,2*no_rows-ni-1)>1) )
928 { printf("The partition passed to or_tableaux() has tooo many parts!\n");
929 init(LIST,list);
930 return(ERROR);
931 }
932
933 /* put the parts in decreasing order: append a zero part */
934
935 part=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
936 filling=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
937
938 for (i=0;i<no_rows;i++)
939 filling[i]=part[i]=s_pa_ii(partition,no_rows-1-i);
940 part[i]=0;
941
942 /* find length of second column */
943
944 for (i=no_rows-1;i>=0 && part[i]<2;i--);
945
946 /* start the recursive tableaux generation process - if n is
947 even then the first entrys are 0. Otherwise ri. */
948
949 m_u_t(partition,empty_tab=callocobject());
950 standard=NULL;
951 count=level=0;
952 or_generate(empty_tab,part,filling,ni&1?0:ri,no_rows-1,no_rows,++i);
953
954 /* put the tableaux list into the argument to this routine */
955
956 if (standard==NULL)
957 init(LIST,list);
958 else
959 { b_ks_o(s_o_k(standard),s_o_s(standard),list);
960 SYM_free(standard);
961 }
962
963 freeall(empty_tab);
964
965 SYM_free(part);
966 SYM_free(filling);
967
968 return(count);
969 }
970
971
972
or_generate(skew_tab,un_part,filling,entry,row,alpha,beta)973 static INT or_generate (skew_tab, un_part, filling, entry, row, alpha, beta)
974 OP skew_tab; INT *un_part; INT *filling; INT entry; INT row;
975 INT alpha; INT beta;
976
977 /* recursive function to generate standard tableaux for the orthogonal
978 group O(n). skew_tab is a partially filled tableaux. One iteration
979 of this function puts a number of _entry into the row _row.
980 un_part gives the shape of the unfilled part of the tableau before
981 ANY _entry was placed. filling is the changed unfilled part after
982 _entry s are included, but only for rows below that currently
983 being considered.
984 */
985
986 { INT j,j_start;
987 INT *new_fill;
988 OP new_tab,new_part,ext;
989
990 copy_tableaux(skew_tab,new_tab=callocobject());
991
992 /* if we are entering a 1 or -1 then we need special consideration */
993
994 if (entry==1)
995 {
996 /* first fill the top row with -1 */
997
998 for (j=0;j<un_part[0];j++)
999 m_i_i(-entry,s_t_ij(new_tab,0,j));
1000
1001 if (row==0)
1002 {
1003 b_sn_l(new_tab,standard,ext=callocobject());
1004 standard=ext;
1005 count++;
1006
1007 /* we need another tableaux for the 1 filling of the top row */
1008
1009 copy_tableaux(skew_tab,new_tab=callocobject());
1010 }
1011
1012 for (j=0;j<un_part[row];j++)
1013 m_i_i(entry,s_t_ij(new_tab,row,j));
1014
1015 b_sn_l(new_tab,standard,ext=callocobject());
1016 standard=ext;
1017 count++;
1018 }
1019
1020 else
1021 /* there is a range of the number of entries to fill:
1022 j_start is set to be the leftmost that must be filled. */
1023 {
1024 j_start=un_part[row]; /* this is the default case */
1025
1026 if (entry<0)
1027 { if (row==alpha-1)
1028 /* the following code deals with both alpha>=beta */
1029
1030 { if (alpha+beta==-2*entry
1031 || (alpha+beta==-1-2*entry && (beta==0
1032 || (alpha<no_rows && s_t_iji(skew_tab,alpha,0)==-entry
1033 && (part[beta]<2 || s_t_iji(skew_tab,beta,1)!=-entry)
1034 ))))
1035 j_start=0;
1036 else if (alpha==beta && alpha==-1-entry
1037 && un_part[alpha]>0 && filling[alpha]==0
1038 && un_part[alpha]<part[alpha]
1039 && s_t_iji(skew_tab,alpha,un_part[alpha])==-entry)
1040 j_start=un_part[alpha]; /* protection condition for = rows */
1041 }
1042 else if (row==beta-1)
1043 { if (alpha+beta==-1-2*entry)
1044 j_start=1;
1045 }
1046
1047 }
1048 else if (entry>0)
1049 { if (row==alpha-1 && beta==0 && alpha==2*entry)
1050 j_start=0;
1051 }
1052 else if (alpha+beta==ni) /* here entry is 0 and ni is odd */
1053 { if (row==alpha-1 && beta==0)
1054 j_start=0;
1055 else if (row==beta-1)
1056 j_start=1;
1057 }
1058
1059 /* now place the entries that are forced */
1060
1061 for (j=j_start;j<un_part[row];j++)
1062 m_i_i(entry,s_t_ij(new_tab,row,j));
1063 filling[row]=j_start;
1064
1065
1066 if (j_start==0 && un_part[row]>0)
1067 alpha--;
1068
1069 if (j_start<=1 && un_part[row]>1)
1070 beta--;
1071
1072 /* now loop between 0 and as many as possible in current row */
1073
1074 for (j=j_start;j>=un_part[row+1];j--)
1075 {
1076 if (j<j_start)
1077 { m_i_i(entry,s_t_ij(new_tab,row,j));
1078 filling[row]--;
1079
1080 if (j==0)
1081 alpha--;
1082 else if (j==1)
1083 beta--;
1084 }
1085
1086 /* and now resubmit to recursion */
1087
1088 if (row>0)
1089 or_generate(new_tab,un_part,filling,entry,row-1,alpha,beta);
1090 else /* just done the top row */
1091 {
1092 if (filling[row]==0) /* tableau is now full */
1093 {
1094 b_sn_l(new_tab,standard,ext=callocobject());
1095 standard=ext;
1096 count++;
1097 level--;
1098 return(OK);
1099 }
1100 else /* start putting in a different entry:
1101 must update the unfilled bit */
1102
1103 { new_fill=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1104 memcpy(new_fill,filling,(no_rows+1)*sizeof(INT));
1105
1106 if (entry>0)
1107 or_generate(new_tab,filling,new_fill,-entry,
1108 alpha-1,alpha,beta);
1109 else if (entry<0)
1110 or_generate(new_tab,filling,new_fill,-entry-1,
1111 alpha-1,alpha,beta);
1112 else
1113 or_generate(new_tab,filling,new_fill,ri,
1114 alpha-1,alpha,beta);
1115
1116 SYM_free(new_fill);
1117 }
1118 }
1119 }
1120
1121 freeall(new_tab);
1122 }
1123 level--;
1124 return(OK);
1125 }
1126
1127
so_tableaux(n,partition,flag,list)1128 INT so_tableaux (n,partition,flag,list) INT flag;OP n; OP partition; OP list;
1129
1130 /* generates standard tableaux for the special orthogonal group SO(n).
1131 First generates tableaux for O(n) and if relevant (n even
1132 AND no. parts equal to n/2) extracts the required tableaux from
1133 this set. flag=-1 selects the - representation and if +1 selects
1134 the + representation.
1135 */
1136
1137 { INT i,e,c,f,count;
1138 OP trawl,back;
1139
1140 if (partition==NULL || s_o_k(partition)!=PARTITION
1141 || n==NULL || s_o_k(n)!=INTEGER )
1142 { printf("so_tableaux() did not receive the correct objects!\n");
1143 init(LIST,list);
1144 return(ERROR);
1145 }
1146
1147 no_rows=s_pa_li(partition);
1148 ni=s_i_i(n);
1149 ri=ni/2;
1150
1151 if (ri<no_rows)
1152 { printf("The partition passed to so_tableaux() has tooo many parts!\n");
1153 init(LIST,list);
1154 return(ERROR);
1155 }
1156
1157 count=or_tableaux(n,partition,list);
1158
1159 if (!(ni&1) && ri==no_rows) /* O(n) rep reduces on restriction to SO(n) */
1160 { count=0;
1161
1162 if (flag<0)
1163 f=1;
1164 else if (flag>0)
1165 f=0;
1166 else /* undocumented option! */
1167 f=(ri&1)?1:0;
1168
1169 for (trawl=list,back=NULL;trawl!=NULL;)
1170 {
1171 for (i=c=0;i<ri;i++)
1172 {
1173 e=s_t_iji(s_l_s(trawl),i,0L);
1174 if (e==i+1) /* count number of positive entries in 1st col */
1175 c++;
1176 else if (e!=-i-1)
1177 break; /* halt loop if entry not i+1 or -(i+1) */
1178 }
1179
1180 /* now test whether this tableau should be excluded */
1181
1182 if ( (i==ri && (f^c)&1) /* test after e==i+1 all down tableau */
1183 || (i<ri && e>=-i && e<=i) ) /* entry tooo small here */
1184 {
1185 if (back!=NULL)
1186 { c_l_n(back,s_l_n(trawl));
1187 c_l_n(trawl,NULL);
1188 freeall(trawl);
1189 trawl=s_l_n(back);
1190 }
1191 else /* at top of list */
1192 { trawl=s_l_n(trawl);
1193 c_l_n(list,NULL);
1194 freeself(list);
1195 b_ks_o(LIST,s_o_s(trawl),list);
1196 SYM_free(trawl);
1197 trawl=list;
1198 }
1199 }
1200 else
1201 { trawl=s_l_n(back=trawl);
1202 count++;
1203 }
1204 }
1205 }
1206
1207 return(count);
1208 }
1209
1210
pn_tableaux(n,partition,list)1211 INT pn_tableaux (n,partition,list) OP n; OP partition; OP list;
1212
1213 /* generates standard spin tableaux for the spin orthogonal group O(n) */
1214
1215 { INT i;
1216 INT *filling;
1217 OP empty_tab,r,hafling;
1218
1219 if (partition==NULL || s_o_k(partition)!=PARTITION
1220 || n==NULL || s_o_k(n)!=INTEGER )
1221 { printf("or_tableaux() did not receive the correct objects!\n");
1222 init(LIST,list);
1223 return(ERROR);
1224 }
1225
1226 ni=s_i_i(n);
1227 ri=ni/2;
1228 no_rows=s_pa_li(partition);
1229
1230 if (ri<no_rows)
1231 { printf("The partition passed to pn_tableaux() has tooo many parts!\n");
1232 init(LIST,list);
1233 return(ERROR);
1234 }
1235
1236 /* put the parts in decreasing order: append a zero part */
1237
1238 part=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1239 filling=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1240
1241 for (i=0;i<no_rows;i++)
1242 filling[i]=part[i]=s_pa_ii(partition,no_rows-1-i);
1243 part[i]=0;
1244
1245 standard=NULL;
1246 count=level=0;
1247
1248 /* we consider the half boxes as a separate tableau. They will
1249 be generated in the outer loop here.
1250 Then, all tableaux of the given shape which has that
1251 particular half box configuration, are generated.
1252 First create a half box column with all barred entries.
1253 */
1254
1255 m_i_i(ri,r=callocobject());
1256 last_partition(r,hafling=callocobject());
1257 m_u_t(hafling,spin=callocobject());
1258 freeall(r);
1259 freeall(hafling);
1260 for (i=0;i<ri;i++)
1261 m_i_i(-i-1,s_t_ij(spin,i,0));
1262
1263 if (no_rows) /* treat 0 partition differently */
1264 {
1265 while (1)
1266 { /* start the recursive tableaux generation process - if n is
1267 even then the first entrys are 0. Otherwise ri. */
1268
1269 m_u_t(partition,empty_tab=callocobject());
1270 pn_generate(empty_tab,part,filling,ni&1?0:ri,no_rows-1);
1271 freeall(empty_tab);
1272
1273 /* find the lowermost barred entry in the spin boxes
1274 and change it */
1275
1276 for (i=ri-1;i>=0 && s_t_iji(spin,i,0)>0;i--);
1277 if (i>=0)
1278 {
1279 c_i_i(s_t_ij(spin,i,0),i+1);
1280 for (i++;i<ri;i++)
1281 c_i_i(s_t_ij(spin,i,0),-i-1);
1282 }
1283 else
1284 break;
1285 }
1286 }
1287 else
1288 { OP vec,par,tab,spin_cop,mon,ext;
1289
1290 while (1)
1291 {
1292 m_il_v(1L,vec=callocobject());
1293 m_i_i(1L,s_v_i(vec,0L));
1294 b_ks_pa(VECTOR,vec,par=callocobject());
1295 m_u_t(par,tab=callocobject());
1296 m_i_i(0L,s_t_ij(tab,0L,0L));
1297
1298 copy_tableaux(spin,spin_cop=callocobject());
1299 b_sk_mo(tab,spin_cop,mon=callocobject());
1300 b_sn_l(mon,standard,ext=callocobject());
1301 standard=ext;
1302 count++;
1303 freeall(par);
1304
1305 /* find the lowermost barred entry in the spin boxes
1306 and change it */
1307
1308 for (i=ri-1;i>=0 && s_t_iji(spin,i,0)>0;i--);
1309 if (i>=0)
1310 {
1311 c_i_i(s_t_ij(spin,i,0),i+1);
1312 for (i++;i<ri;i++)
1313 c_i_i(s_t_ij(spin,i,0),-i-1);
1314 }
1315 else
1316 break;
1317 }
1318 }
1319
1320 freeall(spin);
1321
1322 /* put the tableaux list into the argument to this routine */
1323
1324 if (standard==NULL)
1325 init(LIST,list);
1326 else
1327 { b_ks_o(s_o_k(standard),s_o_s(standard),list);
1328 SYM_free(standard);
1329 }
1330
1331 SYM_free(part);
1332 SYM_free(filling);
1333
1334 return(count);
1335 }
1336
1337
pn_generate(skew_tab,un_part,filling,entry,row)1338 static INT pn_generate (skew_tab, un_part, filling, entry, row)
1339 OP skew_tab; INT *un_part; INT *filling; INT entry; INT row;
1340
1341 /* recursive function to generate spin standard tableaux for the orthogonal
1342 group O(n). skew_tab is a partially filled tableaux. One iteration
1343 of this function puts a number of _entry into the row _row.
1344 un_part gives the shape of the unfilled part of the tableau before
1345 ANY _entry was placed. filling is the changed unfilled part after
1346 _entry s are included, but only for rows below that currently
1347 being considered.
1348 */
1349
1350 { INT j,j_start,i;
1351 INT *new_fill;
1352 OP new_tab,new_part,ext,spin_cop,mon;
1353
1354 copy_tableaux(skew_tab,new_tab=callocobject());
1355
1356 if (entry==1 || entry==-1)
1357 {
1358 entry=s_t_iji(spin,row,0L);
1359
1360 for (j=0;j<un_part[row];j++)
1361 m_i_i(entry,s_t_ij(new_tab,row,j));
1362
1363 copy_tableaux(spin,spin_cop=callocobject());
1364 b_sk_mo(new_tab,spin_cop,mon=callocobject());
1365 b_sn_l(mon,standard,ext=callocobject());
1366 standard=ext;
1367 count++;
1368 }
1369
1370 else
1371 /* there is a range of the number of entries to fill:
1372 j_start is set to be the leftmost that must be filled. */
1373 {
1374 j_start=un_part[row]; /* this is the default case */
1375
1376 if (entry<0)
1377 { if (row+entry==-1)
1378 j_start=0;
1379 else if (row+entry==-2 && s_t_iji(spin,row+1,0L)==entry
1380 && un_part[row+1]<part[row+1]
1381 && s_t_iji(skew_tab,row+1,un_part[row+1])==-entry)
1382 j_start=un_part[row+1]; /* protection condition for = rows */
1383 }
1384 else if (entry==row+1 && s_t_iji(spin,row,0L)==entry)
1385 j_start=0;
1386 else if (row==ri) /* here entry can only be 0 */
1387 j_start=0;
1388
1389 /* now place the entries that are forced */
1390
1391 for (j=j_start;j<un_part[row];j++)
1392 m_i_i(entry,s_t_ij(new_tab,row,j));
1393 filling[row]=j_start;
1394
1395 /* now loop between 0 and as many as possible in current row */
1396
1397 for (j=j_start;j>=un_part[row+1];j--)
1398 {
1399
1400 if (j<j_start)
1401 { m_i_i(entry,s_t_ij(new_tab,row,j));
1402 filling[row]--;
1403 }
1404
1405 /* and now resubmit to recursion */
1406
1407 if (row>0)
1408 pn_generate(new_tab,un_part,filling,entry,row-1);
1409 else /* just done the top row */
1410 {
1411 /* find lowest unfilled row */
1412
1413 for (i=no_rows-1;filling[i]==0;i--);
1414 if (i>=0)
1415 { new_fill=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1416 if (entry>0)
1417 pn_generate(new_tab,filling,new_fill,-entry,i);
1418 else if (entry<0)
1419 pn_generate(new_tab,filling,new_fill,-entry-1,i);
1420 else
1421 pn_generate(new_tab,filling,new_fill,ri,i);
1422 SYM_free(new_fill);
1423 }
1424 else /* tableau is full: need to store it. */
1425 {
1426 copy_tableaux(spin,spin_cop=callocobject());
1427 b_sk_mo(new_tab,spin_cop,mon=callocobject());
1428 b_sn_l(mon,standard,ext=callocobject());
1429 standard=ext;
1430 count++;
1431 return(OK);
1432 }
1433 }
1434 }
1435
1436 freeall(new_tab);
1437 }
1438 level--;
1439 return(OK);
1440 }
1441
1442
sn_tableaux(n,partition,flag,list)1443 INT sn_tableaux ( n, partition, flag, list)
1444 OP n; OP partition; INT flag; OP list;
1445
1446 /* generates standard spin tableaux for the spin orthogonal group SO(n).
1447 If relevant (n is even), flag=-1 selects the - representation and
1448 flag=+1 selects the + representation.
1449 */
1450
1451 { INT i,f;
1452 INT *filling;
1453 OP empty_tab,r,hafling;
1454
1455 if (partition==NULL || s_o_k(partition)!=PARTITION
1456 || n==NULL || s_o_k(n)!=INTEGER )
1457 { printf("sn_tableaux() did not receive the correct objects!\n");
1458 init(LIST,list);
1459 return(ERROR);
1460 }
1461
1462 ni=s_i_i(n);
1463 ri=ni/2;
1464 no_rows=s_pa_li(partition);
1465
1466 if (ri<no_rows)
1467 { printf("The partition passed to sn_tableaux() has tooo many parts!\n");
1468 init(LIST,list);
1469 return(ERROR);
1470 }
1471
1472 if (ni&1) /* same tableaux as for O(n) case */
1473 return(pn_tableaux(n,partition,list));
1474
1475 if (flag>0)
1476 f=0;
1477 else if (flag<0)
1478 f=1;
1479 else
1480 f=ri&1; /* undocumented: includes tableau with all spins barred */
1481
1482 /* put the parts in decreasing order: append a zero part */
1483
1484 part=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1485 filling=(INT*)SYM_calloc(no_rows+1,sizeof(INT));
1486
1487 for (i=0;i<no_rows;i++)
1488 filling[i]=part[i]=s_pa_ii(partition,no_rows-1-i);
1489 part[i]=0;
1490
1491 standard=NULL;
1492 count=level=0;
1493
1494 /* we consider the half boxes as a separate tableau. They will
1495 be generated in the outer loop here.
1496 Then, all tableaux of the given shape which has that
1497 particular half box configuration, are generated.
1498 First create a half box column with all barred entries.
1499 For SO(2r) the lowermost spin entry is determined by the others.
1500 */
1501
1502 m_i_i(ri,r=callocobject());
1503 last_partition(r,hafling=callocobject());
1504 m_u_t(hafling,spin=callocobject());
1505 freeall(r);
1506 freeall(hafling);
1507 for (i=0;i<ri-1;i++)
1508 m_i_i(-i-1,s_t_ij(spin,i,0));
1509 m_i_i((f^ri)&1?ri:-ri,s_t_ij(spin,ri-1,0));
1510
1511 if (no_rows) /* treat 0 partition differently */
1512 {
1513 while (1)
1514 { /* start the recursive tableaux generation process - if n is
1515 even then the first entrys are 0. Otherwise ri. */
1516
1517 m_u_t(partition,empty_tab=callocobject());
1518 pn_generate(empty_tab,part,filling,ni&1?0:ri,no_rows-1);
1519 freeall(empty_tab);
1520
1521 /* find the lowermost barred entry in the spin boxes
1522 (except the last) and change it */
1523
1524 for (i=ri-2;i>=0 && s_t_iji(spin,i,0)>0;i--);
1525 if (i>=0)
1526 {
1527 c_i_i(s_t_ij(spin,i,0),i+1);
1528 if ( !((ri-i)&1) ) /* need to change last entry */
1529 addinvers_apply_integer(s_t_ij(spin,ri-1,0));
1530 for (i++;i<ri-1;i++)
1531 c_i_i(s_t_ij(spin,i,0),-i-1);
1532 }
1533 else
1534 break;
1535 }
1536 }
1537 else
1538 { OP vec,par,tab,spin_cop,mon,ext;
1539
1540 while (1)
1541 {
1542 m_il_v(1L,vec=callocobject());
1543 m_i_i(1L,s_v_i(vec,0L));
1544 b_ks_pa(VECTOR,vec,par=callocobject());
1545 m_u_t(par,tab=callocobject());
1546 m_i_i(0L,s_t_ij(tab,0L,0L));
1547
1548 copy_tableaux(spin,spin_cop=callocobject());
1549 b_sk_mo(tab,spin_cop,mon=callocobject());
1550 b_sn_l(mon,standard,ext=callocobject());
1551 standard=ext;
1552 count++;
1553 freeall(par);
1554
1555 /* find the lowermost barred entry in the spin boxes
1556 (except the last) and change it */
1557
1558 for (i=ri-2;i>=0 && s_t_iji(spin,i,0)>0;i--);
1559 if (i>=0)
1560 {
1561 c_i_i(s_t_ij(spin,i,0),i+1);
1562 if ( !((ri-i)&1) ) /* need to change last entry */
1563 addinvers_apply_integer(s_t_ij(spin,ri-1,0));
1564 for (i++;i<ri-1;i++)
1565 c_i_i(s_t_ij(spin,i,0),-i-1);
1566 }
1567 else
1568 break;
1569 }
1570
1571 }
1572
1573 freeall(spin);
1574
1575 /* put the tableaux list into the argument to this routine */
1576
1577 if (standard==NULL)
1578 init(LIST,list);
1579 else
1580 { b_ks_o(s_o_k(standard),s_o_s(standard),list);
1581 SYM_free(standard);
1582 }
1583
1584 SYM_free(part);
1585 SYM_free(filling);
1586
1587 return(count);
1588 }
1589
1590
tableaux_character(list,r,character)1591 INT tableaux_character ( list, r, character)
1592 OP list; OP r; OP character;
1593
1594 /* Takes a list of standard tableaux (maximum entry r) and computes
1595 the corresponding character by summing over all tableaux, the
1596 monomial formed by multplying indeterminants for each entry
1597 (negative entries give the indeterminant to the negative power).
1598 */
1599
1600 { INT i,j,e;
1601 OP trawl,term,pol;
1602
1603 if (s_o_k(list)!=LIST || s_o_k(r)!=INTEGER
1604 || (!empty_listp(list) && s_o_k(s_l_s(list))!=TABLEAUX))
1605 { printf("tableaux_character() did not receive correct arguments!");
1606 return(ERROR);
1607 }
1608
1609 if (empty_listp(list))
1610 { init(POLYNOM,character);
1611 return(OK);
1612 }
1613
1614 if (!emptyp(character))
1615 freeself(character);
1616
1617 /* get the shape of the first tableau and assume the others are
1618 of the same shape. */
1619
1620 no_rows=s_pa_li(s_t_u(s_l_s(list)));
1621
1622 /* put the parts in decreasing order: */
1623
1624 part=(INT*)SYM_calloc(no_rows,sizeof(INT));
1625
1626 for (i=0;i<no_rows;i++)
1627 part[i]=s_pa_ii(s_t_u(s_l_s(list)),no_rows-1-i);
1628
1629 /* go through the list and form a monomial for each tableau */
1630
1631 for (trawl=list;trawl!=NULL;trawl=s_l_n(trawl))
1632 {
1633 m_il_nv(s_i_i(r),term=callocobject());
1634
1635 for (i=0;i<no_rows;i++)
1636 for (j=0;j<part[i];j++)
1637 { if ((e=s_t_iji(s_l_s(trawl),i,j))>0)
1638 inc(S_V_I(term,e-1));
1639 else if (e<0)
1640 dec(S_V_I(term,-e-1));
1641 }
1642
1643 b_skn_po(term,callocobject(),NULL,pol=callocobject());
1644 m_i_i(1L,s_po_k(pol));
1645 insert(pol,character,NULL,NULL);
1646 }
1647
1648 SYM_free(part);
1649 return(OK);
1650 }
1651
1652
spin_tableaux_character(list,r,character)1653 INT spin_tableaux_character ( list, r, character) OP list; OP r; OP character;
1654
1655 /* Takes a list of standard spin-tableaux (maximum entry r) and computes
1656 the corresponding character by summing over all such tableaux, the
1657 monomial formed by multplying indeterminants for each entry
1658 (negative entries give the indeterminant to the negative power)
1659 in the spin part and the square of the indeterminants for each
1660 entry in the tensor part. Thus, in the resulting polynomial,
1661 each exponent is twice the value it should be (to accommodate
1662 half odd integer values). A spin-tableau is regarded as a pair
1663 of tableaux (in a MONOM object), the koeff part is a single column
1664 of height the rank (r) giving the spin indices, the self part is
1665 the set of usual tensor indices.
1666 */
1667
1668 { INT i,j,e;
1669 OP trawl,term,pol;
1670
1671 if (s_o_k(list)!=LIST || s_o_k(r)!=INTEGER
1672 || (!empty_listp(list) && (s_o_k(s_l_s(list))!=MONOM
1673 || s_o_k(s_mo_k(s_l_s(list)))!=TABLEAUX
1674 || s_o_k(s_mo_s(s_l_s(list)))!=TABLEAUX)))
1675 { printf("spin_tableaux_character() did not receive correct arguments!");
1676 return(ERROR);
1677 }
1678
1679 if (empty_listp(list))
1680 { init(POLYNOM,character);
1681 return(OK);
1682 }
1683
1684 if (!emptyp(character))
1685 freeself(character);
1686
1687 /* get the shape of the first tableau and assume the others are
1688 of the same shape. */
1689
1690 no_rows=s_pa_li(s_t_u(s_mo_s(s_l_s(list))));
1691 ri=s_i_i(r); /* length of spin column */
1692
1693 /* put the parts in decreasing order: */
1694
1695 part=(INT*)SYM_calloc(no_rows,sizeof(INT));
1696
1697 for (i=0;i<no_rows;i++)
1698 part[i]=s_pa_ii(s_t_u(s_mo_s(s_l_s(list))),no_rows-1-i);
1699
1700 /* go through the list and form a monomial for each tableau */
1701
1702 for (trawl=list;trawl!=NULL;trawl=s_l_n(trawl))
1703 {
1704 m_il_nv(ri,term=callocobject());
1705
1706 for (i=0;i<no_rows;i++)
1707 for (j=0;j<part[i];j++)
1708 { if ((e=s_t_iji(s_mo_s(s_l_s(trawl)),i,j))>0)
1709 { inc(S_V_I(term,e-1));
1710 inc(S_V_I(term,e-1));
1711 }
1712 else if (e<0)
1713 { dec(S_V_I(term,-e-1));
1714 dec(S_V_I(term,-e-1));
1715 }
1716 }
1717
1718 for (i=0;i<ri;i++)
1719 { if ((e=s_t_iji(s_mo_k(s_l_s(trawl)),i,0L))>0)
1720 { inc(S_V_I(term,e-1));
1721 }
1722 else if (e<0)
1723 { dec(S_V_I(term,-e-1));
1724 }
1725 }
1726
1727 b_skn_po(term,callocobject(),NULL,pol=callocobject());
1728 m_i_i(1L,s_po_k(pol));
1729 insert(pol,character,NULL,NULL);
1730 }
1731
1732 SYM_free(part);
1733 return(OK);
1734 }
1735
1736
gl_character(n,partition,character)1737 INT gl_character ( n, partition, character) OP n; OP partition; OP character;
1738
1739 /* calculates the character (in n indeterminants) of the representation
1740 of GL(n) labelled by partition. This is the Schur function.
1741 */
1742
1743 { INT erg;
1744 OP t_list;
1745
1746 if (s_pa_li(partition)==0) /* null partition => char=1 */
1747 erg=m_i_i(1L,character);
1748 else
1749 { erg=gl_tableaux(n,partition,t_list=callocobject());
1750 if (erg>=0)
1751 erg=tableaux_character(t_list,n,character);
1752 freeall(t_list);
1753 }
1754
1755 return(erg);
1756 }
1757
1758
sp_character(n,partition,character)1759 INT sp_character ( n, partition, character)OP n; OP partition; OP character;
1760
1761 /* calculates the character (in [n/2] indeterminants) of the representation
1762 of Sp(n) labelled by partition.
1763 */
1764
1765 { INT erg;
1766 OP t_list,r;
1767
1768 if (s_pa_li(partition)==0)
1769 erg=m_i_i(1L,character);
1770 else
1771 { erg=sp_tableaux(n,partition,t_list=callocobject());
1772 m_i_i(s_i_i(n)/2L,r=callocobject());
1773 if (erg>=0)
1774 erg=tableaux_character(t_list,r,character);
1775 freeall(t_list);
1776 freeall(r);
1777 }
1778
1779 return(erg);
1780 }
1781
1782
or_character(n,partition,character)1783 INT or_character ( n, partition, character) OP n,partition,character;
1784
1785 /* calculates the character (in [n/2] indeterminants) of the ordinary
1786 representation of O(n) labelled by partition.
1787 */
1788
1789 { INT erg;
1790 OP t_list,r;
1791
1792 if (s_pa_li(partition)==0)
1793 erg=m_i_i(1L,character);
1794 else
1795 { erg=or_tableaux(n,partition,t_list=callocobject());
1796 m_i_i(s_i_i(n)/2L,r=callocobject());
1797 if (erg>=0)
1798 erg=tableaux_character(t_list,r,character);
1799 freeall(t_list);
1800 freeall(r);
1801 }
1802
1803 return(erg);
1804 }
1805
1806
so_character(n,partition,flag,character)1807 INT so_character ( n, partition, flag, character)
1808 OP n,partition,character; INT flag;
1809
1810 /* calculates the character (in [n/2] indeterminants) of the ordinary
1811 representation of SO(n) labelled by partition.
1812 In the case where n is even AND no. parts equal to n/2, we need
1813 to specify the + or - representation: flag=-1 selects the -
1814 representation and if +1 selects the + representation.
1815 */
1816
1817 { INT erg;
1818 OP t_list,r;
1819
1820 if (s_pa_li(partition)==0)
1821 erg=m_i_i(1L,character);
1822 else
1823 { erg=so_tableaux(n,partition,flag,t_list=callocobject());
1824 m_i_i(s_i_i(n)/2L,r=callocobject());
1825 if (erg>=0)
1826 erg=tableaux_character(t_list,r,character);
1827 freeall(t_list);
1828 freeall(r);
1829 }
1830
1831 return(erg);
1832 }
1833
1834
pn_character(n,partition,character)1835 INT pn_character ( n, partition, character)OP n; OP partition; OP character;
1836
1837 /* calculates the character (in [n/2] indeterminants) of the spin
1838 representation of O(n) labelled by partition.
1839 */
1840
1841 { INT erg;
1842 OP t_list,r;
1843
1844 erg=pn_tableaux(n,partition,t_list=callocobject());
1845 m_i_i(s_i_i(n)/2L,r=callocobject());
1846 if (erg>=0)
1847 erg=spin_tableaux_character(t_list,r,character);
1848 freeall(t_list);
1849 freeall(r);
1850
1851 return(erg);
1852 }
1853
1854
sn_character(n,partition,flag,character)1855 INT sn_character ( n, partition, flag, character)
1856 OP n; OP partition; INT flag; OP character;
1857
1858 /* calculates the character (in [n/2] indeterminants) of the spin
1859 representation of SO(n) labelled by partition.
1860 If relevant (n is even), flag=-1 selects the - representation and
1861 flag=+1 selects the + representation.
1862 */
1863
1864 { INT erg;
1865 OP t_list,r;
1866
1867 erg=sn_tableaux(n,partition,flag,t_list=callocobject());
1868 m_i_i(s_i_i(n)/2L,r=callocobject());
1869 if (erg>=0)
1870 erg=spin_tableaux_character(t_list,r,character);
1871 freeall(t_list);
1872 freeall(r);
1873
1874 return(erg);
1875 }
1876
1877
1878
1879