1 /* SYMMETRICA file:ta.c */
2 #include "def.h"
3 #include "macro.h"
4
5 static struct tableaux * calloctableaux();
6 static INT inhaltcoroutine();
7 static INT free_tableaux();
8
9 static INT mem_counter_tab;
10
11 #ifdef TABLEAUXTRUE
12 #define ZEILENENDE(tab,zn)/* AK 100902 */\
13 (\
14 S_O_K(S_T_U(tab)) == PARTITION ?\
15 (zn >= S_PA_LI(S_T_U(tab)) ? -1 :S_PA_II(S_T_U(tab),S_PA_LI(S_T_U(tab))-1-zn) -1 ):\
16 (zn >= S_T_UGLI(tab) ? -1 :S_PA_II(S_T_UG(tab),S_T_UGLI(tab)-zn-1)-1)\
17 )
18
tab_anfang()19 INT tab_anfang()
20 /* AK 100893 */
21 {
22 mem_counter_tab=0L;
23 return OK;
24 }
25
tab_ende()26 INT tab_ende()
27 /* AK 100893 */
28 {
29 INT erg = OK;
30 if (mem_counter_tab != 0L)
31 {
32 fprintf(stderr, "mem_counter_tab = %" PRIINT "\n" ,mem_counter_tab);
33 erg += error("tab memory not freed");
34 }
35 return erg;
36 }
37
cast_apply_tableaux(a)38 INT cast_apply_tableaux(a) OP a;
39 /* AK 270295 */
40 /* AK 260398 V2.0 */
41 /* tries to make the object a into a TABLEAUX object */
42 {
43 INT erg = OK;
44 EOP("cast_apply_tableaux(1)",a);
45 if (MATRIXP(a))
46 {
47 erg += m_matrix_tableaux(a,a);
48 }
49 else if (VECTORP(a))
50 {
51 erg += cast_apply_matrix(a);
52 erg += m_matrix_tableaux(a,a);
53 }
54 else {
55 WTO("cast_apply_tableaux(1)",a);
56 }
57 SYMCHECK(a == S_T_S(a), "cast_apply_tableaux(i1)");
58 ENDR("cast_apply_tableaux");
59 }
60
conjugate_tableaux(a,b)61 INT conjugate_tableaux(a,b) OP a,b;
62 /* AK 040398 V2.0 */
63 {
64 INT erg = OK;
65 CTO(TABLEAUX,"conjugate_tableaux",a);
66 CE2(a,b,conjugate_tableaux);
67 erg += b_us_t(callocobject(),callocobject(),b);
68 erg += conjugate(S_T_U(a), S_T_U(b));
69 erg += transpose(S_T_S(a), S_T_S(b));
70 ENDR("conjugate_tableaux");
71 }
72
73
74 #endif /* TABLEAUXTRUE */
75
tableauxp(a)76 INT tableauxp(a) OP a;
77 /* AK 040398 V2.0 */
78 {
79 OP z;
80 if (S_O_K(a) != TABLEAUX)
81 return FALSE;
82 if (not matrixp(S_T_S(a)))
83 return FALSE;
84 z = S_T_U(a);
85
86 switch(S_O_K(z)) {
87 case PARTITION:
88 if (not partitionp(z)) return FALSE;
89 return TRUE;
90 case SKEWPARTITION:
91 if (not skewpartitionp(z)) return FALSE;
92 return TRUE;
93 }
94
95 return FALSE;
96 }
97
98 #ifdef TABLEAUXTRUE
charge_tableaux(a,b)99 INT charge_tableaux(a,b) OP a,b;
100 /* AK 141196 */
101 /* AK 040398 V2.0 */
102 /* a and b may be equal */
103 {
104 INT erg = OK;
105 OP c;
106 CTO(TABLEAUX,"charge_tableaux(1)",a);
107 c = CALLOCOBJECT();
108 erg += rowwordoftableaux(a,c);
109 erg += charge_word(c,b);
110 FREEALL(c);
111 ENDR("charge_tableaux");
112 }
113
114
free_tableaux(a)115 static INT free_tableaux(a) char *a;
116 {
117 SYM_free(a);
118 mem_counter_tab--;
119 return OK;
120 }
121
freeself_tableaux(a)122 INT freeself_tableaux(a) OP a;
123 /* AK 260789 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
124 /* AK 260398 V2.0 */
125 {
126 INT erg = OK;
127 CTO(TABLEAUX,"freeself_tableaux(1)",a);
128 FREEALL(S_T_S(a));
129 FREEALL(S_T_U(a));
130 free_tableaux((char *) S_O_S(a).ob_tableaux);
131 C_O_K(a,EMPTY);
132 ENDR("freeself_tableaux");
133 }
134
135
136
copy_tableaux(a,b)137 INT copy_tableaux(a,b) OP a,b;
138 /* AK 260789 */ /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
139 /* AK 260398 V2.0 */
140 {
141 INT erg = OK;
142 CTO(TABLEAUX,"copy_tableaux(1)",a);
143 CTO(EMPTY,"copy_tableaux(2)",b);
144
145 erg += b_us_t(callocobject(),callocobject(),b);
146 if (S_O_K(S_T_S(a)) == INTEGERMATRIX)
147 erg += copy_integermatrix(S_T_S(a),S_T_S(b));
148 else
149 erg += copy_matrix(S_T_S(a),S_T_S(b)); /* self ist immer matrix */
150 if (S_O_K(S_T_U(a)) == PARTITION)
151 erg += copy_partition(S_T_U(a),S_T_U(b));
152 else
153 erg += copy(S_T_U(a),S_T_U(b));
154 ENDR("copy_tableaux");
155 }
156
157
158
159
calloctableaux()160 static struct tableaux * calloctableaux()
161 /* 020488 AK erste prozedur beim einfuehren eines neuen datentyps */
162 /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
163 /* AK 040398 V2.0 */
164 {
165 struct tableaux *erg
166 = (struct tableaux *) SYM_calloc((int)1,sizeof(struct tableaux));
167 if (erg == NULL)
168 error("calloctableaux:no memory");
169 mem_counter_tab++;
170 return(erg);
171 }
172
173 /* CONSTRUCTORS */
174 INT m_us_t();
175 INT b_us_t();
176 INT b_u_t();
177 INT m_u_t();
178 INT b_matrix_tableaux();
179 INT m_matrix_tableaux();
180
181
b_matrix_tableaux(mat,tab)182 INT b_matrix_tableaux(mat,tab) OP mat,tab;
183 /* AK 010988 */ /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
184 /* AK 040398 V2.0 */
185 {
186 OP u;
187 INT erg = OK;
188 if (not MATRIXP(mat))
189 WTO("b_matrix_tableaux",mat);
190 CE2(mat,tab,b_matrix_tableaux);
191
192 u = callocobject();
193 erg += m_matrix_umriss(mat,u);
194 erg += b_us_t(u,mat,tab);
195 ENDR("b_matrix_tableaux");
196 }
197
m_matrix_tableaux(mat,tab)198 INT m_matrix_tableaux(mat,tab) OP mat,tab;
199 /* AK 010988 */ /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
200 /* AK 040398 V2.0 */
201 {
202 OP u;
203 INT erg = OK;
204 if (not MATRIXP(mat))
205 WTO("m_matrix_tableaux",mat);
206
207 CE2(mat,tab,m_matrix_tableaux);
208
209 u = callocobject();
210 erg += m_matrix_umriss(mat,u);
211 erg += m_us_t(u,mat,tab);
212 erg += freeall(u);
213 ENDR("m_matrix_tableaux");
214 }
215
m_u_t(umriss,res)216 INT m_u_t(umriss,res) OP umriss,res;
217 /* AK 020488 */
218 /* AK 281289 V1.1 */ /* AK 240791 V1.3 */
219 /* AK 020398 V2.0 */
220 /* umriss and res may be equal */
221 {
222 OP l,h;
223 INT erg = OK;
224 CTTO(PARTITION,SKEWPARTITION,"m_u_t(1)",umriss);
225
226 CE2(umriss,res,m_u_t);
227
228 l= callocobject();
229 h= callocobject();
230
231 erg += b_us_t(CALLOCOBJECT(),CALLOCOBJECT(),res);
232 COPY(umriss,S_T_U(res));
233
234 erg += length(umriss,h);
235 erg += lastof(umriss,l);
236 erg += b_lh_m(l,h,S_T_S(res));
237
238 CTO(TABLEAUX,"m_u_t(res)",res);
239 ENDR("m_u_t");
240 }
241
b_u_t(umriss,res)242 INT b_u_t(umriss,res) OP umriss,res;
243 /* AK 020398 V2.0 */
244 {
245 OP l,h;
246 INT erg = OK;
247 COP("b_u_t(2)",res);
248
249 l= callocobject();
250 h= callocobject();
251
252 erg += length(umriss,h);
253 /* bsp umriss = 1234 ==> height = 4
254 umriss = 23456789/3456 ==> height = 8 */
255
256 erg += lastof(umriss,l);
257
258 erg += b_us_t(umriss,callocobject(),res);
259 erg += b_lh_m(l,h,S_T_S(res));
260 ENDR("b_u_t");
261 }
262
m_us_t(umriss,self,res)263 INT m_us_t(umriss,self,res) OP umriss,self,res;
264 /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
265 /* AK 040398 V2.0 */
266 {
267 INT erg = OK;
268 COP("m_us_t(3)",res);
269 erg += b_us_t(callocobject(),callocobject(),res);
270 erg += copy(umriss,S_T_U(res));
271 erg += copy_matrix(self,S_T_S(res));
272 ENDR("m_us_t");
273 }
274
275
b_us_t(umriss,self,res)276 INT b_us_t(umriss,self,res) OP umriss,self,res;
277 /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
278 /* AK 040398 V2.0 */
279 {
280 OBJECTSELF d;
281 INT erg = OK;
282 COP("b_us_t(3)",res);
283
284 d.ob_tableaux = calloctableaux();
285 erg += b_ks_o(TABLEAUX, d, res);
286
287 erg += c_t_u(res,umriss);
288 erg += c_t_s(res,self);
289 ENDR("b_us_t");
290 }
291
292
293
objectread_tableaux(f,a)294 INT objectread_tableaux(f,a) FILE *f; OP a;
295 /* AK 210690 V1.1 */ /* AK 200891 V1.3 */
296 /* AK 040398 V2.0 */
297 {
298 INT erg = OK;
299 CTO(EMPTY,"objectread_tableaux(2)",a);
300 COP("objectread_tableaux(1)",f);
301 erg += b_us_t(callocobject(),callocobject(),a);
302 erg += objectread(f,S_T_U(a));
303 erg += objectread(f,S_T_S(a));
304 ENDR("objectread_tableaux");
305 }
306
307
308
objectwrite_tableaux(f,a)309 INT objectwrite_tableaux(f,a) FILE *f; OP a;
310 /* AK 210690 V1.1 */ /* AK 200891 V1.3 */
311 /* AK 040398 V2.0 */
312 {
313 INT erg = OK;
314 CTO(TABLEAUX,"objectwrite_tableaux(2)",a);
315 COP("objectwrite_tableaux(1)",f);
316 fprintf(f, "%" PRIINT " " ,(INT)S_O_K(a));
317 erg += objectwrite(f,S_T_U(a));
318 erg += objectwrite(f,S_T_S(a));
319 ENDR("objectwrite_tableaux");
320 }
321
m_matrix_umriss(mat,umr)322 INT m_matrix_umriss(mat,umr) OP mat,umr;
323 /* AK 080688 */
324 /* AK 010989 V1.0 */ /* AK 110790 V1.1 */ /* AK 200891 V1.3 */
325 /* AK 040398 V2.0 */
326 /* mat and umr may be equal */
327 {
328 INT i,j,k,schalter;
329 INT erg = OK;
330
331 if (not MATRIXP(mat))
332 {
333 WTO("m_matrix_umriss",mat);
334 goto endr_ende;
335 }
336 CE2(mat,umr,m_matrix_umriss);
337
338 /* zuerst die laenge der partition */
339 for (i=0L;i<S_M_HI(mat);i++)
340 if (EMPTYP(S_M_IJ(mat,i,0L))) break;
341
342 if (i==0L) {
343 /* SKEWPARTITION */
344 /* AK 110790 V1.1 */
345 OP a = callocobject(), b = callocobject();
346 erg += m_il_integervector(S_M_HI(mat),a);
347 erg += m_il_integervector(S_M_HI(mat),b);
348 for (i=0L;i<S_M_HI(mat); i++)
349 {
350 schalter = 0L;
351 for (j=0L;j<S_M_LI(mat); j++)
352 {
353 if (schalter == 0L) {
354 /* noch im linken leeren teil */
355 if (not EMPTYP(S_M_IJ(mat,i,j))) {
356 M_I_I(j,S_V_I(b,i));
357 schalter=1L;
358 }
359 else if (j == S_M_LI(mat)-1L) {
360 /* d.h. am ende */
361 M_I_I(S_M_LI(mat),S_V_I(a,i));
362 M_I_I(S_M_LI(mat),S_V_I(b,i));
363 }
364 }
365 if (schalter == 1L) {
366 /* im teil mit eintraegen */
367 if (EMPTYP(S_M_IJ(mat,i,j))) {
368 M_I_I(j,S_V_I(a,i));
369 schalter=2L;
370 }
371 else
372 if (j == S_M_LI(mat)-1L) {
373 /* d.h. am ende */
374 M_I_I(S_M_LI(mat),S_V_I(a,i));}
375 }
376 else
377 if (schalter == 2L) {
378 if (not EMPTYP(S_M_IJ(mat,i,j))) {
379 freeall(a); freeall(b);
380 debugprint(mat);
381 return
382 error("m_matrix_umriss:no MATRIX");
383 }
384 }
385 }
386 }
387 for (i=S_M_HI(mat)-1L; i>=0L; i--)
388 {
389 if (S_V_II(b,i) == S_M_LI(mat))
390 {
391 M_I_I(0L,S_V_I(b,i));
392 M_I_I(0L,S_V_I(a,i));
393 }
394 else break;
395 }
396 /* nun sind die nullen am ende */
397 /* das umdrehen */
398 erg += b_gk_spa(callocobject(),callocobject(),umr);
399 erg += m_v_pa(a,S_SPA_G(umr));
400 erg += m_v_pa(b,S_SPA_K(umr));
401 erg += freeall(a);
402 erg += freeall(b);
403
404 if (EMPTYP(S_SPA_G(umr))) /* no real entry in the matrix */
405 {
406 erg += freeself(umr);
407 }
408 goto endr_ende;
409 }
410
411 erg += b_ks_pa(VECTOR,CALLOCOBJECT(),umr);
412 erg += m_il_integervector(i,S_PA_S(umr));
413 /* die laenge wurde berechnet */
414
415 k = S_M_LI(mat);
416 for (i=0L;i<S_PA_LI(umr);i++)
417 {
418 for (j=0L;j<S_M_LI(mat);j++)
419 if (EMPTYP(S_M_IJ(mat,i,j))) break;
420 if (j==0L)
421 {
422 erg += error("0 in m_matrix_umriss");
423 goto endr_ende;
424 }
425 if (j > k)
426 {
427 erg += error("m_matrix_umriss:no partition shape");
428 goto endr_ende;
429 }
430 M_I_I(j,S_PA_I(umr,S_PA_LI(umr)-1-i));
431 k = j;
432 };
433 ENDR("m_matrix_umriss");
434 }
435
436
tex_tableaux(a)437 INT tex_tableaux(a) OP a;
438 /* AK 060588 */ /* AK 230790 V1.1 */
439 /* AK 070291 V1.2 prints to texout */ /* AK 200891 V1.3 */
440 /* AK 260398 V2.0 */
441 {
442 INT i,j;
443 INT erg = OK;
444 CTO(TABLEAUX,"tex_tableaux(1)",a);
445
446 if (S_O_K(S_T_U(a)) != PARTITION) /* AK 310892 */
447 {
448 return error("tex_tableaux: only for PARTITION shape");
449 }
450 fprintf(texout,"\\hbox { \\vbox {\n");
451 for (i=0L; i< S_PA_LI(S_T_U(a)); i++)
452 {
453 fprintf(texout,"\\hrule width %ldpt\n",
454 S_PA_II(S_T_U(a),i)*13-1L);
455 fprintf(texout,"\\vskip 0pt\n\\hbox {\n");
456 for (j=0L; j< S_PA_II(S_T_U(a),i); j++)
457 {
458 fprintf(texout,
459 "\\kern -3.5pt\n\\hbox to 13pt{");
460 fprintf(texout,"\\vrule height10pt depth3pt$");
461 /* s_t_iji statt S_T_IJI */
462 if (s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j) < 10L)
463 fprintf(texout, "\\ %" PRIINT ,
464 /* s_t_iji statt S_T_IJI */
465 s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j));
466 /* s_t_iji statt S_T_IJI */
467 else if (s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j) < 100L)
468 fprintf(texout, "%" PRIINT ,
469 /* s_t_iji statt S_T_IJI */
470 s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j));
471 else return
472 error("tex_tableaux:entry too big in tableaux");
473
474 fprintf(texout,
475 "$ \\vrule height10pt depth3pt}\n");
476 }
477 fprintf(texout,"}\n\\vskip 0pt\n");
478 if (i== S_PA_LI(S_T_U(a)) -1L)
479 fprintf(texout,
480 "\\hrule width %ldpt\n",S_PA_II(S_T_U(a),i)*13-1L);
481 }
482
483 fprintf(texout,"} } ");
484 ENDR("tex_tableaux");
485 }
486
487
comp_tableaux(a,b)488 INT comp_tableaux(a,b) OP a,b;
489 /* AK 060588 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
490 /* AK 221097 */
491 /* AK 260398 V2.0 */
492 {
493 INT erg=OK,i,j,k;
494 CTO(TABLEAUX,"comp_tableaux",a);
495 CTO(TABLEAUX,"comp_tableaux",b);
496 erg = comp(S_T_U(a), S_T_U(b));
497 if (erg != (INT)0) return erg;
498 for (i=0;i<S_T_HI(a) ; i++)
499 {
500 k = ZEILENENDE(a,i);
501 for (j=zeilenanfang(a,i);j<=k;j++)
502 {
503 erg = comp(S_T_IJ(a,i,j), S_T_IJ(b,i,j));
504 if (erg != (INT)0) return erg;
505 }
506 }
507 return (INT)0;
508 ENDR("comp_tableaux");
509 }
510
511
inc_tableaux(tab)512 INT inc_tableaux(tab) OP tab;
513 /* AK 250488 */ /* AK 291289 V1.1 */ /* AK 200891 V1.3 */
514 /* AK 260398 V2.0 */
515
516 /* the new self part will have a new empty row and a new empty
517 column */
518 {
519 OP a,b;
520 INT i,j;
521 INT erg = OK;
522 CTO(TABLEAUX,"inc_tableaux(1)",tab);
523
524 a = S_T_S(tab);
525
526 b = CALLOCOBJECT();
527 erg += m_ilih_m(S_M_LI(a)+1,S_M_HI(a)+1,b);
528
529 for (i=0L;i<S_M_HI(a);i++)
530 for (j=0L;j<S_M_LI(a);j++)
531 {
532 C_O_S(S_M_IJ(b,i+1L,j),S_O_S(S_M_IJ(a,i,j)));
533 C_O_K(S_M_IJ(b,i+1L,j),S_O_K(S_M_IJ(a,i,j)));
534 }
535 erg += freeall(S_M_H(a));
536 erg += freeall(S_M_L(a));
537 *a = *b;
538 ENDR("inc_tableaux");
539 }
540
541
weight_tableaux(a,b)542 INT weight_tableaux(a,b) OP a,b;
543 /* subroutine of weight in the case of a tableau object */
544 /* weight of a tableau is the number of entries */
545 /* AK 170790 V1.1 */
546 /* AK 200891 V1.3 */
547 /* AK 260398 V2.0 */
548 {
549 INT erg = OK;
550 CTO(TABLEAUX,"weight_tableaux(1)",a);
551 CTO(EMPTY,"weight_tableaux(2)",b);
552 erg += weight(S_T_U(a),b);
553 ENDR("weight_tableaux");
554 }
555
556
557 #define CO_CO_FPT \
558 if (S_O_K(S_T_U(a)) == PARTITION)\
559 {if (i >= S_T_ULI(a)) continue;}\
560 else if (S_O_K(S_T_U(a)) == SKEWPARTITION)\
561 {if (i >= S_T_UGLI(a)) continue;}\
562 /*empty matrix*/else if (S_O_K(S_T_U(a)) == EMPTY)\
563 continue;\
564 \
565 fprintf(fp,"\n");\
566 if (fp == stdout) zeilenposition = 0L;\
567 schalter=1L;\
568 for (j=0L; j<S_T_LI(a); j++)\
569 if (EMPTYP(S_T_IJ(a,i,j)))\
570 {\
571 if (schalter==2L)/*fprintf(fp," ")*/;\
572 else if (schalter==1L)fprintf(fp,"# ");\
573 }\
574 else {\
575 schalter=2L;\
576 fprint(fp,S_T_IJ(a,i,j));\
577 fprintf(fp," ");\
578 }\
579
fprint_tableaux(fp,a)580 INT fprint_tableaux(fp,a) FILE *fp; OP a;
581 /* AK 020488 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
582 /* AK 020398 V2.0 */
583 {
584 INT i,j,schalter;
585 INT erg = OK;
586 CTO(TABLEAUX,"fprint_tableaux",a);
587 if ((S_T_HI(a)*S_T_LI(a)) == (INT)0) /* empty tableaux, shape = [] */
588 {
589 fprintf(fp,"[]");
590 }
591 else
592 {
593 if (english_tableau != TRUE)
594 {
595 for (i=S_T_HI(a)-1L;i >= 0L; i--)
596 {
597 CO_CO_FPT
598 };
599 }
600 else
601 {
602 for (i=0L; i < S_T_HI(a);i++)
603 {
604 CO_CO_FPT
605 };
606 }
607 }
608 fprintf(fp,"\n");
609 if (fp == stdout) {
610 zeilenposition = (INT)0;
611 }
612 ENDR("fprint_tableaux");
613 }
614
615
616 /* SELECTORS */
s_t_s(a)617 OP s_t_s(a) OP a;
618 /* AK 200891 V1.3 */ /* AK 040398 V2.0 */
619 {
620 OBJECTSELF c;
621 c = s_o_s(a);
622 return(c.ob_tableaux->t_self);
623 }
624
s_t_u(a)625 OP s_t_u(a) OP a;
626 /* AK 200891 V1.3 */ /* AK 040398 V2.0 */
627 {
628 OBJECTSELF c;
629 c=s_o_s(a);
630 return(c.ob_tableaux->t_umriss);
631 }
632
s_t_ug(a)633 OP s_t_ug(a) OP a;
634 /* AK 200891 V1.3 */
635 /* AK 040398 V2.0 */
636 { return(s_spa_g(s_t_u(a))); }
637
s_t_l(a)638 OP s_t_l(a) OP a;
639 /* AK 200891 V1.3 */
640 /* AK 040398 V2.0 */
641 { return(s_m_l(s_t_s(a))); }
642
s_t_li(a)643 INT s_t_li(a) OP a;
644 /* AK 200891 V1.3 */
645 /* AK 040398 V2.0 */
646 { return(s_m_li(s_t_s(a))); }
647
s_t_hi(a)648 INT s_t_hi(a) OP a;
649 /* AK 200891 V1.3 */
650 /* AK 040398 V2.0 */
651 { return(s_m_hi(s_t_s(a))); }
652
s_t_iji(a,i,j)653 INT s_t_iji(a,i,j) OP a;INT i,j;
654 /* AK 200891 V1.3 */
655 /* AK 040398 V2.0 */
656 { return(s_i_i(s_t_ij(a,i,j))); }
657
s_t_ij(a,i,j)658 OP s_t_ij(a,i,j) OP a;INT i,j;
659 /* AK 200891 V1.3 */
660 /* AK 040398 V2.0 */
661 { return(s_m_ij(s_t_s(a),i,j)); }
662
s_t_h(a)663 OP s_t_h(a) OP a;
664 /* AK 200891 V1.3 */
665 /* AK 040398 V2.0 */
666 { return(s_m_h(s_t_s(a))); }
667
c_t_s(a,b)668 INT c_t_s(a,b) OP a,b;
669 /* AK 200891 V1.3 */
670 /* AK 040398 V2.0 */
671 { OBJECTSELF c; c = s_o_s(a); c.ob_tableaux->t_self = b;
672 return(OK); }
673
c_t_u(a,b)674 INT c_t_u(a,b) OP a,b;
675 /* AK 200891 V1.3 */
676 /* AK 040398 V2.0 */
677 { OBJECTSELF c; c = s_o_s(a); c.ob_tableaux->t_umriss = b; return(OK); }
678
s_t_uk(a)679 OP s_t_uk(a) OP a;
680 /* AK 200891 V1.3 */
681 /* AK 040398 V2.0 */
682 { return(s_spa_k(s_t_u(a))); }
683
s_t_us(a)684 OP s_t_us(a) OP a;
685 /* AK 200891 V1.3 */
686 /* AK 040398 V2.0 */
687 { return(s_pa_s(s_t_u(a))); }
688
s_t_uli(a)689 INT s_t_uli(a) OP a;
690 /* AK 040398 V2.0 */
691 {
692 INT erg = OK;
693 CTO(TABLEAUX,"s_t_uli",a);
694 CTO(PARTITION,"s_t_uli:shape of the tableau",s_t_u(a));
695 return(s_pa_li(s_t_u(a)));
696 ENDR("s_t_uli");
697 }
698
s_t_ul(a)699 OP s_t_ul(a) OP a;
700 /* AK 040398 V2.0 */
701 {
702 OP umriss = s_t_u(a);
703 if (s_o_k(umriss) != PARTITION)
704 {
705 printobjectkind(umriss);
706 error("s_t_ul: not a partition shape tableau");
707 return NULL;
708 }
709 return(s_pa_l(s_t_u(a))); }
710
s_t_ui(a,i)711 OP s_t_ui(a,i) OP a;INT i;
712 /* AK 200891 V1.3 */
713 /* AK 040398 V2.0 */
714 {
715 OP umriss = s_t_u(a);
716 if (s_o_k(umriss) != PARTITION)
717 {
718 printobjectkind(umriss);
719 error("s_t_ui: not a partition shape tableau");
720 return NULL;
721 }
722 return(s_pa_i(s_t_u(a),i)); }
723
s_t_uii(a,i)724 INT s_t_uii(a,i) OP a;INT i;
725 /* AK 200891 V1.3 */
726 /* AK 040398 V2.0 */
727 {
728 OP umriss = s_t_u(a);
729 if (s_o_k(umriss) != PARTITION)
730 {
731 printobjectkind(umriss);
732 error("s_t_uii: not a partition shape tableau");
733 return ERROR;
734 }
735 return(s_pa_ii(s_t_u(a),i)); }
736
s_t_ukii(a,i)737 INT s_t_ukii(a,i) OP a;INT i;
738 /* AK 200891 V1.3 */
739 /* AK 040398 V2.0 */
740 { return(s_spa_kii(s_t_u(a),i)); }
741
s_t_ukli(a)742 INT s_t_ukli(a) OP a;
743 /* AK 200891 V1.3 */
744 /* AK 040398 V2.0 */
745 { return(s_spa_kli(s_t_u(a))); }
746
s_t_ugii(a,i)747 INT s_t_ugii(a,i) OP a;INT i;
748 /* AK 200891 V1.3 */
749 /* AK 040398 V2.0 */
750 { return(s_spa_gii(s_t_u(a),i)); }
751
s_t_ugli(a)752 INT s_t_ugli(a) OP a;
753 /* AK 200891 V1.3 */
754 /* AK 040398 V2.0 */
755 { return(s_spa_gli(s_t_u(a))); }
756
757
758
content_tableaux(a,content)759 INT content_tableaux(a,content) OP a,content;
760 /* AK 250488 */ /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
761 /* AK 040398 V2.0 */
762 {
763 INT i,j,an,en;
764 INT erg = OK;
765 CTO(TABLEAUX,"content_tableaux(1)",a);
766 CE2(a,content,content_tableaux);
767
768 erg += m_il_nv(1L,content);
769
770 for (i=S_T_HI(a)-1L;i>=0L;i--)
771 {
772 an = zeilenanfang(a,i);
773 en = ZEILENENDE(a,i);
774 for (j=an;j<=en;j++)
775 erg += inhaltcoroutine(S_T_IJI(a,i,j),content);
776 }
777 ENDR("content_tableaux");
778 }
779
780
inhaltcoroutine(zahl,content)781 static INT inhaltcoroutine(zahl,content) INT zahl; OP content;
782 /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
783 /* AK 040398 V2.0 */
784 {
785 INT erg = OK;
786 CTO(VECTOR,"internal routine:inhaltcoroutine(2)",content);
787 if (zahl <= S_V_LI(content))
788 INC_INTEGER(S_V_I(content,zahl-1L));
789 else {
790 OP b=callocobject();
791 INT k,m=S_V_LI(content);
792 erg += m_il_v(zahl,b);
793 for (k=0L;k<m;k++)
794 M_I_I(S_V_II(content,k),S_V_I(b,k));
795 for (k=m;k<zahl;k++)
796 M_I_I(0L,S_V_I(b,k));
797 M_I_I(1L,S_V_I(b,zahl-1L));
798 erg += freeself(content);
799 *content = *b;
800 C_O_K(b,EMPTY);
801 erg += freeall(b);
802 };
803 ENDR("internal routine:inhaltcoroutine");
804 }
805
806
807
scan_tableaux(a)808 INT scan_tableaux(a) OP a;
809 /* 020488 AK */ /* AK 010889 V1.1 */
810 /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
811 /* AK 040398 V2.0 */
812 {
813 INT erg = OK;
814 char c[2];
815 CTO(EMPTY,"scan_tableaux(1)",a);
816 again:
817 printeingabe("Please enter (S)kewpartition or (P)artition for the shape of the tableau");
818 scanf("%s",&c[0]);
819
820 if (c[0] == 'P')
821 { erg += scan_parttableaux(a); }
822 else if (c[0] == 'S')
823 { erg += scan_skewtableaux(a); }
824 else
825 { goto again; }
826 ENDR("scan_tableaux");
827 }
828
scan_skewtableaux(a)829 INT scan_skewtableaux(a) OP a;
830 /* AK 020398 V2.0 */
831 {
832 INT k,m;
833 INT i,j;
834 INT erg = OK;
835 OP umriss;
836 char c[100];
837
838 CTO(EMPTY,"scan_skewtableaux(1)",a);
839
840 umriss = callocobject();
841
842 printeingabe("Please enter a tableau of skewpartition shape\n");
843 erg += scan(SKEWPARTITION,umriss);
844 erg += b_u_t(umriss,a);
845 printeingabe("Now please enter the tableau\n");
846 m = S_T_UKLI(a); /* ab diesen index ist nur noch
847 die groessere Partition */
848 for (i=0L; i<S_T_HI(a); i++)
849 {
850 /* s_t_ukii statt S_T_UKII */
851 if (i<m) k=s_t_ukii(a,S_T_UKLI(a)-1-i);
852 else k=0L;
853 /* in spalte k wird eingetragen */
854 sprintf(c,"row nr %ld \n",(i+1L)); /* AK 020792 */
855 printeingabe(c); /* AK 020792 */
856 for (j=k;j<S_PA_II(s_t_ug(a),S_T_UGLI(a)-1-i);j++)
857 erg += scan(INTEGER,S_T_IJ(a,i,j));
858 };
859 ENDR("scan_skewtableaux");
860 }
861
scan_parttableaux(a)862 INT scan_parttableaux(a) OP a;
863 /* AK 020398 V2.0 */
864 {
865 INT i,j,erg = OK;
866 char c[100];
867 OP umriss;
868 CTO(EMPTY,"scan_parttableaux(1)",a);
869
870 printeingabe("Please enter a tableau of partition shape\n");
871 umriss = callocobject();
872 erg += scan(PARTITION,umriss);
873
874 erg += b_u_t(umriss,a);
875 printeingabe("Now please enter the tableau\n");
876 for (i=0L; i<S_T_HI(a); i++)
877 {
878 sprintf(c,"row nr %ld \n",(i+1L)); /* AK 020792 */
879 printeingabe(c); /* AK 020792 */
880 for (j=0L;j<S_PA_II(S_T_U(a),S_T_HI(a)-1-i);j++)
881 erg += scan(INTEGER,S_T_IJ(a,i,j));
882 };
883 ENDR("scan_parttableaux");
884 }
885
886
887
888
wordoftableaux(a,b)889 INT wordoftableaux(a,b) OP a,b;
890 /* AK 200891 V1.3 */
891 /* AK 260398 V2.0 */
892 {
893 INT erg = OK;
894 CTO(TABLEAUX,"wordoftableaux(1)",a);
895 erg += columnwordoftableaux(a,b);
896 ENDR("wordoftableaux");
897 }
898
899
900
rowwordoftableaux(a,b)901 INT rowwordoftableaux(a,b) OP a,b;
902 /* berechnet das zu einem Tableaux gehoerende word */
903 /* MD p.68 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
904 /* AK 230398 V2.0 */
905 {
906 OP l = callocobject();
907 INT i,j,k;
908 INT index=0L; /* der index im word */
909 INT erg = OK; /* AK 300792 */
910
911 CTO(TABLEAUX,"rowwordoftableaux",a);
912 CE2(a,b,rowwordoftableaux);
913
914 erg += weight_tableaux(a,l);
915 /* die laenge des wortes ist das gewicht des tableaus */
916
917 erg += m_il_w(S_I_I(l),b);
918
919 for (i=0;i<S_T_HI(a);i++)
920 {
921 k = zeilenanfang(a,i);
922 for(j=ZEILENENDE(a,i);j>=k;j--)
923 { M_I_I(S_T_IJI(a,i,j),S_W_I(b,index));index++; }
924
925 }
926 erg += freeall(l);
927 ENDR("rowwordoftableaux");
928 }
929
930
931
columnwordoftableaux(a,b)932 INT columnwordoftableaux(a,b) OP a,b;
933 /* berechnet das zu einem Tableaux gehoerende word */
934 /* AK 020290 V1.1 */ /* AK 200891 V1.3 */
935 /* AK 230398 V2.0 */
936 {
937 OP l;
938 INT i,j,k,erg=OK;
939 INT index=0L; /* der index im word */
940 CTO(TABLEAUX,"columnwordoftableaux(1)",a);
941
942 l = callocobject();
943 erg += weight_tableaux(a,l);
944 /* die laenge des wortes ist das gewicht des tableaus */
945
946 erg += m_il_w(S_I_I(l),b);
947
948 for (j=0L;j<S_T_LI(a);j++)
949 {
950 k = spaltenanfang(a,j);
951 for(i=spaltenende(a,j);i>=k;i--)
952 { M_I_I(S_T_IJI(a,i,j),S_W_I(b,index));index++; }
953
954 }
955 erg += freeall(l);
956 ENDR("columnwordoftableaux");
957 }
958
959
spaltenanfang(a,b)960 INT spaltenanfang(a,b) OP a; INT b;
961 /* AK 020290 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
962 /* AK 230398 V2.0 */
963 {
964 OP z = S_T_U(a);
965 INT j;
966 if (b <0L)
967 return error("spaltenanfang:index < 0");
968 if (S_O_K(z) == PARTITION)
969 {
970 if (b >= S_PA_II(z,S_PA_LI(z)-1L)) return(S_T_HI(a));
971 else return(0L);
972 }
973 else if (S_O_K(z) == SKEWPARTITION)
974 {
975 /* s_t_ugii statt S_T_UGII */
976 if (b >= s_t_ugii(a,S_T_UGLI(a)-1L)) return(S_T_HI(a));
977 /* s_t_ukii statt S_T_UKII */
978 else if (b>=s_t_ukii(a,S_T_UKLI(a)-1L)) return(0L);
979 else
980 {
981 for (j=S_T_UKLI(a)-1L;j>=0L;j--)
982 if (S_T_UKII(a,j) <= b) break;
983 return(S_T_UKLI(a) - 1L - j);
984 }
985 }
986 else error("spaltenanfang: wrong shape");
987 return OK;
988 }
989
spaltenende(a,b)990 INT spaltenende(a,b) OP a; INT b;
991 /* AK 020290 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
992 /* AK 230398 V2.0 */
993 {
994 OP z = S_T_U(a);
995 INT j;
996 if (b <0L)
997 return error("spaltenende:index < 0");
998 if (S_O_K(z) == PARTITION)
999 {
1000 if (b >= S_PA_II(z,S_PA_LI(z)-1L)) return(-1L);
1001 else {
1002 for (j=S_PA_LI(z)-1L;j>=0L;j--)
1003 if (S_PA_II(z,j) <= b) break;
1004 return(S_PA_LI(z) - 2L - j);
1005 }
1006 }
1007 else if (S_O_K(z) == SKEWPARTITION)
1008 {
1009 /* s_t_ugii statt S_T_UGII */
1010 if (b >= s_t_ugii(a,S_T_UGLI(a)-1L)) return(-1L);
1011 else {
1012 for (j=S_T_UGLI(a)-1L;j>=0L;j--)
1013 if (S_T_UGII(a,j) <= b) break;
1014 return(S_T_UGLI(a) - 2L - j);
1015 }
1016 }
1017 else return error("spaltenende: wrong shape");
1018 }
1019
zeilenanfang(tab,zn)1020 INT zeilenanfang(tab,zn) OP tab; INT zn;
1021 /* AK 090688 */
1022 /* gibt index ersten eintrag in zeile zn */
1023 /* falls zn keine besetzte zeile ist, dann ist das ergebnis die breite der
1024 matrix */
1025 /* AK 281289 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
1026 /* AK 230398 V2.0 */
1027 {
1028 INT erg = OK;
1029 CTO(TABLEAUX,"zeilenanfang",tab);
1030 if (zn <0L)
1031 {
1032 erg += error("zeilenanfang:index < 0");
1033 goto endr_ende;
1034 }
1035 if (S_O_K(S_T_U(tab)) == PARTITION) { /* ein tableau */
1036 if (zn < S_PA_LI(S_T_U(tab)) ) return(0L);
1037 else return(S_T_LI(tab));
1038 }
1039 else if (S_O_K(S_T_U(tab)) == SKEWPARTITION) /* ein schieftableau */
1040 {
1041 if (zn >= S_T_UGLI(tab)) return(S_T_LI(tab));
1042 else if (zn >= S_T_UKLI(tab)) return(0L);
1043 else return( S_T_UKII(tab,S_T_UKLI(tab)-zn-1L));
1044 }
1045 else {
1046 printobjectkind(S_T_U(tab));
1047 erg += error("zeilenanfang: wrong umriss");
1048 }
1049 ENDR("zeilenanfang");
1050 }
1051
zeilenende(tab,zn)1052 INT zeilenende(tab,zn) OP tab; INT zn;
1053 /* letzter erlaubter index */
1054 /* AK 281289 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
1055 /* AK 230398 V2.0 */
1056 /* AK 100902 V2.1 */
1057 {
1058 OP u = S_T_U(tab);
1059 INT erg = OK;
1060 CTO(TABLEAUX,"zeilenende(1)",tab);
1061 CTTO(PARTITION,SKEWPARTITION,"zeilenende(1.shape)",S_T_U(tab));
1062 SYMCHECK(zn<0,"zeilenende:index < 0");
1063
1064 if (S_O_K(u) == PARTITION)
1065 {
1066 if (zn >= S_PA_LI(u))
1067 return -1;
1068 else
1069 return(S_PA_II(u,S_PA_LI(u)-1L-zn) -1);
1070 }
1071 else
1072 {
1073 if (zn >= S_T_UGLI(tab))
1074 return -1;
1075 else
1076 return(S_PA_II(S_T_UG(tab),S_T_UGLI(tab)-zn-1L)-1);
1077 }
1078 ENDR("zeilenende");
1079 }
1080
1081
1082
skewplane_plane(a,b)1083 INT skewplane_plane(a,b) OP a,b;
1084 /* AK 010889 */
1085 /* Jeu de Taquin auf a wird b . a ist schiefplanepartition
1086 und wird eine planepartition b */
1087 /* AK 010889 V1.1 */ /* Ak 200891 V1.3 */
1088 /* AK 230398 V2.0 */
1089 {
1090 OP self = callocobject();
1091 OP umriss;
1092 OP unten,rechts;
1093 INT i,j;
1094 INT posi,posj; /* aktuelle position des jokers */
1095 INT nexti,nextj; /* naechste position des jokers */
1096 INT si=0,sj=0; /* start of joker */
1097
1098 copy (S_T_S(a),self);
1099 m0108893: /* ein neues spiel */
1100 i = 0L;
1101 for (j=0L;j<S_M_LI(self);j++)
1102 if (not EMPTYP(S_M_IJ(self,i,j)))
1103 {
1104 if (j == 0L) goto m010889stop1; /* ende */
1105 /* man hat ein tableaux */
1106
1107
1108 /* spalte mit eintrag */
1109 j = j - 1L;
1110 for (i=0L;i<S_M_HI(self);i++)
1111 if (not EMPTYP(S_M_IJ(self,i,j)))
1112 { si=i-1L;sj=j;goto m0108891;}
1113 };
1114 m0108891: /* si,sj die position des jokers */
1115 posi = si; posj = sj;
1116 m0108892: /* next step */
1117 /* nach richtung kleineres element, bei gleich nach unten */
1118 unten = NULL; rechts = NULL;
1119 if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
1120 {
1121 unten = S_M_IJ(self,posi+1L,posj);
1122 if (EMPTYP(unten)) unten = NULL;
1123 };
1124 if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
1125 {
1126 rechts = S_M_IJ(self,posi,posj+1L);
1127 if (EMPTYP(rechts)) rechts = NULL;
1128 };
1129 if ( (unten == NULL) && (rechts == NULL) )
1130 /* ende ein neues spiel */ goto m0108893;
1131 if ( (unten == NULL)) /* nach rechts */
1132 { nexti = posi; nextj=posj+1L; }
1133 else if ( (rechts == NULL)) /* nach unten */
1134 { nexti = posi+1L; nextj=posj; }
1135 else /* in beide richtungen ist noch ein eintrag */
1136 {
1137 if (gt(rechts,unten))
1138 { nexti = posi; nextj=posj+1L; }
1139 else { nexti = posi+1L; nextj=posj; };
1140 };
1141
1142 copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
1143 freeself(S_M_IJ(self,nexti,nextj));
1144 posi=nexti; posj=nextj;
1145 goto m0108892; /* noch eine runde */
1146 m010889stop1: /* wir sind fertig,aus der matrix wird ein tableau */
1147 umriss = callocobject();
1148 m_matrix_umriss(self,umriss);
1149 return b_us_t(umriss,self,b);
1150 }
1151
1152
1153
1154
plane_tableau(a,b)1155 INT plane_tableau(a,b) OP a,b;
1156 /* AK 010889 */
1157 /* Jeu de Taquin auf a wird b . a ist planepartition
1158 und wird ein tableau b */
1159 /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
1160 {
1161 OP self = callocobject();
1162 OP unten,rechts;
1163 INT startwert;
1164 INT posi,posj; /* aktuelle position des jokers */
1165 INT nexti,nextj; /* naechste position des jokers */
1166
1167 copy(a,b);
1168 copy (S_T_S(a),self);
1169 n0108893: /* ein neues spiel */
1170 /* posi,posj die position des jokers */
1171 posi = 0L; posj = 0L;
1172 if (EMPTYP(S_M_IJ(self,posi,posj)))
1173 goto n010889stop1;
1174 startwert=S_M_IJI(self,posi,posj);
1175 n0108892: /* next step */
1176 /* nach richtung kleineres element, bei gleich nach unten */
1177 unten = NULL; rechts = NULL;
1178 if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
1179 {
1180 unten = S_M_IJ(self,posi+1L,posj);
1181 if (EMPTYP(unten)) unten = NULL;
1182 };
1183 if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
1184 {
1185 rechts = S_M_IJ(self,posi,posj+1L);
1186 if (EMPTYP(rechts)) rechts = NULL;
1187 };
1188 if ( (unten == NULL) && (rechts == NULL) )
1189 /* ende ein neues spiel */ {
1190 freeself(S_M_IJ(self,posi,posj));
1191 M_I_I(startwert,S_T_IJ(b,posi,posj));
1192 goto n0108893; }
1193 if ( (unten == NULL)) /* nach rechts */
1194 { nexti = posi; nextj=posj+1L; }
1195 else if ( (rechts == NULL)) /* nach unten */
1196 { nexti = posi+1L; nextj=posj; }
1197 else /* in beide richtungen ist noch ein eintrag */
1198 {
1199 if (gt(rechts,unten))
1200 { nexti = posi; nextj=posj+1L; }
1201 else { nexti = posi+1L; nextj=posj; };
1202 };
1203
1204 copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
1205 freeself(S_M_IJ(self,nexti,nextj));
1206 posi=nexti; posj=nextj;
1207 goto n0108892; /* noch eine runde */
1208 n010889stop1: /* wir sind fertig */
1209 freeall(self);
1210 return(OK);
1211 }
1212
apply_INJDT(a,l,k,anz)1213 INT apply_INJDT(a,l,k,anz) OP a,l;INT k,anz;
1214 /* a ist tableau, l ist liste, hier werden die ergebnisse eingefuegt */
1215 /* k ist die mindestspalte */
1216 /* AK 160790 V1.1 */ /* AK 200891 V1.3 */
1217 {
1218 OP b ;
1219 INT i,j,oj,obergrenze=0;
1220 INT erg = OK;
1221 CTO(TABLEAUX,"apply_INJDT(1)",a);
1222
1223 if (anz == 0L) return OK;
1224 oj = S_T_LI(a)+1L;
1225 if (S_O_K(S_T_U(a)) == PARTITION) obergrenze=S_T_ULI(a);
1226 if (S_O_K(S_T_U(a)) == SKEWPARTITION) obergrenze=S_T_UGLI(a);
1227 for (i=0; i<=obergrenze ; i++)
1228 {
1229 j=ZEILENENDE(a,i)+1;
1230 if (j == -1) break;
1231 if (j == oj) continue; /* keine ecke */
1232 if (j < k) continue;
1233 b = callocobject();
1234 inverse_nilplactic_jeudetaquin_tableaux(a,i,j,b);
1235 oj = j;
1236 if (anz == 1L)insert(b,l,NULL,NULL);
1237 else { apply_INJDT(b,l,j+1L,anz-1L); freeall(b); }
1238 }
1239 ENDR("apply_INJDT");
1240 }
1241
perm_tableaux(a,b)1242 INT perm_tableaux(a,b) OP a,b;
1243 /* a ist permutation
1244 b wird liste von tableaux, die reduzierte Zerlegung sind */
1245 /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
1246 /* AK 260398 V2.0 */
1247 /* a and b may be equal */
1248 {
1249 INT erg = OK;
1250 OP c;
1251 CTO(PERMUTATION,"perm_tableaux(1)",a);
1252 c= callocobject();
1253 erg += lehmercode(a,c);
1254 erg += lehmercode_tableaux(c,b);
1255 erg += freeall(c);
1256 ENDR("perm_tableaux");
1257 }
1258
1259
lehmercode_tableaux(a,b)1260 INT lehmercode_tableaux(a,b) OP a,b;
1261 /* a ist lehmercode
1262 b wird liste von tableaux, die reduzierte Zerlegung sind */
1263 /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
1264 /* AK 260398 V2.0 */
1265 {
1266 INT i,j,za,k;
1267 OP zz,c,d,z,e;
1268 INT erg = OK;
1269
1270 CTTO(INTEGERVECTOR,VECTOR,"lehmercode_tableaux(1)",a);
1271 CE2(a,b,lehmercode_tableaux);
1272
1273 for (i=0L; i<S_V_LI(a); i++) if (S_V_II(a,i) != 0L) break;
1274 /* i ist der erste index eines
1275 eintrags ungleich 0 im lehmercode */
1276 if (i==S_V_LI(a)) return OK; /* lehmercode == 0-Vektor */
1277
1278 /* nun haben wir einen lehmercode mit inversionen */
1279 c = callocobject(); copy(a,c); M_I_I(0L,S_V_I(c,i));
1280 /* c ist der gleiche lehmercode wie a nur
1281 mit einer 0 an der ersten stelle
1282 einer inversion */
1283
1284 d = callocobject();
1285 erg += lehmercode_tableaux(c,d);
1286 erg += init(LIST,b); /* b ist list-object mit NULL self und next */
1287 if (EMPTYP(d)) {
1288 /* c war 0-Vektor */
1289 erg += b_us_t(callocobject(),callocobject(),c);
1290 erg += m_ilih_m(S_V_II(a,i),1L,S_T_S(c));
1291 for (j=0;j<S_T_LI(c);j++) M_I_I(j+1+i,S_T_IJ(c,0L,j));
1292 erg += m_matrix_umriss(S_T_S(c),S_T_U(c));
1293 insert(c,b,NULL,NULL);
1294 erg += freeall(d);
1295 goto endr_ende;
1296 }
1297 erg += freeall(c);
1298 z=d;
1299 e = callocobject(); init(LIST,e);
1300 while (z != NULL)
1301 {
1302 apply_INJDT(S_L_S(z),e,0L,S_V_II(a,i));
1303 z = S_L_N(z);
1304 }
1305 erg += freeall(d);
1306 /* jetzt muss diese liste durch sucht werden ob man in der untersten
1307 zeile einfuegen kann */
1308 z = e;
1309 while (z != NULL)
1310 {
1311 zz = S_L_S(z);
1312 if (S_T_UKLI(zz) != 1L) freeself(zz);
1313 /* s_t_ukii statt S_T_UKII wg MSC */
1314 /* s_t_ugii statt S_T_UGII wg MSC */
1315 else if ( s_t_ukii(zz,S_T_UKLI(zz)-1L) ==
1316 s_t_ugii(zz,S_T_UGLI(zz)-1L) )
1317 {
1318 za = S_V_II(a,i);
1319 for (j=S_V_II(a,i),k=1L;j>0L; j--,k++)
1320 m_i_i(j+i,S_T_IJ(zz,0L,za-k));
1321 erg += m_matrix_umriss(S_T_S(zz),S_T_U(zz));
1322 insert(zz,b,NULL,NULL);
1323 C_L_S(z,NULL);
1324 }
1325 else if (
1326 S_T_IJI(zz,0L,zeilenanfang(zz,0L)) <=
1327 S_V_II(a,i) + i + 1L
1328 ) freeself(zz);
1329 else {
1330 za = zeilenanfang(zz,0L);
1331 for (j=S_V_II(a,i),k=1L;j>0L; j--,k++)
1332 m_i_i(j+i,S_T_IJ(zz,0L,za-k));
1333 erg += m_matrix_umriss(S_T_S(zz),S_T_U(zz));
1334 insert(zz,b,NULL,NULL);
1335 C_L_S(z,NULL);
1336 }
1337 z = S_L_N(z);
1338 }
1339 erg += freeall(e);
1340 ENDR("lehmercode_tableaux");
1341 }
1342
1343
1344
1345
umriss_tableaux(a,b)1346 INT umriss_tableaux(a,b) OP a,b;
1347 /* AK 300792 */
1348 /* AK 040398 V2.0 */
1349 {
1350 INT erg = OK;
1351 CTO(TABLEAUX,"umriss_tableaux",a);
1352 CE2(a,b,umriss_tableaux);
1353
1354 erg += copy(S_T_U(a),b);
1355 ENDR("umriss_tableaux");
1356 }
1357
1358
1359
standardp(a)1360 INT standardp(a) OP a;
1361 /* AK 300792 */
1362 /* true if weakly increasing in rows
1363 and strictly in columns */
1364 /* AK 040398 V2.0 */
1365 {
1366 INT i,j;
1367 INT erg = OK;
1368 CTO(TABLEAUX,"standardp",a);
1369 for (i=0L; i<S_T_HI(a); i++)
1370 for (j=0L; j<S_T_LI(a); j++)
1371 if (not EMPTYP(S_T_IJ(a,i,j)))
1372 {
1373 if (i>0L)
1374 if (not EMPTYP(S_T_IJ(a,i-1L,j)))
1375 if (S_T_IJI(a,i,j) <= S_T_IJI(a,i-1L,j))
1376 return FALSE;
1377 if (j>0L)
1378 if (not EMPTYP(S_T_IJ(a,i,j-1L)))
1379 if (S_T_IJI(a,i,j) < S_T_IJI(a,i,j-1L))
1380 return FALSE;
1381 }
1382 return TRUE;
1383 ENDR("standardp");
1384 }
1385
1386
planep(a)1387 INT planep(a) OP a;
1388 /* true if strictly decreasing in rows and columns */
1389 /* AK 260398 V2.0 */
1390 {
1391 INT i,j;
1392 INT erg = OK;
1393 CTO(TABLEAUX,"planep",a);
1394 for (i=0L; i<S_T_HI(a); i++)
1395 for (j=0L; j<S_T_LI(a); j++)
1396 if (not EMPTYP(S_T_IJ(a,i,j)))
1397 {
1398 if (i>0L)
1399 if (not EMPTYP(S_T_IJ(a,i-1L,j)))
1400 if (S_T_IJI(a,i,j) > S_T_IJI(a,i-1L,j))
1401 return FALSE;
1402 if (j>0L)
1403 if (not EMPTYP(S_T_IJ(a,i,j-1L)))
1404 if (S_T_IJI(a,i,j) > S_T_IJI(a,i,j-1L))
1405 return FALSE;
1406 }
1407 return TRUE;
1408 ENDR("planep");
1409 }
1410
1411
youngp(a)1412 INT youngp(a) OP a;
1413 /* AK 160992 */
1414 /* TRUE if entries 1,2,3,....n,
1415 each exactly one time */
1416 /* AK 040398 V2.0 */
1417 {
1418 OP c;
1419 INT res,erg = OK;
1420 CTO(TABLEAUX,"youngp",a);
1421 c = callocobject();
1422 erg += inhalt_tableaux(a,c);
1423 if (not einsp_integervector(c)) res=FALSE;
1424 else res=TRUE;
1425 erg += freeall(c);
1426 if (erg != OK)
1427 goto endr_ende;
1428 return res;
1429 ENDR("youngp");
1430 }
1431
1432
sort_rows_tableaux_apply(b)1433 INT sort_rows_tableaux_apply(b) OP b;
1434 /* AK 070295 */
1435 {
1436 INT erg = OK;
1437 INT i,j,k;
1438 CTO(TABLEAUX,"sort_rows_tableaux_apply(1)",b);
1439
1440 for (i=0;i<S_T_HI(b);i++)
1441 {
1442 k = zeilenanfang(b,i);
1443 j = ZEILENENDE(b,i);
1444
1445 qsort(S_T_IJ(b,i,k),j-k+1,sizeof(struct object),comp_integer);
1446 }
1447 ENDR("sort_rows_tableaux_apply");
1448 }
1449
1450
select_row_tableaux(a,i,b)1451 INT select_row_tableaux(a,i,b) OP a,b; INT i;
1452 /* AK 280193 */
1453 /* AK 091204 V3.0 */
1454 {
1455 INT erg = OK;
1456 CTO(TABLEAUX,"select_row_tableaux(1)",a);
1457 {
1458 INT za,ze;
1459 INT j;
1460 za = zeilenanfang(a,i);
1461 ze = ZEILENENDE(a,i);
1462
1463 FREESELF(b);
1464 if (za == S_T_LI(a))
1465 return OK; /* no entry in this row */
1466 erg += m_il_v(ze-za+1L,b);
1467 for (j=za; j <= ze; j++)
1468 COPY(S_T_IJ(a,i,j), S_V_I(b, j-za));
1469 }
1470 ENDR("select_row_tableaux");
1471 }
1472
select_column_tableaux(a,i,b)1473 INT select_column_tableaux(a,i,b) OP a,b; INT i;
1474 /* AK 280193 */
1475 {
1476 INT za,ze;
1477 INT erg = OK;
1478 INT j;
1479
1480 CTO(TABLEAUX,"select_column_tableaux(1)",a);
1481
1482
1483 za = spaltenanfang(a,i);
1484 ze = spaltenende(a,i);
1485 erg += freeself(b);
1486 if (za == S_T_HI(a))
1487 return OK; /* no entry in this column */
1488 erg += m_il_v(ze-za+1L,b);
1489 for (j=za; j <= ze; j++)
1490 erg += copy(S_T_IJ(a,j,i), S_V_I(b, j-za));
1491
1492 ENDR("select_column_tableaux");
1493 }
1494
1495
1496
1497
1498 #ifdef PERMTRUE
operate_perm_tableaux(b,a,c)1499 INT operate_perm_tableaux(b,a,c) OP a,b,c;
1500 /* AK 110593 */
1501 /* AK 240398 V2.0 */
1502 /* AK 100902 V2.1 */
1503 {
1504 INT erg=OK;
1505 CTO(TABLEAUX,"operate_perm_tableaux",a);
1506 CTO(PERMUTATION,"operate_perm_tableaux",b);
1507 SYMCHECK(S_P_K(b) != VECTOR,"operate_perm_tableaux: only for vector permutations");
1508 CE3(b,a,c,operate_perm_tableaux);
1509 {
1510 INT i,j;
1511 erg += copy_tableaux(a,c);
1512 for (i=0L;i<S_T_HI(a);i++)
1513 for (j=ZEILENENDE(a,i);j>=0;j--)
1514 {
1515 if (not EMPTYP(S_T_IJ(a,i,j)))
1516 {
1517 if (S_T_IJI(a,i,j) <= S_P_LI(b))
1518 M_I_I(S_P_II(b,S_T_IJI(a,i,j)-1L), S_T_IJ(c,i,j));
1519 }
1520 }
1521 }
1522 ENDR("operate_perm_tableaux");
1523 }
1524 #endif /* PERMTRUE */
1525
1526
1527
first_tableaux(a,b)1528 INT first_tableaux(a,b) OP a,b;
1529 /* AK 040693 */ /* a is umriss */ /* b first tableau according lex order
1530 on column word */
1531 {
1532 INT erg = OK;
1533 INT i,j,k=1,sa,se;
1534 CTTO(PARTITION,SKEWPARTITION,"first_tableaux",a);
1535 erg += m_u_t(a,b);
1536 for (j=0L;j<S_T_LI(b);j++)
1537 {
1538 sa = spaltenanfang(b,j); se=spaltenende(b,j);
1539 for (i=sa;i<=se;i++,k++)
1540 M_I_I(k,S_T_IJ(b,i,j));
1541 }
1542
1543 ENDR("first_tableaux");
1544 }
1545
makevectorofSYT(shape,c)1546 INT makevectorofSYT(shape,c) OP shape,c;
1547 /* AK 100902 */
1548 /* generates a vector with all SYT of a given shape */
1549 /* AK 090804 V3.0 */
1550 {
1551 INT erg = OK;
1552 CTTO(SKEWPARTITION,PARTITION,"makevectorofSYT(1)",shape);
1553 CE2(shape,c,makevectorofSYT);
1554 {
1555 OP d,e;
1556 INT i;
1557 d = CALLOCOBJECT();
1558 e = CALLOCOBJECT();
1559 weight(shape,d);
1560 erg += m_il_v(S_I_I(d),e);
1561 C_O_K(e,INTEGERVECTOR);
1562 for (i=0;i<S_V_LI(e);i++) M_I_I(1,S_V_I(e,i));
1563 erg += makevectoroftableaux(shape,e,c);
1564 FREEALL2(e,d);
1565 }
1566 ENDR("makevectorofSYT");
1567 }
1568
makevectoroftableaux(shape,content,c)1569 INT makevectoroftableaux(shape,content,c) OP shape,content,c;
1570 /* AK 080295 */
1571 /* AK 240398 V2.0 */
1572 /* AK 100902 V2.1 */
1573 {
1574 INT erg = OK;
1575 CTTO(SKEWPARTITION,PARTITION,"makevectoroftableaux(1)",shape);
1576 if (S_O_K(content) == PARTITION)
1577 {
1578 }
1579 else if (S_O_K(content) == INTEGERVECTOR)
1580 {
1581 }
1582 else if (S_O_K(content) == VECTOR)
1583 {
1584 INT i;
1585 for (i=0;i<S_V_LI(content);i++)
1586 if (S_O_K(S_V_I(content,i)) != INTEGER)
1587 goto aaa;
1588 }
1589 else {
1590 aaa:
1591 WTO("makevectoroftableaux(2)",content);
1592 goto endr_ende;
1593 }
1594 CE3(shape,content,c,makevectoroftableaux);
1595 C2R(shape,content,"makevectoroftableaux",c);
1596 {
1597 OP d,e;
1598 e = CALLOCOBJECT();
1599 erg += SYM_sum(content,e); /* AK 271098 */
1600 d = CALLOCOBJECT();
1601 erg += weight(shape,d);
1602 if (NEQ(d,e))
1603 {
1604 erg += error("makevectoroftableaux: different weight of input partitions");
1605 goto aa;
1606 }
1607 erg += kostka_tab(shape,content,d);
1608 erg += t_LIST_VECTOR(d,c);
1609 aa:
1610 FREEALL(d);
1611 FREEALL(e);
1612 }
1613 S2R(shape,content,"makevectoroftableaux",c);
1614 ENDR("makevectoroftableaux");
1615 }
1616
max_tableaux(a,b)1617 INT max_tableaux(a,b) OP a,b;
1618 /* AK 211097 */
1619 /* AK 090804 V3.0 */
1620 {
1621 INT erg = OK;
1622 CTO(TABLEAUX,"max_tableaux(1)",a);
1623 {
1624 erg += max_matrix(S_T_S(a),b);
1625 }
1626 ENDR("max_tableaux");
1627 }
1628
min_tableaux(a,b)1629 INT min_tableaux(a,b) OP a,b;
1630 /* AK 140703 */
1631 {
1632 INT erg = OK;
1633 CTO(TABLEAUX,"min_tableaux(1)",a);
1634 erg += min_matrix(S_T_S(a),b);
1635 ENDR("min_tableaux");
1636 }
1637
1638
ym_min(form,res)1639 INT ym_min(form,res) OP form,res;
1640 {
1641 INT lg_part,i,j,db,ind;
1642 OP wght,form1;
1643 INT erg = OK;
1644 CTO(PARTITION,"ym_min(1)",form);
1645
1646 wght=callocobject();
1647 form1=callocobject();
1648 erg += conjugate(form,form1);
1649 erg += weight(form,wght);
1650 erg += m_l_v(wght,res);
1651 lg_part=S_PA_LI(form1);
1652 ind=0L;
1653 for(i=0L;i<lg_part;i++)
1654 {
1655 db=S_PA_II(form1,i)-1L;
1656 for(j=db;j>=0L;j--)
1657 {
1658 M_I_I(j,S_V_I(res,ind));
1659 ind++;
1660 }
1661 }
1662 erg += freeall(wght);
1663 erg += freeall(form1);
1664 ENDR("ym_min");
1665 }
1666
1667
1668
1669
nxt_ym(ym1,ym2)1670 INT nxt_ym(ym1,ym2) OP ym1,ym2;
1671 {
1672 INT i,j,l,ind_max,av,pres=0,crt,tp;
1673 char *tab;
1674
1675 ind_max=S_V_LI(ym1)-1L; av=S_V_II(ym1,ind_max);
1676 for(i=ind_max-1L;i>=0L;i--)
1677 {
1678 pres=S_V_II(ym1,i);
1679 if(pres<av) break;
1680 av=pres;
1681 }
1682 if(i== -1L) return FALSE;
1683 if(ym1!=ym2)
1684 {
1685 m_il_v(ind_max+1L,ym2);
1686 for(j=0L;j<i;j++)
1687 M_I_I(S_V_II(ym1,j),S_V_I(ym2,j));
1688 }
1689 av=pres;tp=0L;
1690 while(tp<=0L)
1691 {
1692 tp=0L;av++;l=0L;
1693 for(j=ind_max;(j>i)&&(l<av+2L);j--)
1694 {
1695 l=S_V_II(ym1,j);
1696 if(l==av) tp++;
1697 else if(l==av+1L) tp--;
1698 }
1699 }
1700
1701 tp=i; pres=S_V_II(ym1,i+1L);
1702 tab=(char *)SYM_calloc(pres+1L,1);
1703 for(;i<=ind_max;i++)
1704 (*(tab+S_V_II(ym1,i)))++;
1705 (*(tab+av))--;
1706 M_I_I(av,S_V_I(ym2,tp));
1707 crt=ind_max;i=0L;
1708 for(j=pres;j>0L;j--)
1709 for(;i<*(tab+j);i++)
1710 for(l=0L;l<=j;l++,crt--)
1711 M_I_I(l,S_V_I(ym2,crt));
1712 for(;crt>tp;crt--)
1713 M_I_I(0L,S_V_I(ym2,crt));
1714 SYM_free(tab);
1715 return(TRUE);
1716 }
1717
1718
1719
find_tab_entry(tab,b,i,j)1720 INT find_tab_entry(tab,b,i,j) OP tab,b; INT *i, *j;
1721 /* place of b in tab */
1722 /* FALSE if not */
1723 {
1724 INT k,l;
1725 for (k=0;k<S_T_HI(tab);k++)
1726 for (l=0;l<S_T_LI(tab);l++)
1727 if (eq(b,S_T_IJ(tab,k,l)))
1728 { *i = k; *j = l; return TRUE; }
1729 *i = -1; *j = -1;
1730 return FALSE;
1731 }
1732
find_knuth_tab_entry(P,Q,b,i,j)1733 INT find_knuth_tab_entry(P,Q,b,i,j) OP P,Q,b; INT *i, *j;
1734 /* findet groessten eintrag in P, wobei in Q an der stelle ein b
1735 steht */
1736 /* FALSE if not */
1737 /* P und Q haben gleichen umriss */
1738 {
1739 INT k,l;
1740
1741 *i = -1; *j = -1;
1742 for (k=0;k<S_T_HI(P);k++)
1743 for (l=0;l<S_T_LI(P);l++)
1744 if (eq(b,S_T_IJ(Q,k,l)))
1745 if (l > *j)
1746 {
1747 *i = k;
1748 *j = l;
1749 }
1750
1751 if (*i == -1) return FALSE;
1752 else return TRUE;
1753 }
1754
word_tableaux(a,b)1755 INT word_tableaux(a,b) OP a,b;
1756 {
1757 INT erg = OK;
1758 CE2(a,b,word_tableaux);
1759 erg += word_schen(a,b,NULL);
1760 ENDR("word_tableaux");
1761 }
1762
word_schen(a,p_symbol,q_symbol)1763 INT word_schen(a,p_symbol,q_symbol) OP a,p_symbol,q_symbol;
1764 {
1765 INT i;
1766 INT erg = OK;
1767 CE3(a,p_symbol,q_symbol,word_schen);
1768 if (S_O_K(a) == PERMUTATION)
1769 erg += word_schen(S_P_S(a),p_symbol,q_symbol);
1770 else {
1771 erg += freeself(p_symbol);
1772 if (q_symbol != NULL)
1773 erg += freeself(q_symbol);
1774
1775 for (i=0;i<S_V_LI(a);i++)
1776 erg += schensted_row_insert_step(S_V_I(a,i),p_symbol,q_symbol);
1777 }
1778 ENDR("word_schen");
1779 }
1780
matrix_knuth(m,p_symbol,q_symbol)1781 INT matrix_knuth(m,p_symbol,q_symbol) OP m,p_symbol,q_symbol;
1782 {
1783 OP a,b;
1784 INT erg = OK;
1785 CTO(MATRIX,"matrix_knuth(1)",m);
1786
1787 a = callocobject();
1788 b = callocobject();
1789 erg += matrix_twoword(m,a,b);
1790 erg += twoword_knuth(a,b,p_symbol,q_symbol);
1791 erg += freeall(a);
1792 erg += freeall(b);
1793 ENDR("matrix_knuth");
1794 }
1795
twoword_knuth(a,b,p_symbol,q_symbol)1796 INT twoword_knuth(a,b,p_symbol,q_symbol) OP a,b,p_symbol,q_symbol;
1797 /* bijection 0-1 matrix (a,b) nach (p_symbol,q_symbol) */
1798 {
1799 INT i;
1800 INT erg = OK;
1801 CTTO(INTEGERVECTOR,VECTOR,"twoword_knuth(1)",a);
1802 CTTO(INTEGERVECTOR,VECTOR,"twoword_knuth(2)",b);
1803 erg += freeself(p_symbol);
1804 if (q_symbol != NULL)
1805 erg += freeself(q_symbol);
1806
1807 for (i=0;i<S_V_LI(a);i++)
1808 erg += knuth_row_insert_step(S_V_I(a,i),S_V_I(b,i),p_symbol,q_symbol);
1809
1810 conjugate(p_symbol,p_symbol);
1811
1812 ENDR("twoword_knuth");
1813 }
1814
matrix_twoword(matrix,column_index,row_index)1815 INT matrix_twoword(matrix, column_index, row_index)
1816 OP matrix, column_index, row_index;
1817 /* bijektion matrix mit zahlen >= 0 zu paar von integer vektoren */
1818 {
1819 INT erg = OK,i,j,k,l;
1820 OP c;
1821 CE3(matrix, column_index, row_index,matrix_twoword);
1822 c = callocobject();
1823 erg += zeilen_summe(matrix,c);
1824 erg += SYM_sum(c,c);
1825 erg += m_l_v(c,column_index);
1826 erg += m_l_v(c,row_index);
1827 for(i=0,l=0;i<S_M_HI(matrix);i++)
1828 for(j=0;j<S_M_LI(matrix);j++)
1829 for(k=0;k<S_M_IJI(matrix,i,j);k++)
1830 {
1831 M_I_I(j+1,S_V_I(column_index,l));
1832 M_I_I(i+1,S_V_I(row_index,l));
1833 l++;
1834 }
1835 erg += freeall(c);
1836 ENDR("matrix_twoword");
1837 }
1838
twoword_matrix(c_index,row_index,matrix)1839 INT twoword_matrix( c_index, row_index, matrix)
1840 OP matrix, c_index, row_index;
1841 {
1842 INT erg = OK,i;
1843 OP c;
1844 CE3(c_index, row_index, matrix,twoword_matrix);
1845 CTTO(VECTOR,WORD,"twoword_matrix",c_index);
1846 CTTO(VECTOR,WORD,"twoword_matrix",row_index);
1847 c = callocobject();
1848 erg += max(c_index,c);
1849 m_ilih_nm(S_I_I(c),S_V_II(row_index,S_V_LI(row_index)-1),matrix);
1850 for(i=0;i<S_V_LI(row_index);i++)
1851 inc_integer(S_M_IJ(matrix,S_V_II(row_index,i)-1,
1852 S_V_II(c_index,i)-1));
1853 erg += freeall(c);
1854 ENDR("twoword_matrix");
1855 }
1856
knuth_twoword(a,b,cc,dd)1857 INT knuth_twoword(a,b,cc,dd) OP a,b,cc,dd;
1858 /* b wird fuer das q symbol verwendet = zeilennummern der 0 -1 matrix */
1859 /* dd wird q -symbol */
1860
1861 {
1862 INT i;
1863 INT erg = OK;
1864 OP c,d;
1865 CTTO(INTEGERVECTOR,VECTOR,"knuth_twoword(1)",a);
1866 CTTO(INTEGERVECTOR,VECTOR,"knuth_twoword(2)",b);
1867
1868 c = callocobject();
1869 d = callocobject();
1870 erg += conjugate(cc,c);
1871 erg += copy(dd,d);
1872 erg += weight(cc,a);
1873 erg += m_il_w(S_I_I(a),b);
1874 erg += m_il_w(S_I_I(a),a);
1875 for (i=S_V_LI(a)-1;i>=0;i--)
1876 erg += knuth_row_delete_step(S_V_I(a,i),S_V_I(b,i),c,d);
1877 erg += freeall(d);
1878 erg += freeall(c);
1879 ENDR("knuth_twoword");
1880 }
1881
schen_word(a,bb,cb)1882 INT schen_word(a,bb,cb) OP a,bb,cb;
1883 /* input are the two tableaux
1884 bb and cc
1885 a becomes the result a word */
1886 {
1887 INT i;
1888 INT erg = OK;
1889 OP c,b;
1890 CTO(TABLEAUX,"schen_word(2)",bb);
1891 CTO(TABLEAUX,"schen_word(3)",cb);
1892 c = callocobject();
1893 b = callocobject();
1894 erg += copy(bb,b);
1895 erg += copy(cb,c);
1896 erg += weight(b,a);
1897 erg += m_il_w(S_I_I(a),a);
1898 for (i=S_V_LI(a)-1;i>=0;i--)
1899 {
1900 erg += schensted_row_delete_step(S_V_I(a,i),b,c);
1901 }
1902 erg += freeall(b);
1903 erg += freeall(c);
1904 CTO(WORD,"schen_word(e1)",a);
1905 ENDR("schen_word");
1906 }
1907
knuth_row_insert_step(rein,qrein,P,Q)1908 INT knuth_row_insert_step(rein,qrein,P,Q) OP qrein,rein,P,Q;
1909 /* for 01 matrices */
1910 {
1911 INT erg = OK,i,j,k;
1912 OP c,z;
1913 CTTO(EMPTY,TABLEAUX,"knuth_row_insert_step(3)",P);
1914 c = callocobject();
1915 if (emptyp(P)) /* anfang */
1916 {
1917 m_ilih_m(10L,10L,c);
1918 if (Q != NULL)
1919 {
1920 copy(qrein,S_M_IJ(c,0,0));
1921 m_matrix_tableaux(c,Q);
1922 }
1923 copy(rein,S_M_IJ(c,0,0));
1924 b_matrix_tableaux(c,P);
1925 goto sk;
1926 }
1927 z = callocobject();
1928 i=0;copy(rein,z);
1929 aa:
1930 k = ZEILENENDE(P,i);
1931 for (j=0;j<=k;j++)
1932 if (le(z,S_T_IJ(P,i,j))) break;
1933 if (j <= k) /* d.h. im tableau */
1934 {
1935 if (
1936 (S_O_K(S_T_IJ(P,i,j)) == INTEGER) &&
1937 (S_O_K(z) == INTEGER)
1938 ) {
1939 M_I_I(S_T_IJI(P,i,j),c);
1940 M_I_I(S_I_I(z),S_T_IJ(P,i,j));
1941 M_I_I(S_I_I(c),z);
1942 }
1943 else {
1944 copy(S_T_IJ(P,i,j),c);
1945 copy(z,S_T_IJ(P,i,j));
1946 copy(c,z);
1947 }
1948 i++;
1949 if (i == S_T_ULI(P))
1950 {
1951 /* neue zeile */
1952 j=0;
1953 goto kk;
1954 }
1955 else goto aa;
1956 }
1957 else /* anhaengen */
1958 {
1959 kk:
1960 freeself(c);
1961 swap(S_T_S(P),c);
1962 if ((i >= S_M_HI(c)) || (j>= S_M_LI(c)) )
1963 {
1964 inc(c);
1965 }
1966 if (i < S_T_ULI(P))
1967 {
1968 if (S_O_K(z) == INTEGER)
1969 M_I_I(S_I_I(z),S_M_IJ(c,i,j));
1970 else
1971 copy(z,S_M_IJ(c,i,j));
1972 INC_INTEGER(S_T_UI(P,S_T_ULI(P)-1-i));
1973 swap(S_T_S(P),c);
1974 freeall(c); /* AK 130297 */
1975 }
1976 else {
1977 copy(z,S_M_IJ(c,i,j));
1978 b_matrix_tableaux(c,P);
1979 }
1980 if (Q == NULL)
1981 {
1982 freeall(z);
1983 goto sk; /* nicht freigeben */
1984 }
1985
1986 freeself(z);
1987 swap(S_T_S(Q),z);
1988 if ((i >= S_M_HI(z)) || (j>= S_M_LI(z)) )
1989 {
1990 inc(z);
1991 }
1992 if (i < S_T_ULI(Q))
1993 {
1994 copy(qrein,S_M_IJ(z,i,j));
1995 INC_INTEGER(S_T_UI(Q,S_T_ULI(Q)-1-i));
1996 swap(S_T_S(Q),z);
1997 freeall(z);
1998 }
1999 else {
2000 copy(qrein,S_M_IJ(z,i,j));
2001 b_matrix_tableaux(z,Q);
2002 }
2003 goto sk;
2004 }
2005 sk:
2006 ENDR("knuth_row_insert_step");
2007 }
2008
schensted_row_insert_step(rein,P,Q)2009 INT schensted_row_insert_step(rein,P,Q) OP rein,P,Q;
2010 {
2011 INT erg = OK,i,j,k;
2012 OP c,z;
2013 CTTO(EMPTY,TABLEAUX,"schensted_row_insert_step(2)",P);
2014 c = callocobject();
2015 if (emptyp(P)) /* anfang */
2016 {
2017 m_ilih_m(10L,10L,c);
2018 if (Q != NULL)
2019 {
2020 m_i_i(1L,S_M_IJ(c,0,0));
2021 m_matrix_tableaux(c,Q);
2022 }
2023 copy(rein,S_M_IJ(c,0,0));
2024 b_matrix_tableaux(c,P);
2025 goto sk;
2026 }
2027 z = callocobject();
2028 i=0;copy(rein,z);
2029 aa:
2030 k = ZEILENENDE(P,i);
2031 for (j=0;j<=k;j++)
2032 if (lt(z,S_T_IJ(P,i,j))) break;
2033 if (j <= k) /* d.h. im tableau */
2034 {
2035 if (
2036 (S_O_K(S_T_IJ(P,i,j)) == INTEGER) &&
2037 (S_O_K(z) == INTEGER)
2038 ) {
2039 M_I_I(S_T_IJI(P,i,j),c);
2040 M_I_I(S_I_I(z),S_T_IJ(P,i,j));
2041 M_I_I(S_I_I(c),z);
2042 }
2043 else {
2044 copy(S_T_IJ(P,i,j),c);
2045 copy(z,S_T_IJ(P,i,j));
2046 copy(c,z);
2047 }
2048 i++;
2049 if (i == S_T_ULI(P))
2050 {
2051 /* neue zeile */
2052 j=0;
2053 goto kk;
2054 }
2055 else goto aa;
2056 }
2057 else /* anhaengen */
2058 {
2059 kk:
2060 freeself(c);
2061 swap(S_T_S(P),c);
2062 if ((i >= S_M_HI(c)) || (j>= S_M_LI(c)) )
2063 {
2064 inc(c);
2065 }
2066 if (i < S_T_ULI(P))
2067 {
2068 if (S_O_K(z) == INTEGER)
2069 M_I_I(S_I_I(z),S_M_IJ(c,i,j));
2070 else
2071 copy(z,S_M_IJ(c,i,j));
2072 INC_INTEGER(S_T_UI(P,S_T_ULI(P)-1-i));
2073 swap(S_T_S(P),c);
2074 freeall(c); /* AK 130297 */
2075 }
2076 else {
2077 copy(z,S_M_IJ(c,i,j));
2078 b_matrix_tableaux(c,P);
2079 }
2080 if (Q == NULL)
2081 {
2082 freeall(z);
2083 goto sk; /* nicht freigeben */
2084 }
2085 weight(Q,z); k = S_I_I(z); /* gewicht */
2086 freeself(z);
2087 swap(S_T_S(Q),z);
2088 if ((i >= S_M_HI(z)) || (j>= S_M_LI(z)) )
2089 {
2090 inc(z);
2091 }
2092 if (i < S_T_ULI(Q))
2093 {
2094 M_I_I(k+1,S_M_IJ(z,i,j));
2095 INC_INTEGER(S_T_UI(Q,S_T_ULI(Q)-1-i));
2096 swap(S_T_S(Q),z);
2097 freeall(z);
2098 }
2099 else {
2100 m_i_i(k+1,S_M_IJ(z,i,j));
2101 b_matrix_tableaux(z,Q);
2102 }
2103 goto sk;
2104 }
2105 sk:
2106 ENDR("schensted_row_insert_step");
2107 }
2108
2109
knuth_row_delete_step(raus,qraus,P,Q)2110 INT knuth_row_delete_step(raus,qraus,P,Q) OP raus,qraus,P,Q;
2111 {
2112 INT i,j,l,k,erg = OK;
2113 OP c;
2114 CTO(TABLEAUX,"knuth_row_delete_step(3)",P);
2115 CTO(TABLEAUX,"knuth_row_delete_step(4)",Q);
2116 if (S_T_ULI(P) == 1)
2117 {
2118 i = ZEILENENDE(P,0);
2119 erg += copy_integer(S_T_IJ(P,0L,i),raus);
2120 erg += copy_integer(S_T_IJ(Q,0L,i),qraus);
2121 if (i==0) {
2122 erg += freeself(P);
2123 erg += freeself(Q);
2124 goto sre;
2125 }
2126 erg += dec_integer(S_T_UI(P,0));
2127 erg += dec_integer(S_T_UI(Q,0));
2128 erg += freeself_integer(S_T_IJ(P,0L,i));
2129 erg += freeself_integer(S_T_IJ(Q,0L,i));
2130 goto sre;
2131 }
2132 /* richtiges tableau */
2133 c = callocobject();
2134 max(Q,c);
2135 copy(c,qraus);
2136 /* jetzt suchen wo das max in Q vorkommt, davon aber dann den groessten wert in P*/
2137 find_knuth_tab_entry(P,Q,c,&i,&j);
2138 if (i == -1)
2139 error("internal error:");
2140 copy(S_T_IJ(P,i,j),c);
2141 freeself(S_T_IJ(P,i,j));
2142 freeself(S_T_IJ(Q,i,j));
2143 for (l=i-1;l>=0;l--)
2144 {
2145 i = ZEILENENDE(P,l);
2146 for (k=0;k<= i;k++)
2147 if (gt(S_T_IJ(P,l,k),c)) {
2148 break;
2149 }
2150 else if (eq(S_T_IJ(P,l,k),c)) {
2151 k++;
2152 break;
2153 }
2154 k--;
2155 /* nun an k setzen */
2156 swap(S_T_IJ(P,l,k),c);
2157 }
2158 copy(c,raus);
2159 copy(S_T_S(P),c);
2160 m_matrix_tableaux(c,P);
2161 copy(S_T_S(Q),c);
2162 b_matrix_tableaux(c,Q);
2163 sre:
2164 ENDR("knuth_row_delete_step");
2165 }
2166
schensted_row_delete_step(raus,P,Q)2167 INT schensted_row_delete_step(raus,P,Q) OP raus,P,Q;
2168 {
2169 INT i,j,l,k,erg = OK;
2170 OP c;
2171 CTO(TABLEAUX,"schensted_row_delete_step(2)",P);
2172 CTO(TABLEAUX,"schensted_row_delete_step(3)",Q);
2173 if (S_T_ULI(P) == 1)
2174 {
2175 i = ZEILENENDE(P,0);
2176 erg += copy(S_T_IJ(P,0L,i),raus);
2177 if (i==0) {
2178 erg += freeself(P);
2179 erg += freeself(Q);
2180 goto sre;
2181 }
2182 erg += dec(S_T_UI(P,0));
2183 erg += dec(S_T_UI(Q,0));
2184 erg += freeself(S_T_IJ(P,0L,i));
2185 erg += freeself(S_T_IJ(Q,0L,i));
2186 goto sre;
2187 }
2188 /* richtiges tableau */
2189 c = callocobject();
2190 weight(Q,c);
2191 find_tab_entry(Q,c,&i,&j);
2192 if (i == -1) error("internal error:");
2193 copy(S_T_IJ(P,i,j),c);
2194 freeself(S_T_IJ(P,i,j));
2195 freeself(S_T_IJ(Q,i,j));
2196 for (l=i-1;l>=0;l--)
2197 {
2198 i = ZEILENENDE(P,l);
2199 for (k=0;k<= i;k++)
2200 if (ge(S_T_IJ(P,l,k),c)) break;
2201 k--;
2202 /* nun an k setzen */
2203 swap(S_T_IJ(P,l,k),c);
2204 }
2205 copy(c,raus);
2206 copy(S_T_S(P),c);
2207 m_matrix_tableaux(c,P);
2208 copy(S_T_S(Q),c);
2209 b_matrix_tableaux(c,Q);
2210 sre:
2211 ENDR("schensted_row_delete_step");
2212 }
2213
2214
2215
all_plactic_word(w,c)2216 INT all_plactic_word(w,c) OP w,c;
2217 /* AK 211195 */
2218 /* enter a word return all plactic equivalent words */
2219 /* using Schensted */
2220 /* AK 240398 V2.0 */
2221 {
2222 OP a,b,d;
2223 INT i, erg = OK;
2224 CTO(WORD,"all_plactic_word(1)",w);
2225 a = callocobject();
2226 b = callocobject();
2227 d = callocobject();
2228 erg += word_schen(w,a,b);
2229 erg += last_partition(S_V_L(w),b);
2230 erg += kostka_tab(S_T_U(a),b,d);
2231 erg += t_LIST_VECTOR(d,b);
2232 erg += m_il_v(S_V_LI(b),c);
2233 for (i=0;i<S_V_LI(b);i++)
2234 erg += schen_word(S_V_I(c,i),a,S_V_I(b,i));
2235 FREEALL3(a,b,d);
2236 ENDR("all_plactic_word");
2237 }
2238
inverse_nilplactic_jeudetaquin_tableaux(a,si,sj,b)2239 INT inverse_nilplactic_jeudetaquin_tableaux(a,si,sj,b) OP a,b;INT si,sj;
2240 /* AK 120790 V1.1 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
2241 {
2242 OP self,umriss;
2243 INT posi,posj; /* aktuelle position des jokers */
2244 OP unten, links;
2245 if (not EMPTYP(b) ) freeself(b);
2246 if (sj != ZEILENENDE(a,si)+1L)
2247 return error("INV_NILJDT: illegel index");
2248 if (S_O_K(S_T_U(a)) == PARTITION)
2249 if (si > S_T_ULI(a))
2250 return error("INV_NILJDT: illegel index");
2251 if (S_O_K(S_T_U(a)) == SKEWPARTITION)
2252 if (si > S_T_UGLI(a))
2253 return error("INV_NILJDT: illegel index");
2254 self = callocobject();
2255 copy(S_T_S(a),self);
2256 if (sj == S_M_LI(self)) inc(self);
2257 if (si == S_M_HI(self)) inc(self);
2258 posi = si; posj = sj;
2259 m120790again:
2260 unten = NULL; links = NULL;
2261 if (posj > 0L) {
2262 links = S_M_IJ(self, posi, posj-1L);
2263 if (EMPTYP(links)) links = NULL;}
2264 if (posi > 0L) {
2265 unten = S_M_IJ(self, posi-1L, posj);
2266 if (EMPTYP(unten)) unten = NULL;}
2267
2268 if ((links == NULL) && (unten == NULL))
2269 {
2270 /* Abbruchbedingung */
2271 C_O_K(S_M_IJ(self,posi,posj),EMPTY);
2272 umriss = callocobject();
2273 m_matrix_umriss(self,umriss);
2274 return b_us_t(umriss,self,b);
2275 }
2276
2277 if (links == NULL)
2278 { M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
2279 posi--; goto m120790again; }
2280 if (unten == NULL)
2281 { M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
2282 posj--; goto m120790again; }
2283 if (S_I_I(unten) == S_I_I(links))
2284 {
2285 if ( not emptyp(S_M_IJ(self,posi-1L,posj-1L)))
2286 if ( S_M_IJI(self,posi-1L,posj-1L) == S_I_I(links)-1L )
2287 {
2288 /* jetzt anwenden der nilplactic relationen */
2289 INT i;
2290 M_I_I(S_M_IJI(self,posi,posj-1L),
2291 S_M_IJ(self,posi,posj));
2292 for (i=1L; i <= posi ; i++)
2293 {
2294 if (
2295 (S_M_IJI(self,posi-i,posj-1L)
2296 != S_I_I(links)-i) ||
2297 (S_M_IJI(self,posi-i,posj)
2298 != S_I_I(links)-i+1L)
2299 ) break;
2300 M_I_I(S_M_IJI(self,posi-i,posj-1L),
2301 S_M_IJ(self,posi-i,posj));
2302 }
2303 posj--;
2304 goto m120790again;
2305 }
2306 }
2307 if (S_I_I(unten) >= S_I_I(links))
2308 { M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
2309 posi--; goto m120790again; }
2310 else
2311 { M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
2312 posj--; goto m120790again; }
2313
2314 }
2315
2316
inverse_jeudetaquin_tableaux(a,si,sj,b)2317 INT inverse_jeudetaquin_tableaux(a,si,sj,b) OP a,b;INT si,sj;
2318 /* AK 100790 V1.1 */ /* AK 200891 V1.3 */
2319 {
2320 OP self,umriss;
2321 INT posi,posj; /* aktuelle position des jokers */
2322 OP unten, links;
2323 if (not EMPTYP(b) ) freeself(b);
2324 if (sj != ZEILENENDE(a,si)+1L)
2325 return error("inverse_jeudetaquin_tableaux: illegel index");
2326 self = callocobject();
2327 copy(S_T_S(a),self);
2328 if (sj == S_M_LI(self)) inc(self);
2329 if (si == S_M_HI(self)) inc(self);
2330 posi = si; posj = sj;
2331 m100790again:
2332 unten = NULL; links = NULL;
2333 if (posj > 0L) {
2334 links = S_M_IJ(self, posi, posj-1L);
2335 if (EMPTYP(links)) links = NULL;}
2336 if (posi > 0L) {
2337 unten = S_M_IJ(self, posi-1L, posj);
2338 if (EMPTYP(unten)) unten = NULL;}
2339
2340 if ((links == NULL) && (unten == NULL))
2341 {
2342 /* Abbruchbedingung */
2343 C_O_K(S_M_IJ(self,posi,posj),EMPTY);
2344 umriss = callocobject();
2345 m_matrix_umriss(self,umriss);
2346 b_us_t(umriss,self,b); return(OK);
2347 }
2348 if (links == NULL)
2349 { M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
2350 posi--; goto m100790again; }
2351 if (unten == NULL)
2352 { M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
2353 posj--; goto m100790again; }
2354 if (S_I_I(unten) >= S_I_I(links))
2355 { M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
2356 posi--; goto m100790again; }
2357 else
2358 { M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
2359 posj--; goto m100790again; }
2360
2361 }
2362
jeudetaquin_tableaux(a,b)2363 INT jeudetaquin_tableaux(a,b) OP a,b;
2364 /* AK 080688 */
2365 /* Jeu de Taquin auf a wird b . a ist schieftableau und wird ein tableau b */
2366 /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
2367 {
2368 OP self,umriss,unten,rechts;
2369 INT i,j;
2370 INT posi,posj; /* aktuelle position des jokers */
2371 INT nexti,nextj; /* naechste position des jokers */
2372 INT si= -1,sj= -1; /* start of joker */
2373
2374 if (S_O_K(S_T_U(a)) == PARTITION) return copy(a,b);
2375
2376 self = callocobject();
2377 copy (S_T_S(a),self);
2378 m0806883: /* ein neues spiel */
2379 i = 0L;
2380 for (j=0L;j<S_M_LI(self);j++)
2381 if (not EMPTYP(S_M_IJ(self,i,j)))
2382 {
2383 if (j == 0L) goto m080688stop1; /* ende */
2384 /* man hat ein tableaux */
2385
2386
2387 /* spalte mit eintrag */
2388 j = j - 1L;
2389 for (i=0L;i<S_M_HI(self);i++)
2390 if (not EMPTYP(S_M_IJ(self,i,j)))
2391 { si=i-1L;sj=j;goto m0806881;}
2392 };
2393 m0806881: /* si,sj die position des jokers */
2394 posi = si; posj = sj;
2395 m0806882: /* next step */
2396 /* nach richtung kleineres element, bei gleich nach unten */
2397 unten = NULL; rechts = NULL;
2398 if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
2399 {
2400 unten = S_M_IJ(self,posi+1L,posj);
2401 if (EMPTYP(unten)) unten = NULL;
2402 };
2403 if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
2404 {
2405 rechts = S_M_IJ(self,posi,posj+1L);
2406 if (EMPTYP(rechts)) rechts = NULL;
2407 };
2408 if ( (unten == NULL) && (rechts == NULL) )
2409 /* ende ein neues spiel */ goto m0806883;
2410 if ( (unten == NULL)) /* nach rechts */
2411 { nexti = posi; nextj=posj+1L; }
2412 else if ( (rechts == NULL)) /* nach unten */
2413 { nexti = posi+1L; nextj=posj; }
2414 else /* in beide richtungen ist noch ein eintrag */
2415 {
2416 if (lt(rechts,unten))
2417 { nexti = posi; nextj=posj+1L; }
2418 else { nexti = posi+1L; nextj=posj; };
2419 };
2420
2421 copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
2422 freeself(S_M_IJ(self,nexti,nextj));
2423 posi=nexti; posj=nextj;
2424 goto m0806882; /* noch eine runde */
2425 m080688stop1: /* wir sind fertig,aus der matrix wird ein tableau */
2426 umriss = callocobject();
2427 m_matrix_umriss(self,umriss);
2428 b_us_t(umriss,self,b);
2429 return(OK);
2430 }
2431
next_lex_tableaux(a,b)2432 INT next_lex_tableaux(a,b) OP a,b;
2433 /* computes the next row equivalent tableau */
2434 /* input tableau of partition shape
2435 output lexicographic next row equivalent tableau
2436 i.e. in general a non standard tableau
2437 return TRUE if there is a next tableau
2438 FALSE else
2439 */
2440 /* AK 060802 */
2441 {
2442 INT erg = OK;
2443 CTO(TABLEAUX,"next_lex_tableaux(1)",a);
2444 CTO(PARTITION,"next_lex_tableaux(1-shape)",S_T_U(a));
2445 {
2446 INT i,res,j;
2447 OP v;
2448 v = CALLOCOBJECT();
2449 m_il_v(S_T_HI(a),v);
2450 for (i=0;i<S_V_LI(v);i++) select_row(a,i,S_V_I(v,i));
2451 for (i=S_V_LI(v)-1;i>=0;i--)
2452 {
2453 res = next_lex_vector(S_V_I(v,i),S_V_I(v,i));
2454 if (res != FALSE) break;
2455 }
2456 if (i==-1) res = FALSE; else res=TRUE;
2457 if (res ==TRUE)
2458 {
2459 for (i++;i<S_V_LI(v);i++)
2460 erg += qsort_vector(S_V_I(v,i));
2461 }
2462
2463 if (a !=b) erg += copy(a,b);
2464 for (i=0;i<S_V_LI(v);i++)
2465 for (j=0;j<S_V_LI(S_V_I(v,i)); j++)
2466 M_I_I(S_V_II(S_V_I(v,i),j), S_T_IJ(b,i,j));
2467 FREEALL(v);
2468 return res;
2469 }
2470 ENDR("next_lex_tableaux");
2471 }
2472
first_lex_tableaux(a,b)2473 INT first_lex_tableaux(a,b) OP a,b;
2474 /* computes the first row equivalent tableau */
2475 /* input tableau of partition shape
2476 output lexicographic first row equivalent tableau
2477 i.e. ordering in the rows
2478 */
2479 /* AK 060802 */
2480 {
2481 INT erg = OK;
2482 CTO(TABLEAUX,"first_lex_tableaux(1)",a);
2483 CTO(PARTITION,"first_lex_tableaux(1-shape)",S_T_U(a));
2484 {
2485 INT i,res,j;
2486 OP v;
2487 v = CALLOCOBJECT();
2488 m_il_v(S_T_HI(a),v);
2489 for (i=0;i<S_V_LI(v);i++) select_row(a,i,S_V_I(v,i));
2490 for (i=S_V_LI(v)-1;i>=0;i--)
2491 erg+= qsort_vector(S_V_I(v,i));
2492
2493 if (a !=b) erg += copy(a,b);
2494 for (i=0;i<S_V_LI(v);i++)
2495 for (j=0;j<S_V_LI(S_V_I(v,i)); j++)
2496 M_I_I(S_V_II(S_V_I(v,i),j), S_T_IJ(b,i,j));
2497 FREEALL(v);
2498 }
2499 ENDR("first_lex_tableaux");
2500 }
2501 #endif /* TABLEAUXTRUE */
2502
2503