1 /* file: poly.c */
2 #include "def.h"
3 #include "macro.h"
4
5 struct monom * callocmonom();
6
7 INT mem_counter_monom=0;
8
9 static int tex_poly_var = LETTERS;
10 static int tex_poly_first_var_index = (INT)0;
11 /* static INT monom_speicher_ende(); */
12
13
14 #ifdef POLYTRUE
get_tex_polynom_parameter(a)15 INT get_tex_polynom_parameter(a) INT a; /* AK 090395 */
16 {
17 INT erg = OK;
18 switch(a)
19 {
20 case VARTYP:
21 return tex_poly_var;
22 case FIRSTVARINDEX:
23 return tex_poly_first_var_index;
24 default:
25 erg += error("get_tex_polynom:wrong parameter");
26 goto endr_ende;
27 }
28 ENDR("get_tex_polynom_parameter");
29 }
30
31
set_tex_polynom_parameter(i,a)32 INT set_tex_polynom_parameter(i,a) INT i,a; /* AK 090395 */
33 {
34 INT erg =OK;
35 switch(i)
36 {
37 case FIRSTVARINDEX:
38 tex_poly_first_var_index = a;
39 break;
40 case VARTYP:
41 if (a == LETTERS)
42 tex_poly_var = LETTERS;
43 else if (a == NUMERICAL)
44 tex_poly_var = NUMERICAL;
45 else
46 {
47 erg += error("set_tex_polynom:VARTYP:wrong parameter");
48 goto endr_ende;
49 }
50 break;
51 default:
52 erg+= error("set_tex_polynom:wrong parameter");
53 goto endr_ende;
54 }
55 ENDR("set_tex_polynom_parameter");
56 }
57
58
monom_release()59 INT monom_release()
60 /* AK 100893 */
61 {
62 INT erg = OK;
63 return erg;
64 }
65
66
eval_polynom(poly,vec,res)67 INT eval_polynom(poly,vec,res) OP poly,vec,res;
68 /* AK 310588 */
69 /* ein polynom wird ausgewertet indem der vector
70 vec eingesetzt wird
71 bsp poly:= 2 [3,0,1]
72 vec:= [4,4,5]
73 res = 2 * 4^3 * 5 = 640 [0,0,0] */
74 /* AK 110789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
75 /* AK 220904 V3.0 */
76 {
77 INT erg=OK;
78 CTO(POLYNOM,"eval_polynom(1)",poly);
79 CTTO(VECTOR,INTEGERVECTOR,"eval_polynom(2)",vec);
80 CE3(poly,vec,res,eval_polynom);
81 {
82 OP zeiger = poly,monom,z;
83 OP speicher;
84 INT i,l;
85
86 if (NULLP(poly))
87 {
88 init(POLYNOM,res);
89 goto endr_ende;
90 }
91
92 if (scalarp(poly))
93 {
94 erg += m_scalar_polynom(poly,res);
95 goto endr_ende;
96 }
97
98
99 speicher = callocobject();
100 m_il_v(10,speicher);
101 for (i=0;i<10;i++) m_il_v(S_V_LI(vec),S_V_I(speicher,i));
102
103 // c = callocobject();
104 while (zeiger != NULL)
105 {
106 monom = callocobject();
107 erg += m_skn_po(S_PO_S(zeiger),S_PO_K(zeiger),NULL,monom);
108 if (not VECTORP(S_PO_S(zeiger)))
109 {
110 printobjectkind(S_PO_S(zeiger));
111 return error("eval_polynom:self != VECTOR ");
112 }
113 for (i=(INT)0;i<S_PO_SLI(zeiger); i++)
114 {
115 if (i >= S_V_LI(vec)) goto evalpoly3;
116 /* i ist < S_V_LI(vec) */
117 if (not EMPTYP(S_V_I(vec,i)))
118 if (S_PO_SII(zeiger,i) != (INT)0)
119 {
120 if (S_PO_SII(zeiger,i) != 1L)
121 {
122 if (S_PO_SII(zeiger,i) >= S_V_LI(speicher))
123 {
124 l = S_V_LI(speicher);
125 inc_vector_co(speicher,
126 S_PO_SII(zeiger,i)-S_V_LI(speicher)+1);
127 for (;l<S_V_LI(speicher);l++)
128 m_il_v(S_V_LI(vec),S_V_I(speicher,l));
129 }
130
131 z = S_V_I(S_V_I(speicher,S_PO_SII(zeiger,i)),i);
132 if (EMPTYP(z))
133 erg += hoch(S_V_I(vec,i),S_PO_SI(zeiger,i),z);
134 MULT_APPLY(z,S_PO_K(monom));
135 }
136 else /* AK 040892 */
137 MULT_APPLY(S_V_I(vec,i),S_PO_K(monom));
138 }
139 M_I_I((INT)0,S_PO_SI(monom,i));
140 };
141 evalpoly3:
142 insert(monom,res,add_koeff,comp_monomvector_monomvector);
143 zeiger = S_PO_N(zeiger);
144 }
145 if (nullp(res))
146 erg += m_i_i(0,res);
147 else if (S_PO_N(res) == NULL) /* AK 311091 */
148 if (nullp(S_PO_S(res))) /* scalar as result */
149 {
150 OP c = CALLOCOBJECT();
151 SWAP(S_PO_K(res),c);
152 FREESELF(res);
153 SWAP(c,res);
154 FREEALL(c);
155 }
156 FREEALL(speicher);
157 }
158 ENDR("eval_polynom");
159 }
160 #endif /* POLYTRUE */
161
162
163
164
165 #ifdef MONOMTRUE
166 /* global as used in the macro B_SK_MO */
167 INT monom_speicherindex=-1; /* AK 301001 */
168 INT monom_speichersize=0; /* AK 301001 */
169 struct monom **monom_speicher=NULL; /* AK 301001 */
170
monom_anfang()171 INT monom_anfang()
172 /* AK 100893 */
173 {
174 ANFANG_MEMMANAGER(monom_speicher,monom_speicherindex,
175 monom_speichersize,mem_counter_monom);
176 return OK;
177 }
178
callocmonom()179 struct monom * callocmonom()
180 /* AK 230688 */ /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
181 {
182 INT erg =OK;
183 struct monom *c;
184 CALLOC_MEMMANAGER(struct monom,
185 monom_speicher,
186 monom_speicherindex,
187 mem_counter_monom,
188 c);
189 return c;
190 ENDTYP("callocmonom",struct monom *);
191 }
192
freemonom(v)193 INT freemonom(v) struct monom *v;
194 /* AK 231001 */
195 {
196 INT erg = OK;
197 FREE_MEMMANAGER(struct monom *,
198 monom_speicher,
199 monom_speicherindex,
200 monom_speichersize,
201 mem_counter_monom,
202 v);
203 ENDR("freemonom");
204 }
205
monom_ende()206 INT monom_ende()
207 /* AK 230101 */
208 {
209 INT erg = OK;
210 ENDE_MEMMANAGER(monom_speicher,
211 monom_speicherindex,
212 monom_speichersize,
213 mem_counter_monom,"monom_ende:speicher not freed");
214 ENDR("monom_speicher_ende");
215 }
216
217
m_sk_mo(self,koeff,c)218 INT m_sk_mo(self,koeff,c) OP self,koeff,c;
219 /* AK 070690 V1.1 */ /* AK 200891 V1.3 */
220 /* AK 211106 V3.1 */
221 {
222 INT erg = OK;
223 CE3(self,koeff,c,m_sk_mo);
224 B_SK_MO(CALLOCOBJECT(),CALLOCOBJECT(),c);
225 COPY(self,S_MO_S(c));
226 COPY(koeff,S_MO_K(c));
227 ENDR("m_sk_mo");
228 }
229
230
231
b_sk_mo(self,koeff,c)232 INT b_sk_mo(self,koeff,c) OP self,koeff,c;
233 /* build_self koeff_monom AK 230688 */
234 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
235 {
236 OBJECTSELF d;
237 INT erg = OK;
238 COP("b_sk_mo(3)",c);
239
240 SYMCHECK( ( (self != NULL) && (self == koeff) ) ,"b_sk_mo:identical objects");
241
242 d.ob_monom = callocmonom(); /* AK 161189 */
243
244 erg += b_ks_o(MONOM,d,c);
245 C_MO_S(c,self);
246 C_MO_K(c,koeff);
247 ENDR("b_sk_mo");
248 }
249
mult_apply_monom(a,b)250 INT mult_apply_monom(a,b) OP a,b;
251 /* AK 230999 */
252 {
253 INT erg = OK;
254 CTO(MONOM,"mult_apply_monom(1)",a);
255
256 if (S_O_K(b) == MONOM) {
257 erg += add_apply(S_MO_S(a), S_MO_S(b));
258 MULT_APPLY(S_MO_K(a), S_MO_K(b));
259 }
260 else {
261 erg += mult(a,b,b);
262 }
263 ENDR("mult_apply_monom");
264 }
265
mult_monom(a,b,c)266 INT mult_monom(a,b,c) OP a,b,c;
267 /* AK 230999 */
268 {
269 INT erg = OK;
270 CTO(MONOM,"mult_monom(1)",a);
271 CTO(EMPTY,"mult_monom(3)",c);
272
273 switch(S_O_K(b))
274 {
275 case INTEGER:
276 erg += copy_monom(a,c);
277 erg += mult_apply_integer(b,S_MO_K(c));
278 break;
279 case BRUCH:
280 erg += copy_monom(a,c);
281 erg += mult_apply_bruch(b,S_MO_K(c));
282 break;
283 case LONGINT:
284 erg += copy_monom(a,c);
285 erg += mult_apply_longint(b,S_MO_K(c));
286 break;
287 default:
288 erg += WTO("mult_monom",b);
289 }
290 ENDR("mult_monom");
291 }
292
293
294
objectwrite_monom(f,a)295 INT objectwrite_monom(f,a) FILE *f; OP a;
296 /* AK 210690 V1.1 */ /* AK 200891 V1.3 */
297 {
298 INT erg = OK;
299 COP("objectwrite_monom(1)",f);
300 fprintf(f, "%" PRIINT " " ,(INT)MONOM);
301 erg += objectwrite(f,S_MO_K(a));
302 erg += objectwrite(f,S_MO_S(a));
303 ENDR("objectwrite_monom");
304 }
305
306
307
objectread_monom(f,a)308 INT objectread_monom(f,a) FILE *f; OP a;
309 /* AK 210690 V1.1 */ /* AK 200891 V1.3 */
310 {
311 INT erg = OK;
312 COP("objectread_monom(1)",f);
313 erg += b_sk_mo(callocobject(),callocobject(),a);
314 erg += objectread(f,S_MO_K(a));
315 erg += objectread(f,S_MO_S(a));
316 ENDR("objectread_monom");
317 }
318
319
320
scan_monom(c)321 INT scan_monom(c) OP c;
322 /* AK 230688 */ /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
323 {
324 OBJECTKIND kind;
325 INT erg = OK;
326 CTO(EMPTY,"scan_monom(1)",c);
327
328 erg += b_sk_mo(callocobject(),callocobject(),c);
329 printeingabe("what kind of monom");
330 kind = scanobjectkind();
331
332 erg += scan(kind,S_MO_S(c));
333 printeingabe("what kind of coefficient");
334 kind = scanobjectkind();
335 erg += scan(kind,S_MO_K(c));
336 ENDR("scan_monom");
337 }
338
339
340
fprint_monom(f,monom)341 INT fprint_monom(f,monom) FILE *f; OP monom;
342 /* AK 230688 */ /* AK 100789 V1.0 */ /* AK 071289 V1.1 */
343 /* AK 040391 V1.2 */ /* AK 200891 V1.3 */
344 {
345 INT erg = OK;
346 COP("fprint_monom(1)",f);
347 CTO(MONOM,"fprint_monom(2)",monom);
348
349 if (dynamicp(S_MO_K(monom))) /* AK zum unterscheiden */
350 fprintf(f,"(");
351 erg += fprint(f,S_MO_K(monom));
352 if (dynamicp(S_MO_K(monom))) /* AK 240795 */
353 fprintf(f,")");
354 if (f==stdout)
355 {
356 if (zeilenposition > row_length) {
357 zeilenposition = (INT)0; fprintf(stdout,"\n"); }
358 else zeilenposition++;
359 }
360 fprintf(f," ");
361 erg += fprint(f,S_MO_S(monom));
362 if (f==stdout)
363 {
364 if (zeilenposition > row_length) {
365 zeilenposition = (INT)0;
366 fprintf(stdout,"\n");
367 }
368 }
369 ENDR("fprint_monom");
370 }
371
372
373
tex_monom(monom)374 INT tex_monom(monom) OP monom;
375 /* AK 230688 */ /* AK 100789 V1.0 */ /* AK 191289 V1.1 */
376 /* AK 070291 V1.2 tex to texout */ /* AK 200891 V1.3 */
377 {
378 INT erg = OK;
379 CTO(MONOM,"tex_monom(1)",monom);
380 if (POLYNOMP(S_MO_K(monom)))
381 fprintf(texout,"(");
382 erg += tex(S_MO_K(monom));
383 fprintf(texout,"\\ ");
384 texposition += (INT)2;
385 if (POLYNOMP(S_MO_K(monom))) /* AK 240795 */
386 fprintf(texout,")");
387 erg += tex(S_MO_S(monom));
388 ENDR("tex_monom");
389 }
390 #endif /* MONOMTRUE */
391
392 #ifdef POLYTRUE
m_s_po(self,poly)393 INT m_s_po(self,poly) OP self,poly;
394 /* AK 120790 V1.1 */ /* AK 200891 V1.3 */
395 {
396 INT erg = OK;
397 OP s;
398 COP("m_s_po(2)",poly);
399 s = CALLOCOBJECT();
400 COPY(self,s);
401 erg += b_s_po(s,poly);
402 ENDR("m_s_po");
403 }
404
405
406
b_s_po(self,poly)407 INT b_s_po(self,poly) OP self,poly;
408 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
409 /* AK 210904 V3.0 */
410 {
411 INT erg = OK;
412 COP("b_s_po(2)",poly);
413 SYMCHECK(self==poly,"b_s_po:two equal parameters");
414 {
415 erg += b_sn_l(CALLOCOBJECT(),NULL,poly);
416 C_O_K(poly,POLYNOM);
417 B_SK_MO(self,CALLOCOBJECT(),S_L_S(poly));
418 M_I_I(1,S_PO_K(poly));
419 }
420 ENDR("b_s_po");
421 }
422
423
424 #endif /* POLYTRUE */
425
426 #ifdef MONOMTRUE
freeself_monom(a)427 INT freeself_monom(a) OP a;
428 /* AK 100789 V1.0 */ /* AK 211189 V1.1 */ /* AK 140891 V1.3 */
429 {
430 INT erg = OK;
431 CTO(MONOM,"freeself_monom(1)",a);
432
433 FREEALL(S_MO_S(a));
434 FREEALL(S_MO_K(a));
435 FREEMONOM(S_O_S(a).ob_monom);
436 C_O_K(a,EMPTY);
437 ENDR("freeself_monom");
438 }
439
440
441
comp_monom(a,b)442 INT comp_monom(a,b) OP a,b;
443 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */
444 /* AK 080390 bei gleichheit von self wird koeff verglichen */
445 /* AK 200891 V1.3 */
446 {
447 INT erg=OK;
448 CTO(MONOM,"comp_monom(1)",a);
449 CTO(MONOM,"comp_monom(2)",b);
450 {
451 INT res;
452 res = COMP(S_MO_S(a), S_MO_S(b));
453 if (res != 0)
454 return res;
455 else
456 return COMP(S_MO_K(a),S_MO_K(b));
457 }
458 ENDR("comp_monom");
459 }
460
461
462
copy_monom(a,b)463 INT copy_monom(a,b) OP a,b;
464 /* AK 100789 V1.0 */ /* AK 071289 V1.1 */ /* AK 140891 V1.3 */
465 {
466 INT erg = OK;
467 CTO(MONOM,"copy_monom(1)",a);
468 CTO(EMPTY,"copy_monom(2)",b);
469 B_SK_MO(CALLOCOBJECT(),CALLOCOBJECT(),b);
470 COPY(S_MO_K(a), S_MO_K(b));
471 COPY(S_MO_S(a), S_MO_S(b));
472 ENDR("copy_monom");
473 }
474
475
476
s_mo_s(a)477 OP s_mo_s(a) OP a;
478 /* select_monom_self */ /* AK 100789 V1.0 */ /* AK 191289 V1.1 */
479 /* AK 200891 V1.3 */
480 {
481 OBJECTSELF c;
482 if (a == NULL)
483 return error("s_mo_s:a == NULL"),(OP)NULL;
484 if (S_O_K(a) != MONOM)
485 return error("s_mo_s:a != MONOM"),(OP)NULL;
486 c = s_o_s(a);
487 return(c.ob_monom->mo_self);
488 }
489
s_mo_k(a)490 OP s_mo_k(a) OP a;
491 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
492 {
493 OBJECTSELF c;
494 if (a == NULL)
495 return error("s_mo_k:a == NULL"),(OP)NULL;
496 if (S_O_K(a) != MONOM)
497 return error("s_mo_k:a != MONOM"),(OP)NULL;
498 c = s_o_s(a);
499 return(c.ob_monom->mo_koeff);
500 }
501
502 /* the following routines only work with self part which are VECTORobjects */
s_mo_sl(a)503 OP s_mo_sl(a) OP a;
504 /* AK 200891 V1.3 */
505 {
506 return s_v_l(s_mo_s(a));
507 }
s_mo_sli(a)508 INT s_mo_sli(a) OP a;
509 /* AK 200891 V1.3 */
510 {
511 return s_v_li(s_mo_s(a));
512 }
s_mo_si(a,i)513 OP s_mo_si(a,i) OP a;INT i;
514 /* AK 200891 V1.3 */
515 {
516 return s_v_i(s_mo_s(a),i);
517 }
s_mo_sii(a,i)518 INT s_mo_sii(a,i) OP a;INT i;
519 /* AK 200891 V1.3 */
520 {
521 return s_v_ii(s_mo_s(a),i);
522 }
523
524
s_mo_ki(a)525 INT s_mo_ki(a) OP a;
526 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
527 {
528 return(s_i_i(s_mo_k(a)));
529 }
530
c_mo_s(a,b)531 INT c_mo_s(a,b) OP a,b;
532 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
533 {
534 OBJECTSELF c;
535 c = s_o_s(a);
536 c.ob_monom->mo_self = b;
537 return(OK);
538 }
539
c_mo_k(a,b)540 INT c_mo_k(a,b) OP a,b;
541 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
542 {
543 OBJECTSELF c;
544 c = s_o_s(a);
545 c.ob_monom->mo_koeff = b;
546 return(OK);
547 }
548
mult_scalar_monom(a,b,c)549 INT mult_scalar_monom(a,b,c) OP a,b,c;
550 /* AK 111188 */
551 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
552 {
553 INT erg = OK;
554 CTO(MONOM,"mult_scalar_monom(2)",b);
555 CTO(EMPTY,"mult_scalar_monom(3)",c);
556 B_SK_MO(CALLOCOBJECT(),CALLOCOBJECT(),c);
557 COPY(S_MO_S(b),S_MO_S(c));
558 MULT(S_MO_K(b),a,S_MO_K(c));
559 ENDR("mult_scalar_monom");
560 }
561
mult_integer_monom(a,b,c)562 INT mult_integer_monom(a,b,c) OP a,b,c;
563 /* AK 111188 */
564 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
565 {
566 INT erg = OK;
567 CTO(INTEGER,"mult_integer_monom(1)",a);
568 CTO(MONOM,"mult_integer_monom(2)",b);
569 CTO(EMPTY,"mult_integer_monom(3)",c);
570
571 B_SK_MO(CALLOCOBJECT(),CALLOCOBJECT(),c);
572 COPY(S_MO_S(b),S_MO_S(c));
573 MULT_INTEGER(a,S_MO_K(b),S_MO_K(c));
574
575 ENDR("mult_integer_monom");
576 }
577
578 #endif /* MONOMTRUE */
579
580 #ifdef POLYTRUE
mult_polynom(a,b,d)581 INT mult_polynom(a,b,d) OP a,b,d;
582 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 150591 V1.2 */
583 /* AK 080891 V1.3 */
584 /* CC 210595 fuer die rationnellen Funktionen*/
585
586 {
587 INT erg = OK;
588 OP tp1, tp2;
589 CTO(POLYNOM,"mult_polynom(1)",a);
590 CTO(EMPTY,"mult_polynom(3)",d);
591
592 if (NULLP(a))
593 {
594 M_I_I(0,d);
595 goto ende;
596 }
597
598 switch(S_O_K(b)) {
599 case INTEGER:
600 case FF:
601 case LONGINT:
602 erg+=mult_scalar_polynom(b,a,d);
603 break;
604 #ifdef BRUCHTRUE
605 case BRUCH:
606 if((!scalarp(S_B_O(b))) ||(!scalarp(S_B_U(b))))
607 {
608 tp1=callocobject();tp2=callocobject();
609 M_I_I(1L,tp1);m_ou_b(a,tp1,tp2);
610 copy(tp2,a);
611 freeall(tp1);freeall(tp2);
612 erg += mult_bruch_bruch(a,b,d);
613 }
614 else
615 erg+=mult_scalar_polynom(b,a,d);
616 break;
617 #endif /* BRUCHTRUE */
618 case POLYNOM: erg+=mult_polynom_polynom(a,b,d);
619 break;
620 #ifdef SCHUBERTTRUE
621 case SCHUBERT:
622 erg+=mult_schubert_polynom(b,a,d); /* AK 190690 */
623 goto ende;
624 #endif /* SCHUBERTTRUE */
625 #ifdef GRALTRUE
626 case GRAL:
627 erg += mult_scalar_gral(a,b,d);
628 goto ende;
629 #endif /* GRALTRUE */
630 #ifdef SCHURTRUE
631 case HOM_SYM:
632 erg += mult_homsym_scalar(b,a,d);
633 goto ende;
634 case MONOMIAL:
635 erg += mult_monomial_scalar(b,a,d);
636 goto ende;
637 case POW_SYM:
638 erg += mult_powsym_scalar(b,a,d);
639 goto ende;
640 case ELM_SYM:
641 erg += mult_elmsym_scalar(b,a,d);
642 goto ende;
643 case SCHUR:
644 erg += mult_schur_scalar(b,a,d);
645 goto ende;
646 #endif /* SCHURTRUE */
647 #ifdef MATRIXTRUE
648 case MATRIX:
649 erg+=mult_scalar_matrix(a,b,d);
650 goto ende;
651 #endif /* MATRIXTRUE */
652 #ifdef MONOMTRUE
653 case MONOM:
654 erg += mult_scalar_monom(a,b,d);
655 goto ende;
656 #endif /* MONOMTRUE */
657 case MONOPOLY:
658 erg += mult_monopoly_polynom(b,a,d);
659 goto ende;
660
661 default:
662 erg += WTO("mult_polynom(2)",b);
663 }
664 ende:
665 ENDR("mult_polynom");
666 }
667
668
669
mult_scalar_polynom(a,poly,res)670 INT mult_scalar_polynom(a,poly,res) OP a,poly,res;
671 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 150591 V1.2 */
672 /* AK 200891 V1.3 */
673 {
674 INT erg = OK;
675 CTO(POLYNOM,"mult_scalar_polynom(2)",poly);
676 CTO(EMPTY,"mult_scalar_polynom(3)",res);
677 MULT_SCALAR_MONOMLIST(a,poly,res);
678 ENDR("mult_scalar_polynom");
679 }
680
mult_polynom_polynom(eins,zwei,c)681 INT mult_polynom_polynom(eins,zwei,c) OP eins, zwei, c;
682 /* AK 100789 V1.0 */ /* AK 081289 V1.1 */ /* AK 150591 V1.2 */
683 /* AK 140891 V1.3 */
684 {
685 OP z, ez, zz;
686 INT erg = OK;
687 CTO(POLYNOM,"mult_polynom_polynom(1)",eins);
688 CTO(POLYNOM,"mult_polynom_polynom(2)",zwei);
689 CTO(EMPTY,"mult_polynom_polynom(3)",c);
690
691 erg += init_polynom(c);
692
693 if (NULLP(eins)) goto ende;
694 if (NULLP(zwei)) goto ende;
695
696 zz = zwei;
697 while (zz != NULL)
698 {
699 z = CALLOCOBJECT();
700 erg += copy_list(eins,z); /* eins ist polynom */
701
702 ez = z;
703 while (ez != NULL)
704 {
705 ADD_APPLY( S_PO_S(zz), S_PO_S(ez));
706 MULT_APPLY( S_PO_K(zz), S_PO_K(ez));
707 ez = S_PO_N(ez);
708 };
709 INSERT(z,c,add_koeff,comp_monomvector_monomvector);
710 zz = S_PO_N(zz);
711 };
712
713 ende:
714 CTO(POLYNOM,"mult_polynom_polynom(e3)",c);
715 ENDR("mult_polynom_polynom");
716 }
717
init_polynom(a)718 INT init_polynom(a) OP a;
719 /* AK 250102 */
720 {
721 INT erg = OK;
722 CTO(EMPTY,"init_polynom(1)",a);
723 erg += b_sn_l(NULL,NULL,a);
724 C_O_K(a,POLYNOM);
725 CTO(POLYNOM,"init_polynom(e1)",a);
726 ENDR("init_polynom");
727 }
728
729
730
numberofmonomials(a,n)731 INT numberofmonomials(a,n) OP a,n;
732 /* AK 230999 */
733 /* only works for positive integer coefficients */
734 {
735 INT erg = OK;
736 OP z;
737
738 CTO(POLYNOM,"numberofmonomials",a);
739 CE2(a,n,numberofmonomials);
740
741 erg += m_i_i((INT)0,n); /* frees the result automaticaly */
742 if (S_L_S(a) == NULL)
743 goto ne;
744 z = a;
745 while (z != NULL)
746 {
747 if (S_O_K(S_PO_K(z)) == INTEGER)
748 {
749 if (negp(S_PO_K(z))) { m_i_i(-1L,n); goto ne; }
750 else add_apply(S_PO_K(z),n);
751 }
752 else if (S_O_K(S_PO_K(z)) == LONGINT)
753 {
754 if (negp(S_PO_K(z))) { m_i_i(-1L,n); goto ne; }
755 else add_apply(S_PO_K(z),n);
756 }
757 else {
758 println(a);
759 WTO("numberofmonomials",S_PO_K(z));
760 m_i_i(-1L,n);
761 goto ne;
762 }
763 z = S_PO_N(z);
764 }
765 ne:
766 ENDR("numberofmonomials");
767 }
768
numberofvariables(a,n)769 INT numberofvariables(a,n) OP a,n;
770 /* AK 250692 */
771 /* n becomes the number of variables of the POLYNOM a */
772 {
773 INT i,erg = OK;
774 OP z;
775
776 CTO(POLYNOM,"numberofvariables(1)",a);
777 CE2(a,n,numberofvariables);
778
779 M_I_I((INT)0,n);
780 if (S_L_S(a) == NULL)
781 goto ne;
782 z = a;
783 while (z != NULL)
784 {
785 i = S_PO_SLI(z)-1L;
786 while (S_PO_SII(z,i) == (INT)0)
787 i--;
788 if (i+1L > S_I_I(n))
789 M_I_I(i+1L,n);
790 z = S_PO_N(z);
791 }
792 ne:
793 ENDR("numberofvariables");
794 }
795
796
mult_disjunkt_polynom_polynom(a,b,c)797 INT mult_disjunkt_polynom_polynom(a,b,c) OP a, b, c;
798 /* AK 300889 */
799 /* die beiden polynome haben disjunkte alphabete */
800 /* beim c werden die alphabete hintereinandergehaengt */
801 /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
802 {
803 OP z, ap, bp;
804 OP n,l;
805 INT i;
806 INT erg = OK;
807 CTO(POLYNOM,"mult_disjunkt_polynom_polynom(1)",a);
808 CTO(POLYNOM,"mult_disjunkt_polynom_polynom(2)",b);
809 CE3(a,b,c,mult_disjunkt_polynom_polynom);
810
811 /* first check the number of variables of a */ /* AK 250692 */
812 n = callocobject();
813 numberofvariables(a,n);
814
815 bp = b;
816 l = callocobject();
817 while (bp != NULL)
818 {
819 z = callocobject();
820 copy(a,z);
821
822 ap = z;
823 while (ap != NULL)
824 {
825 if (S_PO_SLI(ap) < S_I_I(n)) /* AK 250692 */
826 {
827 m_il_nv(S_I_I(n),l);
828 for (i=(INT)0;i<S_PO_SLI(ap);i++)
829 M_I_I(S_PO_SII(ap,i),S_V_I(l,i));
830 append(l,S_PO_S(bp),S_PO_S(ap));
831 }
832 else
833 append( S_PO_S(ap), S_PO_S(bp), S_PO_S(ap));
834 mult( S_PO_K(ap), S_PO_K(bp), S_PO_K(ap));
835 ap = S_PO_N(ap);
836 };
837
838 add_apply(z,c);
839 freeall(z);
840
841 bp = S_PO_N(bp);
842 };
843 FREEALL(n);
844 FREEALL(l);
845 ENDR("mult_disjunkt_polynom_polynom");
846 }
847
848
849
mult_apply_polynom_scalar(a,b)850 INT mult_apply_polynom_scalar(a,b) OP a,b;
851 /* AK 160290 V1.1 */ /* AK 200891 V1.3 */
852 {
853 INT erg = OK;
854 OP c;
855 CTO(POLYNOM,"mult_apply_polynom_scalar(1)",a);
856 c = CALLOCOBJECT();
857 *c = *b;
858 C_O_K(b,EMPTY);
859 erg += copy_polynom(a,b);
860 erg += mult_apply_scalar_polynom(c,b);
861 erg += freeall(c);
862 ENDR("mult_apply_polynom_scalar");
863 }
864
865
866
mult_apply_polynom(a,b)867 INT mult_apply_polynom(a,b) OP a,b;
868 /* AK 140290 V1.1 */ /* AK 140591 V1.2 */ /* AK 220791 V1.3 */
869 {
870 INT erg = OK; /* zuweisung AK091091 */
871 CTO(POLYNOM,"mult_apply_polynom(1)",a);
872 EOP("mult_apply_polynom(2)",b);
873 if (NULLP(b))
874 goto map_ende;
875
876 if (NULLP(a))
877 {
878 erg += m_i_i((INT)0,b);
879 goto map_ende;
880 }
881
882 switch(S_O_K(b)) {
883 case BRUCH:
884 case LONGINT:
885 case INTEGER: /* a ist scalar, b ist poly */
886 erg+= mult_apply_polynom_scalar(a,b);
887 goto map_ende;
888 case POLYNOM:
889 erg+= mult_apply_polynom_polynom(a,b);
890 goto map_ende;
891 default:
892 {
893 OP c = callocobject();
894 *c = *b; C_O_K(b,EMPTY);
895 erg = mult(a,c,b);
896 if (erg == ERROR) {
897 printobjectkind(c);
898 error("mult_apply_polynom:wrong second type");
899 }
900 freeall(c);
901 goto map_ende;
902 }
903 }
904 map_ende:
905 ENDR("mult_apply_polynom");
906 }
907
908
909
mult_apply_polynom_polynom(a,b)910 INT mult_apply_polynom_polynom(a,b) OP a,b;
911 /* AK 140290 V1.1 */ /* AK 170591 V1.2 */ /* AK 200891 V1.3 */
912 {
913 OP c;
914 INT erg=OK;
915 CTO(POLYNOM,"mult_apply_polynom_polynom(1)",a);
916 CTO(POLYNOM,"mult_apply_polynom_polynom(2)",b);
917 if (NULLP(b)) goto mape;
918 if (NULLP(a)) {
919 FREESELF(b);
920 erg += init_polynom(b);
921 goto mape;
922 }
923
924 if (S_PO_N(a) == NULL) /* AK 100394 */
925 {
926 c = b;
927 while (c != NULL)
928 {
929 MULT_APPLY(S_PO_K(a),S_PO_K(c));
930 ADD_APPLY(S_PO_S(a),S_PO_S(c));
931 c = S_PO_N(c);
932 }
933 goto mape;
934 }
935
936 c = CALLOCOBJECT();
937 *c = *b;
938 C_O_K(b,EMPTY);
939 erg += mult_polynom_polynom(a,c,b);
940 FREEALL(c);
941 mape:
942 ENDR("mult_apply_polynom_polynom");
943 }
944 #endif /* POLYTRUE */
945
mult_apply_scalar_monom(a,b)946 INT mult_apply_scalar_monom(a,b) OP a,b;
947 /* AK 150290 V1.1 */ /* AK 200891 V1.3 */
948 {
949 INT erg = OK;
950 CTO(MONOM,"mult_apply_scalar_monom(2)",b);
951 MULT_APPLY(a,S_MO_K(b));
952 ENDR("mult_apply_scalar_monom");
953 }
954
mult_apply_integer_monom(a,b)955 INT mult_apply_integer_monom(a,b) OP a,b;
956 {
957 INT erg = OK;
958 CTO(INTEGER,"mult_apply_integer_monom(1)",a);
959 CTO(MONOM,"mult_apply_integer_monom(2)",b);
960 MULT_APPLY_INTEGER(a,S_MO_K(b));
961 ENDR("mult_apply_integer_monom");
962 }
963
mult_apply_bruch_monom(a,b)964 INT mult_apply_bruch_monom(a,b) OP a,b;
965 {
966 INT erg = OK;
967 CTO(BRUCH,"mult_apply_bruch_monom(1)",a);
968 CTO(MONOM,"mult_apply_bruch_monom(2)",b);
969 MULT_APPLY_BRUCH(a,S_MO_K(b));
970 ENDR("mult_apply_bruch_monom");
971 }
972
973
974
975 #ifdef POLYTRUE
mult_apply_scalar_polynom(a,b)976 INT mult_apply_scalar_polynom(a,b) OP a,b;
977 /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
978 /* AK 030498 V2.0 */
979 {
980 OP z = b;
981 INT erg = OK;
982 OBJECTKIND k;
983 if (NULLP(a))
984 {
985 k = S_O_K(b);
986 erg += init(k,b);
987 goto endr_ende;
988 }
989
990 FORALL(z,b,{ MULT_APPLY(a,S_MO_K(z)); });
991
992 ENDR("mult_apply_scalar_polynom");
993 }
994
mult_apply_integer_polynom(a,b)995 INT mult_apply_integer_polynom(a,b) OP a,b;
996 /* AK 291001 */
997 {
998 INT erg = OK;
999 OBJECTKIND d = S_O_K(b);
1000 OP z;
1001 CTO(INTEGER,"mult_apply_integer_polynom(1)",a);
1002
1003 if (NULLP_INTEGER(a)) {
1004 erg += init(d,b);
1005 goto ende;
1006 }
1007
1008 FORALL(z,b, {
1009 MULT_APPLY_INTEGER(a,S_MO_K(z));
1010 });
1011
1012 ende:
1013 CTO(d,"mult_apply_integer_polynom(e2)",b);
1014 ENDR("mult_apply_integer_polynom");
1015 }
1016
mult_apply_longint_polynom(a,b)1017 INT mult_apply_longint_polynom(a,b) OP a,b;
1018 /* AK 291001 */
1019 {
1020 INT erg = OK;
1021 OBJECTKIND d = S_O_K(b);
1022 OP z;
1023 CTO(LONGINT,"mult_apply_longint_polynom(1)",a);
1024
1025 if (NULLP_LONGINT(a)) {
1026 erg += init(d,b);
1027 goto endr_ende;
1028 }
1029 if (S_L_S(b) == NULL) goto endr_ende;
1030 z = b;
1031 while (z != NULL)
1032 {
1033 MULT_APPLY_LONGINT(a,S_PO_K(z));
1034 z = S_L_N(z);
1035 }
1036
1037 ENDR("mult_apply_longint_polynom");
1038 }
1039
mult_apply_bruch_polynom(a,b)1040 INT mult_apply_bruch_polynom(a,b) OP a,b;
1041 /* AK 291001 */
1042 /* AK 090805 */
1043 {
1044 INT erg = OK;
1045 OBJECTKIND d = S_O_K(b);
1046 OP z;
1047 CTO(BRUCH,"mult_apply_bruch_polynom(1)",a);
1048
1049 if (NULLP_BRUCH(a)) {
1050 erg += init(d,b);
1051 goto endr_ende;
1052 }
1053 if (S_L_S(b) == NULL) goto endr_ende;
1054 z = b;
1055 while (z != NULL)
1056 {
1057 MULT_APPLY_BRUCH(a,S_PO_K(z));
1058 z = S_L_N(z);
1059 }
1060
1061 ENDR("mult_apply_bruch_polynom");
1062 }
1063
mod_monom(a,b,c)1064 INT mod_monom(a,b,c) OP a,b,c;
1065 {
1066 INT erg = OK;
1067 CTO(MONOM,"mod_monom(1)",a);
1068 CTTO(INTEGER,LONGINT,"mod_monom(2)",b);
1069 CE3(a,b,c,mod_monom);
1070 b_sk_mo(CALLOCOBJECT(),CALLOCOBJECT(),c);
1071 erg += mod(S_MO_K(a),b,S_MO_K(c));
1072 COPY(S_MO_S(a),S_MO_S(c));
1073 ENDR("mod_monom");
1074 }
1075
mod_polynom(a,b,c)1076 INT mod_polynom(a,b,c) OP a,b,c;
1077 /* AK 230703 */
1078 /* AK c = a mod b */
1079 /* scalar operation */
1080 {
1081 INT erg = OK;
1082 CTO(POLYNOM,"mod_polynom(1)",a);
1083 CTTO(INTEGER,LONGINT,"mod_polynom(2)",b);
1084 CE3(a,b,c,mod_polynom);
1085 {
1086 OP z,y; INT t=0;
1087 /* z over a, y over c */
1088 init_polynom(c);
1089 if (S_L_S(a) == NULL) goto endr_ende;
1090
1091 y = c;z=a;
1092 while (z!=NULL) {
1093 OP e;
1094 e = CALLOCOBJECT();
1095 erg +=mod_monom(S_L_S(z),b,e);
1096 if (NULLP(S_MO_K(e))) FREEALL(e);
1097 else {
1098 if (t==0) { C_L_S(y,e); t=1; }
1099 else {
1100 OP f;
1101 f = CALLOCOBJECT();
1102 erg +=b_sn_po(e,NULL,f);
1103 C_L_N(y,f);y = S_L_N(y);
1104 }
1105 }
1106 z=S_PO_N(z);
1107 }
1108 }
1109 ENDR("mod_polynom");
1110 }
1111
1112
1113
1114
1115
scan_polynom(poly)1116 INT scan_polynom(poly) OP poly;
1117 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1118 /* AK 201093: with add_apply */
1119 {
1120 char antwort[2];
1121 INT erg = OK;
1122 OP d;
1123 CTO(EMPTY,"scan_polynom(1)",poly);
1124
1125 erg +=
1126 printeingabe("input of a POLYNOM object as a sum of MONOM objects");
1127 erg += init(POLYNOM,poly);
1128 d = callocobject();
1129 spa:
1130 erg += b_sn_l(callocobject(),NULL,d);
1131 C_O_K(d,POLYNOM);
1132 erg += scan(MONOM,S_L_S(d));
1133 erg += add_apply(d,poly);
1134 spe:
1135 erg += printeingabe("one more monom y/n");
1136 skip_comment(); /* AK 210395 */
1137 scanf("%s",antwort);
1138 if (antwort[0] == 'y')
1139 goto spa;
1140 if (antwort[0] == 'j')
1141 goto spa;
1142 if (antwort[0] != 'n')
1143 goto spe;
1144 erg += freeall(d);
1145 ENDR("scan_polynom");
1146 }
1147
1148
1149
scan_fastpolynom(poly)1150 INT scan_fastpolynom(poly) OP poly;
1151 /* AK 211093 */
1152 {
1153 char antwort[2];
1154 INT erg = OK;
1155 OBJECTKIND kind;
1156 OP d;
1157 CTO(EMPTY,"scan_fastpolynom(1)",poly);
1158
1159 erg +=
1160 printeingabe("input of a POLYNOM object as a sum of MONOM objects");
1161 printeingabe("what kind of coefficient");
1162 kind = scanobjectkind();
1163 erg += init(POLYNOM,poly);
1164 d = callocobject();
1165 spa:
1166 erg += b_skn_po(callocobject(),callocobject(),NULL,d);
1167 printeingabe("enter the exponent vector of the polynom");
1168 erg += scan(INTEGERVECTOR,S_PO_S(d));
1169 printeingabe("enter the coefficient of the polynom");
1170 scan(kind,S_PO_K(d));
1171 erg += add_apply(d,poly);
1172 spe:
1173 erg += printeingabe("one more monom y/n");
1174 skip_comment(); /* AK 210395 */
1175 scanf("%s",antwort);
1176 if (antwort[0] == 'y')
1177 goto spa;
1178 if (antwort[0] == 'j')
1179 goto spa;
1180 if (antwort[0] != 'n')
1181 goto spe;
1182 erg += freeall(d);
1183 ENDR("scan_fastpolynom");
1184 }
1185 #endif /* POLYTRUE */
1186
1187
1188 #ifdef MONOMTRUE
add_monom(a,b,c)1189 INT add_monom(a,b,c) OP a,b,c;
1190 /* AK 201289 V1.1 */ /* AK 050891 V1.3 */
1191 {
1192 INT erg = OK;
1193 OP h;
1194 CTO(MONOM,"add_monom(1)",a);
1195 CTO(EMPTY,"add_monom(3)",c);
1196
1197 switch (S_O_K(b)) {
1198
1199 #ifdef HOMSYMTRUE
1200 case HOM_SYM: erg += add_monom_homsym(a,b,c);break;
1201 #endif /* HOMSYMTRUE */
1202
1203 #ifdef SCHURTRUE
1204 case SCHUR: erg += add_monom_schur(a,b,c);break;
1205 #endif /* SCHURTRUE */
1206
1207 case MONOM:
1208 erg += m_sn_l(a,NULL,c);
1209 C_O_K(c,POLYNOM);
1210 ADD_APPLY(b,c);
1211 break;
1212
1213 case POLYNOM:
1214 h = callocobject();
1215 erg += m_sn_l(a,NULL,h);
1216 C_O_K(h,POLYNOM);
1217 erg += add_polynom_polynom(h,b,c);
1218 FREEALL(h);
1219 break;
1220
1221 default:
1222 WTO("add_monom(2)",b);
1223 }
1224 ENDR("add_monom");
1225 }
1226 #endif /* MONOMTRUE */
1227
1228 #ifdef SCHURTRUE
add_monom_schur(a,b,d)1229 INT add_monom_schur(a,b,d) OP a,b,d;
1230 /* for all partition typ polynomials */
1231 /* AK 201289 V1.1 */ /* AK 050891 V1.3 */
1232 {
1233 INT erg = OK;
1234 OP c;
1235 CTO(MONOM,"add_monom_schur(1)",a);
1236
1237 c = callocobject();
1238 erg += init(S_O_K(b),c);
1239 erg += copy_monom(a,S_L_S(c));
1240 erg += add(c,b,d);
1241 erg += freeall(c);
1242 ENDR("add_monom_schur");
1243 }
1244 #endif /* SCHURTRUE */
1245
1246 #ifdef MONOMTRUE
add_koeff(a,b)1247 INT add_koeff(a,b) OP a,b;
1248 /* eqhandle bei insert bei polynomen, monopoly
1249 addiert die beiden koeffizienten der monome a und b
1250 nach dem monom b */
1251 /* wenn das ergebnis 0 ist wird das ergebnis geloescht */
1252
1253 /* AK 100789 V1.0 */ /* AK 231189 V1.1 */ /* AK 200891 V1.3 */
1254 {
1255 INT erg = OK;
1256 CTO(MONOM,"add_koeff",a);
1257 CTO(MONOM,"add_koeff",b);
1258
1259 ADD_APPLY(S_MO_K(a), S_MO_K(b));
1260 if (NULLP(S_MO_K(b)))
1261 erg += freeself_monom(b);
1262
1263 ENDR("add_koeff");
1264 }
1265 #endif /* MONOMTRUE */
1266
1267 #ifdef POLYTRUE
add_scalar_polynom(a,b,c)1268 INT add_scalar_polynom(a,b,c) OP a,b,c;
1269 /* a scalar, b polynom, c empty */
1270 /* AK 060891 V1.3 */
1271 /* AK 060498 V2.0 */
1272 {
1273 INT erg = OK;
1274 OP d;
1275 CTO(POLYNOM,"add_scalar_polynom",b);
1276
1277 if (nullp(a))
1278 {
1279 erg += copy_polynom(b,c);
1280 goto endr_ende;
1281 }
1282
1283 d = callocobject();
1284 erg += m_scalar_polynom(a,d);
1285 erg += add_polynom_polynom(d,b,c);
1286 erg += freeall(d);
1287 ENDR("add_scalar_polynom");
1288 }
1289
add_polynom(a,b,c)1290 INT add_polynom(a,b,c) OP a,b,c;
1291 /* AK 110789 V1.0 */ /* AK 191289 V1.1 */ /* AK 290591 V1.2 */
1292 /* AK 060891 V1.3 */
1293 /*CC 210595 Fuer die rationnellen Funktionen*/
1294
1295 {
1296 INT erg = OK;
1297 OP tp1,tp2;
1298
1299 CTO(EMPTY,"add_polynom(3)",c);
1300
1301 if (NULLP(a))
1302 {
1303 COPY(b,c);
1304 goto ende;
1305 }
1306 if (NULLP(b))
1307 {
1308 COPY(a,c);
1309 goto ende;
1310 }
1311
1312 switch (S_O_K(b))
1313 {
1314 case FF: /* AK 290304 */
1315 case INTEGER:
1316 case LONGINT:
1317 erg += add_scalar_polynom(b,a,c);
1318 goto ende; /* AK 060891 */
1319 case BRUCH:
1320 if((!scalarp(S_B_O(b)))
1321 ||(!scalarp(S_B_U(b))))
1322 {
1323 tp1=callocobject();tp2=callocobject();
1324 M_I_I(1L,tp1);m_ou_b(a,tp1,tp2);
1325 copy(tp2,a);
1326 freeall(tp1);freeall(tp2);
1327 erg += add_bruch_bruch(a,b,c);
1328 }
1329 else
1330 erg += add_scalar_polynom(b,a,c); /* AK 060891 */
1331
1332 goto ende;
1333 case GRAL:
1334 case POLYNOM:
1335 erg+= add_polynom_polynom(a,b,c);
1336 goto ende;
1337 case MONOPOLY: /* project to the first variable */
1338 /* CC */
1339 erg += t_POLYNOM_MONOPOLY(a,c);
1340 erg += add_apply_monopoly(b,c);
1341
1342 goto ende;
1343 default:
1344 WTO("add_polynom(2)",b);
1345 goto ende;
1346 }
1347 ende:
1348 ENDR("add_polynom");
1349 }
1350
1351
add_polynom_polynom(a,b,c)1352 INT add_polynom_polynom(a,b,c) OP a,b,c;
1353 /* works for all types */
1354 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 290591 V1.2 */
1355 /* AK 050891 V1.3 */
1356 {
1357 INT erg=OK;
1358 OP d;
1359 CTO(EMPTY,"add_polynom_polynom(3)",c);
1360
1361 if (
1362 (not LISTP(a))
1363 ||
1364 (not LISTP(b))
1365 )
1366 erg+= WTT("add_polynom_polynom(1,2)",a,b);
1367 SYMCHECK(S_O_K(a) != S_O_K(b), "add_polynom_polynom:different object types");
1368 d = callocobject();
1369 erg += copy_list(a,d);
1370 erg += copy_list(b,c);
1371
1372
1373 insert(d,c,add_koeff,comp_monomvector_monomvector);
1374
1375 ENDR("add_polynom_polynom");
1376 }
1377
1378
1379
posp_polynom(a)1380 INT posp_polynom(a) OP a;
1381 /* AK V2.0 221298 */
1382 /* TRUE if all coeffs > 0 */
1383 /* works also for other list objects */
1384 /* false for empty list */
1385 {
1386 OP z = a;
1387 if (S_L_S(a) == NULL) return FALSE;
1388 while (z != NULL)
1389 {
1390 if (not posp(S_PO_K(z)))
1391 return FALSE;
1392 z = S_PO_N(z);
1393 }
1394 return TRUE;
1395 }
1396
1397
1398
negp_polynom(a)1399 INT negp_polynom(a) OP a;
1400 /* AK V2.0 221298 */
1401 /* TRUE
1402 if all coeffs < 0 */
1403 /* works also for other list objects */
1404 {
1405 OP z = a;
1406 if (S_L_S(a) == NULL) return TRUE;
1407 while (z != NULL)
1408 {
1409 if (not negp(S_PO_K(z))) return FALSE;
1410 z = S_PO_N(z);
1411 }
1412 return TRUE;
1413 }
1414
1415
comp_polynom(a,b)1416 INT comp_polynom(a,b) OP a,b;
1417 {
1418 INT erg = OK;
1419 CTO(POLYNOM,"comp_polynom(1)",a);
1420
1421 switch (S_O_K(b))
1422 {
1423 case INTEGER:
1424 case LONGINT:
1425 case BRUCH:
1426 case FF:
1427 return comp_polynom_scalar(a,b);
1428 case POLYNOM:
1429 if ( (S_L_S(a) == NULL) && (S_L_S(b) == NULL) ) return 0;
1430 if (S_L_S(a) == NULL) return -1;
1431 if (S_L_S(b) == NULL) return 1;
1432 /* return comp_list_co(a,b,comp); AK061207 *//* comp but not comp_monomvector */
1433 return comp_list_co(a,b,comp_monomvector_monomvector);/* comp but not comp_monomvector */
1434 default:
1435 WTO("comp_polynom(2)",b);
1436 break;
1437 }
1438 ENDR("comp_polynom");
1439 }
1440
comp_polynom_scalar(a,b)1441 INT comp_polynom_scalar(a,b) OP a,b;
1442 /* AK 030298 */
1443 {
1444 if (not nullp(S_PO_S(a)))
1445 return -1;
1446 if (S_PO_N(a) != NULL)
1447 return 1;
1448 return comp(S_PO_K(a),b);
1449 }
1450
1451 #define COMP_MONOMSF(a,b)\
1452 if (S_PA_LI(S_MO_S(a)) == S_PA_LI(S_MO_S(b)))\
1453 {\
1454 INT i,l=S_PA_LI(S_MO_S(b)); OP ap,bp;\
1455 if (S_PA_LI(S_MO_S(a)) == 0) return 0;\
1456 ap = S_V_S (S_PA_S( S_MO_S(a) ));\
1457 bp = S_V_S (S_PA_S( S_MO_S(b) ));\
1458 for (i=0;i<l;i++,ap++,bp++)\
1459 if (S_I_I(ap) - S_I_I(bp)) return S_I_I(ap) - S_I_I(bp);\
1460 return 0;\
1461 }\
1462 else if (S_PA_LI(S_MO_S(a)) == 0) return -1;\
1463 else if (S_PA_LI(S_MO_S(b)) == 0) return 1;\
1464 else if ( S_PA_LI(S_MO_S(a)) > S_PA_LI(S_MO_S(b)) )\
1465 {\
1466 INT i,l=S_PA_LI(S_MO_S(b)); OP ap,bp;\
1467 ap = S_V_S (S_PA_S( S_MO_S(a) ));\
1468 bp = S_V_S (S_PA_S( S_MO_S(b) ));\
1469 for (i=0;i<l;i++,ap++,bp++)\
1470 if (S_I_I(ap) - S_I_I(bp)) return S_I_I(ap) - S_I_I(bp);\
1471 return 1;\
1472 }\
1473 else {\
1474 INT i,l=S_PA_LI(S_MO_S(a)); OP ap,bp;\
1475 ap = S_V_S (S_PA_S( S_MO_S(a) ));\
1476 bp = S_V_S (S_PA_S( S_MO_S(b) ));\
1477 for (i=0;i<l;i++,ap++,bp++)\
1478 if (S_I_I(ap) - S_I_I(bp)) return S_I_I(ap) - S_I_I(bp);\
1479 return -1;\
1480 }
1481
1482
comp_monompowsym(a,b)1483 INT comp_monompowsym(a,b) OP a,b;
1484 {
1485 INT erg = OK;
1486 CTO(MONOM,"comp_monompowsym",a);
1487 CTO(MONOM,"comp_monompowsym",b);
1488 CTO(PARTITION,"comp_monompowsym",S_MO_S(a));
1489 CTO(PARTITION,"comp_monompowsym",S_MO_S(b));
1490 COMP_MONOMSF(a,b);
1491 ENDR("comp_monompowsym");
1492 }
1493
comp_monomschur(a,b)1494 INT comp_monomschur(a,b) OP a,b;
1495 {
1496 INT erg = OK;
1497 CTO(MONOM,"comp_monomschur(1)",a);
1498 CTO(MONOM,"comp_monomschur(2)",b);
1499 CTO(PARTITION,"comp_monomschur(1)",S_MO_S(a));
1500 CTO(PARTITION,"comp_monomschur(2)",S_MO_S(b));
1501 COMP_MONOMSF(a,b);
1502 ENDR("comp_monomschur");
1503 }
1504
eq_monomsymfunc(a,b)1505 INT eq_monomsymfunc(a,b) OP a,b;
1506 {
1507 INT erg = OK;
1508 CTO(MONOM,"eq_monomsymfunc(1)",a);
1509 CTO(MONOM,"eq_monomsymfunc(2)",b);
1510 CTO(PARTITION,"eq_monomsymfunc(1)",S_MO_S(a));
1511 CTO(PARTITION,"eq_monomsymfunc(2)",S_MO_S(b));
1512 return eq_partition_partition(S_MO_S(a),S_MO_S(b));
1513 ENDR("eq_monomsymfunc");
1514 }
1515
eq_monomsymfunchash(a,b)1516 INT eq_monomsymfunchash(a,b) OP a,b;
1517 {
1518 INT erg = OK;
1519 CTO(MONOM,"eq_monomsymfunchash(1)",a);
1520 CTO(MONOM,"eq_monomsymfunchash(2)",b);
1521 CTO(PARTITION,"eq_monomsymfunchash(1)",S_MO_S(a));
1522 CTO(PARTITION,"eq_monomsymfunchash(2)",S_MO_S(b));
1523 return S_PA_HASH(S_MO_S(a)) == S_PA_HASH(S_MO_S(b)) ;
1524 ENDR("eq_monomsymfunchash");
1525 }
1526
1527
1528
comp_monomhomsym(a,b)1529 INT comp_monomhomsym(a,b) OP a,b;
1530 {
1531 INT erg = OK;
1532 CTO(MONOM,"comp_monomhomsym",a);
1533 CTO(MONOM,"comp_monomhomsym",b);
1534 CTO(PARTITION,"comp_monomhomsym",S_MO_S(a));
1535 CTO(PARTITION,"comp_monomhomsym",S_MO_S(b));
1536 COMP_MONOMSF(a,b);
1537 ENDR("comp_monomhomsym");
1538 }
comp_monommonomial(a,b)1539 INT comp_monommonomial(a,b) OP a,b;
1540 {
1541 INT erg = OK;
1542 CTO(MONOM,"comp_monommonomial",a);
1543 CTO(MONOM,"comp_monommonomial",b);
1544 CTO(PARTITION,"comp_monommonomial",S_MO_S(a));
1545 CTO(PARTITION,"comp_monommonomial",S_MO_S(b));
1546 COMP_MONOMSF(a,b);
1547 ENDR("comp_monommonomial");
1548 }
comp_monomelmsym(a,b)1549 INT comp_monomelmsym(a,b) OP a,b;
1550 {
1551 INT erg = OK;
1552 CTO(MONOM,"comp_monomelmsym",a);
1553 CTO(MONOM,"comp_monomelmsym",b);
1554 CTO(PARTITION,"comp_monomelmsym",S_MO_S(a));
1555 CTO(PARTITION,"comp_monomelmsym",S_MO_S(b));
1556 COMP_MONOMSF(a,b);
1557 ENDR("comp_monomelmsym");
1558 }
1559
comp_monomvector_monomvector(a,b)1560 INT comp_monomvector_monomvector(a,b) OP a,b;
1561 /* vergleicht zwei monome von vectorform */
1562 /* wenn keine vectorform dann der normale vergleich */
1563 /* AK 100789 V1.0 */ /* AK 081289 V1.1 */ /* vergleich bei polynomen */
1564 /* AK 120391 V1.2 */ /* AK 200891 V1.3 */
1565 {
1566 INT i,j,erg=OK;
1567 OP as,bs;
1568
1569
1570
1571 CTO(MONOM,"comp_monomvector_monomvector",a);
1572 CTO(MONOM,"comp_monomvector_monomvector",b);
1573
1574 as = S_MO_S(a);
1575 bs = S_MO_S(b);
1576
1577 if ( (S_O_K(as) == PARTITION)
1578 &&
1579 (S_O_K(bs)==PARTITION) )
1580 {
1581 return comp_partition(as,bs);
1582 }
1583
1584 if ( (S_O_K(as) == PERMUTATION)
1585 &&
1586 (S_O_K(bs)==PERMUTATION) )
1587 /* AK 210690 if schubert polynom */
1588 /* or gral */
1589 {
1590 erg=1L;
1591 if (S_P_LI(bs) > S_P_LI(as)) {
1592 a=bs;
1593 bs=as;
1594 as=a;
1595 erg= -1L;
1596 }
1597 /* as ist laenger als bs */
1598 for (i=(INT)0; i<S_P_LI(as); i++)
1599 {
1600 if (i < S_P_LI(bs))
1601 {
1602 if (S_P_II(as,i) > S_P_II(bs,i)) return erg*1L;
1603 if (S_P_II(as,i) < S_P_II(bs,i)) return erg*-1L;
1604 }
1605 else {
1606 if (S_P_II(as,i) < i+1L) return erg*-1L;
1607 if (S_P_II(as,i) > i+1L) return erg*1L;
1608 }
1609 }
1610 return (INT)0;
1611 }
1612 if ( (S_O_K(as) == MATRIX)
1613 &&
1614 (S_O_K(bs)==MATRIX) )
1615 {
1616 INT h,l;
1617 h = (S_M_HI(as) > S_M_HI(bs) ? S_M_HI(as) : S_M_HI(bs));
1618 l = (S_M_LI(as) > S_M_LI(bs) ? S_M_LI(as) : S_M_LI(bs));
1619 for (i=(INT)0; i<h; i++)
1620 for (j=(INT)0; j<l; j++)
1621 {
1622 if (
1623 ( i<S_M_HI(as) ) &&
1624 ( i<S_M_HI(bs) ) &&
1625 ( j<S_M_LI(as) ) &&
1626 ( j<S_M_LI(bs) )
1627 )
1628 if ((erg = COMP(S_M_IJ(as,i,j),S_M_IJ(bs,i,j)))
1629 != (INT)0) return erg;
1630 if (
1631 ( i>=S_M_HI(as) ) &&
1632 ( j<S_M_LI(bs) )
1633 )
1634 if (not NULLP(S_M_IJ(bs,i,j)))
1635 return -1L;
1636 if (
1637 ( i>=S_M_HI(bs) ) &&
1638 ( j<S_M_LI(as) )
1639 )
1640 if (not NULLP(S_M_IJ(as,i,j)))
1641 return 1L;
1642 if (
1643 ( i<S_M_HI(as) ) &&
1644 ( j>=S_M_LI(bs) )
1645 )
1646 if (not NULLP(S_M_IJ(as,i,j)))
1647 return 1L;
1648 if (
1649 ( i<S_M_HI(bs) ) &&
1650 ( j>=S_M_LI(as) )
1651 )
1652 if (not NULLP(S_M_IJ(bs,i,j)))
1653 return -1L;
1654 }
1655 return (INT)0;
1656 }
1657 if (
1658 ((S_O_K(as) != VECTOR)&&(S_O_K(as) != INTEGERVECTOR))
1659 ||
1660 ((S_O_K(bs) != VECTOR)&&(S_O_K(bs) != INTEGERVECTOR))
1661 )
1662 return COMP(as,bs);
1663
1664
1665 for (i=(INT)0;i<S_V_LI(as);i++)
1666 {
1667 if (S_O_K(S_V_I(as,i)) != INTEGER)
1668 {
1669 if (S_O_K(S_V_I(as,i)) == LONGINT) {
1670 C_O_K(as,VECTOR);
1671 goto ccc;
1672 }
1673 fprintln(stderr,as);
1674 error("comp_monomvector_monomvector:as no INTEGERVECTOR");
1675 }
1676 else if (i >= S_V_LI(bs))
1677 {
1678 if (S_V_II(as,i) != (INT)0)
1679 return 1L;
1680 }
1681 else if (S_O_K(S_V_I(bs,i)) != INTEGER)
1682 {
1683 if (S_O_K(S_V_I(bs,i)) == LONGINT) {
1684 C_O_K(bs,VECTOR);
1685 goto ccc;
1686 }
1687 fprintln(stderr,bs);
1688 error("comp_monomvector_monomvector:bs no INTEGERVECTOR");
1689 }
1690 else if ( S_V_II(as,i) > S_V_II(bs,i) )
1691 return 1L;
1692 else if ( S_V_II(as,i) < S_V_II(bs,i) )
1693 return -1L;
1694 }
1695
1696 for (j=i;j<S_V_LI(bs);j++)
1697 {
1698 /* if (S_O_K(S_V_I(bs,i)) != INTEGER) error AK 311091 */
1699 if (S_O_K(S_V_I(bs,j)) != INTEGER)
1700 {
1701 if (S_O_K(S_V_I(bs,j)) == LONGINT)
1702 {
1703 C_O_K(bs,VECTOR);
1704 goto ccc;
1705 }
1706 fprintln(stderr,bs);
1707 error("comp_monomvector_monomvector:bs no INTEGERVECTOR");
1708 }
1709 /* else if (S_V_II(bs,i) != (INT)0 ) error AK 311091 */
1710 else if (S_V_II(bs,j) != (INT)0 )
1711 return -1L;
1712 }
1713
1714
1715 return (INT)0;
1716 ccc: /* AK 300195 */ /* vergleich mit longint -- slow */
1717 for (i=(INT)0;i<S_V_LI(as);i++)
1718 {
1719 if (i >= S_V_LI(bs))
1720 {
1721 if (not nullp(S_V_I(as,i)))
1722 return 1L;
1723 }
1724 else if ( gt(S_V_I(as,i),S_V_I(bs,i)) )
1725 return 1L;
1726 else if ( lt(S_V_I(as,i),S_V_I(bs,i)) )
1727 return -1L;
1728 }
1729
1730 for (j=i;j<S_V_LI(bs);j++)
1731 {
1732 if (not nullp(S_V_I(bs,j)))
1733 return -1L;
1734 }
1735 return (INT)0;
1736 ENDR("comp_monomvector_monomvector");
1737 }
1738 #endif /* POLYTRUE */
1739
1740
1741 #ifdef MONOMTRUE
addinvers_monom(a,b)1742 INT addinvers_monom(a,b) OP a,b;
1743 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1744 {
1745 INT erg=OK;
1746 CTO(MONOM,"addinvers_monom(1)",a);
1747 CTO(EMPTY,"addinvers_monom(2)",b);
1748 B_SK_MO(callocobject(),callocobject(),b);
1749 COPY(S_MO_S(a),S_MO_S(b));
1750 ADDINVERS(S_MO_K(a),S_MO_K(b));
1751 ENDR("addinvers_monom");
1752 }
1753
addinvers_apply_monom(a)1754 INT addinvers_apply_monom(a) OP a;
1755 /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
1756 {
1757 INT erg = OK;
1758 CTO(MONOM,"addinvers_apply_monom(1)",a);
1759 ADDINVERS_APPLY(S_MO_K(a));
1760 ENDR("addinvers_apply_monom");
1761 }
1762 #endif /* MONOMTRUE */
1763
1764 #ifdef POLYTRUE
addinvers_polynom(a,b)1765 INT addinvers_polynom(a,b) OP a,b;
1766 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1767 {
1768 return(transformlist(a,b,addinvers));
1769 }
1770
addinvers_apply_polynom(a)1771 INT addinvers_apply_polynom(a) OP a;
1772 /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
1773 {
1774 INT erg = OK;
1775 OP z;
1776 CTTO(HASHTABLE,POLYNOM,"addinvers_apply_polynom(1)",a);
1777
1778 FORALL(z,a, {
1779 ADDINVERS_APPLY(S_MO_K(z));
1780 });
1781
1782 ENDR("addinvers_apply_polynom");
1783 }
1784
m_skn_po(a,b,c,d)1785 INT m_skn_po(a,b,c,d) OP a,b,c,d;
1786 /* make_self.koeff.next_polynom */
1787 /* AK 290590 V1.1 */ /* AK 200891 V1.3 */
1788 {
1789 OP s=NULL,k=NULL,n=NULL;
1790 INT erg = OK;
1791 COP("m_skn_po(4)",d);
1792 if (c != NULL) {
1793 n = CALLOCOBJECT();
1794 erg += copy(c,n);
1795 }
1796 if (a != NULL) {
1797 s = CALLOCOBJECT();
1798 erg += copy(a,s);
1799 }
1800 if (b != NULL) {
1801 k = CALLOCOBJECT();
1802 erg += copy(b,k);
1803 }
1804 erg += b_skn_po(s,k,n,d);
1805 ENDR("m_skn_po");
1806 }
1807
b_skn_po(a,b,c,d)1808 INT b_skn_po(a,b,c,d) OP a,b,c,d;
1809 /* AK 100789 V1.0 */ /* AK 241189 V1.1 */ /* AK 130891 V1.3 */
1810 {
1811 INT erg = OK;
1812 COP("b_skn_po(4)",d);
1813 erg += b_sn_l(CALLOCOBJECT(),c,d);
1814 C_O_K(d,POLYNOM);
1815 B_SK_MO(a,b,S_L_S(d));
1816 ENDR("b_skn_po");
1817 }
1818
1819
s_po_s(a)1820 OP s_po_s(a) OP a;
1821 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1822 {
1823 if (a == NULL) return
1824 error("s_po_s: a == NULL"),(OP)NULL;
1825 if (s_o_k(a) != POLYNOM) return
1826 error("s_po_s: not POLYNOM"),(OP)NULL;
1827 return(s_mo_s(s_l_s(a)));
1828 }
1829
s_po_k(a)1830 OP s_po_k(a) OP a;
1831 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1832 {
1833 if (a == NULL) return
1834 error("s_po_k: a == NULL"),(OP)NULL;
1835 if (s_o_k(a) != POLYNOM) return
1836 error("s_po_k: not POLYNOM"),(OP)NULL;
1837 return s_mo_k(s_l_s(a));
1838 }
1839
s_po_n(a)1840 OP s_po_n(a) OP a;
1841 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1842 {
1843 if (a == NULL) return
1844 error("s_po_n: a == NULL"),(OP)NULL;
1845 if (s_o_k(a) != POLYNOM) return
1846 error("s_po_n: not POLYNOM"),(OP)NULL;
1847 return s_l_n(a);
1848 }
1849
s_po_si(a,i)1850 OP s_po_si(a,i) OP a; INT i;
1851 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1852 {
1853 if (a == NULL) return
1854 error("s_po_si: a == NULL"),(OP)NULL;
1855 if (s_o_k(a) != POLYNOM) return
1856 error("s_po_si: not POLYNOM"),(OP)NULL;
1857 return s_v_i(s_mo_s(s_l_s(a)),i);
1858 }
1859
s_po_sl(a)1860 OP s_po_sl(a) OP a;
1861 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1862 {
1863 if (a == NULL) return
1864 error("s_po_sl: a == NULL"),(OP)NULL;
1865 if (s_o_k(a) != POLYNOM) return
1866 error("s_po_sl: not POLYNOM"),(OP)NULL;
1867 return s_v_l(s_mo_s(s_l_s(a)));
1868 }
1869
s_po_ki(a)1870 INT s_po_ki(a) OP a;
1871 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1872 {
1873 return(s_mo_ki(s_l_s(a)));
1874 }
1875
s_po_sii(a,i)1876 INT s_po_sii(a,i) OP a; INT i;
1877 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1878 {
1879 return(s_v_ii(s_mo_s(s_l_s(a)),i));
1880 }
1881
1882
s_po_sli(a)1883 INT s_po_sli(a) OP a;
1884 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
1885 {
1886 return(s_v_li(s_mo_s(s_l_s(a))));
1887 }
1888
1889
1890
test_poly()1891 INT test_poly()
1892 /* AK 191289 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
1893 {
1894 OP a = callocobject();
1895 OP b = callocobject();
1896 OP c = callocobject();
1897
1898 printf("test_poly:scan(a)");
1899 scan(POLYNOM,a);
1900 println(a);
1901 printf("test_poly:copy(a,b)");
1902 copy(a,b);
1903 println(b);
1904 printf("test_poly:mult(a,b,b)");
1905 mult(a,b,b);
1906 println(b);
1907 printf("test_poly:tex(b)");
1908 tex(b);
1909 printf("test_poly:add(b,a,a)");
1910 add(b,a,a);
1911 println(a);
1912 printf("test_poly:hoch(b,2L,a)");
1913 hoch(b,cons_zwei,a);
1914 println(a);
1915 printf("test_poly:eval_polynom(a,b,c)");
1916 m_il_v(2L,b);
1917 M_I_I(3L,s_v_i(b,(INT)0));
1918 M_I_I(5L,s_v_i(b,1L));
1919 printf("b=");
1920 println(b);
1921 eval_polynom(a,b,c);
1922 println(c);
1923 printf("test_poly:vander(4L,c)");
1924 M_I_I(4L,b);
1925 vander(b,c);
1926 println(c);
1927 printf("test_poly:numberofvariables(c,b)");
1928 numberofvariables(c,b);
1929 println(b);
1930
1931 #ifdef BRUCHTRUE
1932 freeself(a); freeself(b); freeself(c);
1933 printf("test_poly:lagrange_polynom([1,7],[5,7],c)");
1934 m_il_v(2L,a);
1935 m_i_i(1L, s_v_i(a,(INT)0));
1936 m_i_i(7L, s_v_i(a,1L));
1937
1938 m_il_v(2L,b);
1939 m_i_i(5L, s_v_i(b,(INT)0));
1940 m_i_i(7L, s_v_i(b,1L));
1941
1942 lagrange_polynom(a,b,c);println(c);
1943 #endif /* BRUCHTRUE */
1944 printf("test_poly:mult_disjunkt_polynom_polynom(c,c,a)");
1945 mult_disjunkt_polynom_polynom(c,c,a);
1946 println(a);
1947
1948
1949 m_i_i(1L,a);
1950 m_scalar_polynom(a,b);
1951 if (not einsp(b))
1952 printf("test_poly:ERROR!!:einsp test not successful\n");
1953 else
1954 printf("test_poly:einsp test successful\n");
1955
1956 m_i_i((INT)0,a);
1957 m_scalar_polynom(a,b);
1958 if (not nullp(b))
1959 printf("test_poly:ERROR!!:nullp test not successful\n");
1960 else
1961 printf("test_poly:nullp test successful\n");
1962
1963 freeall(a);
1964 freeall(b);
1965 freeall(c);
1966 return(OK);
1967 }
1968
1969
1970
tex_polynom(poly)1971 INT tex_polynom(poly) OP poly;
1972 /* AK 101187 */ /* zur TeXausgabe eines polynoms */
1973 /* AK 100789 V1.0 */ /* AK 191289 V1.1 */
1974 /* AK 070291 V1.2 tex to texout */ /* AK 200891 V1.3 */
1975 {
1976 OP zeiger = poly;
1977 OP z;
1978 INT i,j;
1979 INT hbool=1L;
1980 INT ts = texmath_yn; /* AK 260892 */
1981
1982 if (ts == (INT)0)
1983 {
1984 texmath_yn = 1L;
1985 fprintf(texout,"\\ $ ");
1986 }
1987 else
1988 fprintf(texout,"\\ ");
1989 texposition += 3L;
1990 if (EMPTYP(poly))
1991 return(OK);
1992 while (zeiger != NULL)
1993 {
1994 hbool = 1L;
1995 if (not einsp(S_PO_K(zeiger)))
1996 {
1997 if (negeinsp(S_PO_K(zeiger))) /* AK 100892 */
1998 {
1999 fprintf(texout," - ");
2000 texposition += 3L;
2001 }
2002 else
2003 {
2004 if (POLYNOMP(S_PO_K(zeiger)))
2005 fprintf(texout,"(");
2006 if (negp(S_PO_K(zeiger)))
2007 {
2008 fprintf(texout," - ");
2009 addinvers_apply(S_PO_K(zeiger));
2010 tex(S_PO_K(zeiger));
2011 addinvers_apply(S_PO_K(zeiger));
2012 }
2013 else
2014 tex(S_PO_K(zeiger));
2015 hbool=(INT)0;
2016 if (POLYNOMP(S_PO_K(zeiger)))
2017 fprintf(texout,")");
2018 }
2019 }
2020 /* der koeffizient wird nur geschrieben wenn er ungleich 1 ist*/
2021 fprintf(texout,"\\ ");
2022 texposition += 3L;
2023 if (S_O_K(S_PO_S(zeiger)) == MATRIX) /* AK 031291 */
2024 {
2025 z = S_PO_S(zeiger);
2026 for (i=(INT)0;i<S_M_HI(z);i++)
2027 for (j=(INT)0;j<S_M_LI(z);j++)
2028 if (S_M_IJI(z,i,j) >(INT)0)
2029 {
2030 hbool=(INT)0;
2031 if (S_M_IJI(z,i,j) >1L)
2032 fprintf(texout, " x_{%" PRIINT ",%" PRIINT "}^{%" PRIdPTR "} " ,
2033 i,j,S_M_IJI(z,i,j));
2034 else
2035 fprintf(texout, " x_{%" PRIINT ",%" PRIINT "} " , i,j);
2036 texposition += 15L;
2037 }
2038 }
2039 else {
2040 for (i= (INT)0 ;i < S_PO_SLI(zeiger); i++)
2041 if (S_PO_SII(zeiger,i) > (INT)0)
2042 {
2043 hbool=(INT)0;
2044 if (tex_poly_var == NUMERICAL) /* AK 090395 */
2045 fprintf(texout, "x_{%" PRIINT "}" ,i+tex_poly_first_var_index);
2046 else
2047 fprintf(texout,"%c",(char)( 'a'+i+tex_poly_first_var_index));
2048 texposition ++;
2049 if (S_PO_SII(zeiger,i) != 1L)
2050 {
2051 fprintf(texout,"^{%ld}",S_PO_SII(zeiger,i));
2052 texposition += 10L;
2053 };
2054 };
2055 }
2056 if (hbool == 1L)
2057 fprintf(texout,"1");
2058 fprintf(texout,"\\ ");
2059 texposition += 3L;
2060 if (texposition > tex_row_length)
2061 {
2062 fprintf(texout,"\n");
2063 texposition = (INT)0;
2064 }
2065
2066 zeiger = S_PO_N(zeiger);
2067 if (zeiger != NULL)
2068 if (not negp(S_PO_K(zeiger))) /* AK 100892 */
2069 {
2070 fprintf(texout," + ");
2071 texposition += 5L;
2072 }
2073 };
2074 if (ts == (INT)0)
2075 {
2076 fprintf(texout,"$ \\ ");
2077 texmath_yn = (INT)0;
2078 }
2079 else
2080 fprintf(texout,"\\ ");
2081 texposition += 2L;
2082 return(OK);
2083 }
2084
2085
2086
copy_polynom(a,b)2087 INT copy_polynom(a,b) OP a,b;
2088 /* AK 091190 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
2089 {
2090 return(copy_list(a,b));
2091 }
2092
2093
2094
add_apply_polynom_polynom(a,b)2095 INT add_apply_polynom_polynom(a,b) OP a,b;
2096 /* AK 091190 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
2097 {
2098 INT erg = OK;
2099 OP c;
2100 CTO(POLYNOM,"add_apply_polynom_polynom(1)",a);
2101 CTO(POLYNOM,"add_apply_polynom_polynom(2)",b);
2102 c = callocobject();
2103 erg += copy_polynom(a,c);
2104 insert(c,b,add_koeff,comp_monomvector_monomvector);
2105 ENDR("add_apply_polynom_polynom");
2106 }
2107
2108
add_apply_polynom_scalar(a,b)2109 INT add_apply_polynom_scalar(a,b) OP a,b;
2110 /* AK 130891 V1.3 */
2111 {
2112 OP c;
2113 INT erg = OK;
2114 CTO(POLYNOM,"add_apply_polynom_scalar(1)",a);
2115 #ifdef UNDEF /* 170304 removed */
2116 c = callocobject();
2117 erg += copy(a,c);
2118 erg += add(b,c,b); /* error AK 211194 */
2119 erg += freeall(c);
2120 #endif
2121 c = callocobject();
2122 erg += m_scalar_polynom(b,c);
2123 erg += add(a,c,b);
2124 erg += freeall(c);
2125 ENDR("add_apply_polynom_scalar");
2126 }
2127
add_apply_polynom(a,b)2128 INT add_apply_polynom(a,b) OP a,b;
2129 /* AK 220390 V1.1 */ /* AK 190291 V1.2 */
2130 /* AK 130891 V1.3 */
2131 /* AK 030498 V2.0 */
2132 {
2133 INT erg = OK;
2134 OP d;
2135 CTO(POLYNOM,"add_apply_polynom",a);
2136 if ((EMPTYP(b))
2137 || nullp(b) )
2138 {
2139 erg += copy_polynom(a,b);
2140 goto endr_ende;
2141 }
2142 switch(S_O_K(b)) {
2143 case BRUCH:
2144 case FF:
2145 case LONGINT:
2146 case CYCLOTOMIC:
2147 case SQ_RADICAL:
2148 case INTEGER:
2149 erg += add_apply_polynom_scalar(a,b);break;
2150 case MONOPOLY:
2151 d=callocobject();
2152 erg += t_POLYNOM_MONOPOLY(a,d);
2153 erg += add_apply_monopoly(d,b);
2154 erg += freeall(d);
2155 break;
2156
2157
2158 case POLYNOM: erg += add_apply_polynom_polynom(a,b);break;
2159 #ifdef SCHUBERTTRUE
2160 case SCHUBERT: erg += add_apply_polynom_schubert(a,b);break;
2161 #endif /* SCHUBERTTRUE */
2162 default:
2163 WTO("add_apply_polynom(2)",b);
2164 goto endr_ende;
2165 }
2166 ENDR("add_apply_polynom");
2167 }
2168 #endif /* POLYTRUE */
2169
2170 #ifdef SCHUBERTTRUE
add_apply_polynom_schubert(a,b)2171 INT add_apply_polynom_schubert(a,b) OP a,b;
2172 /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
2173 {
2174 OP c;
2175 INT erg = OK;
2176 CTO(POLYNOM,"add_apply_polynom_schubert(1)",a);
2177 CTO(SCHUBERT,"add_apply_polynom_schubert(2)",b);
2178
2179 c = callocobject();
2180 erg += t_POLYNOM_SCHUBERT(a,c);
2181 erg += add_apply(c,b);
2182 erg += freeall(c);
2183 ENDR("add_apply_polynom_schubert");
2184 }
2185
gauss_schubert_polynom(a,b,c)2186 INT gauss_schubert_polynom(a,b,c) OP a,b,c;
2187 /* AK 040190 gausspolynom [a+b \atop b] */
2188 /* mittels schubertpolynome */
2189 /* AK 040190 V1.1 */ /* AK 200891 V1.3 */
2190 /* AK 280199 V2.0 */
2191 /* a,b,c may be equal */
2192 {
2193 INT i,m;
2194 OP vec,perm;
2195 INT erg = OK;
2196 CTO(INTEGER,"gauss_schubert_polynom",a);
2197 CTO(INTEGER,"gauss_schubert_polynom",b);
2198
2199 vec = callocobject();
2200 perm = callocobject();
2201
2202 erg += m_il_v(S_I_I(a)+S_I_I(b)+1L,vec);
2203 for (i=(INT)0,m=(INT)0;i<S_I_I(b);i++,m++)
2204 M_I_I((INT)0,S_V_I(vec,m));
2205 M_I_I(S_I_I(a),S_V_I(vec,m)); m++;
2206 for (i=(INT)0;i<S_I_I(a);i++,m++)
2207 M_I_I((INT)0,S_V_I(vec,m));
2208 /* dies ist der lehmercode */
2209 erg += lehmercode_vector(vec,perm);
2210 erg += m_perm_schubert_qpolynom(perm,c);
2211 FREEALL2(perm,vec);
2212 ENDR("gauss_schubert_polynom");
2213 }
2214 #endif /* SCHUBERTTRUE */
2215
2216 #ifdef POLYTRUE
polya_sub(a,c,b)2217 INT polya_sub(a,c,b) OP a,b,c;
2218 /* einsetzung */ /* a ist polynom */ /* c ist length of alphabet */
2219 /* b wird ergebnis x_i ----> 1 + q^i */
2220 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */
2221 {
2222 OP d,e,f;
2223 OP z;
2224 INT i;
2225 INT erg = OK;
2226 CTO(POLYNOM,"polya_sub(1)",a);
2227 CTO(INTEGER,"polya_sub(2)",c);
2228
2229 e=CALLOCOBJECT();
2230 erg += b_skn_po(CALLOCOBJECT(),CALLOCOBJECT(),NULL,e);
2231 erg += m_il_nv(1L,S_PO_S(e));
2232 M_I_I(1,S_PO_K(e));
2233
2234 f=CALLOCOBJECT(); COPY(e,f);
2235 M_I_I(1L,S_PO_SI(f,0L));
2236 erg += insert(f,e,add_koeff,comp_monomvector_monomvector);
2237
2238 d=CALLOCOBJECT(); erg += m_il_v(S_I_I(c),d);
2239 for (i=0L;i<S_V_LI(d);i++)
2240 {
2241 COPY(e,S_V_I(d,i));
2242 z = S_V_I(d,i);
2243 while (z != NULL)
2244 {
2245 M_I_I(S_PO_SII(z,0L)*(i+1),S_PO_SI(z,0));
2246 z = S_L_N(z);
2247 }
2248 }
2249 erg += eval_polynom(a,d,b);
2250 FREEALL2(d,e);
2251 ENDR("polya_sub");
2252 }
2253 #endif /* POLYTRUE */
2254
unimodalp(a)2255 INT unimodalp(a) OP a;
2256 /* AK 080190 */ /* AK 091190 V1.1 */ /* AK 200891 V1.3 */
2257 {
2258 OP z,k;
2259 if (EMPTYP(a)) return(FALSE);
2260 if (S_O_K(a) != POLYNOM) return(FALSE);
2261 z = S_PO_N(a);
2262 k = S_PO_K(a);
2263 while (z != NULL)
2264 {
2265 if (lt(S_PO_K(z),k)) break;
2266 k = S_PO_K(z);
2267 z = S_PO_N(z);
2268 }
2269 if (z == NULL) return(TRUE);
2270 k = S_PO_K(z);
2271 z = S_PO_N(z);
2272 while (z != NULL)
2273 {
2274 if (gr(S_PO_K(z),k)) return(FALSE);
2275 k = S_PO_K(z);
2276 z = S_PO_N(z);
2277 }
2278 return(TRUE);
2279 }
2280
degree_polynom(a,b)2281 INT degree_polynom(a,b) OP a,b;
2282 /* b becomes the degree, but only if in one variable */
2283 /* AK 300590 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
2284 {
2285 OP z,za=NULL;
2286 INT erg = OK;
2287 CTO(POLYNOM,"degree_polynom(1)",a);
2288 CTO(EMPTY,"degree_polynom(2)",b);
2289
2290
2291 z = a;
2292 while (z != NULL)
2293 {
2294 za = z;
2295 if( (S_O_K(S_PO_S(z)) != VECTOR) &&
2296 (S_O_K(S_PO_S(z)) != INTEGERVECTOR)) /*CC*/
2297 {
2298 printobjectkind(S_PO_S(z));
2299 return error("degree_polynom: not VECTOR");
2300 }
2301
2302 if (S_PO_SLI(z) != 1L)
2303 return error("degree_polynom: not single variable");
2304 z = S_PO_N(z);
2305 }
2306 /* za has now maximal degree */
2307 COPY(S_PO_SI(za,0L),b);
2308 ENDR("degree_polynom");
2309 }
2310
2311 #ifdef POLYTRUE
lagrange_polynom(a,b,c)2312 INT lagrange_polynom(a,b,c) OP a,b,c;
2313 /* a sind die stuetzpunkte VECTOR
2314 b die werte VECTOR
2315 c wird das polynom */
2316 /* AK 060690 V1.1 */ /* AK 200891 V1.3 */
2317 {
2318 INT i,j,erg=OK;
2319 OP zw,h;
2320
2321 CTO(VECTOR,"lagrange_polynom(1)",a);
2322 CTO(VECTOR,"lagrange_polynom(2)",b);
2323 SYMCHECK(S_V_LI(a) != S_V_LI(b),
2324 "lagrange_polynom: different vector length");
2325 CE3(a,b,c,lagrange_polynom);
2326
2327 zw = CALLOCOBJECT();
2328 h = CALLOCOBJECT();
2329 for (i=0L; i< S_V_LI(a) ; i++ )
2330 {
2331 COPY (S_V_I(b,i), zw);
2332 for (j = 0L; j < S_V_LI(a); j++)
2333 if (i != j) {
2334 erg += sub(S_V_I(a,i),S_V_I(a,j),h);
2335 erg += div(zw,h,zw);
2336 FREESELF(h);
2337 erg += b_skn_po(
2338 CALLOCOBJECT(),CALLOCOBJECT(),CALLOCOBJECT(),h);
2339 erg += b_skn_po(
2340 CALLOCOBJECT(),CALLOCOBJECT(),NULL,S_PO_N(h));
2341 erg += m_il_nv(1,S_PO_S(h));
2342 erg += m_il_v(1,S_PO_S(S_PO_N(h)));
2343 M_I_I(1,S_PO_SI(S_PO_N(h),0L));
2344 ADDINVERS(S_V_I(a,j), S_PO_K(h));
2345 M_I_I(1, S_PO_K(S_PO_N(h)));
2346 MULT_APPLY(h,zw);
2347 }
2348 if (i == 0) SWAP(c,zw);
2349 else {
2350 ADD_APPLY(zw,c);
2351 FREESELF(zw);
2352 }
2353 }
2354 FREEALL2(zw,h);
2355 ENDR("lagrange_polynom");
2356 }
2357
2358
2359
m_index_monom(i,res)2360 INT m_index_monom(i,res) OP i; OP res;
2361 /* res = x_i */
2362 /* AK 220904 V3.0 */
2363 {
2364 INT erg = OK;
2365 CTO(INTEGER,"m_index_monom(1)",i);
2366 SYMCHECK(S_I_I(i)<0,"m_index_monom:negative parameter");
2367 {
2368 erg += m_iindex_monom(S_I_I(i),res);
2369 }
2370 ENDR("m_index_monom");
2371 }
2372
m_iindex_monom(i,res)2373 INT m_iindex_monom(i,res) INT i; OP res;
2374 /* res = x_i */
2375 /* AK 200891 V1.3 */
2376 /* AK 220904 V3.0 */
2377 {
2378 INT erg = OK;
2379 SYMCHECK(i<0 ,"m_iindex_monom:index < 0 ");
2380 {
2381 erg += m_iindex_iexponent_monom(i,1,res);
2382 }
2383 ENDR("m_iindex_monom");
2384 }
2385
2386
2387
m_iindex_iexponent_monom(i,ex,res)2388 INT m_iindex_iexponent_monom(i,ex,res) INT i,ex; OP res;
2389 /* AK 300588 */
2390 /* AK 030789 V1.0 */ /* AK 060390 V1.1 */ /* AK 200891 V1.3 */
2391 /* res = x_i^ex */
2392 {
2393 INT erg = OK;
2394 COP("m_iindex_iexponent_monom(3)",res);
2395 SYMCHECK(i<0 ,"m_iindex_iexponent_monom:index < 0 ");
2396 {
2397 erg += b_skn_po(callocobject(),callocobject(),NULL,res);
2398 erg += m_il_nv(i+1L,S_PO_S(res));
2399 C_O_K(S_PO_S(res),INTEGERVECTOR);
2400 M_I_I(1,S_PO_K(res));
2401 M_I_I(ex,S_PO_SI(res,i));
2402 }
2403 ENDR("m_iindex_iexponent_monom");
2404 }
2405
nullp_polynom(a)2406 INT nullp_polynom(a) OP a;
2407 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2408 {
2409 OP z;
2410 FORALL(z,a, { if (not NULLP(S_MO_K(z)) ) return FALSE; } );
2411 return TRUE;
2412 }
2413
nullp_schur(a)2414 INT nullp_schur(a) OP a;
2415 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2416 {
2417 OP z;
2418 FORALL(z,a, { if (not NULLP(S_MO_K(z)) ) return FALSE; } );
2419 return TRUE;
2420 }
2421
nullp_homsym(a)2422 INT nullp_homsym(a) OP a;
2423 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2424 {
2425 OP z;
2426 FORALL(z,a,
2427 {
2428 if (not NULLP(S_MO_K(z)) ) return FALSE;
2429 } );
2430 return TRUE;
2431 }
2432
nullp_powsym(a)2433 INT nullp_powsym(a) OP a;
2434 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2435 {
2436 OP z;
2437 FORALL(z,a,
2438 {
2439 if (not NULLP(S_MO_K(z)) ) return FALSE;
2440 } );
2441 return TRUE;
2442 }
2443
nullp_monomial(a)2444 INT nullp_monomial(a) OP a;
2445 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2446 {
2447 OP z;
2448 FORALL(z,a,
2449 {
2450 if (not NULLP(S_MO_K(z)) ) return FALSE;
2451 } );
2452 return TRUE;
2453 }
2454
nullp_elmsym(a)2455 INT nullp_elmsym(a) OP a;
2456 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2457 {
2458 OP z;
2459 FORALL(z,a,
2460 {
2461 if (not NULLP(S_MO_K(z)) ) return FALSE;
2462 } );
2463 return TRUE;
2464 }
2465
2466
2467
2468
2469
2470
2471
negeinsp_polynom(a)2472 INT negeinsp_polynom(a) OP a;
2473 /* AK 060502 */
2474 {
2475 OP z = a;
2476 INT i;
2477 if (empty_listp(a)) return FALSE;
2478 if (not negeinsp(S_PO_K(z)) ) return FALSE;
2479 /* now check whether self == 000000 */
2480 for (i=(INT)0; i<S_PO_SLI(z); i++)
2481 if (S_PO_SII(z,i) != (INT)0) return FALSE;
2482 z = S_PO_N(z);
2483 if (z != NULL) return FALSE;
2484 return TRUE;
2485 }
2486
2487
einsp_polynom(a)2488 INT einsp_polynom(a) OP a;
2489 /* AK 180291 V1.2 */ /* AK 200891 V1.3 */
2490 {
2491 OP z = a;
2492 INT i;
2493 if (empty_listp(a)) return FALSE;
2494 if (not einsp(S_PO_K(z)) ) return FALSE;
2495 /* now check whether self == 000000 */
2496 for (i=(INT)0; i<S_PO_SLI(z); i++)
2497 if (S_PO_SII(z,i) != (INT)0) return FALSE;
2498 z = S_PO_N(z);
2499 if (z != NULL) return FALSE;
2500 return TRUE;
2501 }
2502
2503
2504
consp_polynom(a)2505 INT consp_polynom(a) OP a;
2506 {
2507 INT i;
2508 OP z = a;
2509 if (empty_listp(a)) return FALSE;
2510 for (i=(INT)0; i<S_PO_SLI(z); i++)
2511 if (S_PO_SII(z,i) != (INT)0) return FALSE;
2512 z = S_PO_N(z);
2513 if (z != NULL) return FALSE;
2514 return TRUE;
2515 }
2516
2517
2518
m_scalar_polynom(a,b)2519 INT m_scalar_polynom(a,b) OP a,b;
2520 /* AK 180291 V1.2 */ /* AK 060891 V1.3 */
2521 /* AK 271005 V3.1 */
2522 {
2523 INT erg = OK;
2524 CE2(a,b,m_scalar_polynom);
2525 {
2526 erg += b_skn_po(CALLOCOBJECT(),CALLOCOBJECT(),NULL,b);
2527 COPY(a,S_PO_K(b));
2528 erg += m_il_v(1,S_PO_S(b));
2529 M_I_I(0,S_PO_SI(b,0));
2530 C_O_K(S_PO_S(b),INTEGERVECTOR);
2531 }
2532 ENDR("m_scalar_polynom");
2533 }
2534
eval_char_polynom(poly,vec,res)2535 INT eval_char_polynom(poly,vec,res) OP poly,vec,res;
2536 /* AK 310588 */
2537 /* ein polynom wird ausgewertet indem der vector
2538 vec eingesetzt wird
2539 bsp poly:= 2 [3,0,1]
2540 vec:= [4,4,5]
2541 res = 2 * 4^3 * 5 = 640 [0,0,0] */
2542 /* AK 110789 V1.0 */ /* AK 191289 V1.1 */ /* AK 200891 V1.3 */
2543 {
2544 OP zeiger = poly,monom,c;
2545 INT i;
2546 INT erg=OK;
2547
2548 if (
2549 (S_O_K(vec) != VECTOR) &&
2550 (S_O_K(vec) != INTEGERVECTOR)
2551 )
2552 {
2553 printobjectkind(vec);
2554 return error("eval_char_polynom:vec != VECTOR ");
2555 }
2556
2557 m_i_i((INT)0,res);
2558 c = callocobject();
2559 monom = callocobject();
2560
2561 while (zeiger != NULL)
2562 {
2563 erg += copy(S_PO_K(zeiger),monom);
2564 if (
2565 (S_O_K(S_PO_S(zeiger)) != VECTOR) &&
2566 (S_O_K(S_PO_S(zeiger)) != INTEGERVECTOR)
2567 )
2568 {
2569 printobjectkind(S_PO_S(zeiger));
2570 return error("eval_char_polynom:self != VECTOR ");
2571 }
2572 for (i=(INT)0;i<S_PO_SLI(zeiger); i++)
2573 {
2574 if (i >= S_V_LI(vec)) goto evalpoly3;
2575 /* i ist < S_V_LI(vec) */
2576 if (not EMPTYP(S_V_I(vec,i)))
2577 /* if (not nullp (S_PO_SI(zeiger,i))) AK 040892 */
2578 if (S_PO_SII(zeiger,i) != (INT)0)
2579 {
2580 if (S_PO_SII(zeiger,i) == 1L)
2581 mult_apply_integer(S_V_I(vec,i),monom);
2582 else if (S_PO_SII(zeiger,i) == 2L)
2583 {
2584 m_i_i(S_V_II(vec,i)*S_V_II(vec,i),c);
2585 mult_apply_integer(c,monom);
2586 }
2587 else if (S_PO_SII(zeiger,i) == 3L)
2588 {
2589 m_i_i(S_V_II(vec,i)*S_V_II(vec,i)*S_V_II(vec,i),c);
2590 erg += mult_apply_integer(c,monom);
2591 }
2592 else if (S_PO_SII(zeiger,i) == 4L)
2593 {
2594 m_i_i(S_V_II(vec,i)*S_V_II(vec,i)*S_V_II(vec,i)*S_V_II(vec,i),c);
2595 erg += mult_apply_integer(c,monom);
2596 }
2597 else /* AK 040892 */
2598 {
2599 erg += hoch(S_V_I(vec,i),S_PO_SI(zeiger,i),c);
2600 erg += mult_apply(c,monom);
2601 }
2602 }
2603 };
2604 evalpoly3:
2605 if ( (S_O_K(monom) == INTEGER)
2606 && (S_O_K(res) == INTEGER) )
2607 erg += add_apply_integer_integer(monom,res);
2608 else if (S_O_K(monom) == BRUCH)
2609 erg += add_apply_bruch(monom,res);
2610 else
2611 erg += add_apply(monom,res);
2612 zeiger = S_PO_N(zeiger);
2613 }
2614 erg += freeall(c);
2615 erg += freeall(monom);
2616 return erg;
2617 }
2618
m_vec_poly(a,c)2619 INT m_vec_poly(a,c) OP a,c;
2620 /* AK 090805 */
2621 /* input vec a
2622 out polynom c = ... a_i x^i */
2623 {
2624 INT erg = OK;
2625 CTO(VECTOR,"m_vec_poly(1)",a);
2626 CE2(a,c,m_vec_poly);
2627 {
2628 INT i;OP z,zz;
2629 if (i==0) init(POLYNOM,c);
2630 else if (NULLP(a)) init(POLYNOM,c);
2631 else
2632 {
2633 zz= z = c;
2634 for (i=0;i<S_V_LI(a);i++)
2635 {
2636 if (not NULLP(S_V_I(a,i))) {
2637 m_iindex_iexponent_monom(0,i,z);
2638 copy(S_V_I(a,i),S_PO_K(z));
2639 if (i+1 < S_V_LI(a)) {
2640 C_L_N(z,CALLOCOBJECT());
2641 zz = z;
2642 z = S_L_N(z);
2643 }
2644 }
2645 }
2646 if (EMPTYP(S_L_N(zz))) {
2647 FREEALL(S_L_N(zz));
2648 C_L_N(zz,NULL);
2649 }
2650 }
2651 }
2652 ENDR("m_vec_poly");
2653 }
2654
m_vec_vec_poly(a,b,c)2655 INT m_vec_vec_poly(a,b,c) OP a,b,c;
2656 /* AK 310892 */
2657 /* input two integer vectors a,b of same length */
2658 /* output polynom c= ... a_i ^ b_i ... with coeff 1 */
2659 {
2660 INT erg = OK;
2661 INT i,maxvar;
2662 CTO(VECTOR,"m_vec_vec_poly(1)",a);
2663 CTO(VECTOR,"m_vec_vec_poly(2)",b);
2664 SYMCHECK (S_V_LI(a) != S_V_LI(b),"m_vec_vec_poly:different lengths");
2665
2666 maxvar = (INT)0;
2667 for (i=(INT)0;i<S_V_LI(a);i++)
2668 {
2669 if (S_O_K(S_V_I(a,i)) != INTEGER)
2670 return ERROR;
2671 if (S_O_K(S_V_I(b,i)) != INTEGER)
2672 return ERROR;
2673 if (S_V_II(b,i) < (INT)0)
2674 return ERROR;
2675 if (S_V_II(a,i) < (INT)0)
2676 return ERROR;
2677 if (S_V_II(a,i) > maxvar)
2678 maxvar = S_V_II(a,i);
2679 }
2680 /* now the input is OK */
2681 erg += b_skn_po(callocobject(),callocobject(),NULL,c);
2682 erg += m_i_i(1L,S_PO_K(c));
2683 erg += m_il_nv(maxvar+1L,S_PO_S(c));
2684 for (i=(INT)0;i<S_V_LI(a);i++)
2685 {
2686 M_I_I(S_V_II(b,i)+S_PO_SII(c,S_V_II(a,i)),
2687 S_PO_SI(c,S_V_II(a,i)));
2688 }
2689 ENDR("m_vec_vec_poly");
2690 }
2691
2692
2693
is_scalar_polynom(a)2694 INT is_scalar_polynom(a) OP a;
2695 /* AK 290793 */
2696 {
2697 if (scalarp(a) )
2698 return TRUE;
2699 if (nullp(S_PO_S(a)) && S_PO_N(a) == NULL)
2700 return TRUE;
2701 else
2702 return FALSE;
2703 }
2704
2705
2706
2707
select_coeff_polynom(a,b,c)2708 INT select_coeff_polynom(a,b,c) OP a,b,c;
2709 /* AK 020893 */
2710 /* c becomes the coeff of the exponent vector b in the polynomial a */
2711 {
2712 OP z;
2713 INT erg = OK;
2714 if ((S_O_K(a) != POLYNOM) ||
2715 (S_O_K(b) != VECTOR))
2716 return WTT("select_coeff_polynom",a,b);
2717
2718 z = a;
2719 while (z != NULL)
2720 {
2721 if (comp_numeric_vector(S_PO_S(z), b) == (INT)0)
2722 {
2723 erg += copy(S_PO_K(z),c);
2724 goto s_p_c_ende;
2725 }
2726 z = S_L_N(z);
2727 }
2728 erg += m_i_i((INT)0,c);
2729 s_p_c_ende:
2730 return erg;
2731 }
2732
2733
2734
random_monom(a)2735 INT random_monom(a) OP a;
2736 /* AK 180893 */
2737 {
2738 OP b,c;
2739 INT i,erg = OK;
2740
2741 b = callocobject();
2742 c = callocobject();
2743 erg += random_integer(b,cons_eins,NULL);
2744 erg += m_l_v(b,c);
2745 for (i=(INT)0;i<S_V_LI(c);i++)
2746 erg += random_integer(S_V_I(c,i),NULL,NULL);
2747
2748 erg += b_skn_po(c,callocobject(),NULL,a);
2749 erg += random_integer(b,NULL,NULL);
2750 if ((S_I_I(b) % 3L) == (INT)0)
2751 erg += random_integer(S_PO_K(a),NULL,NULL);
2752 if ((S_I_I(b) % 3L) == 1L)
2753 erg += random_longint(S_PO_K(a),NULL);
2754 if ((S_I_I(b) % 3L) == 2L)
2755 {
2756 erg += b_ou_b(callocobject(),callocobject(),S_PO_K(a));
2757 erg += random_integer(S_B_O(S_PO_K(a)),NULL,NULL);
2758 erg += random_integer(S_B_U(S_PO_K(a)),cons_eins,NULL);
2759 erg += kuerzen(S_PO_K(a));
2760 }
2761 erg += freeall(b);
2762 return erg;
2763 }
2764
2765
random_polynom(a)2766 INT random_polynom(a) OP a;
2767 /* AK 180893 */
2768 {
2769 INT erg = OK;
2770 OP b,c;
2771 INT i;
2772
2773 CALLOCOBJECT2(b,c);
2774 erg += random_integer(b,NULL,NULL);
2775 init(POLYNOM,a);
2776 for (i=0;i<=S_I_I(b);i++)
2777 {
2778 erg += random_monom(c);
2779 erg += add_apply(c,a);
2780 }
2781
2782 FREEALL2(b,c);
2783 ENDR("random_polynom");
2784 }
2785
2786
2787
symmetricp_i(a,i)2788 INT symmetricp_i(a,i) OP a; INT i;
2789 /* AK 141293 */
2790 /* true if the POLYNOM object a ist the symmetric in a_i and a_{i+1} */
2791 {
2792 OP d,c;
2793 INT erg = OK, res;
2794
2795 if (i<(INT)0)
2796 return error("symmetricp_i: index < 0");
2797 CTO(POLYNOM,"symmetricp_i",a);
2798
2799 d = callocobject();
2800 c = callocobject();
2801 M_I_I(i+1,c);
2802 erg += divdiff(c,a,d);
2803 if (nullp(d))
2804 res = TRUE;
2805 else
2806 res = FALSE;
2807 erg += freeall(d);
2808 erg += freeall(c);
2809 return res;
2810 ENDR("symmetricp_i");
2811 }
2812
symmetricp(a)2813 INT symmetricp(a) OP a;
2814 {
2815 OP n;
2816 INT i,res,erg = OK;
2817 if (MATRIXP(a)) return symmetricp_matrix(a);
2818 CTO(POLYNOM,"symmetricp",a);
2819 if (consp_polynom(a))
2820 return TRUE;
2821
2822 n=callocobject();
2823 numberofvariables(a,n);
2824 for (i=(INT)0;i<S_I_I(n)-1L;i++)
2825 if (symmetricp_i(a,i) == FALSE)
2826 { res =FALSE; goto se; }
2827
2828 res = TRUE;
2829 se:
2830 freeall(n);
2831 return res;
2832 ENDR("symmetricp");
2833 }
2834
cast_apply_monom(a)2835 INT cast_apply_monom(a) OP a;
2836 /* AK 010394 */
2837 {
2838 INT erg = OK;
2839 switch(S_O_K(a))
2840 {
2841 }
2842 return erg;
2843 }
2844
2845
GaussRecInternal(po,m,n,res)2846 INT GaussRecInternal(po, m, n, res) INT po, m, n; OP res;
2847 {
2848 if (n==0L || m==n)
2849 {
2850 M_I_I(S_V_II(res,po)+1, S_V_I(res,po));
2851 }
2852 /* inc(S_V_I(res,po)); */
2853 else {
2854 GaussRecInternal(po,m-1,n-1,res);
2855 GaussRecInternal(po+n,m-1,n,res);
2856 }
2857 return OK;
2858 }
2859
gauss_polynom(m,n,pol)2860 INT gauss_polynom(m, n, pol) OP m,n,pol;
2861 /* computes the gauss polynomial */
2862 /* SV&AL */
2863 /* AK 201204 V3.0 */ /* AK 161006 V3.1 */
2864 {
2865 INT erg = OK;
2866 CTO(INTEGER,"gauss_polynom(1)",m);
2867 CTO(INTEGER,"gauss_polynom(2)",n);
2868
2869 {
2870 OP res;
2871 INT i;
2872
2873 if (S_I_I(m) < S_I_I(n)) {
2874 m_i_i(0,pol);
2875 }
2876 else {
2877 res = CALLOCOBJECT();
2878 erg += m_il_nv(S_I_I(n)* ( S_I_I(m)-S_I_I(n) ) + 1 ,res);
2879 GaussRecInternal(0,S_I_I(m),S_I_I(n),res);
2880 erg += m_iindex_iexponent_monom(0,0,pol);
2881 for (i=1;i<S_V_LI(res);i++)
2882 {
2883 C_PO_N(pol,callocobject());
2884 erg += m_iindex_iexponent_monom(0,i,S_PO_N(pol));
2885 pol = S_PO_N(pol);
2886 erg += m_i_i(S_V_II(res,i),S_PO_K(pol));
2887 }
2888 FREEALL(res);
2889 }
2890 }
2891
2892 ENDR("gauss_polynom");
2893 }
2894
2895
t_LIST_POLYNOM(a,b)2896 INT t_LIST_POLYNOM(a,b) OP a,b;
2897 /* AK 250195 */ /* AK 161006 V3.1 */
2898 {
2899 INT erg = OK;
2900 OP z,zb;
2901 CTO(LIST,"t_LIST_POLYNOM(1)",a);
2902 CE2(a,b,t_LIST_POLYNOM);
2903
2904 z = a;
2905 erg += init(POLYNOM,b);
2906 zb = b;
2907 if (S_L_S(z) == NULL)
2908 goto endr_ende;
2909 C_L_S(zb,callocobject());
2910 again:
2911 erg += m_sk_mo(S_L_S(z),cons_eins,S_L_S(zb));
2912 C_O_K(zb,POLYNOM);
2913 if (S_L_N(z) != NULL)
2914 {
2915 C_L_N(zb,callocobject());
2916 erg += b_sn_l(callocobject(),NULL,S_L_N(zb));
2917 zb = S_L_N(zb);
2918 z = S_L_N(z);
2919 goto again;
2920 }
2921
2922 ENDR("t_LIST_POLYNOM");
2923 }
2924
invers_POLYNOM(a,b)2925 INT invers_POLYNOM(a,b) OP a ,b;
2926 /* CC */
2927 {
2928 INT erg = OK;
2929 CTO(POLYNOM,"invers_POLYNOM(1)",a);
2930 CTO(EMPTY,"invers_POLYNOM(2)",b);
2931
2932 erg += m_ou_b(cons_eins,a,b);
2933 ENDR("invers_POLYNOM");
2934 }
2935
2936
2937
maple_polynom(poly)2938 INT maple_polynom(poly) OP poly;
2939 /* AL */
2940 {
2941 OP zeiger = poly;
2942 INT i;
2943
2944 if (EMPTYP(poly)) return(OK);
2945 while (zeiger != NULL)
2946 {
2947 print(S_PO_K(zeiger));
2948 for (i= 0L ;i < S_PO_SLI(zeiger); i++)
2949 if (S_PO_SII(zeiger,i) > 0L)
2950 {
2951 fprintf(texout, "*x%" PRIINT ,i+1);
2952 texposition ++;
2953 if (S_PO_SII(zeiger,i) != 1L)
2954 {
2955 fprintf(texout,"^%ld",S_PO_SII(zeiger,i));
2956 texposition += 10L;
2957 };
2958 };
2959
2960 texposition += 1L;
2961 if (texposition > 70L)
2962 {
2963 fprintf(texout,"\n");
2964 texposition = 0L;
2965 }
2966
2967 zeiger = S_PO_N(zeiger);
2968 if (zeiger != NULL)
2969 if (not negp(S_PO_K(zeiger)))
2970 {
2971 fprintf(texout,"+");
2972 texposition +=3L;
2973 }
2974 };
2975 return(OK);
2976 }
2977
cast_apply_polynom(a)2978 INT cast_apply_polynom(a) OP a;
2979 /* tries to transform the object a into a POLYNOM object */
2980 /* AK 170206 V3.0 */
2981 {
2982 INT erg = OK;
2983 COP("cast_apply_polynom(1)",a);
2984 switch (S_O_K(a)) {
2985 case BRUCH:
2986 case LONGINT:
2987 case INTEGER:
2988 erg += m_scalar_polynom(a,a);
2989 break;
2990 case MONOPOLY:
2991 erg += t_MONOPOLY_POLYNOM(a,a);
2992 break;
2993 default:
2994 erg += WTO("cast_apply_polynom",a);
2995 break;
2996 }
2997 ENDR("cast_apply_polynom");
2998 }
2999
3000
s_lc_poly(OP pol)3001 OP s_lc_poly(OP pol)
3002 /* AK 181203 */
3003 /* pointer auf leading coeff */
3004 {
3005 INT erg = OK;
3006 OP z;
3007 CTO(POLYNOM,"s_lc_poly(1)",pol);
3008 SYMCHECK (S_L_S(pol)==NULL,"s_lc_poly:null polynom");
3009 z = S_PO_S(pol);
3010 SYMCHECK (( S_O_K(z)!= VECTOR )&&(S_O_K(z)!= INTEGERVECTOR),
3011 "s_lc_poly:wrong type of list self part");
3012 SYMCHECK (S_V_LI(z)!= 1, "s_lc_poly:not a univariate polynomial");
3013 z=pol;
3014 while (S_L_N(z)!=NULL) z=S_L_N(z);
3015 return S_PO_K(z);
3016 ENDO("s_lc_poly");
3017 }
3018
content_polynom(OP a,OP b)3019 INT content_polynom(OP a, OP b)
3020 /* AK 171203 */
3021 {
3022 OP z;
3023 INT erg =OK;
3024 CTO(POLYNOM,"content_polynom(1)",a);
3025 if (NULLP(a)) { m_i_i(0,b); }
3026 copy(S_PO_K(a),b);
3027 FORALL(z,a,{ ggt(b,S_MO_K(z),b); });
3028 ENDR("content_polynom");
3029 }
3030
ggt_field_polynom(OP a,OP b,OP c)3031 INT ggt_field_polynom(OP a, OP b, OP c)
3032 /* AK 170206 */
3033 /* Cohen p.113 */
3034 {
3035 INT erg = OK;
3036 CTO(POLYNOM,"ggt_field_polynom(1)",a);
3037 CTO(POLYNOM,"ggt_field_polynom(2)",b);
3038 {
3039 if (NULLP(b)) erg+=copy(a,c);
3040 else {
3041 OP q=callocobject();
3042 OP r=callocobject();
3043 erg += quores(a,b,q,r);
3044 erg += ggt_field_polynom(b,r,c);
3045 freeall(q);
3046 freeall(r);
3047 }
3048 }
3049 ENDR("ggt_field_polynom");
3050 }
3051
ggt_polynom(OP a,OP b,OP c)3052 INT ggt_polynom(OP a, OP b, OP c)
3053 /* AK 171203 */
3054 {
3055 INT erg = OK;
3056 CTO(POLYNOM,"ggt_polynom(1)",a);
3057 CTO(POLYNOM,"ggt_polynom(2)",b);
3058 {
3059 OP aa,bb;OP q,r;
3060 OP ac,bc;
3061 OP d,z;
3062 if (NULLP(b)) { erg += copy(a,c); goto endr_ende;}
3063 aa=CALLOCOBJECT();content_polynom(a,aa);
3064 bb=CALLOCOBJECT();content_polynom(b,bb);
3065 d = CALLOCOBJECT();
3066 ggt(aa,bb,d);
3067 invers_apply(bb);
3068 invers_apply(aa);
3069 ac = CALLOCOBJECT();mult_scalar_polynom(aa,a,ac);FREESELF(aa);
3070 bc = CALLOCOBJECT();mult_scalar_polynom(bb,b,bc);FREESELF(bb);
3071 degree_polynom(ac,aa); degree_polynom(bc,bb);
3072 if (LT(aa,bb)) swap(ac,bc);
3073
3074 CALLOCOBJECT2(q,r);
3075 bb:
3076 FREESELF(aa);
3077 FREESELF(bb);
3078 degree_polynom(ac,aa); degree_polynom(bc,bb); /* aa >= bb is known */
3079 sub(aa,bb,aa); inc(aa);
3080 hoch (s_lc_poly(bc),aa,bb);
3081 mult_apply(bb,ac); /* no coeff division necessary in quores */
3082 quores(ac,bc,q,r);
3083 if (NULLP(r)) goto aa;
3084 FREESELF(q);
3085 degree_polynom(r,q); if (NULLP(q)) { eins(S_PO_K(r),bc); goto aa; }
3086 content_polynom(r,q); copy(bc,ac); invers_apply(q);
3087 FREESELF(bc);
3088 mult_scalar_polynom(q,r,bc); goto bb;
3089
3090 aa:
3091 MULT(d,bc,c);
3092 FREEALL3(d,aa,bb);
3093 FREEALL4(ac,bc,q,r);
3094 }
3095 ENDR("ggt_polynom");
3096 }
3097
3098
derivative(OP pol,OP pold)3099 INT derivative(OP pol, OP pold)
3100 /* AK 171203 */
3101 {
3102 INT erg = OK;
3103 OP z;
3104 CTO(POLYNOM,"derivative(1)",pol);
3105 CE2(pol,pold,derivative);
3106 if (S_L_S(pol)==NULL)
3107 {
3108 erg += copy(pol,pold);
3109 goto endr_ende;
3110 }
3111 z = S_PO_S(pol);
3112 SYMCHECK (S_O_K(z)!= VECTOR, "derivative:wrong type of list self part");
3113 SYMCHECK (S_V_LI(z)!= 1, "derivative:not a univariate polynomial");
3114 if (S_V_II(z,0) == 0)
3115 {
3116 if (S_PO_N(pol)==NULL) {
3117 init(POLYNOM,pold);
3118 goto endr_ende;
3119 }
3120 pol = S_PO_N(pol);
3121 }
3122 COPY(pol,pold);
3123 FORALL(z,pold,{
3124 MULT_APPLY(S_MO_SI(z,0),S_MO_K(z));
3125 DEC(S_MO_SI(z,0));
3126 });
3127
3128
3129 ENDR("derivative");
3130 }
3131
horner(OP point,OP vec,OP res)3132 INT horner( OP point, OP vec, OP res)
3133 /* eval polynomial at point */
3134 /* vec[0] constant term */
3135 /* res = vec[0]+point*vec[1]+point^2 *vec[2]+ .. */
3136 /* AK 300607 */
3137 {
3138 INT erg = OK;
3139 CTTO(VECTOR,INTEGERVECTOR,"horner(2)",vec);
3140 CE3(point,vec,res,horner);
3141 {
3142 INT i;
3143 COPY(S_V_I(vec,S_V_LI(vec)-1), res);
3144 for (i=S_V_LI(vec)-2;i>=0;i--)
3145 {
3146 MULT_APPLY(point,res);
3147 ADD_APPLY(S_V_I(vec,i),res);
3148 }
3149 }
3150 ENDR("horner");
3151 }
3152
3153
3154 #endif /* POLYTRUE */
3155
3156
3157