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