1
2 #include "def.h"
3 #include "macro.h"
4
5 static INT ausgabe_koeff();
6 static INT write_polynom();
7
8
9
10
11 /* global variables for output */
12 INT zeilenposition;
13 INT texposition;
14 INT texmath_yn; /* 1 in mathmode */ /* 0 not in mathmode */
15 INT scanoutput_yn; /* 1 no output */ /* 0 bitte output */
16 INT row_length = 70;
17 INT tex_row_length = 70;
18 INT integer_format = 0; /* no format */
19
print_type(a)20 INT print_type(a) OBJECTKIND a;
21 /* AK 280294 */
22 /* AK 240398 V2.0 */
23 {
24 OP b;
25 INT erg = OK;
26
27 b = CALLOCOBJECT();
28 C_O_K(b,a);
29 erg += printobjectkind(b);
30 C_O_K(b,EMPTY);
31 FREEALL(b);
32
33 ENDR("print_type");
34 }
35
printobjectkind(a)36 INT printobjectkind(a) OP a;
37 /* AK 270689 V1.0 */ /* AK 020290 V1.1 */ /* AK 130891 V1.3 */
38 /* AK 240398 V2.0 */
39 {
40 INT erg = OK;
41 if (a == NULL)
42 {
43 fprintf(stderr,"object is NULL object\n");
44 goto endr_ende;
45 }
46 fprintf(stderr,"kind of object is ");
47
48 switch(S_O_K(a))
49 {
50 case AUG_PART: fprintf(stderr,"augpart\n");break;
51 case BARPERM: fprintf(stderr,"barred permutation\n");break;
52 case BINTREE: fprintf(stderr,"bintree\n");break;
53 case BITVECTOR: fprintf(stderr,"bitvector\n");break;
54 case BRUCH: fprintf(stderr,"bruch\n");break;
55 case CHARPARTITION: fprintf(stderr,"internal type charpartition\n");break;
56 case COMPOSITION: fprintf(stderr,"composition\n");break;
57 case CYCLOTOMIC: fprintf(stderr,"cyclotomic\n");break;
58 case ELM_SYM: fprintf(stderr,"elementary symmetric function\n");break;
59 case FF: fprintf(stderr,"finite field element\n");break;
60 case GALOISRING: fprintf(stderr,"galois ring element\n");break;
61 case GRAL: fprintf(stderr,"groupalgebra\n");break;
62 case HOM_SYM: fprintf(stderr,"complete symmetric function\n");break;
63 case INTEGER: fprintf(stderr,"integer\n");break;
64 case KOSTKA: fprintf(stderr,"kostka\n");break;
65 case KRANZ: fprintf(stderr,"kranz\n");break;
66 case KRANZTYPUS: fprintf(stderr,"kranztypus\n");break;
67 case LAURENT: fprintf(stderr,"laurent\n");break;
68 case LIST: fprintf(stderr,"list\n");break;
69 case LONGINT: fprintf(stderr,"longint\n");break;
70 case INTEGERMATRIX: fprintf(stderr,"integermatrix\n");break;
71 case MATRIX: fprintf(stderr,"matrix\n");break;
72 case MONOM: fprintf(stderr,"monom\n");break;
73 case MONOMIAL: fprintf(stderr,"monomial symmetric function\n");break;
74 case MONOPOLY: fprintf(stderr,"monopoly\n");break;
75 case PARTITION: fprintf(stderr,"partition\n");break;
76 case PERMUTATION: fprintf(stderr,"permutation\n");break;
77 case POLYNOM: fprintf(stderr,"polynom\n");break;
78 case POW_SYM: fprintf(stderr,"powersum symmetric function\n");break;
79 case REIHE: fprintf(stderr,"power-series\n");break;
80 case SCHUR: fprintf(stderr,"schur-polynom\n");break;
81 case SCHUBERT: fprintf(stderr,"schubert-polynom\n");break;
82 case SKEWPARTITION: fprintf(stderr,"skewpartition\n");break;
83 case SQ_RADICAL: fprintf(stderr,"square-radical\n");break;
84 case SUBSET: fprintf(stderr,"subset\n");break;
85 case SYMCHAR: fprintf(stderr,"symchar\n");break;
86 case TABLEAUX: fprintf(stderr,"tableaux\n");break;
87 case VECTOR: fprintf(stderr,"vector\n");break;
88 case WORD: fprintf(stderr,"word\n");break;
89 case HASHTABLE: fprintf(stderr,"hashtable\n");break;
90 case INTEGERVECTOR: fprintf(stderr,"integervector\n");break;
91 case (OBJECTKIND) 0: fprintf(stderr,"empty-object\n");break;
92 default: fprintf(stderr," %ld ",S_O_K(a));
93 fprintf(stderr,"unknown\n");
94 break;
95 };
96 ENDR("printobjectkind");
97 }
98
ferrers(obj)99 INT ferrers(obj) OP obj;
100 /* AK 290986 */ /* AK 010889 V1.0 */ /* AK 020290 V1.1 */
101 /* AK 130891 V1.3 */
102 /* AK 240398 V2.0 */
103 {
104 INT erg = OK;
105 COP("ferrers(1)",obj);
106
107 switch(S_O_K(obj)) {
108 #ifdef PARTTRUE
109 case PARTITION: erg += ferrers_partition(obj); break;
110 #endif /* PARTTRUE */
111 #ifdef SKEWPARTTRUE
112 case SKEWPARTITION: erg += ferrers_skewpartition(obj); break;
113 #endif /* SKEWPARTTRUE */
114 default:
115 erg += WTO("ferrers",obj); break;
116 }
117 ENDR("ferrers");
118 }
119
120
scan_printeingabe(text)121 INT scan_printeingabe(text) char *text;
122 /* AK 250194 */
123 /* AK 240398 V2.0 */
124 {
125 extern INT scanoutput_yn; /* 1 no output */ /* 0 bitte output */
126 if (scanoutput_yn == (INT) 0)
127 return printeingabe(text);
128 return OK;
129 }
130
printeingabe(text)131 INT printeingabe(text) char *text;
132 /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
133 /* AK 070291 V1.2 prints to stderr instead to stdout , returns OK */
134 /* AK 130891 V1.3 */
135 /* AK 240398 V2.0 */
136 {
137 fprintf(stderr,"%s\n",text);
138 return OK;
139 }
140
sprint(string,obj)141 INT sprint(string, obj) char *string; OP obj;
142 /* AK 020195 */
143 /* to get length of string use strlen */
144 /* AK 240398 V2.0 */
145 {
146 INT erg = OK;
147 COP("sprint(2)",obj);
148 COP("sprint(1)",string);
149
150 switch(S_O_K(obj))
151 {
152 #ifdef FFTRUE
153 case FF:
154 erg+= sprint_ff(string,obj);
155 goto spe;
156 #endif
157 case INTEGER:
158 erg+= sprint_integer(string,obj);
159 goto spe;
160 #ifdef LONGINTTRUE
161 case LONGINT:
162 erg+= sprint_longint(string,obj);
163 goto spe;
164 #endif /* LONGINTTRUE */
165 #ifdef PARTTRUE
166 case SKEWPARTITION:
167 erg+= sprint_skewpartition(string,obj);
168 goto spe;
169 case PARTITION:
170 erg+= sprint_partition(string,obj);
171 goto spe;
172 #endif /* PARTTRUE */
173 #ifdef PERMTRUE
174 case PERMUTATION:
175 erg+= sprint_permutation(string,obj);
176 goto spe;
177 #endif /* PERMTRUE */
178 #ifdef VECTORTRUE
179 case INTEGERVECTOR:
180 erg+= sprint_integervector(string,obj);
181 goto spe;
182 case VECTOR:
183 erg+= sprint_vector(string,obj);
184 goto spe;
185 #endif /* VECTORTRUE */
186
187 default:
188 WTO("sprint(1)",obj);
189 goto spe;
190 }
191 spe:
192 ENDR("sprint");
193 }
194
fprint(of,obj)195 INT fprint(of,obj) FILE *of; OP obj;
196 /* AK 211186 */ /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
197 /* AK 050891 V1.3 */
198 /* AK 240398 V2.0 */
199 {
200 INT erg = OK;
201 COP("fprint(1)",of);
202 COP("fprint(2)",obj);
203
204 switch(S_O_K(obj))
205 {
206 #ifdef PARTTRUE
207 case AUG_PART:
208 case PARTITION: erg += fprint_partition(of,obj);break;
209 #endif /* PARTTRUE */
210 #ifdef BINTREETRUE
211 case BINTREE: erg += fprint_bintree(of,obj);break;
212 #endif /* BINTREETRUE */
213 #ifdef BRUCHTRUE
214 case BRUCH: erg += fprint_bruch(of,obj);break;
215 #endif /* BRUCHTRUE */
216 #ifdef FFTRUE
217 case FF: erg += fprint_ff(of,obj);break;
218 #endif /* FFTRUE */
219 #ifdef INTEGERTRUE
220 case INTEGER: erg += fprint_integer(of,obj);break;
221 #endif /* INTEGERTRUE */
222 #ifdef LISTTRUE
223 case ELM_SYM: case MONOMIAL: case HOM_SYM: case POW_SYM:
224 case GRAL: case MONOPOLY: case POLYNOM: case SCHUBERT:
225 case SCHUR: case LIST:
226 erg += fprint_list(of,obj);break;
227 #endif /* LISTTRUE */
228 #ifdef LONGINTTRUE
229 case LONGINT: erg += fprint_longint(of,obj);break;
230 #endif /* LONGINTTRUE */
231 #ifdef MATRIXTRUE
232 case KOSTKA:
233 case KRANZTYPUS:
234 case INTEGERMATRIX:
235 case MATRIX: erg += fprint_matrix(of,obj);break;
236 #endif /* MATRIXTRUE */
237 #ifdef MONOMTRUE
238 case MONOM: erg += fprint_monom(of,obj);break;
239 #endif /* MONOMTRUE */
240 #ifdef PERMTRUE
241 case PERMUTATION: erg += fprint_permutation(of,obj);
242 break;
243 #endif /* PERMTRUE */
244 #ifdef REIHETRUE
245 case REIHE: erg += fprint_reihe(of,obj);
246 break;
247 #endif /* REIHETRUE */
248 #ifdef SKEWPARTTRUE
249 case SKEWPARTITION: /*020488 */
250 erg += fprint_skewpartition(of,obj);break;
251 #endif /* SKEWPARTTRUE */
252 #ifdef CHARTRUE
253 case SYMCHAR: /*110488 */
254 erg += fprint_symchar(of,obj);break;
255 #endif /* CHARTRUE */
256 #ifdef TABLEAUXTRUE
257 case TABLEAUX: /*020488 */
258 erg += fprint_tableaux(of,obj);break;
259 #endif /* TABLEAUXTRUE */
260 #ifdef VECTORTRUE
261 case QUEUE:
262 erg += fprint_queue(of,obj);break;
263 case HASHTABLE:
264 erg += fprint_hashtable(of,obj);break;
265 case COMPOSITION:
266 case SUBSET:
267 case WORD:
268 case KRANZ:
269 case INTEGERVECTOR:
270 case GALOISRING:
271 case LAURENT:
272 case VECTOR: erg += fprint_vector(of,obj);break;
273 case BITVECTOR: erg += fprint_bitvector(of,obj);break;
274 #endif /* VECTORTRUE */
275 #ifdef NUMBERTRUE
276 case SQ_RADICAL:
277 case CYCLOTOMIC: erg += fprint_number(of,obj);break;
278 #endif /* NUMBERTRUE */
279 case 0:
280 fprintf(of,"#");
281 /* AK 310889 */
282 if (of == stdout)
283 zeilenposition++;
284 break;
285 default: erg += WTO("fprint",obj);
286 break;
287 };
288
289 ENDR("fprint");
290 }
291
display(obj)292 INT display(obj) OP obj;
293 /* AK 271087 */ /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
294 /* AK 130891 V1.3 */
295 /* AK 240398 V2.0 */
296 {
297 INT erg = OK;
298 COP("display(1)",obj);
299
300 switch(S_O_K(obj))
301 {
302 #ifdef SCHUBERTTRUE
303 case SCHUBERT:
304 erg += display_schubert(obj);
305 break;
306 #endif /* SCHUBERTTRUE */
307 default:
308 erg += WTO("display(1)",obj);
309 break;
310 };
311 ENDR("display");
312 }
313
fprintln(f,obj)314 INT fprintln(f,obj) FILE *f; OP obj;
315 /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
316 /* AK 130891 V1.3 */ /* AK 240398 V2.0 */
317 /* AK 201204 V3.0 */
318 {
319 INT erg = OK;
320 COP("fprintln(1)",f);
321 COP("fprintln(2)",obj);
322
323 erg += fprint(f,obj);
324 putc('\n',f);
325 if (f == stdout) zeilenposition = 0;
326 ENDR("fprintln");
327 }
328
check_zeilenposition(f)329 INT check_zeilenposition(f) FILE *f;
330 /* AK 201204 */
331 {
332 if (f==stdout) {
333 /* printf("(zp=%d)",zeilenposition); */
334 if (zeilenposition > row_length) { putchar('\n'); zeilenposition=0; }
335 }
336 return OK;
337 }
338
339
340
print(obj)341 INT print(obj) OP obj;
342 /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
343 /* AK 130891 V1.3 */ /* AK 240398 V2.0 */
344 /* AK 201204 V3.0 */
345 {
346 INT erg = OK;
347 COP("print(1)",obj);
348 erg += check_zeilenposition(stdout);
349 erg += fprint(stdout,obj);
350 ENDR("print");
351 }
352
353
354
println(obj)355 INT println(obj) OP obj;
356 /* AK 270689 V1.0 */ /* AK 020290 V1.1 */
357 /* AK 130891 V1.3 */
358 /* AK 240398 V2.0 */
359 {
360 INT erg = OK;
361 COP("println(1)",obj);
362 erg += print(obj);
363 putchar('\n'); zeilenposition = 0;
364 ENDR("println");
365 }
366
367
skip_comment()368 INT skip_comment()
369 /* AK 240398 V2.0 */
370 {
371 int i;
372 /* here we insert code to implement comments *//* AK 210395 */
373 sa:
374 i = getc(stdin);
375 if (i == EOF)
376 return error("scan:EOF encountered");
377 else if (i==' ') goto sa;
378 else if (i=='\t') goto sa;
379 else if (i=='#') /* comments til the end of line */
380 {
381 while ((i=getc(stdin)) != '\n');
382 goto sa;
383 }
384 else ungetc(i,stdin);
385 return OK;
386 }
387
388
scan(kind,obj)389 INT scan(kind,obj) OBJECTKIND kind; OP obj;
390 /* AK 270787 */ /* AK 280689 V1.0 */ /* AK 020290 V1.1 */ /* AK 050891 V1.3 */
391 /* AK 240298 V2.0 */
392 {
393 INT erg = OK;
394 COP("scan(2)",obj);
395
396 if (not EMPTYP(obj))
397 erg += freeself(obj);
398
399 switch(kind)
400 {
401 #ifdef BRUCHTRUE
402 case BRUCH: erg += scan_bruch(obj); break;
403 case INTEGERBRUCH: erg += scan_integerbruch(obj); break;
404 #endif /* BRUCHTRUE */
405 #ifdef CYCLOTRUE
406 case CYCLOTOMIC: erg += scan_cyclo(obj); break;
407 #endif /* CYCLOTRUE */
408 #ifdef ELMSYMTRUE
409 case ELM_SYM: erg += scan_elmsym(obj); break;
410 #endif /* ELMSYMTRUE */
411 #ifdef GRALTRUE
412 case GRAL: erg += scan_gral(obj); break;
413 #endif /* GRALTRUE */
414 #ifdef FFTRUE
415 case FF: erg += scan_ff(obj); break;
416 #endif /* FFTRUE */
417 #ifdef HOMSYMTRUE
418 case HOM_SYM: erg += scan_homsym(obj); break;
419 #endif /* HOMSYMTRUE */
420 #ifdef INTEGERTRUE
421 case INTEGER: erg += scan_integer(obj); break;
422 #endif /* INTEGERTRUE */
423 #ifdef VECTORTRUE
424 case INTEGERVECTOR: erg += scan_integervector(obj); break;
425 #endif /* VECTORTRUE */
426 #ifdef MATRIXTRUE
427 case INTEGERMATRIX: erg += scan_integermatrix(obj); break;
428 #endif /* MATRIXTRUE */
429 #ifdef KOSTKATRUE
430 case KOSTKA: erg += scan_kostka(obj); break;
431 #endif /* KOSTKATRUE */
432 #ifdef KRANZTRUE
433 case KRANZ: erg += scan_kranz(obj); break;
434 #endif /* KRANZTRUE */
435 #ifdef LAURENTTRUE
436 case LAURENT: erg += scan_laurent(obj); break;
437 #endif /* LAURENTTRUE */
438 #ifdef LISTTRUE
439 case LIST: erg += scan_list(obj,(OBJECTKIND)0); break;
440 #endif /* LISTTRUE */
441 #ifdef LONGINTTRUE
442 case LONGINT: erg += scan_longint(obj); break;
443 #endif /* LONGINTTRUE */
444 #ifdef MATRIXTRUE
445 case KRANZTYPUS:
446 erg += scan_matrix(obj);
447 C_O_K(obj,KRANZTYPUS);
448 break;
449 case MATRIX: erg += scan_matrix(obj); break;
450 #endif /* MATRIXTRUE */
451 #ifdef MONOMTRUE
452 case MONOM: erg += scan_monom(obj); break;
453 #endif /* MONOMTRUE */
454 #ifdef MONOMIALTRUE
455 case MONOMIAL: erg += scan_monomial(obj); break;
456 #endif /* MONOMIALTRUE */
457 #ifdef MONOPOLYTRUE
458 case MONOPOLY: erg += scan_monopoly(obj); break;
459 #endif /* MONOPOLYTRUE */
460 #ifdef PARTTRUE
461 case REVERSEPARTITION: erg += scan_reversepartition(obj);
462 break;
463 case EXPONENTPARTITION: erg += scan_exponentpartition(obj);
464 break;
465 case PARTITION: erg += scan_partition(obj); break;
466 #endif /* PARTTRUE */
467 #ifdef PERMTRUE
468 case BARPERM: erg += scan_bar(obj); break;
469 case PERMUTATION: erg += scan_permutation(obj); break;
470 #endif /* PERMTRUE */
471 #ifdef POLYTRUE
472 case FASTPOLYNOM: erg += scan_fastpolynom(obj); break;
473 case POLYNOM: erg += scan_polynom(obj); break;
474 #endif /* POLYTRUE */
475 #ifdef POWSYMTRUE
476 case POW_SYM: erg += scan_powsym(obj); break;
477 #endif /* POWSYMTRUE */
478 #ifdef REIHETRUE
479 case REIHE: erg += scan_reihe(obj); break;
480 #endif /* REIHETRUE */
481 #ifdef SCHUBERTTRUE
482 case SCHUBERT: erg += scan_schubert(obj); break;
483 #endif /* SCHUBERTTRUE */
484 #ifdef SCHURTRUE
485 case SCHUR: erg += scan_schur(obj); break;
486 #endif /* SCHURTRUE */
487 #ifdef SKEWPARTTRUE
488 case SKEWPARTITION: erg += scan_skewpartition(obj); break;
489 #endif /* SKEWPARTTRUE */
490 #ifdef SQRADTRUE
491 case SQ_RADICAL: erg += scan_sqrad(obj); break;
492 #endif /* SQRADTRUE */
493 #ifdef CHARTRUE
494 case SYMCHAR: erg += scan_symchar(obj); break;
495 #endif /* CHARTRUE */
496 #ifdef TABLEAUXTRUE
497 case PARTTABLEAUX:
498 erg += scan_parttableaux(obj);
499 break;
500 case SKEWTABLEAUX:
501 erg += scan_skewtableaux(obj);
502 break;
503 case TABLEAUX:
504 erg += scan_tableaux(obj);
505 break;
506 #endif /* TABLEAUXTRUE */
507 #ifdef VECTORTRUE
508 case VECTOR:
509 erg += scan_vector(obj); break;
510 case BITVECTOR:
511 erg += scan_bitvector(obj); break;
512 case PERMUTATIONVECTOR:
513 erg += scan_permvector(obj); break;
514 #endif /* VECTORTRUE */
515 #ifdef WORDTRUE
516 case WORD: erg += scan_word(obj); break;
517 #endif /* WORDTRUE */
518 default:
519 {
520 fprintf(stderr,"kind = %ld\n",kind);
521 erg += error("scan:wrong type");
522 goto endr_ende;
523 }
524 };
525 ENDR("scan");
526 }
527
skip(t,kind)528 INT skip(t,kind) char *t; OBJECTKIND kind;
529 /* AK 300998 */
530 /* return >= 0 gives the offset in t after the given object */
531 {
532 INT erg = OK;
533 COP("skip(1)",t);
534
535 switch(kind)
536 {
537 case INTEGER:
538 {
539 erg = skip_integer(t);
540 if (erg >= 0) return erg;
541 }
542 default:
543 {
544 fprintf(stderr,"kind = %ld\n",kind);
545 erg += error("skip:wrong type");
546 goto endr_ende;
547 }
548 }
549 ENDR("skip");
550 }
551
sscan(t,kind,obj)552 INT sscan(t,kind,obj) char *t; OBJECTKIND kind; OP obj;
553 /* AK 301293 */
554 {
555 INT erg = OK;
556 COP("sscan(1)",t);
557 COP("sscan(3)",obj);
558
559 if (not EMPTYP(obj))
560 erg += freeself(obj);
561 switch(kind)
562 {
563 #ifdef INTEGERTRUE
564 case INTEGER: erg += sscan_integer(t,obj); break;
565 #endif /* INTEGERTRUE */
566 #ifdef VECTORTRUE
567 case BITVECTOR: erg += sscan_bitvector(t,obj); break;
568 case INTEGERVECTOR: erg += sscan_integervector(t,obj); break;
569 case PERMUTATIONVECTOR: erg += sscan_permvector(t,obj); break;
570 #endif /* VECTORTRUE */
571 #ifdef LONGINTTRUE
572 case LONGINT: erg += sscan_longint(t,obj); break;
573 #endif /* LONGINTTRUE */
574 #ifdef PARTTRUE
575 case PARTITION:
576 erg += sscan_partition(t,obj);
577 break;
578 case REVERSEPARTITION:
579 erg += sscan_reversepartition(t,obj);
580 break;
581 #endif /* PARTTRUE */
582 #ifdef PERMTRUE
583 case BARPERM: erg += sscan_bar(t,obj); break;
584 case PERMUTATION: erg += sscan_permutation(t,obj); break;
585 #endif /* PERMTRUE */
586 #ifdef SCHURTRUE
587 case ELMSYM: erg += sscan_elmsym(t,obj); break;
588 case HOMSYM: erg += sscan_homsym(t,obj); break;
589 case SCHUR: erg += sscan_schur(t,obj); break;
590 #endif /* SCHURTRUE */
591 #ifdef WORDTRUE
592 case WORD: erg += sscan_word(t,obj); break;
593 #endif /* WORDTRUE */
594
595
596 default:
597 {
598 fprintf(stderr,"kind = %ld\n",kind);
599 error("sscan:wrong type");
600 return(ERROR);
601 }
602 };
603 ENDR("sscan");
604 }
605
scanobjectkind()606 OBJECTKIND scanobjectkind()
607 /* routine zum einlesen des objecttyps 160787 */
608 /* AK 280689 V1.0 */ /* AK 020290 V1.1 */
609 /* AK 070291 V1.2 works with stderr instead of stdin */
610 /* AK 130891 V1.3 */
611 /* AK 240398 V2.0 */
612 {
613 INT erg;
614 INT i = 0L;
615
616 printeingabe("enter kind of object");
617 /* hier sind neue objecttypen einzufuegen */
618
619 #ifdef INTEGERTRUE
620 fprintf(stderr,"integer [1]");
621 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
622 #endif /* INTEGERTRUE */
623 #ifdef VECTORTRUE
624 fprintf(stderr,"vector [2]");
625 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
626 #endif /* VECTORTRUE */
627 #ifdef PARTTRUE
628 fprintf(stderr,"partition [3]");
629 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
630 #endif /* PARTTRUE */
631 #ifdef BRUCHTRUE
632 fprintf(stderr,"bruch [4]");
633 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
634 #endif /* BRUCHTRUE */
635 #ifdef PERMTRUE
636 fprintf(stderr,"permutation [6]");
637 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
638 #endif /* PERMTRUE */
639 #ifdef SKEWPARTTRUE
640 fprintf(stderr,"skewpart [7]");
641 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
642 #endif /* SKEWPARTTRUE */
643 #ifdef TABLEAUXTRUE
644 fprintf(stderr,"tableaux [8]");
645 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
646 #endif /* TABLEAUXTRUE */
647 #ifdef POLYTRUE
648 fprintf(stderr,"polynom [9]");
649 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
650 #endif /* POLYTRUE */
651 #ifdef SCHURTRUE
652 fprintf(stderr,"schurfunk [10]");
653 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
654 #endif /* SCHURTRUE */
655 #ifdef MATRIXTRUE
656 fprintf(stderr,"matrix [11]");
657 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
658 #endif /* MATRIXTRUE */
659 #ifdef HOMSYMTRUE
660 fprintf(stderr,"homsym [13]");
661 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
662 #endif /* HOMSYMTRUE */
663 #ifdef SCHUBERTTRUE
664 fprintf(stderr,"schubert [14]");
665 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
666 #endif /* SCHUBERTTRUE */
667 #ifdef KOSTKATRUE
668 fprintf(stderr,"kostka [16]");
669 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
670 #endif /* KOSTKATRUE */
671 #ifdef CHARTRUE
672 fprintf(stderr,"symchar [18]");
673 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
674 #endif /* CHARTRUE */
675 #ifdef WORDTRUE
676 fprintf(stderr,"word [19]");
677 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
678 #endif /* WORDTRUE */
679 #ifdef LISTTRUE
680 fprintf(stderr,"list [20]");
681 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
682 #endif /* LISTTRUE */
683 #ifdef LONGINTTRUE
684 fprintf(stderr,"longint [22]");
685 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
686 #endif /* LONGINTTRUE */
687 #ifdef POWSYMTRUE
688 fprintf(stderr,"powersum [28]");
689 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
690 #endif /* POWSYMTRUE */
691 #ifdef MONOMIALTRUE
692 fprintf(stderr,"mon. sym. [29]");
693 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
694 #endif /* MONOMIALTRUE */
695 #ifdef GRALTRUE
696 fprintf(stderr,"groupalg. [32]");
697 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
698 #endif /* GRALTRUE */
699 #ifdef ELMSYMTRUE
700 fprintf(stderr,"elm. sym. [33]");
701 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
702 #endif /* ELMSYMTRUE */
703 #ifdef FFTRUE
704 fprintf(stderr,"fin. field [35]");
705 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
706 #endif /* FFTRUE */
707 #ifdef REIHETRUE
708 fprintf(stderr,"reihe [36]");
709 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
710 #endif /* REIHETRUE */
711 #ifdef CYCLOTRUE
712 fprintf(stderr,"cyclotomic [41]");
713 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
714 #endif /* CYCLOTRUE */
715 #ifdef MONOPOLYTRUE
716 fprintf(stderr,"monopoly [42]");
717 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
718 #endif /* MONOPOLYTRUE */
719 #ifdef SQRADTRUE
720 fprintf(stderr,"radical [43]");
721 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
722 #endif /* SQRADTRUE */
723 fprintf(stderr,"bitvector [44]");
724 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
725 #ifdef LAURENTTRUE
726 fprintf(stderr,"laurent [45]");
727 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
728 #endif /* LAURENTTRUE */
729 fprintf(stderr,"barperm [46]");
730 if (i++ == 4L)fprintf(stderr,"\n"),i=0L;
731
732 fprintf(stderr,"\nwhat kind:? ");
733 scanf( "%" SCNINT ,&erg);
734 if (erg == 46) erg = BARPERM;
735 return (OBJECTKIND)erg;
736 }
737
objectread(f,obj)738 INT objectread(f,obj) FILE *f; OP obj;
739 /* AK 131086 */ /* AK 280689 V1.0 */ /* AK 160190 V1.1 */ /* AK 020591 V1.2 */
740 /* AK 090891 V1.3 */
741 /* AK 240398 V2.0 */
742 {
743 OBJECTKIND kind;
744 INT c,erg=OK,i;
745 COP("objectread(1)",f);
746 COP("objectread(2)",obj);
747
748 FREESELF(obj);
749 i=fscanf(f, "%" SCNINT ,&c);
750 SYMCHECK(i!=1,"objectread:could not read datatype");
751 kind = (OBJECTKIND)c;
752 switch(kind)
753 {
754 case (OBJECTKIND)0:
755 break;
756 #ifdef BRUCHTRUE
757 case BRUCH:
758 erg += objectread_bruch(f,obj);
759 break;
760 #endif /* BRUCHTRUE */
761 #ifdef FFTRUE
762 case FF:
763 erg += objectread_ff(f,obj);
764 break;
765 #endif /* FFTRUE */
766 #ifdef INTEGERTRUE
767 case INTEGER:
768 erg += objectread_integer(f,obj);
769 break;
770 #endif /* INTEGERTRUE */
771 #ifdef LISTTRUE
772 case GRAL: case HOM_SYM: case POW_SYM: case MONOMIAL:
773 case ELM_SYM: case SCHUR: case MONOPOLY: case POLYNOM:
774 case SCHUBERT: case LIST:
775 erg += objectread_list(f,obj);
776 C_O_K(obj,kind);
777 break;
778 #endif /* LISTTRUE */
779 #ifdef LONGINTTRUE
780 case LONGINT:
781 erg += objectread_longint(f,obj);
782 break;
783 #endif /* LONGINTTRUE */
784 #ifdef MATRIXTRUE
785 case MATRIX:
786 erg += objectread_matrix(f,obj);
787 break;
788 #endif /* MATRIXTRUE */
789 #ifdef MONOMTRUE
790 case MONOM:
791 erg += objectread_monom(f,obj);
792 break;
793 #endif /* MONOMTRUE */
794 #ifdef NUMBERTRUE
795 case SQ_RADICAL:
796 erg += OBJECTREAD_SQRAD(f,obj);
797 break;
798 case CYCLOTOMIC:
799 erg += OBJECTREAD_CYCLO(f,obj);
800 break;
801 #endif /* NUMBERTRUE */
802 #ifdef PARTTRUE
803 case PARTITION:
804 erg += objectread_partition(f,obj);
805 break;
806 #endif /* PARTTRUE */
807 #ifdef PERMTRUE
808 case PERMUTATION:
809 erg += objectread_permutation(f,obj);
810 break;
811 #endif /* PERMTRUE */
812 #ifdef CHARTRUE
813 case SYMCHAR:
814 erg += objectread_symchar(f,obj);
815 break;
816 #endif /* CHARTRUE */
817 #ifdef SKEWPARTTRUE
818 case SKEWPARTITION:
819 erg += objectread_skewpartition(f,obj);
820 break;
821 #endif /* SKEWPARTTRUE */
822 #ifdef TABLEAUXTRUE
823 case TABLEAUX:
824 erg += objectread_tableaux(f,obj);
825 break;
826 #endif /* TABLEAUXTRUE */
827 #ifdef VECTORTRUE
828 case HASHTABLE:
829 erg += objectread_hashtable(f,obj);
830 break;
831 case COMPOSITION:
832 case INTEGERVECTOR:
833 case VECTOR:
834 case GALOISRING:
835 erg += objectread_vector(f,obj);
836 C_O_K(obj,c);
837 break;
838 case BITVECTOR:
839 erg += objectread_bv(f,obj);
840 break;
841 #endif /* VECTORTRUE */
842 default:
843 fprintf(stderr,"kind = %ld\n",kind);
844 erg += error("objectread:wrong type");
845 goto oe;
846 };
847 oe:
848 ENDR("objectread");
849 }
850
objectwrite(f,obj)851 INT objectwrite(f,obj) FILE *f; OP obj;
852 /* AK 131086 */ /* AK 280689 V1.0 */ /* AK 160190 V1.1 */
853 /* AK 090891 V1.3 */
854 /* AK 240398 V2.0 */
855 {
856 INT erg = OK;
857 COP("objectwrite(1)",f);
858 COP("objectwrite(2)",obj);
859
860 switch(S_O_K(obj))
861 {
862 case 0: fprintf(f," %ld ",0L); return(OK);
863 #ifdef BRUCHTRUE
864 case BRUCH: erg += objectwrite_bruch(f,obj);break;
865 #endif /* BRUCHTRUE */
866 #ifdef FFTRUE
867 case FF: erg += objectwrite_ff(f,obj);break;
868 #endif /* FFTRUE */
869 #ifdef INTEGERTRUE
870 case INTEGER: erg += objectwrite_integer(f,obj);break;
871 #endif /* INTEGERTRUE */
872 #ifdef LISTTRUE
873 case GRAL: case HOM_SYM: case POW_SYM:
874 case ELM_SYM: case MONOMIAL: case SCHUR: case MONOPOLY:
875 case POLYNOM: case SCHUBERT: case LIST:
876 erg += objectwrite_list(f,obj);
877 break;
878 #endif /* LISTTRUE */
879 #ifdef LONGINTTRUE
880 case LONGINT: erg += objectwrite_longint(f,obj);break;
881 #endif /* LONGINTTRUE */
882 #ifdef MATRIXTRUE
883 case KRANZTYPUS: /* AK 220492 */
884 case MATRIX: erg += objectwrite_matrix(f,obj);break;
885 #endif /* MATRIXTRUE */
886 #ifdef MONOMTRUE
887 case MONOM: erg += objectwrite_monom(f,obj);break;
888 #endif /* MONOMTRUE */
889 #ifdef NUMBERTRUE
890 case SQ_RADICAL:
891 case CYCLOTOMIC: erg += objectwrite_number(f,obj);break;
892 #endif /* NUMBERTRUE */
893 #ifdef PARTTRUE
894 case PARTITION: erg += objectwrite_partition(f,obj);break;
895 #endif /* PARTTRUE */
896 #ifdef PERMTRUE
897 case PERMUTATION:erg += objectwrite_permutation(f,obj);break;
898 #endif /* PERMTRUE */
899 #ifdef CHARTRUE
900 case SYMCHAR:erg += objectwrite_symchar(f,obj);break;
901 #endif /* CHARTRUE */
902 #ifdef SKEWPARTTRUE
903 case SKEWPARTITION: erg += objectwrite_skewpartition(f,obj);
904 break;
905 #endif /* SKEWPARTTRUE */
906 #ifdef TABLEAUXTRUE
907 case TABLEAUX: erg += objectwrite_tableaux(f,obj);break;
908 #endif /* TABLEAUXTRUE */
909 #ifdef VECTORTRUE
910 case HASHTABLE:
911 erg += objectwrite_hashtable(f,obj);
912 break;
913 case INTEGERVECTOR:
914 case COMPOSITION:
915 case GALOISRING:
916 case VECTOR: erg += objectwrite_vector(f,obj);break;
917 case BITVECTOR: erg += objectwrite_bv(f,obj); break;
918 #endif
919 default:
920 {
921 printobjectkind(obj);
922 return error("objectwrite:wrong type");
923 }
924 };
925 ENDR("objectwrite");
926 }
927
928
tex(obj)929 INT tex(obj) OP obj;
930 /* tex-output of the object obj */
931 /* AK 101187 */ /* AK 060789 V1.0 */ /* AK 020290 V1.1 */
932 /* AK 300791 V1.3 */
933 /* AK 260298 V2.0 */
934 {
935 INT erg = OK;
936 /* es folgen zwei sonderfaelle */
937 EOP("tex(1)",obj);
938
939 switch(S_O_K(obj))
940 {
941 #ifdef BRUCHTRUE
942 case BRUCH: erg += tex_bruch(obj);break;
943 #endif /* BRUCHTRUE */
944 #ifdef CYCLOTRUE
945 case CYCLOTOMIC: erg += tex_cyclo(obj); break;
946 #endif /* CYCLOTRUE */
947 #ifdef INTEGERTRUE
948 case INTEGER: erg += tex_integer(obj);break;
949 #endif /* INTEGERTRUE */
950 #ifdef LONGINTTRUE
951 case LONGINT: erg += tex_longint(obj); break;
952 #endif /* LONGINTTRUE */
953 #ifdef MONOPOLYTRUE
954 case MONOPOLY: erg += tex_monopoly(obj); break;
955 #endif /* MONOPOLYTRUE */
956 #ifdef SCHUBERTTRUE
957 case SCHUBERT: erg += tex_schubert(obj); break;
958 #endif /* SCHUBERTTRUE */
959 #ifdef SCHURTRUE
960 case MONOMIAL:
961 case POW_SYM:
962 case ELM_SYM:
963 case HOM_SYM:
964 case SCHUR:erg += tex_schur(obj); break;
965 #endif /* SCHURTRUE */
966 #ifdef CHARTRUE
967 case SYMCHAR: erg += tex_symchar(obj); break;
968 #endif /* CHARTRUE */
969 case GRAL:
970 #ifdef LISTTRUE
971 case LIST: erg += tex_list(obj);break;
972 #endif /* LISTTRUE */
973 #ifdef MATRIXTRUE
974 case KOSTKA:
975 case MATRIX: erg += tex_matrix(obj);break;
976
977 #endif /* MATRIXTRUE */
978 #ifdef MONOMTRUE
979 case MONOM: erg += tex_monom(obj);break;
980 #endif /* MONOMTRUE */
981 #ifdef PARTTRUE
982 case PARTITION: erg+= tex_partition(obj);break;
983 #endif /* PARTTRUE */
984 #ifdef PERMTRUE
985 case PERMUTATION: erg+= tex_permutation(obj);break;
986 #endif /* PERMTRUE */
987 #ifdef POLYTRUE
988 case POLYNOM: erg+= tex_polynom(obj);break;
989 #endif /* POLYTRUE */
990 #ifdef TABLEAUXTRUE
991 case TABLEAUX: erg+= tex_tableaux(obj);break;
992 #endif /* TABLEAUXTRUE */
993 #ifdef SQRADTRUE
994 case SQ_RADICAL: erg += tex_sqrad(obj);break;
995 #endif /* SQRADTRUE */
996 #ifdef VECTORTRUE
997 case INTEGERVECTOR:
998 case SUBSET:
999 case HASHTABLE:
1000 case COMPOSITION:
1001 case VECTOR:
1002 erg += tex_vector(obj);
1003 break;
1004 #endif /* VECTORTRUE */
1005 default:
1006 WTO("tex",obj);
1007 break;
1008 };
1009 ENDR("tex");
1010 }
1011
1012
1013 #ifdef MATRIXTRUE
1014 #ifdef POLYTRUE
latex_glm_dar(M)1015 INT latex_glm_dar(M) OP M;
1016 /* RH */
1017 /* AK 280192 output to texout */
1018 /* AK 240398 V2.0 */
1019 {
1020 INT i;
1021 INT j;
1022 INT k;
1023 INT var = 1L;
1024
1025 OP moddy = callocobject();
1026 OP rest = callocobject();
1027 OP vier = callocobject();
1028
1029 if(S_M_LI(M) >= 10) var = 1L;
1030 M_I_I(var,vier);
1031 ganzdiv(S_M_L(M),vier,moddy);
1032 mult(moddy,vier,vier);
1033 sub(S_M_L(M),vier,rest);
1034
1035 if(S_I_I(moddy) != 0L)
1036 {
1037 fprintf(texout,"$$\n");
1038 fprintf(texout,"\\left[\n");
1039 for(i=0L;i<S_I_I(moddy);++i)
1040 {
1041 if(i != 0L)
1042 {
1043 fprintf(texout,"$$\n");
1044 fprintf(texout,"\\left.\n");
1045 }
1046 fprintf(texout,"\\begin{array}{l");
1047 for(j=1L;j<var;++j) fprintf(texout,"|l");
1048 fprintf(texout,"}\n");
1049 for(j=0L;j<S_M_HI(M);++j)
1050 {
1051 for(k=0L;k<var;++k)
1052 {
1053 write_polynom(S_M_IJ(M,j,var*i+k));
1054 if(k != var-1L) fprintf(texout," & ");
1055 else
1056 if(j != S_M_HI(M)-1L)
1057 fprintf(texout,"\\\\\\hline\n");
1058 else
1059 fprintf(texout,"\\\\\n");
1060 }
1061 }
1062 fprintf(texout,"\\end{array}\n");
1063 if(i < S_I_I(moddy)-1L)
1064 {
1065 fprintf(texout,"\\right.\n");
1066 fprintf(texout,"$$\n");
1067 }
1068 else
1069 if(i < S_I_I(moddy))
1070 {
1071 if(S_I_I(rest) != 0L)
1072 {
1073 fprintf(texout,"\\right.\n");
1074 fprintf(texout,"$$\n");
1075 }
1076 else
1077 {
1078 fprintf(texout,"\\right]\n");
1079 fprintf(texout,"$$\n");
1080 }
1081 }
1082 }
1083 }
1084 if(S_I_I(rest) != 0L)
1085 {
1086 fprintf(texout,"\n\\bigskip\n");
1087 fprintf(texout,"$$\n");
1088 if(S_I_I(moddy) != 0)
1089 fprintf(texout,"\\left.\n");
1090 else
1091 fprintf(texout,"\\left[\n");
1092 fprintf(texout,"\\begin{array}{l");
1093 for(j=1L;j<S_I_I(rest)-1L;++j)
1094 fprintf(texout,"|l");
1095 fprintf(texout,"|l}\n");
1096 for(j=0L;j<S_M_HI(M);++j)
1097 {
1098 for(k=0L;k<S_I_I(rest);++k)
1099 {
1100 write_polynom(S_M_IJ(M,j,var*S_I_I(moddy)+k));
1101 if(k != S_I_I(rest)-1L) fprintf(texout," & ");
1102 else
1103 if(j != S_M_HI(M)-1L) fprintf(texout,"\\\\\\hline\n");
1104 else fprintf(texout,"\\\\\n");
1105 }
1106 }
1107 fprintf(texout,"\\end{array}\n");
1108 fprintf(texout,"\\right]\n");
1109 fprintf(texout,"$$\n");
1110 }
1111
1112 freeall(moddy);
1113 freeall(rest);
1114 freeall(vier);
1115 return OK;
1116 }
1117 #endif /* POLYTRUE */
1118 #endif /* MATRIXTRUE */
1119
1120 #ifdef POLYTRUE
write_polynom(poly)1121 static INT write_polynom(poly) OP poly;
1122 /* AK 280192 output to texout */
1123 /* AK 240398 V2.0 */
1124 {
1125 INT k,l;
1126 OP z = poly;
1127
1128 while(z != NULL)
1129 {
1130 if(!nullp(s_po_k(z)) && !emptyp(s_po_k(z)))
1131 {
1132 ausgabe_koeff(s_po_k(z));
1133 for(k=0L;k<S_M_HI(s_po_s(z));++k)
1134 {
1135 for(l=0L;l<S_M_LI(s_po_s(z));++l)
1136 if(S_M_IJI(s_po_s(z),k,l) > 0L)
1137
1138 if(S_M_IJI(s_po_s(z),k,l) == 1L)
1139 fprintf(texout,"x_{%ld %ld} ",k+1L,l+1L);
1140 else
1141 fprintf(texout,"x_{%ld %ld}^{%ld} ",k+1L,l+1L,S_M_IJI(s_po_s(z),k,l));
1142 }
1143 if(S_PO_N(z) != NULL)
1144 {
1145 fprintf(texout,"+");
1146 }
1147 }
1148 z = S_PO_N(z);
1149 }
1150 return OK;
1151 }
1152 #endif /* POLYTRUE */
1153
ausgabe_koeff(k)1154 static INT ausgabe_koeff(k) OP k;
1155 /* AK 280192 output to texout */
1156 /* AK 240398 V2.0 */
1157 {
1158 switch(S_O_K(k))
1159 {
1160 case INTEGER:
1161 {
1162 if(S_I_I(k) == 1L)
1163 break;
1164
1165 if(S_I_I(k) == -1L)
1166 {
1167 fprintf(texout,"-");
1168 break;
1169 }
1170 print(k);
1171 break;
1172 }
1173 #ifdef BRUCHTRUE
1174 case BRUCH:
1175 {
1176 kuerzen(k);
1177 fprintf(texout,"\\frac{");
1178 ausgabe_koeff(S_B_O(k));
1179 fprintf(texout,"}{");
1180 ausgabe_koeff(S_B_U(k));
1181 fprintf(texout,"}");
1182 break;
1183 }
1184 #endif /* BRUCHTRUE */
1185 #ifdef NUMBERTRUE
1186 case SQ_RADICAL:
1187 {
1188 OP ptr = S_N_S(k);
1189 while(ptr != NULL)
1190 {
1191 fprintf(texout,"\\sqrt{");
1192 ausgabe_koeff(S_PO_S(ptr));
1193 fprintf(texout,"}");
1194 ptr = S_L_N(ptr);
1195 }
1196 break;
1197 }
1198 #endif /* NUMBERTRUE */
1199 default:
1200 {
1201 printobjectkind(k);
1202 error("unknown type of coefficient !!!\n");
1203 break;
1204 }
1205 }
1206 return OK;
1207 }
1208
1209