1
2 /* SYMMETRICA sb.c */
3 #include "def.h"
4 #include "macro.h"
5
6 #ifdef SCHUBERTTRUE
7 static INT algorithmus2();
8 static INT algorithmus3();
9 static INT algorithmus4();
10 static INT algorithmus5();
11 static INT algorithmus6();
12 static INT pol_sch_alg01();
13 static INT co_L9();
14 #endif /* SCHUBERTTRUE */
15
16 #ifdef SCHUBERTTRUE
17
cast_apply_schubert(a)18 INT cast_apply_schubert(a) OP a;
19 /* tries to transform the object a into a SCHUBERT object */
20 /* AK 170207 V3.0 */
21 {
22 INT erg = OK;
23 COP("cast_apply_schubert(1)",a);
24 switch (S_O_K(a)) {
25 case BRUCH:
26 case LONGINT:
27 case INTEGER:
28 erg += m_scalar_schubert(a,a);
29 break;
30 default:
31 erg += WTO("cast_apply_schubert",a);
32 break;
33 }
34 ENDR("cast_apply_schubert");
35 }
36
m_scalar_schubert(a,b)37 INT m_scalar_schubert(a,b) OP a,b;
38 /* AK 141099 */
39 /* input scalar = INTGEER, BRUCH, LONGINT,... the type is not checked */
40 /* output schubert polynomial labeled by identy perm */
41 {
42 INT erg = OK;
43 CE2(a,b,m_scalar_schubert);
44 erg += b_skn_sch(callocobject(),callocobject(),NULL,b);
45 erg += first_permutation(cons_zwei,S_SCH_S(b));
46 COPY(a,S_SCH_K(b));
47 ENDR("m_scalar_schubert");
48 }
49
maxdegree_schubert(a,b)50 INT maxdegree_schubert(a,b) OP a,b;
51 /* AK 231194 */
52 /* AK 190598 V2.0 */
53 /* b: maximal degree of the permutations
54 labelling the schubert polynomials (INTEGER object) */
55 {
56 OP z;
57 INT erg = OK;
58 CTO(SCHUBERT,"maxdegree_schubert",a);
59 CE2(a,b,maxdegree_schubert);
60 erg += m_i_i((INT)0,b);
61 z = a;
62 while((z != NULL)&&(S_SCH_S(z) != NULL))
63 {
64 if (S_SCH_SLI(z) > S_I_I(b))
65 M_I_I(S_SCH_SLI(z),b);
66 z = S_SCH_N(z);
67 }
68 ENDR("maxdegree_schubert");
69 }
70
einsp_schubert(a)71 INT einsp_schubert(a) OP a;
72 /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
73 {
74 if (einsp(S_SCH_S(a)))
75 if (einsp(S_SCH_K(a)))
76 if (S_SCH_N(a) == NULL) return TRUE;
77 return FALSE;
78 }
79 #endif /* SCHUBERTTRUE */
80
81
schubertp(a)82 INT schubertp(a) OP a;
83 /* AK 200891 V1.3 */
84 {
85 if (s_o_k(a) == SCHUBERT) return TRUE;
86 else return FALSE;
87 }
88
89 #ifdef SCHUBERTTRUE
m_lehmer_schubert_qpolynom(a,b)90 INT m_lehmer_schubert_qpolynom(a,b) OP a,b;
91 /* AK 131097 */
92 {
93 INT erg = OK; /* AK 191191 */
94 OP p;
95 CTTO(INTEGERVECTOR,VECTOR,"m_lehmer_schubert_qpolynom(1)",a);
96
97 p = CALLOCOBJECT();
98 erg += lehmercode(a,p);
99 erg += m_perm_schubert_qpolynom(p,b);
100 FREEALL(p);
101 ENDR("m_lehmer_schubert_qpolynom");
102 }
103
m_lehmer_schubert_monom_summe(a,b)104 INT m_lehmer_schubert_monom_summe(a,b) OP a,b;
105 /* AK 061288 */ /* AK 240789 V1.0 */ /* AK 190690 V1.1 */ /* AK 090891 V1.3 */
106 /* AK 190598 V2.0 */
107 /* a and b may be equal */
108 {
109 INT erg = OK; /* AK 191191 */
110 OP p;
111 CTTO(VECTOR,INTEGERVECTOR,"m_lehmer_schubert_monom_summe(1)",a);
112
113 p = callocobject();
114 erg += lehmercode(a,p);
115 erg += m_perm_schubert_monom_summe(p,b);
116 erg += freeall(p);
117 ENDR("m_lehmer_schubert_monom_summe");
118 }
119
120
121 #endif /* SCHUBERTTRUE */
122
m_perm_schubert_monom_summe(perm,res)123 INT m_perm_schubert_monom_summe(perm,res) OP perm,res;
124 /* Eingabe: PERMUTATION als label des Schubertpolynoms */
125 /* Ausgabe: POLYNOM */
126 /* 020588 */ /* AK 240789 V1.0 */ /* AK 120790 V1.1 */ /* AK 090891 V1.3 */
127 {
128 OP vorfaktor;
129 INT erg = ERROR;
130 /* das monom, mit dem das ergebnis einer einzelnen
131 rekursion multipliziert werden muss */
132 /* beim start = [0,0,0,0,....,0] */
133 #ifdef SCHUBERTTRUE
134 erg = OK;
135 CTO(PERMUTATION,"m_perm_schubert_monom_summe(1)",perm);
136 CE2(perm,res,m_perm_schubert_monom_summe);
137
138 if (einsp(perm)) /* AK 191191 */
139 {
140 erg += m_scalar_polynom(cons_eins,res);
141 goto endr_ende;
142 }
143
144 vorfaktor = CALLOCOBJECT();
145 erg += m_il_nv(S_P_LI(perm),vorfaktor);
146 C_O_K(vorfaktor,INTEGERVECTOR);
147 /* vorfaktor ist nun initialisiert */
148 erg += algorithmus2(vorfaktor,0L,S_P_LI(perm)-1L,perm,res);
149 /* die rekursion wird aufgerufen */
150 FREEALL(vorfaktor);
151 #endif /* SCHUBERTTRUE */
152 ENDR("m_perm_schubert_monom_summe");
153 }
154
155
156 #ifdef SCHUBERTTRUE
m_perm_schubert_qpolynom(perm,res)157 INT m_perm_schubert_qpolynom(perm,res) OP perm,res;
158 /* 020588 */ /* AK 240789 V1.0 */ /* AK 040190 V1.1 */ /* AK 090891 V1.3 */
159 {
160 INT erg = OK;
161 INT w,i;
162 OP c;
163 CTO(PERMUTATION,"m_perm_schubert_qpolynom(1)",perm);
164 c = callocobject();
165 erg += lehmercode(perm,c);
166 w = 0;
167 for (i=0;i<S_V_LI(c);i++)
168 w += S_V_II(c,i) * (i+1);
169 erg += m_il_nv( w , c);
170 if (w == (INT)0)
171 erg += m_skn_po(cons_null,cons_eins,NULL,res);
172 else
173 {
174 erg += algorithmus4(0L,0L,S_P_LI(perm)-1L,perm,c);
175 for (i=0;i<S_V_LI(c);i++)
176 if (gt(S_V_I(c,i) ,cons_null) )
177 {
178 erg += b_skn_po(callocobject(),callocobject(),NULL,res);
179 erg += copy(S_V_I(c,i) ,S_PO_K(res));
180 erg += m_il_v((INT)1, S_PO_S(res));
181 M_I_I(i,S_PO_SI(res,(INT)0));
182 i++;
183 break;
184 }
185 for (;i<S_V_LI(c)-1;i++)
186 if (gt(S_V_I(c,i) ,cons_null) )
187 {
188 C_L_N(res,callocobject());
189 erg += b_skn_po(callocobject(),callocobject(),NULL,S_L_N(res));
190 res = S_L_N(res);
191 erg += copy(S_V_I(c,i) ,S_PO_K(res));
192 erg += m_il_v((INT)1, S_PO_S(res));
193 M_I_I(i,S_PO_SI(res,(INT)0));
194 }
195 if (i<S_V_LI(c))
196 if (gt(S_V_I(c,i) ,cons_null) )
197 {
198 C_L_N(res,callocobject());
199 erg += b_skn_po(callocobject(),callocobject(),NULL,S_L_N(res));
200 res = S_L_N(res);
201 erg += copy(S_V_I(c,i) ,S_PO_K(res));
202 erg += m_il_v((INT)1, S_PO_S(res));
203 M_I_I(i,S_PO_SI(res,(INT)0));
204 }
205 }
206
207 erg += freeall(c);
208 ENDR("m_perm_schubert_qpolynom");
209 }
210
211
212
m_perm_schubert_dimension(perm,res)213 INT m_perm_schubert_dimension(perm,res) OP perm,res;
214 /* 020588 */ /* AK 240789 V1.0 */ /* AK 120790 V1.1 */ /* AK 090891 V1.3 */
215 /* AK 260198 V2.0 */
216 /*
217 input: labeling permutation
218 output: number of terms = evaluation a_i = 1
219 */
220 {
221 INT erg = OK;
222 CTO(PERMUTATION,"m_perm_schubert_dimension(1)",perm);
223 CE2(perm,res,m_perm_schubert_dimension);
224 M_I_I(0,res);
225 erg += algorithmus3(0,perm,res);
226 ENDR("m_perm_schubert_dimension");
227 }
228
229
230
231
t_POLYNOM_SCHUBERT(pol,sch)232 INT t_POLYNOM_SCHUBERT(pol,sch) OP pol,sch;
233 /* AK 240789 V1.0 */ /* AK 131290 V1.1 */
234 /* AK 150291 V1.2 */ /* AK 090891 V1.3 */
235 /* AK 260198 V2.0 */
236 /* input: polynom
237 output: same in the base of schubert polynomials
238 */
239 {
240 OP p; /* wird copie des polynoms */
241 INT erg = OK;
242 if (S_O_K(pol) == MONOM) /* AK 240999 */
243 {
244 p = callocobject();
245 erg += m_sn_l(pol,NULL,p);
246 C_O_K(p,POLYNOM);
247 erg += freeself(sch);
248 goto nn;
249 }
250 CTO(POLYNOM,"t_POLYNOM_SCHUBERT",pol);
251 CE2(pol,sch,t_POLYNOM_SCHUBERT);
252 if (EMPTYP(pol))
253 goto endr_ende;
254 if (nullp(pol))
255 {
256 erg += m_scalar_schubert(cons_null,sch);
257 goto endr_ende;
258 }
259
260 p = callocobject();
261 erg += copy_polynom(pol,p);
262 nn:
263 erg += pol_sch_alg01(p,sch);
264 erg += freeall(p);
265 ENDR("t_POLYNOM_SCHUBERT");
266 }
267
268
269
pol_sch_alg01(p,s)270 static INT pol_sch_alg01 (p,s) OP p,s;
271 /* AK 240789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
272 {
273 OP l,res,schub;
274 INT i,j;
275 INT erg = OK;
276
277 pol_sch_alg01l2:
278 CTO( POLYNOM,"pol_sch_alg01",p);
279 l = callocobject();
280 res = callocobject();
281 schub = callocobject();
282
283 copy(S_PO_S(p),l);
284 if (
285 (S_O_K(l) != VECTOR) && (S_O_K(l) != INTEGERVECTOR)
286 )
287 {
288 debugprint(l);
289 erg += error("pol_sch_alg01: not vectortype in p");
290 goto endr_ende;
291 }
292
293 pol_sch_alg01l1:
294 for (i=0L,j=S_V_LI(l)-1L;i<S_V_LI(l);i++,j--)
295 if(S_V_II(l,i) > j)
296 {
297 inc_vector(l);
298 M_I_I(0L,S_V_I(l,S_V_LI(l)-1L));
299 goto pol_sch_alg01l1;
300 }
301 /* nun ist l ein lehmercode */
302
303 erg += b_skn_sch(callocobject(),callocobject(),NULL,schub);
304 erg += copy(S_PO_K(p),S_SCH_K(schub));
305 erg += lehmercode(l,S_SCH_S(schub));
306
307
308
309 if (not EMPTYP(res))
310 erg += freeself(res);
311 erg += m_lehmer_schubert_monom_summe(l,res);
312 erg += mult_apply(S_PO_K(p),res);
313 erg += sub(p,res,p);
314 insert(schub,s,NULL,comp_monomvector_monomvector);
315 erg += freeall(res);
316 erg += freeall(l);
317 if (not EMPTYP(p))
318 if (not empty_listp(p)) goto pol_sch_alg01l2;
319 ENDR("internal:pol_sch_alg01");
320 }
321
322
algorithmus2(vorfaktor,alphabetindex,stufe,perm,res)323 static INT algorithmus2(vorfaktor,alphabetindex,stufe,perm,res)
324 OP vorfaktor; /* ist ein monom, d.h. vector */
325 /* bsp [0,1,0] == b^2 */
326 /* damit wird das ergebnis dieser rekursion
327 multipliziert und in res eingefuegt */
328 INT alphabetindex;
329 /* ist der start des alphabets a==0 */
330 /* d.h. wird nur noch im alphabet b,c,d, ..
331 gerechnet so ist dies =1 */
332 INT stufe; /* der exponent des Vorfaktors */
333 OP perm; /* die permutation zu der berechnet wird */
334 OP res; /* das globale ergebnis */
335 /* AK 020588 */ /* AK 081188 */ /* AK 240789 V1.0 */ /* AK 201189 V1.1 */
336 /* AK 090891 V1.3 */
337 {
338 INT i,erg=OK;
339 CTO(PERMUTATION,"algorithmus2(1)",perm);
340 CTTO(VECTOR,INTEGERVECTOR,"algorithmus2(2)",vorfaktor);
341 if (S_V_LI(vorfaktor) == 0L)
342 return error("algorithmus2:vorfaktor == 0");
343
344 if (S_P_LI(perm) == 2L)
345 /* ende des algorithmus */
346 {
347 OP monom = callocobject();
348 b_skn_po(callocobject(),callocobject(),NULL,monom);
349 M_I_I(1L,S_PO_K(monom));
350 copy(vorfaktor,S_PO_S(monom));
351 /* das monom ist nun fertig initialisiert */
352
353 if (S_P_II(perm,0L) == 2L)
354 INC(S_PO_SI(monom,alphabetindex));
355 /* der vorfaktor wird noch mit dem i-ten
356 buchstaben multipliziert falls perm = [2,1] */
357 insert(monom,res,add_koeff,comp_monomvector_monomvector);
358 /* einfuegen des ergebnis in das globale ergebnis */
359 return OK;
360 }
361
362
363 if (S_P_II(perm,0L) == S_P_LI(perm)) /* nun die rekursion */
364 {
365 OP neuperm = callocobject();
366 OP neufaktor = callocobject();
367
368 b_ks_p(VECTOR,callocobject(),neuperm);
369 m_il_v(S_P_LI(perm)-1L,S_P_S(neuperm));
370 for(i=0L;i<S_P_LI(neuperm);i++)
371 M_I_I(S_P_II(perm,i+1L),S_P_I(neuperm,i));
372 /* es wurde die permutation um das erste element
373 welches das groesste war gekuerzt, hier wurde
374 ausgenutzt
375 z.B X_634215 = a^6 X_34215(b,c,d,e,f)
376 diese multiplikation folgt nun
377 */
378
379 copy_integervector(vorfaktor,neufaktor);
380 M_I_I(stufe,S_V_I(neufaktor,alphabetindex));
381 algorithmus2( neufaktor,alphabetindex+1,
382 S_P_LI(neuperm)-1,neuperm,res);
383 FREEALL(neufaktor);
384 FREEALL(neuperm);
385 return OK;
386 }
387 else { /* falls keine rekursion im alphabet */
388 INT maximal = S_P_LI(perm)+1L;
389 OP neuperm = callocobject();
390 for (i=1L;i<S_P_LI(perm);i++)
391 if ( (S_P_II(perm,i) < maximal)&&
392 (S_P_II(perm,i) > S_P_II(perm,0L)))
393 {
394 copy(perm,neuperm);
395 maximal = S_P_II(perm,i);
396 M_I_I(S_P_II(perm,0L),S_P_I(neuperm,i));
397 M_I_I(S_P_II(perm,i),S_P_I(neuperm,0L));
398
399 algorithmus2(vorfaktor,alphabetindex,
400 stufe-1L,neuperm,res);
401 };
402 freeall(neuperm);
403 return OK;
404 }
405 ENDR("algorithmus2");
406 }
407
408
409
algorithmus4(exponent,alphabetindex,stufe,perm,result)410 static INT algorithmus4(exponent,alphabetindex,stufe,perm,result)
411 INT exponent; /* exponent zur q-specialisierung */
412 /* bsp [0,1,0] == b^2 */
413 INT alphabetindex; /* ist der startdes alphabets a==0 */
414 INT stufe; /* der exponent des Vorfaktors */
415 OP perm; /* die permutation zu der berechnet wird */
416 OP result;
417 /* AK 020588 */ /* AK 240789 V1.0 */
418 /* AK 170190 V1.1 */ /* aendern monom nicht mehr integer sondern vector */
419 /* AK 090891 V1.3 */
420 {
421 if (S_P_LI(perm) == 2L) /* ende des algorithmus */
422 {
423 if (S_P_II(perm,0L) == 2L)
424 inc(S_V_I(result,exponent+alphabetindex));
425 else
426 inc(S_V_I(result,exponent));
427 return OK;
428 }
429
430 if (S_P_II(perm,0L) == S_P_LI(perm)) /* nun die rekursion */
431 {
432 INT i;
433 DEC_INTEGER(S_P_L(perm));
434 for(i=0L;i<S_P_LI(perm);i++)
435 M_I_I(S_P_II(perm,i+1L),S_P_I(perm,i));
436 algorithmus4(exponent + stufe*alphabetindex ,alphabetindex+1L,
437 S_P_LI(perm)-1L,perm,result);
438 for(i=S_P_LI(perm);i>0;i--)
439 M_I_I(S_P_II(perm,i-1),S_P_I(perm,i));
440 INC_INTEGER(S_P_L(perm));
441 M_I_I(S_P_LI(perm),S_P_I(perm,(INT)0));
442 return OK;
443 }
444 else {
445 INT i;
446 INT maximal = S_P_LI(perm)+1L;
447 for (i=1L;i<S_P_LI(perm);i++)
448 if ( (S_P_II(perm,i) < maximal)&&
449 (S_P_II(perm,i) > S_P_II(perm,0L)))
450 {
451 /*
452 OP neuperm = callocobject();
453 copy_permutation(perm,neuperm);
454 maximal = S_P_II(perm,i);
455 M_I_I(S_P_II(perm,0L),S_P_I(neuperm,i));
456 M_I_I(S_P_II(perm,i),S_P_I(neuperm,0L));
457
458 algorithmus4(exponent,alphabetindex,
459 stufe-1L,neuperm,result);
460 freeall(neuperm);
461 */
462 maximal = S_P_II(perm,i);
463 M_I_I(S_P_II(perm,0L),S_P_I(perm,i));
464 M_I_I(maximal,S_P_I(perm,0L));
465 algorithmus4(exponent,alphabetindex,
466 stufe-1L,perm,result);
467 M_I_I(S_P_II(perm,i),S_P_I(perm,0L));
468 M_I_I(maximal,S_P_I(perm,i));
469 };
470 return(OK);
471 }
472 }
473
474
475
476
algorithmus3(alphabetindex,perm,result)477 static INT algorithmus3(alphabetindex,perm,result)
478 INT alphabetindex; /* ist der startdes alphabets a==0 */
479 OP perm; /* di epermutation zu der berechnet wird */
480 OP result;
481 /* AK 020588 */
482 /* AK 240789 V1.0 */ /* AK 191190 V1.1 */
483 /* AK 090891 V1.3 */
484 {
485 if (S_P_LI(perm) == 2L) /* ende des algorithmus */
486 return inc(result);
487
488 if (S_P_II(perm,0L) == S_P_LI(perm)) /* nun die rekursion */
489 {
490 OP neuperm = callocobject();
491 INT i;
492
493 b_ks_p(VECTOR,callocobject(),neuperm);
494 m_il_v(S_P_LI(perm)-1L,S_P_S(neuperm));
495 for(i=0L;i<S_P_LI(neuperm);i++)
496 M_I_I(S_P_II(perm,i+1L),S_P_I(neuperm,i));
497 algorithmus3(alphabetindex+1L,neuperm,result);
498 freeall(neuperm);
499 return(OK);
500 }
501 else {
502 INT i;
503 INT maximal = S_P_LI(perm)+1L;
504 for (i=1L;i<S_P_LI(perm);i++)
505 if ( (S_P_II(perm,i) < maximal)&&
506 (S_P_II(perm,i) > S_P_II(perm,0L)))
507 {
508 OP neuperm = callocobject();
509 copy(perm,neuperm);
510 maximal = S_P_II(perm,i);
511 M_I_I(S_P_II(perm,0L),S_P_I(neuperm,i));
512 M_I_I(S_P_II(perm,i),S_P_I(neuperm,0L));
513
514 algorithmus3(alphabetindex,neuperm,result);
515 freeall(neuperm);
516 };
517 return(OK);
518 }
519 }
520
521
522
523
524
525
526
all_ppoly(a,c,b)527 INT all_ppoly(a,c,b) OP a,b,c;
528 /* AK 201189 V1.1 */ /* AK 090891 V1.3 */
529 {
530 /* a is PARTITION, c is INTEGER-limit , b becomes result */
531
532 INT i,j,k;
533 OP w = callocobject();
534 for (i=0L;i<=S_I_I(c);i++)
535 {
536 OP d = callocobject();
537 OP e = callocobject(); /* becomes permutation with lehmercode d */
538 OP f = callocobject(); /* becomes q specialisation */
539 OP g = callocobject();
540 m_il_v(i+S_PA_LI(a)+s_pa_ii(a,S_PA_LI(a)-1L),d);
541 for (j=0L;j<i;j++) M_I_I(0L,S_V_I(d,j));
542 for (k=0L;k<S_PA_LI(a);k++,j++) copy(s_pa_i(a,k),S_V_I(d,j));
543
544 for (k=0L;k<s_pa_ii(a,S_PA_LI(a)-1L);k++,j++) M_I_I(0L,S_V_I(d,j));
545 println(d);
546 lehmercode(d,e);
547 println(e);
548 m_perm_schubert_qpolynom(e,f);
549 b_skn_po(callocobject(),f,NULL,g);
550 ;
551 m_il_v(1L,S_PO_S(g));
552 M_I_I(i,S_PO_SI(g,0L));
553 println(g);
554 add(g,b,b);
555 freeall(g);
556 freeall(e);
557 freeall(d);
558 }
559 weight(a,w);
560 println(b);
561 for (i=0L;i<=S_I_I(w);i++)
562 {
563 OP p = callocobject();
564 OP q = callocobject();
565 b_skn_po(callocobject(),callocobject(),NULL,p);
566 b_skn_po(callocobject(),callocobject(),NULL,S_PO_K(p));
567 M_I_I(1L,S_PO_K(S_PO_K(p)));
568 M_I_I(0L,S_PO_S(S_PO_K(p)));
569 m_il_v(1L,S_PO_S(p));
570 M_I_I(0L,S_PO_SI(p,0L));
571 println(p);
572 b_skn_po(callocobject(),callocobject(),NULL,q);
573 b_skn_po(callocobject(),callocobject(),NULL,S_PO_K(q));
574 M_I_I(-1L,S_PO_K(S_PO_K(q)));
575 M_I_I(i,S_PO_S(S_PO_K(q)));
576 m_il_v(1L,S_PO_S(q));
577 M_I_I(1L,S_PO_SI(q,0L));
578 println(q);
579 add(p,q,q);
580 println(q);
581 mult(q,b,b);
582 println(b);
583 }
584 return(OK);
585 }
586
587
588
589
tex_schubert(poly)590 INT tex_schubert(poly) OP poly;
591 /* AK 101187 */ /* AK 240789 V1.0 */ /* AK 191190 V1.1 */
592 /* AK 070291 V1.2 prints to texout */ /* AK 090891 V1.3 */
593 {
594 OP zeiger = poly;
595
596 fprintf(texout,"\\ ");
597 if (EMPTYP(poly)) return(OK);
598 while (zeiger != NULL)
599 {
600 if (not einsp (S_SCH_K(zeiger)))
601 /* der koeffizient wird nur geschrieben wenn er
602 ungleich 1 ist */
603 tex(S_SCH_K(zeiger));
604 fprintf(texout,"\\ $X_{ ");
605 fprint(texout,S_SCH_S(zeiger));
606 fprintf(texout," } $\\ ");
607 zeiger = S_SCH_N(zeiger);
608 if (zeiger != NULL)
609 if (not negp(S_SCH_K(zeiger))) /* AK 100892 */
610 {
611 fprintf(texout," $+$ ");
612 texposition += 5L;
613 }
614 texposition += 15L;
615 if (texposition >70L)
616 {
617 fprintf(texout,"\n");
618 texposition = 0L;
619 }
620 };
621 fprintf(texout,"\\ ");
622 texposition += 3L;
623 return(OK);
624 }
625
626
627
628
add_schubert_schubert(a,b,c)629 INT add_schubert_schubert(a,b,c) OP a,b,c;
630 /* AK 191190 V1.1 */ /* AK 090891 V1.3 */
631 {
632 INT erg;
633 OP d = callocobject();
634 if (not EMPTYP(c))
635 freeself(c);
636 copy_list(a,d);
637 copy_list(b,c);
638
639 erg = insert(d,c,add_koeff,comp_monomvector_monomvector);
640
641 return(erg);
642 }
643
add_schubert(a,b,c)644 INT add_schubert(a,b,c) OP a,b,c;
645 /* AK 080102 */
646 {
647 INT erg = OK;
648 CTO(SCHUBERT,"add_schubert(1)",a);
649 CTO(EMPTY,"add_schubert(3)",c);
650 switch (S_O_K(b))
651 {
652 case SCHUBERT: erg += add_schubert_schubert(a,b,c);
653 goto ende;
654 default:
655 WTO("add_schubert(2)",b);
656 goto ende;
657 }
658 ende:
659 ENDR("add_schubert");
660 }
661
662
663
664
665
m_skn_sch(self,koeff,n,ergebnis)666 INT m_skn_sch(self,koeff,n,ergebnis) OP self,koeff,n,ergebnis;
667 /* AK 110789 V1.0 */ /* AK 191190 V1.1 */ /* AK 090891 V1.3 */
668 {
669 INT erg = OK;
670 COP("m_skn_sch(4)",ergebnis);
671 erg += m_skn_po(self,koeff,n,ergebnis);
672 C_O_K(ergebnis,SCHUBERT);
673 ENDR("m_skn_sch");
674 }
675
676
677
678
b_skn_sch(self,koeff,n,ergebnis)679 INT b_skn_sch(self,koeff,n,ergebnis) OP self,koeff,n,ergebnis;
680 /* AK 110789 V1.0 */ /* AK 191190 V1.1 */ /* AK 090891 V1.3 */
681 {
682 if (ergebnis == NULL)
683 return(ERROR);
684 b_skn_po(self,koeff,n,ergebnis);
685 C_O_K(ergebnis,SCHUBERT);
686 return(OK);
687 }
688
689 #endif /* SCHUBERTTRUE */
690
691 #ifdef SCHUBERTTRUE
scan_schubert(ergebnis)692 INT scan_schubert(ergebnis) OP ergebnis;
693 /* AK 110789 V1.0 */ /* AK 191190 V1.1 */ /* AK 090891 V1.3 */
694 {
695 char antwort[2];
696 OBJECTKIND kind;
697 INT erg = OK;
698
699 CTO(EMPTY,"scan_schubert(1)",ergebnis);
700 erg += b_skn_sch( callocobject(), callocobject(),
701 callocobject(), ergebnis);
702 erg += printeingabe("input of Schubert-monom as permutation");
703 erg += scan(PERMUTATION,S_SCH_S(ergebnis));
704 erg += printeingabe("input kind of coeff");
705 kind = scanobjectkind();
706 erg += scan(kind,S_SCH_K(ergebnis));
707 erg += printeingabe("one more monom y/n");
708 scanf("%s",antwort);
709 if (antwort[0] == 'y')
710 erg += scan(SCHUBERT,S_SCH_N(ergebnis));
711 else {
712 C_O_K(S_SCH_N(ergebnis),EMPTY);
713 erg += freeall(S_SCH_N(ergebnis));
714 erg += c_sch_n(ergebnis,NULL);
715 }
716 ENDR("scan_schubert");
717 }
718
719
720
m_perm_sch(a,b)721 INT m_perm_sch(a,b) OP a,b;
722 /* AK 231194 */
723 {
724 INT erg = OK;
725 CTO(PERMUTATION,"m_perm_sch",a);
726 erg += b_skn_sch(callocobject(),callocobject(),NULL,b);
727 erg += copy(a,S_SCH_S(b));
728 M_I_I((INT)1,S_SCH_K(b));
729 ENDR("m_perm_sch");
730 }
731
s_sch_s(a)732 OP s_sch_s(a) OP a;
733 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
734 {
735 if (a == NULL) return error("s_sch_s:a == NULL"), (OP) NULL;
736 if (not schubertp(a)) return
737 error("s_sch_s:a != SCHUBERT"), (OP) NULL;
738 return(s_mo_s(s_l_s(a)));
739 }
740
s_sch_k(a)741 OP s_sch_k(a) OP a;
742 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
743 {
744 if (a == NULL) return error("s_sch_k:a == NULL"), (OP) NULL;
745 if (not schubertp(a)) return
746 error("s_sch_k:a != SCHUBERT"), (OP) NULL;
747 return(s_mo_k(s_l_s(a)));
748 }
749
s_sch_n(a)750 OP s_sch_n(a) OP a;
751 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
752 {
753 if (a == NULL) return error("s_sch_n:a == NULL"), (OP) NULL;
754 if (not schubertp(a)) return
755 error("s_sch_n:a != SCHUBERT"), (OP) NULL;
756 return(s_l_n(a));
757 }
758
s_sch_si(a,i)759 OP s_sch_si(a,i) OP a; INT i;
760 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
761 {
762 if (a == NULL) return error("s_sch_si:a == NULL"), (OP) NULL;
763 if (not schubertp(a)) return
764 error("s_sch_si:a != SCHUBERT"), (OP) NULL;
765 return s_p_i(s_sch_s(a),i);
766 }
767
s_sch_sl(a)768 OP s_sch_sl(a) OP a;
769 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
770 {
771 if (a == NULL) return error("s_sch_sl:a == NULL"), (OP) NULL;
772 if (not schubertp(a)) return
773 error("s_sch_sl:a != SCHUBERT"), (OP) NULL;
774 return s_p_l(s_sch_s(a));
775 }
776
s_sch_ki(a)777 INT s_sch_ki(a) OP a;
778 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
779 {
780 if (a == NULL) return error("s_sch_ki:a == NULL");
781 if (not schubertp(a)) return error("s_sch_ki:a != SCHUBERT");
782 return s_i_i(s_sch_k(a));
783 }
784
s_sch_sii(a,i)785 INT s_sch_sii(a,i) OP a; INT i;
786 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
787 {
788 if (a == NULL) return error("s_sch_sii:a == NULL");
789 if (not schubertp(a)) return error("s_sch_sii:a != SCHUBERT");
790 return s_p_ii(s_sch_s(a),i);
791 }
792
793
s_sch_sli(a)794 INT s_sch_sli(a) OP a;
795 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
796 {
797 if (a == NULL)
798 return error("s_sch_sli:a == NULL");
799 if (not schubertp(a))
800 return error("s_sch_sli:a != SCHUBERT");
801 return s_p_li(s_sch_s(a));
802 }
803
c_sch_n(a,b)804 INT c_sch_n(a,b) OP a,b;
805 /* AK 110789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
806 {
807 OBJECTSELF c;
808 if (a == NULL)
809 return error("c_sch_n:a == NULL");
810 c = s_o_s(a);
811 c.ob_list->l_next = b;
812 return OK;
813 }
814
815
816
817
display_schubert(a)818 INT display_schubert(a) OP a;
819 /* AK 240789 V1.0 */ /* AK 131290 V1.1 */ /* AK 090891 V1.3 */
820 {
821 return(println(a));
822 }
823
824
825
test_schubert()826 INT test_schubert()
827 /* AK 200891 V1.3 */
828 {
829 OP a = callocobject();
830 OP b = callocobject();
831
832 printf("test_schubert:scan(PERMUTATION)\n");
833 scan(PERMUTATION,a);
834 println(a);
835 printf("test_schubert:m_perm_schubert_monom_summe(a,b)\n");
836 m_perm_schubert_monom_summe(a,b);
837 println(b);
838 printf("test_schubert:scan(POLYNOM)\n");
839 scan(POLYNOM,a);
840 println(a);
841 printf("test_schubert:t_POLYNOM_SCHUBERT(a,b)\n");
842 t_POLYNOM_SCHUBERT(a,b);
843 println(b);
844 printf("test_schubert:tex(b)\n");
845 tex(b);
846 printf("test_schubert:scan(SCHUBERT,a)\n");
847 scan(SCHUBERT,a);
848 println(a);
849 printf("test_schubert:hoch(a,2L,b)\n");
850 hoch(a,cons_zwei,b);
851 println(b);
852 printf("test_schubert:einsp(b)\n");
853 if (not einsp(b))
854 printeingabe("not eins");
855 else
856 printeingabe("is eins");
857
858 freeall(a);
859 freeall(b);
860 return(OK);
861 }
862
863
864
865
print_schubert_difference(b,c)866 INT print_schubert_difference(b,c) OP b,c;
867 /* druckt in spezieller weise aus
868 b ist ein einzelnes Schubertpolynom, c ist eine summe von Schubertpolynomen
869 gedruckt werden nur die stellen die verschieden in den permutationen */
870 /* AK 200690 */
871 /* AK 200891 V1.3 */
872 {
873 OP x;
874 INT i;
875 x = c;
876 while ( x != NULL) {
877 print(S_SCH_K(b));
878 printf(" [");
879 for (i=0L;(i < S_SCH_SLI(x))&&
880 (i <S_SCH_SLI(b)) ; i++ )
881 {
882 if (S_SCH_SII(x,i)==S_SCH_SII(b,i)) printf(".,");
883 else printf("%ld,",S_SCH_SII(b,i));
884 zeilenposition += 2L;
885 }
886 printf("]\n");
887 print(S_SCH_K(x));
888 printf(" [");
889 for (i=0L;(i < S_SCH_SLI(x))&&
890 (i <S_SCH_SLI(b)) ; i++ )
891 {
892 if (S_SCH_SII(x,i)==S_SCH_SII(b,i)) printf(".,");
893 else printf("%ld,",S_SCH_SII(x,i));
894 zeilenposition = 0L;
895 }
896 printf("]\n\n");
897 x = S_SCH_N(x);
898 }
899 return OK;
900 }
901
902
903
904
t_SCHUBERT_POLYNOM(a,b)905 INT t_SCHUBERT_POLYNOM(a,b) OP a,b;
906 /* AK 210690 V1.1 */ /* AK 210291 V1.2 */ /* AK 090891 V1.3 */
907 {
908 OP z=a;
909 OP c;
910
911 INT erg = OK;
912 CTO(SCHUBERT,"t_SCHUBERT_POLYNOM(1)",a);
913 CE2(a,b,t_SCHUBERT_POLYNOM);
914
915 c = CALLOCOBJECT();
916 init(POLYNOM,b);
917
918 while(z != NULL) {
919 erg += m_perm_schubert_monom_summe(S_SCH_S(z),c);
920 MULT_APPLY(S_SCH_K(z),c); /* missing in V1.1 */
921 ADD_APPLY(c,b);
922 z = S_SCH_N(z);
923 }
924 FREEALL(c);
925 ENDR("t_SCHUBERT_POLYNOM");
926 }
927
t_SCHUBERT_SCHUR(a,b)928 INT t_SCHUBERT_SCHUR(a,b) OP a,b;
929 {
930 OP z,s;
931 INT erg = OK;
932
933 CTO(SCHUBERT,"t_SCHUBERT_SCHUR(1)",a);
934 erg += init(SCHUR,b);
935 FORALL(z,a,{
936 s = CALLOCOBJECT();init(SCHUR,s);
937 newtrans(S_MO_S(z),s);
938 MULT_APPLY(S_MO_K(z),s);
939 insert(s,b,add_koeff,comp_monomschur);
940 });
941 ENDR("t_SCHUBERT_SCHUR");
942 }
943
944
945
946
mult_scalar_schubert(von,nach,ergebnis)947 INT mult_scalar_schubert(von,nach,ergebnis) OP von, nach, ergebnis;
948 /* AK 230402 */
949 {
950 INT erg = OK;
951 CTO(SCHUBERT,"mult_scalar_schubert(2)",nach);
952 CTO(EMPTY,"mult_scalar_schubert(3)",ergebnis);
953
954 if ((NULLP(von))|| (NULLP(nach)))
955 {
956 erg += m_i_i(0,ergebnis);
957 goto endr_ende;
958 }
959
960 erg += trans2formlist(von,nach,ergebnis,mult);
961 ENDR("mult_scalar_schubert");
962 }
963
964
mult_schubert_schubert(a,b,c)965 INT mult_schubert_schubert(a,b,c) OP a,b,c;
966 /* AK 210690 V1.1 */ /* AK 090891 V1.3 */
967 {
968 INT erg = OK;
969 OP d;
970 CTO(SCHUBERT,"mult_schubert_schubert(1)",a);
971 CTO(SCHUBERT,"mult_schubert_schubert(2)",b);
972 CTO(EMPTY,"mult_schubert_schubert(3)",c);
973
974 if (S_SCH_SLI(a) > S_SCH_SLI(b)) {
975 d=a;
976 a=b;
977 b=d;
978 }
979 d=callocobject();
980 erg += t_SCHUBERT_POLYNOM(a,d);
981 erg += mult(d,b,c);
982 erg += freeall(d);
983 ENDR("mult_schubert_schubert");
984 }
985
outerproduct_schubert(a,b,c)986 INT outerproduct_schubert(a,b,c) OP a,b,c;
987 /* a PERM b PERM c wird SCHUBERT */
988 {
989 INT erg = OK;
990 OP d,e;
991 CTO(PERMUTATION,"outerproduct_schubert(1)",a);
992 CTO(PERMUTATION,"outerproduct_schubert(2)",b);
993 d=callocobject();
994 e=callocobject();
995 erg += m_perm_sch(a,d);
996 erg += m_perm_sch(b,e);
997 erg += mult(d,e,c);
998 erg += freeall(d);
999 erg += freeall(e);
1000 ENDR("outerproduct_schubert");
1001 }
1002
mult_schubert_variable(a,i,r)1003 INT mult_schubert_variable (a,i,r) OP a,i,r;
1004 /* a ist schubert polynom
1005 i ist INTEGER, index der variable *
1006 r wird result */
1007 /* AK 190690 V1.1 */ /* AK 090891 V1.3 */
1008 {
1009 OP z,ss,c;
1010 INT erg = OK;
1011 INT ii = S_I_I(i); /* variablennumerierung beginnt mit 0 */
1012 INT j;
1013 INT grenzelinks,grenzerechts;
1014
1015 CE3(a,i,r,mult_schubert_variable);
1016 init(SCHUBERT,r);
1017
1018
1019 z = a;
1020 while (z != NULL)
1021 {
1022 ss = S_SCH_S(z);
1023 if (S_P_II(ss,S_P_LI(ss)-1L) != S_P_LI(ss) ) {
1024 inc(S_P_S(ss));
1025 M_I_I(S_P_LI(ss), S_P_I(ss,S_P_LI(ss)-1L) );
1026 }
1027 while (ii+1L >= S_P_LI(ss))
1028 {
1029 inc(S_P_S(ss));
1030 M_I_I(S_P_LI(ss), S_P_I(ss,S_P_LI(ss)-1L) );
1031 }
1032 grenzelinks=0L;
1033 grenzerechts=S_P_LI(ss)+1L;
1034 for (j=ii-1L;j>=0L; j--)
1035 {
1036 if (
1037 (S_P_II(ss,j) < S_P_II(ss,ii) )
1038 &&
1039 (S_P_II(ss,j) > grenzelinks )
1040 )
1041 {
1042 /* nach links tauschen */
1043 c = callocobject();
1044 b_skn_sch(callocobject(),callocobject(),
1045 NULL,c);
1046 addinvers(S_SCH_K(z),S_SCH_K(c));
1047 copy(ss,S_SCH_S(c));
1048 m_i_i(S_P_II(ss,j), S_SCH_SI(c,ii));
1049 m_i_i(S_P_II(ss,ii), S_SCH_SI(c,j));
1050 insert(c,r,add_koeff,
1051 comp_monomvector_monomvector);
1052 grenzelinks = S_P_II(ss,j);
1053 }
1054 }
1055 for (j=ii+1L; j <S_P_LI(ss); j++)
1056 {
1057 if (
1058 (S_P_II(ss,j) > S_P_II(ss,ii) )
1059 &&
1060 (S_P_II(ss,j) < grenzerechts )
1061 )
1062 {
1063 /* nach rechts tauschen */
1064 c = callocobject();
1065 b_skn_sch(callocobject(),callocobject(),
1066 NULL,c);
1067 copy(S_SCH_K(z),S_SCH_K(c));
1068 copy_permutation(ss,S_SCH_S(c));
1069 M_I_I(S_P_II(ss,j), S_SCH_SI(c,ii));
1070 M_I_I(S_P_II(ss,ii), S_SCH_SI(c,j));
1071 insert(c,r,add_koeff,
1072 comp_monomvector_monomvector);
1073 grenzerechts = S_P_II(ss,j);
1074 }
1075 }
1076
1077 z = S_SCH_N(z);
1078 }
1079 ENDR("mult_schubert_variable");
1080 }
1081
1082
1083
1084
mult_schubert_monom(a,b,c)1085 INT mult_schubert_monom(a,b,c) OP a,b,c;
1086 /* a ist SCHUBERT b ist MONOM eines POLYNOMS c wird ergebnis */
1087 /* AK 190690 V1.1 */ /* AK 090891 V1.3 */
1088 {
1089 OP e=callocobject();
1090 INT i,j;
1091 copy(a,c);
1092 for (i=0L; i<S_MO_SLI(b); i++)
1093 for (j=0L; j<S_MO_SII(b,i); j++)
1094 {
1095 M_I_I(i,e);
1096 mult_schubert_variable(c,e,c);
1097 }
1098
1099 mult_apply(S_MO_K(b),c);
1100 freeall(e);
1101 return OK;
1102 }
1103
1104
1105
1106
mult_schubert_polynom(a,b,c)1107 INT mult_schubert_polynom(a,b,c) OP a,b,c;
1108 /* a ist SCHUBERT b ist POLYNOM c wird SCHUBERT */
1109 /* AK 190690 V1.1 */ /* AK 090891 V1.3 */
1110 {
1111 OP d,z = b;
1112 INT erg = OK;
1113 CTO(SCHUBERT,"mult_schubert_polynom(1)",a);
1114 CTO(POLYNOM,"mult_schubert_polynom(2)",b);
1115 CTO(EMPTY,"mult_schubert_polynom(3)",c);
1116
1117 erg += b_sn_l(NULL,NULL,c);
1118 C_O_K(c,SCHUBERT);
1119 while (z != NULL)
1120 {
1121 d = callocobject();
1122 mult_schubert_monom(a,S_L_S(z),d);
1123 insert(d,c,add_koeff,comp_monomvector_monomvector);
1124 z = S_PO_N(z);
1125 }
1126 ENDR("mult_schubert_polynom");
1127 }
1128
1129
1130
1131
t_PERMUTATION_SCHUBERT(a,b)1132 INT t_PERMUTATION_SCHUBERT(a,b) OP a,b;
1133 /* AK 200891 V1.3 */
1134 {
1135 if (not EMPTYP(b))
1136 freeself(b);
1137 b_skn_sch(callocobject(),callocobject(),NULL,b);
1138 M_I_I(1L,S_SCH_K(b));
1139 copy_permutation(a,S_SCH_S(b));
1140 return OK;
1141 }
1142
1143
1144
1145
add_apply_schubert_schubert(a,b)1146 INT add_apply_schubert_schubert(a,b) OP a,b;
1147 /* AK 200891 V1.3 */
1148 {
1149 OP c = callocobject();
1150 copy_list(a,c);
1151 return(insert(c,b,add_koeff,comp_monomvector_monomvector));
1152 }
1153
1154
1155
add_apply_schubert(a,b)1156 INT add_apply_schubert(a,b) OP a,b;
1157 /* AK 220390 V1.1 */ /* AK 210291 V1.2 */ /* AK 090891 V1.3 */
1158 {
1159 INT erg = OK;
1160 EOP("add_apply_schubert(2)",b);
1161 CTO(SCHUBERT,"add_apply_schubert(1)",a);
1162
1163
1164 switch(S_O_K(b))
1165 {
1166 case SCHUBERT:
1167 erg += add_apply_schubert_schubert(a,b);
1168 break;
1169 default:
1170 erg += add_apply_default(a,b);
1171 break;
1172 }
1173 ENDR("add_apply_schubert");
1174 }
1175
1176
1177
1178
1179
println_schub_lehmer(a)1180 INT println_schub_lehmer(a) OP a;
1181 /* AK 070691 V1.2 */ /* AK 200891 V1.3 */
1182 {
1183 OP z,b;
1184 INT erg = OK;
1185 CTO(SCHUBERT,"println_schub_lehmer(1)",a);
1186 z=a;
1187 b = callocobject();
1188 while (z != NULL)
1189 {
1190 erg += print(S_SCH_K(z));
1191 erg += lehmercode(S_SCH_S(z),b);
1192 erg += print(b);
1193 if (S_SCH_N(z) != NULL)
1194 if (not negp(S_SCH_K(S_SCH_N(z)))) {
1195 printf(" + "); zeilenposition += 3L;
1196 }
1197 z = S_SCH_N(z);
1198 }
1199 erg += freeall(b);
1200 printf("\n");zeilenposition = 0L;
1201 ENDR("println_schub_lehmer");
1202 }
1203
1204
1205
1206
m_i_schubert(a,b)1207 INT m_i_schubert(a,b) INT a; OP b;
1208 /* changes a INT into a SCHUBERTpolynomial with this INT as
1209 koeffizent and labeled by the identity perm */
1210 /* AK 181290 V1.1 */ /* AK 090891 V1.3 */
1211 {
1212 b_skn_sch(callocobject(),callocobject(),NULL,b);
1213 M_I_I(a,S_SCH_K(b));
1214 b_ks_p(VECTOR,callocobject(),S_SCH_S(b));
1215 m_il_v(2L,S_P_S(S_SCH_S(b)));
1216 M_I_I(1L,S_P_I(S_SCH_S(b),0L));
1217 M_I_I(2L,S_P_I(S_SCH_S(b),1L));
1218 return OK;
1219 }
1220
1221
1222
1223
invers_polynom(a,b)1224 INT invers_polynom(a,b) OP a,b;
1225 /* AK 281290 V1.1 */ /* AK 090891 V1.3 */
1226 {
1227 INT i,j,erg=OK;
1228 OP c = callocobject();
1229 if (not EMPTYP(b))
1230 erg += freeself(b);
1231 erg += m_i_schubert(1L,b);
1232 erg += t_SCHUBERT_POLYNOM(b,b);
1233 for (i=0L; i< S_P_LI(a); i++)
1234 for (j=i+1; j< S_P_LI(a); j++)
1235 {
1236 if ( S_P_II(a,j) < S_P_II(a,i) )
1237 {
1238 erg += co_L9(i,j,c);
1239 erg += mult_apply(c,b);
1240 erg += freeself(c);
1241 }
1242 }
1243
1244 erg += freeall(c);
1245 return erg;
1246 }
1247
1248
1249
1250
co_L9(i,j,c)1251 static INT co_L9(i,j,c) INT i,j; OP c;
1252 /* computes x_i - x_j */
1253 /* AK 200891 V1.3 */
1254 {
1255 OP d = callocobject();
1256 if (not EMPTYP(c))
1257 freeself(c);
1258 m_iindex_monom(i,c);
1259 m_iindex_monom(j,d);
1260 addinvers_apply(d);
1261 add_apply(d,c);
1262 freeall(d);
1263 return OK;
1264 }
1265
1266
1267
nullp_schubert(a)1268 INT nullp_schubert(a) OP a;
1269 /* AL 180393 */
1270 {
1271 OP z = a;
1272 if (EMPTYP(a)) /* AK 091194 */
1273 return TRUE;
1274 if (empty_listp(a))
1275 return TRUE;
1276 while (z != NULL)
1277 {
1278 if (not nullp(S_SCH_K(z)) )
1279 return FALSE;
1280 z = S_SCH_N(z);
1281 }
1282 return TRUE;
1283 }
1284
1285
1286
dimension_schubert(sb,res)1287 INT dimension_schubert(sb,res) OP sb,res;
1288 /* AL 180393 */
1289 {
1290 OP z,a;
1291 INT erg = OK;
1292
1293 CTO(SCHUBERT,"dimension_schubert(1)",sb);
1294 CE2(sb,res,dimension_schubert);
1295
1296 z=callocobject();
1297 a=callocobject();
1298 M_I_I(0L,res);
1299 z=sb;
1300 while(z !=NULL) {
1301 erg += m_perm_schubert_dimension(S_SCH_S(z),a);
1302 erg += mult_apply(S_SCH_K(z),a);
1303 z=S_SCH_N(z);
1304 erg += add_apply(a,res);
1305 }
1306
1307 erg += freeall(a);
1308 ENDR("dimension_schubert");
1309 }
1310
qdimension_schubert(sb,res)1311 INT qdimension_schubert(sb,res) OP sb,res;
1312 /* AL 180393 */
1313 {
1314 OP z,a;
1315 INT erg = OK;
1316 CTO(SCHUBERT,"qdimension_schubert(1)",sb);
1317 CTO(EMPTY,"qdimension_schubert(2)",res);
1318
1319 z=callocobject();
1320 a=callocobject();
1321 M_I_I(0L,res);
1322 z=sb;
1323 while(z !=NULL) {
1324 erg += m_perm_schubert_qpolynom(S_SCH_S(z),a);
1325 erg += mult_apply(S_SCH_K(z),a);
1326 z=S_SCH_N(z);
1327 erg += add_apply(a,res);
1328 }
1329
1330 erg += freeall(a);
1331 ENDR("qdimension_schubert");
1332 }
1333
divdiff_schubert(a,schub,res)1334 INT divdiff_schubert(a,schub,res) OP a,schub,res;
1335 /* AL 180393 */
1336 {
1337 OP a1,e,f;
1338 INT x,y;
1339 INT erg = OK;
1340 CTO(INTEGER,"divdiff_schubert(1)",a);
1341 CTO(SCHUBERT,"divdiff_schubert(2)",schub);
1342
1343 a1=callocobject();
1344 f=callocobject();
1345 e=callocobject();
1346
1347
1348 M_I_I(S_I_I(a)-1L,a1);
1349 erg += init(SCHUBERT,res);
1350
1351 if (S_L_S(schub) == NULL)
1352 {
1353 erg += copy(schub,res);
1354 goto ende;
1355 }
1356 while(schub!=NULL)
1357 {
1358 copy(S_SCH_S(schub),e);
1359 x=S_P_II(e,S_I_I(a)-1L);
1360 y=S_P_II(e,S_I_I(a));
1361
1362 if(x>y){
1363 M_I_I(x,S_P_I(e,S_I_I(a)));
1364 M_I_I(y,S_P_I(e,S_I_I(a)-1L));
1365
1366 erg += m_skn_sch(e,S_SCH_K(schub),NULL,f);
1367 erg += add_apply(f,res);
1368 }
1369
1370 schub=S_SCH_N(schub);
1371
1372 }
1373 ende:
1374 erg += freeall(f);
1375 erg += freeall(e);
1376 erg += freeall(a1);
1377 ENDR("divdiff_schubert");
1378 }
1379
1380
divdiff_perm_schubert(perm,sb,res)1381 INT divdiff_perm_schubert(perm,sb,res) OP perm,sb,res;
1382 /* AL 180393 */
1383 {
1384 OP red,f;
1385 INT i,erg = OK;
1386 CTO(PERMUTATION,"divdiff_perm_schubert(1)",perm);
1387 CTO(SCHUBERT,"divdiff_perm_schubert(2)",sb);
1388
1389 red=callocobject();
1390 f=callocobject();
1391 erg += rz_perm(perm,red);
1392 erg += copy(sb,res);
1393
1394 for(i=0L;i<S_V_LI(red);i++)
1395 {
1396 erg += divdiff_schubert(S_V_I(red,i), res,f);
1397 erg += copy(f,res);
1398 }
1399 erg += freeall(red);
1400 erg += freeall(f);
1401 ENDR("divdiff_perm_schubert");
1402 }
1403
1404
1405
tex_2schubert_monom_summe(b)1406 INT tex_2schubert_monom_summe(b) OP b;
1407 {
1408 OP z = b;
1409 INT i,j,k;
1410 INT erg = OK;
1411 CTO(POLYNOM,"tex_2schubert_monom_summe",b);
1412 while (z != NULL)
1413 {
1414 tex (S_PO_K(z));
1415 for (i=0L,k=0,j=0;i<S_PO_SLI(z);i++)
1416 {
1417
1418 if (S_PO_SII(z,i) == (INT)1)
1419 {
1420 fprintf(texout, "$ (x_%" PRIINT " - y_%" PRIINT ") $ " ,j,k-j);
1421 texposition += (INT)10;
1422 }
1423 else
1424 if (S_PO_SII(z,i) > (INT)1)
1425 {
1426 fprintf(texout, "$ (x_%" PRIINT " - y_%" PRIINT ")^%" PRIdPTR " $ " ,j,k-j,S_PO_SII(z,i));
1427 texposition += (INT)10;
1428 }
1429
1430 if (k == j) { k++;j=(INT)0; }
1431 else j++;
1432 /*
1433 if (j == 0) { k++;j=k; }
1434 else j--;
1435 */
1436 }
1437 z = S_PO_N(z);
1438 if (texposition >(INT)70)
1439 {
1440 fprintf(texout,"\n");
1441 texposition = 0L;
1442 }
1443 if (z != NULL)
1444 fprintf(texout," $+$ ");
1445 }
1446
1447 ENDR("tex_2schubert_monom_summe");
1448 }
1449
1450
m_perm_2schubert_monom_summe(perm,res)1451 INT m_perm_2schubert_monom_summe(perm,res) OP perm,res;
1452 /* Eingabe: PERMUTATION als label des Schubertpolynoms */
1453 /* Ausgabe: POLYNOM */
1454 /* 020588 */ /* AK 240789 V1.0 */ /* AK 120790 V1.1 */ /* AK 090891 V1.3 */
1455 {
1456 OP vorfaktor;
1457 /* das monom, mit dem das ergebnis einer einzelnen
1458 rekursion multipliziert werden muss */
1459 /* beim start = [0,0,0,0,....,0] */
1460 INT i;
1461 INT erg = OK;
1462 CTO(PERMUTATION,"m_perm_2schubert_monom_summe",perm);
1463 if (einsp(perm)) /* AK 191191 */
1464 return m_scalar_polynom(cons_eins,res);
1465 if (not EMPTYP(res))
1466 erg += freeself(res);
1467 vorfaktor = callocobject();
1468 erg += m_il_v((S_P_LI(perm)*(S_P_LI(perm)-1))/2,vorfaktor);
1469 for (i=0L;i<S_V_LI(vorfaktor);i++)
1470 M_I_I(1L,S_V_I(vorfaktor,i));
1471 /* vorfaktor ist nun initialisiert */
1472 erg += algorithmus5(vorfaktor,0L,S_P_LI(perm)-1L,perm,res);
1473 /* die rekursion wird aufgerufen */
1474 erg += freeall(vorfaktor);
1475 ENDR("m_perm_2schubert_monom_summe");
1476 }
1477
algorithmus5(vorfaktor,alphabetindex,stufe,perm,res)1478 static INT algorithmus5(vorfaktor,alphabetindex,stufe,perm,res)
1479 OP vorfaktor; /* ist ein monom, d.h. vector */
1480 /* bsp [0,1,0] == b^2 */
1481 /* damit wird das ergebnis dieser rekursion
1482 multipliziert und in res eingefuegt */
1483 INT alphabetindex;
1484 /* ist der start des alphabets a==0 */
1485 /* d.h. wird nur noch im alphabet b,c,d, ..
1486 gerechnet so ist dies =1 */
1487 INT stufe; /* der exponent des Vorfaktors */
1488 OP perm; /* die permutation zu der berechnet wird */
1489 OP res; /* das globale ergebnis */
1490 /* AK 020588 */ /* AK 081188 */ /* AK 240789 V1.0 */ /* AK 201189 V1.1 */
1491 /* AK 090891 V1.3 */
1492 {
1493 INT i,j,k;
1494 if (S_O_K(perm) != PERMUTATION)
1495 return error("algorithmus5:no PERMUTATION");
1496 if (S_O_K(vorfaktor) != VECTOR)
1497 return error("algorithmus5:no VECTOR");
1498 if (S_V_LI(vorfaktor) == 0L)
1499 return error("algorithmus5:vorfaktor == 0");
1500 if (S_P_LI(perm) == 2L)
1501 /* ende des algorithmus */
1502 {
1503 OP monom = callocobject();
1504 b_skn_po(callocobject(),callocobject(),NULL,monom);
1505 M_I_I(1L,S_PO_K(monom));
1506 if (S_P_II(perm,0L) == 1L)
1507 {
1508 j = ((1+alphabetindex) * alphabetindex) / 2;
1509 M_I_I(0L,S_V_I(vorfaktor,j + alphabetindex));
1510 }
1511 copy(vorfaktor,S_PO_S(monom));
1512 /* das monom ist nun fertig initialisiert */
1513
1514 /* der vorfaktor wird noch mit dem i-ten
1515 buchstaben multipliziert falls perm = [2,1] */
1516 insert(monom,res,add_koeff,comp_monomvector_monomvector);
1517 /* einfuegen des ergebnis in das globale ergebnis */
1518 return OK;
1519 }
1520
1521
1522 if (S_P_II(perm,0L) == S_P_LI(perm)) /* nun die rekursion */
1523 {
1524 OP neuperm = callocobject();
1525 OP neufaktor = callocobject();
1526
1527 b_ks_p(VECTOR,callocobject(),neuperm);
1528 m_il_v(S_P_LI(perm)-1L,S_P_S(neuperm));
1529 for(i=0L;i<S_P_LI(neuperm);i++)
1530 M_I_I(S_P_II(perm,i+1L),S_P_I(neuperm,i));
1531 /* es wurde die permutation um das erste element
1532 welches das groesste war gekuerzt, hier wurde
1533 ausgenutzt
1534 z.B X_634215 = a^6 X_34215(b,c,d,e,f)
1535 diese multiplikation folgt nun
1536 */
1537
1538 copy_vector(vorfaktor,neufaktor);
1539 /* M_I_I(stufe,S_V_I(neufaktor,alphabetindex)); */
1540 algorithmus5( neufaktor,alphabetindex+1L,
1541 S_P_LI(neuperm)-1,neuperm,res);
1542 freeall(neufaktor);
1543 freeall(neuperm);
1544 return OK;
1545 }
1546 else { /* falls keine rekursion im alphabet */
1547 INT maximal = S_P_LI(perm)+1L;
1548 OP neuperm = callocobject();
1549 OP neufaktor = callocobject();
1550 for (i=1L;i<S_P_LI(perm);i++)
1551 if ( (S_P_II(perm,i) < maximal)&&
1552 (S_P_II(perm,i) > S_P_II(perm,0L)))
1553 {
1554 copy(perm,neuperm);
1555 copy(vorfaktor,neufaktor);
1556 maximal = S_P_II(perm,i);
1557 M_I_I(S_P_II(perm,0L),S_P_I(neuperm,i));
1558 M_I_I(S_P_II(perm,i),S_P_I(neuperm,0L));
1559 /*
1560 M_I_I(1L,S_V_I(neufaktor,S_P_II(perm,0L)-1+alphabetindex));
1561 */
1562 k = alphabetindex + S_P_II(perm,0L) - 1L;
1563 j = ((1+k) * k) / 2;
1564 M_I_I(0L,S_V_I(neufaktor,j + alphabetindex));
1565
1566
1567 /* print(S_P_I(perm,0L));print(neufaktor);println(neuperm); */
1568
1569 algorithmus5(neufaktor,alphabetindex,
1570 stufe-1L,neuperm,res);
1571 };
1572 freeall(neuperm);
1573 freeall(neufaktor);
1574 return OK;
1575 }
1576 }
1577
exchange_alphabets(a,b)1578 INT exchange_alphabets(a,b) OP a,b;
1579 /* AK 101194 */
1580 /* eingabe ein polynom mit matrix self teil in zwei zeilen
1581 = ergebnis von t_2SCHUBERT_POLYNOM */
1582 /* ergbnis tausch der beiden zeilen der matrix */
1583 {
1584 OP z,d;
1585 init(POLYNOM,b);
1586 z = a;
1587 while (z != NULL)
1588 {
1589 d = callocobject();
1590 m_skn_po(S_PO_S(z),S_PO_K(z),NULL,d);
1591 change_row_ij(S_PO_S(d),0L,1L);
1592 insert(d,b,NULL,NULL);
1593 z = S_PO_N(z);
1594 }
1595 return OK;
1596 }
1597
eval_2schubert(a,vec,b)1598 INT eval_2schubert(a,vec,b) OP a,b,vec;
1599 /* AK 101194 */
1600 /* eingabe ein double schubert polynom a (d.h. kodiert in einem vektor)
1601 und ein vektor vec mit den ersetzungen fuer y_i
1602 ergebnis ist b */
1603 {
1604 OP z,c,d,e,f;
1605 INT i,j,k;
1606 z = a;
1607 init ( POLYNOM, b);
1608 if (nullp(a))
1609 return OK;
1610 c = callocobject();
1611 d = callocobject();
1612 e = callocobject();
1613 while (z != NULL)
1614 {
1615 f = callocobject();
1616 m_i_i(1L,f);
1617 for (i=0L,j=0L,k=0L;i<S_PO_SLI(z);i++)
1618 {
1619 if (S_PO_SII(z,i) != 0L)
1620 {
1621 add(S_PO_SL(z), S_PO_SL(z), c);
1622 ganzsquareroot(c,c); /* c is size of self part */
1623 b_skn_po(callocobject(), callocobject(), NULL, d);
1624 M_I_I(1L,S_PO_K(d));
1625 m_l_nv(c,S_PO_S(d));
1626 M_I_I(1L,S_PO_SI(d,k));
1627 sub(d,S_V_I(vec,j-k),d);
1628 hoch(d,S_PO_SI(z,i),d);
1629 mult_apply(d,f);
1630 }
1631 if (j == k) { k = 0L; j++ ; }
1632 else k++;
1633 }
1634 z = S_PO_N(z);
1635 insert(f,b,NULL,NULL);
1636 }
1637 freeall(c);
1638 freeall(d);
1639 freeall(e);
1640 return OK;
1641 }
1642
t_2SCHUBERT_POLYNOM(a,b)1643 INT t_2SCHUBERT_POLYNOM(a,b) OP a,b;
1644 /* AK 101194 */
1645 {
1646 OP z,c,d,e,f;
1647 INT i,j,k;
1648 z = a;
1649 init ( POLYNOM, b);
1650 c = callocobject();
1651 d = callocobject();
1652 e = callocobject();
1653 while (z != NULL)
1654 {
1655 f = callocobject();
1656 m_i_i(1L,f);
1657 for (i=0L,j=0L,k=0L;i<S_PO_SLI(z);i++)
1658 {
1659 if (S_PO_SII(z,i) != 0L)
1660 {
1661 add(S_PO_SL(z), S_PO_SL(z), c);
1662 ganzsquareroot(c,c); /* c is size of matrix */
1663 b_skn_po(callocobject(), callocobject(), NULL, d);
1664 M_I_I(1L,S_PO_K(d));
1665 m_lh_nm(c,cons_zwei,S_PO_S(d));
1666 M_I_I(1L,S_PO_SIJ(d,0L,k));
1667 b_skn_po(callocobject(), callocobject(), NULL, e);
1668 M_I_I(1L,S_PO_K(e));
1669 m_lh_nm(c,cons_zwei,S_PO_S(e));
1670 M_I_I(1L,S_PO_SIJ(e,1L,j-k));
1671 sub(d,e,d);
1672 hoch(d,S_PO_SI(z,i),d);
1673 mult_apply(d,f);
1674 }
1675 if (j == k) { k = 0L; j++ ; }
1676 else k++;
1677 }
1678 z = S_PO_N(z);
1679 insert(f,b,NULL,NULL);
1680 }
1681 freeall(c);
1682 freeall(d);
1683 freeall(e);
1684 return OK;
1685 }
1686
1687
1688
1689
m_perm_2schubert_operating_monom_summe(perm,perm2,res2)1690 INT m_perm_2schubert_operating_monom_summe(perm,perm2,res2) OP perm,perm2,res2;
1691 /* Eingabe: PERMUTATION als label des Schubertpolynoms */
1692 /* Ausgabe: POLYNOM */
1693 /* 020588 */ /* AK 240789 V1.0 */ /* AK 120790 V1.1 */ /* AK 090891 V1.3 */
1694 {
1695 OP vorfaktor;
1696 OP res,vec;
1697 INT i,erg = OK;
1698 CTO(PERMUTATION,"m_perm_2schubert_operating_monom_summe(1)",perm);
1699 CTO(PERMUTATION,"m_perm_2schubert_operating_monom_summe(2)",perm2);
1700
1701 init(POLYNOM,res2);
1702 if (einsp(perm)) /* AK 191191 */
1703 {
1704 erg += m_scalar_polynom(cons_eins,res2);
1705 goto ee;
1706 }
1707
1708 res = callocobject();
1709 init(POLYNOM,res);
1710 vorfaktor = callocobject();
1711 m_il_integervector((S_P_LI(perm)*(S_P_LI(perm)-1))/2,vorfaktor);
1712
1713 for (i=0L;i<S_V_LI(vorfaktor);i++)
1714 M_I_I(1,S_V_I(vorfaktor,i));
1715 /* vorfaktor ist nun initialisiert */
1716 algorithmus6(perm2,vorfaktor,0L,S_P_LI(perm)-1L,perm,res);
1717 /* die rekursion wird aufgerufen */
1718 freeall(vorfaktor);
1719 /* vorfaktor wird freigegeben ==> kein speicher bedarf */
1720
1721 if (nullp(res))
1722 {
1723 FREEALL(res);
1724 goto ee;
1725 }
1726 vec = callocobject();
1727 m_il_v(S_P_LI(perm2),vec);
1728 for (i=0;i<S_V_LI(vec);i++)
1729 m_iindex_monom(S_P_II(perm2,i)-1,S_V_I(vec,i));
1730 eval_2schubert(res,vec,res2);
1731 FREEALL(vec);
1732 FREEALL(res);
1733 ee:
1734 ENDR("m_perm_2schubert_operating_monom_summe");
1735 }
1736
algorithmus6(perm2,vorfaktor,alphabetindex,stufe,perm,res)1737 static INT algorithmus6(perm2,vorfaktor,alphabetindex,stufe,perm,res)
1738 OP vorfaktor; /* ist ein monom, d.h. vector */
1739 /* bsp [0,1,0] == b^2 */
1740 /* damit wird das ergebnis dieser rekursion
1741 multipliziert und in res eingefuegt */
1742 INT alphabetindex;
1743 /* ist der start des alphabets a==0 */
1744 /* d.h. wird nur noch im alphabet b,c,d, ..
1745 gerechnet so ist dies =1 */
1746 INT stufe; /* der exponent des Vorfaktors */
1747 OP perm; /* die permutation zu der berechnet wird */
1748 OP perm2,res; /* das globale ergebnis */
1749 /* AK 020588 */ /* AK 081188 */ /* AK 240789 V1.0 */ /* AK 201189 V1.1 */
1750 /* AK 090891 V1.3 */
1751 {
1752 INT i,j,k;
1753 if (S_O_K(perm) != PERMUTATION)
1754 return error("algorithmus6:no PERMUTATION");
1755 if (! VECTORP(vorfaktor))
1756 return error("algorithmus6:no VECTOR");
1757 if (S_V_LI(vorfaktor) == 0L)
1758 return error("algorithmus6:vorfaktor == 0");
1759 if (S_P_LI(perm) == 2L)
1760 /* ende des algorithmus */
1761 {
1762 OP monom;
1763 if (S_P_II(perm,0L) == 1L)
1764 {
1765 j = ((1+alphabetindex) * alphabetindex) / 2;
1766 M_I_I(0L,S_V_I(vorfaktor,j + alphabetindex));
1767 }
1768
1769 for (i=0,j=1,k=1; i<S_V_LI(vorfaktor);i++)
1770 {
1771 if ((S_P_II(perm2,k-j) == j) &&
1772 (S_V_II(vorfaktor,i) != 0L) )
1773 {
1774 return OK;
1775 }
1776 if (j==k) { j=1;k++; }
1777 else j++;
1778 }
1779 monom = callocobject();
1780 b_skn_po(callocobject(),callocobject(),NULL,monom);
1781 M_I_I(1L,S_PO_K(monom));
1782 copy(vorfaktor,S_PO_S(monom));
1783 insert(monom,res,add_koeff,comp_monomvector_monomvector);
1784 /* einfuegen des ergebnis in das globale ergebnis */
1785 return OK;
1786 }
1787
1788
1789 if (S_P_II(perm,0L) == S_P_LI(perm)) /* nun die rekursion */
1790 {
1791 OP neuperm = callocobject();
1792 OP neufaktor = callocobject();
1793
1794 b_ks_p(VECTOR,callocobject(),neuperm);
1795 m_il_v(S_P_LI(perm)-1L,S_P_S(neuperm));
1796 for(i=0L;i<S_P_LI(neuperm);i++)
1797 M_I_I(S_P_II(perm,i+1L),S_P_I(neuperm,i));
1798 /* es wurde die permutation um das erste element
1799 welches das groesste war gekuerzt, hier wurde
1800 ausgenutzt
1801 z.B X_634215 = a^6 X_34215(b,c,d,e,f)
1802 diese multiplikation folgt nun
1803 */
1804
1805 copy_integervector(vorfaktor,neufaktor);
1806 /* M_I_I(stufe,S_V_I(neufaktor,alphabetindex)); */
1807 algorithmus6( perm2,neufaktor,alphabetindex+1L,
1808 S_P_LI(neuperm)-1,neuperm,res);
1809 freeall(neufaktor);
1810 freeall(neuperm);
1811 return OK;
1812 }
1813 else { /* falls keine rekursion im alphabet */
1814 INT maximal = S_P_LI(perm)+1L;
1815 OP neuperm = callocobject();
1816 OP neufaktor = callocobject();
1817 for (i=1L;i<S_P_LI(perm);i++)
1818 if ( (S_P_II(perm,i) < maximal)&&
1819 (S_P_II(perm,i) > S_P_II(perm,0L)))
1820 {
1821 copy(perm,neuperm);
1822 copy(vorfaktor,neufaktor);
1823 maximal = S_P_II(perm,i);
1824 M_I_I(S_P_II(perm,0L),S_P_I(neuperm,i));
1825 M_I_I(S_P_II(perm,i),S_P_I(neuperm,0L));
1826 k = alphabetindex + S_P_II(perm,0L) - 1L;
1827 j = ((1+k) * k) / 2;
1828 M_I_I(0L,S_V_I(neufaktor,j + alphabetindex));
1829
1830
1831 algorithmus6(perm2,neufaktor,alphabetindex,
1832 stufe-1L,neuperm,res);
1833 };
1834 freeall(neuperm);
1835 freeall(neufaktor);
1836 return OK;
1837 }
1838 }
1839
scalarproduct_schubert(a,b,c)1840 INT scalarproduct_schubert(a,b,c) OP a,b,c;
1841 /* AK 231194 */
1842 {
1843 OP d,e;
1844 INT erg = OK;
1845 CTO(SCHUBERT,"scalarproduct_schubert",a);
1846 CTO(SCHUBERT,"scalarproduct_schubert",b);
1847 d = callocobject();
1848 e = callocobject();
1849 erg += maxdegree_schubert(a,d);
1850 erg += maxdegree_schubert(b,e);
1851 if (gt(e,d)) erg += copy(e,d);
1852 erg += mult(a,b,e);
1853 erg += last_permutation(d,d);
1854 erg += divdiff(d,e,c);
1855 erg += freeall(d);
1856 erg += freeall(e);
1857 ENDR("scalarproduct_schubert");
1858 }
1859
1860 #endif /* SCHUBERTTRUE */
1861