1 /* SYMMETRICA source code file: bruch.c */
2 #include "def.h"
3 #include "macro.h"
4
5 static INT ggt_mp();
6 static INT lowcf_br();
7 static INT lowcf_br();
8
9
10 INT kuerzen_yn;
11 static struct bruch * callocbruch();
12 static INT freebruch();
13
14 static int bruch_speicherindex=-1; /* AK 301001 */
15 static int bruch_speichersize=0; /* AK 301001 */
16 static struct bruch **bruch_speicher=NULL; /* AK 301001 */
17 static INT mem_counter_bruch=0;
18
19
20
21 #ifdef BRUCHTRUE
bruch_anfang()22 INT bruch_anfang()
23 /* AK 100893 */
24 {
25 mem_counter_bruch=0;
26 return OK;
27 }
28
29 #define B_OU_B(oben,unten,ergebnis)\
30 ( C_O_K(ergebnis,BRUCH),\
31 (ergebnis->ob_self).ob_bruch=callocbruch(),\
32 C_B_O(ergebnis,oben) ,\
33 C_B_U(ergebnis,unten) ,\
34 C_B_I(ergebnis,NGEKUERZT) \
35 )
36
bruch_ende()37 INT bruch_ende()
38 /* AK 100893 */
39 /* this function is called to clean up data structures concerning BRUCH objects */
40 /* this function is called from the function ende */
41 {
42 INT erg = OK;
43 if (no_banner != TRUE)
44 if (mem_counter_bruch != 0L)
45 {
46 fprintf(stderr, "mem_counter_bruch = %" PRIINT "\n" ,mem_counter_bruch);
47 erg += error("bruch memory not freed");
48 goto endr_ende;
49 }
50
51 if (bruch_speicher!=NULL)
52 {
53 INT i;
54 for (i=0;i<=bruch_speicherindex;i++)
55 SYM_free(bruch_speicher[i]);
56 SYM_free(bruch_speicher);
57 }
58
59 bruch_speicher=NULL;
60 bruch_speicherindex=-1;
61 bruch_speichersize=0;
62
63 ENDR("bruch_ende");
64 }
65
66
67
68
add_bruch_scalar(a,b,c)69 INT add_bruch_scalar(a,b,c) OP a, b, c;
70 /* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
71 {
72 INT erg = OK;
73 OP d;
74 CTO(BRUCH,"add_bruch_scalar(1)",a);
75 CTO(EMPTY,"add_bruch_scalar(3)",c);
76
77 d = callocobject();
78 erg += m_scalar_bruch(b,d);
79 erg += add_bruch_bruch(a,d,c); /* hat kuerzen */
80
81 FREEALL(d);
82 ENDR("add_bruch_scalar");
83 }
84
add_bruch_integer(a,b,c)85 INT add_bruch_integer(a,b,c) OP a,b,c;
86 /* AK 251001 */
87 {
88 INT erg = OK;
89 OP d;
90 CTO(BRUCH,"add_bruch_integer(1)",a);
91 CTO(INTEGER,"add_bruch_integer(2)",b);
92 CTO(EMPTY,"add_bruch_integer(3)",c);
93
94 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),c);
95 d = CALLOCOBJECT();
96 MULT_INTEGER(b,S_B_U(a),d);
97 ADD(d,S_B_O(a),S_B_O(c));
98 FREEALL(d);
99 COPY(S_B_U(a),S_B_U(c));
100 erg += kuerzen(c);
101 ENDR("add_bruch_integer");
102 }
103
104
random_bruch(a)105 INT random_bruch(a) OP a;
106 /* AK 191093 */
107 {
108 INT erg = OK;
109 CTO(EMPTY,"random_bruch(1)",a);
110 rb_again:
111 erg += b_ou_b(callocobject(),callocobject(),a);
112 /* a is freed automatically */
113 erg += random_integer(S_B_O(a),NULL,NULL);
114 erg += random_integer(S_B_U(a),cons_zwei,NULL);
115 kuerzen(a);
116 if (S_O_K(a) != BRUCH)
117 goto rb_again;
118 ENDR("random_bruch");
119 }
120
121
122
123
add_bruch_bruch(a,b,c)124 INT add_bruch_bruch(a,b,c) OP a, b, c;
125 /* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 270291 V1.2 */
126 /* AK 200891 V1.3 */
127 {
128 OP zw2;
129 INT erg =OK;
130 CTO(BRUCH,"add_bruch_bruch(1)",a);
131 CTO(BRUCH,"add_bruch_bruch(2)",b);
132 CTO(EMPTY,"add_bruch_bruch(3)",c);
133
134 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),c);
135 MULT(S_B_U(a),S_B_U(b),S_B_U(c));
136 zw2 = CALLOCOBJECT();
137 MULT(S_B_O(a), S_B_U(b), S_B_O(c));
138 MULT(S_B_U(a), S_B_O(b), zw2);
139 ADD_APPLY(zw2,S_B_O(c));
140
141 FREEALL(zw2);
142 erg += kuerzen(c);
143 ENDR("add_bruch_bruch");
144 }
145
146
147
148
absolute_bruch(a,b)149 INT absolute_bruch(a,b) OP a,b;
150 /* AK 150393 */
151 {
152 INT erg = OK;
153 CTO(BRUCH,"absolute_bruch(1)",a);
154 CTO(EMPTY,"absolute_bruch(2)",b);
155
156 erg += b_ou_b(callocobject(),callocobject(),b);
157 erg += absolute(S_B_O(a),S_B_O(b));
158 erg += absolute(S_B_U(a),S_B_U(b));
159 ENDR("absolute_bruch");
160 }
161
162
163
add_bruch(a,b,c)164 INT add_bruch(a,b,c) OP a,b,c;
165 /* AK 310888 */ /* AK 050789 V1.0 */ /* AK 181289 V1.1 */
166 /* AK 270291 V1.2 */ /* AK 200891 V1.3 */
167 /*CC 190995 */
168 {
169 INT erg = OK;
170 CTO(BRUCH,"add_bruch(1)",a);
171 CTO(EMPTY,"add_bruch(3)",c);
172
173 switch(S_O_K(b))
174 {
175 case INTEGER:
176 erg += add_bruch_integer(a,b,c);
177 goto aiende;
178
179 case LONGINT:
180 erg += add_bruch_scalar(a,b,c);
181 goto aiende;
182
183 case BRUCH:
184 erg += add_bruch_bruch(a,b,c);
185 goto aiende;
186
187 #ifdef POLYTRUE
188 case LAURENT:
189 {
190 OP tp2;
191 tp2=callocobject();
192 erg += m_ou_b(b,cons_eins,tp2);
193 erg += kuerzen(tp2);
194 erg += add_bruch_bruch(a,tp2,c);
195 erg += freeall(tp2);
196 }
197 break;
198 /*CC*/
199 case MONOPOLY:
200 {
201 OP tp2=callocobject();
202 erg += m_ou_b(b,cons_eins,tp2);
203 erg += add_bruch_bruch(a,tp2,c);
204 erg += freeall(tp2);
205 }
206 break;
207
208 case POLYNOM:
209 /*
210 if (has_one_variable(b))
211 {
212 OP tp2=callocobject();
213 erg += m_ou_b(b,cons_eins,tp2);
214 erg += kuerzen(tp2);
215 erg += add_bruch_bruch(a,tp2,c);
216 erg += freeall(tp2);
217 }
218 else
219 */
220 erg += add_scalar_polynom(a,b,c);
221 goto aiende;
222 #endif /* POLYTRUE */
223
224 #ifdef SCHURTRUE /* AK 240102 */
225 case SCHUR:
226 erg += add_schur(b,a,c);
227 goto aiende;
228 case HOMSYM:
229 erg += add_homsym(b,a,c);
230 goto aiende;
231 case POWSYM:
232 erg += add_powsym(b,a,c);
233 goto aiende;
234 case ELMSYM:
235 erg += add_elmsym(b,a,c);
236 goto aiende;
237 case MONOMIAL:
238 erg += add_monomial(b,a,c);
239 goto aiende;
240 #endif /* SCHURTRUE */
241
242 case SQ_RADICAL:
243 erg += add_scalar_sqrad(a,b,c);
244 goto aiende;
245
246 case CYCLOTOMIC:
247 erg += add_scalar_cyclo(a,b,c);
248 goto aiende;
249
250 default :
251 erg += WTO("add_bruch(2)",b);
252 };
253 erg += kuerzen(c);
254 aiende:
255 ENDR("add_bruch");
256 }
257
258
259
negp_bruch(a)260 INT negp_bruch(a) OP a;
261 /* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
262 /* AK 221298 V2.0 */
263 /* TRUE if a < 0 */
264 {
265 if (negp(S_B_O(a))) {
266 if (negp(S_B_U(a))) return(FALSE);
267 else return(TRUE);
268 }
269 else if (NULLP(S_B_O(a))) /* AK 221298 */
270 return FALSE;
271 /* now S_B_O > 0 */
272 if (negp(S_B_U(a)))
273 return(TRUE);
274 return(FALSE);
275 }
276
277
278
einsp_bruch(a)279 INT einsp_bruch(a) OP a;
280 /* AK 050789 V1.0 */ /* AK 081289 V1.1 */ /* AK 200891 V1.3 */
281 {
282 return EQ(S_B_O(a),S_B_U(a));
283 }
284
285
286
negeinsp_bruch(a)287 INT negeinsp_bruch(a) OP a;
288 /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
289 {
290 INT erg;
291 CTO(BRUCH,"negeinsp_bruch(1)",a);
292 addinvers_apply(S_B_O(a));
293 erg = EQ(S_B_O(a),S_B_U(a));
294 addinvers_apply(S_B_O(a));
295 return(erg);
296 ENDR("negeinsp_bruch");
297 }
298
299
300
nullp_bruch(a)301 INT nullp_bruch(a) OP a;
302 /* AK 050789 V1.0 */ /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
303 {
304 INT erg = OK;
305 CTO(BRUCH,"nullp_bruch(1)",a);
306 return (NULLP(S_B_O(a)));
307 ENDR("nullp_bruch");
308 }
309
310
311
312
313
addinvers_bruch(a,b)314 INT addinvers_bruch(a,b) OP a,b;
315 /* AK 290388*/ /* AK 050789 V1.0 */ /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
316 {
317 INT erg = OK;
318 CTO(BRUCH,"addinvers_bruch(1)",a);
319 CTO(EMPTY,"addinvers_bruch(2)",b);
320
321 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),b);
322 ADDINVERS(S_B_O(a),S_B_O(b));
323 COPY(S_B_U(a),S_B_U(b));
324 if (NEGP(S_B_O(b)) && NEGP(S_B_U(b)))
325 {
326 ADDINVERS_APPLY(S_B_O(b));
327 ADDINVERS_APPLY(S_B_U(b));
328 }
329 C_B_I(b,S_B_I(a));
330
331 ENDR("addinvers_bruch");
332 }
333
334
335
addinvers_apply_bruch(a)336 INT addinvers_apply_bruch(a) OP a;
337 /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
338 {
339 INT erg = OK;
340 CTO(BRUCH,"addinvers_apply_bruch(1)",a);
341 ADDINVERS_APPLY(S_B_O(a));
342 if (NEGP(S_B_O(a)) && NEGP(S_B_U(a)))
343 {
344 ADDINVERS_APPLY(S_B_O(a));
345 ADDINVERS_APPLY(S_B_U(a));
346 }
347 ENDR("addinvers_apply_bruch");
348 }
349
350
351
352
invers_apply_bruch(a)353 INT invers_apply_bruch(a) OP a;
354 /* AK 161001 */
355 {
356 INT erg = OK;
357 CTO(BRUCH,"invers_apply_bruch(1)",a);
358 erg += swap(S_B_O(a),S_B_U(a));
359 ENDR("invers_apply_bruch");
360 }
361
invers_bruch(a,b)362 INT invers_bruch(a,b) OP a,b;
363 /* AK 031286 */ /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
364 {
365 INT erg = OK;
366 CTO(BRUCH,"invers_bruch(1)",a);
367 CTO(EMPTY,"invers_bruch(2)",b);
368
369 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),b);
370 COPY(S_B_U(a),S_B_O(b));
371 COPY(S_B_O(a),S_B_U(b));
372 C_B_I(b,S_B_I(a));
373
374 ENDR("invers_bruch");
375 }
376
377
378
mult_bruch_integer(a,b,c)379 INT mult_bruch_integer(a,b,c) OP a,b,c;
380 /* AK 040789 V1.0 */ /* AK 081289 V1.1 */ /* AK 200891 V1.3 */
381 {
382 INT erg = OK;
383 OP d;
384
385 CTO(BRUCH,"mult_bruch_integer(1)",a);
386 CTO(INTEGER,"mult_bruch_integer(2)",b);
387 CTO(EMPTY,"mult_bruch_integer(3)",c);
388
389 if (INTEGRALP(S_B_O(a)) && INTEGRALP(S_B_U(a)) )
390 {
391
392 d = CALLOCOBJECT();
393 GGT_INTEGER(b,S_B_U(a),d);
394
395 if (EQ(d,S_B_U(a))) {
396 GANZDIV(b,d,c);
397 MULT_APPLY(S_B_O(a),c);
398 FREEALL(d);
399 goto ende;
400 }
401
402 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),c);
403 GANZDIV(S_B_U(a),d,S_B_U(c));
404 GANZDIV_INTEGER(b,d,S_B_O(c));
405 FREEALL(d);
406 MULT_APPLY(S_B_O(a),S_B_O(c));
407 if (NEGP(S_B_O(c)) && NEGP(S_B_U(c)))
408 {
409 ADDINVERS_APPLY(S_B_O(c));
410 ADDINVERS_APPLY(S_B_U(c));
411 }
412 C_B_I(c,GEKUERZT);
413 goto ende;
414 }
415 /* denominator or nominator not a integer */
416 /* AK 060502 */
417 COPY(a,c);
418 MULT_APPLY(b,S_B_O(c));
419 erg += kuerzen(c);
420
421 ende:
422 CTTTTO(LONGINT,INTEGER,S_O_K(S_B_O(a)),BRUCH,"mult_bruch_integer(e3)",c);
423 ENDR("mult_bruch_integer");
424 }
425
mult_bruch_longint(a,b,c)426 INT mult_bruch_longint(a,b,c) OP a,b,c;
427 /* AK 040789 V1.0 */ /* AK 081289 V1.1 */ /* AK 200891 V1.3 */
428 {
429 INT erg = OK;
430 OP d;
431
432 CTO(BRUCH,"mult_bruch_longint(1)",a);
433 CTO(LONGINT,"mult_bruch_longint(2)",b);
434 CTO(EMPTY,"mult_bruch_longint(3)",c);
435 d = CALLOCOBJECT();
436 GGT_LONGINT(b,S_B_U(a),d);
437
438 if (EQ(d,S_B_U(a))) {
439 GANZDIV(b,d,c);
440 MULT_APPLY(S_B_O(a),c);
441 FREEALL(d);
442 goto endr_ende;
443 }
444
445 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),c);
446 GANZDIV(S_B_U(a),d,S_B_U(c));
447 GANZDIV_LONGINT(b,d,S_B_O(c));
448 FREEALL(d);
449 MULT_APPLY(S_B_O(a),S_B_O(c));
450 if (NEGP(S_B_O(c)) && NEGP(S_B_U(c)))
451 {
452 ADDINVERS_APPLY(S_B_O(c));
453 ADDINVERS_APPLY(S_B_U(c));
454 }
455 C_B_I(c,GEKUERZT);
456
457 CTTTTO(INTEGER,LONGINT,S_O_K(S_B_O(a)),BRUCH,"mult_bruch_longint(e3)",c);
458 ENDR("mult_bruch_longint");
459 }
460
mult_bruch_bruch(a,b,c)461 INT mult_bruch_bruch(a,b,c) OP a,b,c;
462 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
463 {
464 INT erg = OK;
465 CTO(BRUCH,"mult_bruch_bruch(1)",a);
466 CTO(BRUCH,"mult_bruch_bruch(2)",b);
467 CTTO(EMPTY,BRUCH,"mult_bruch_bruch(3)",c);
468
469
470 if (S_O_K(c) == BRUCH)
471 {
472 FREESELF(S_B_O(c));
473 FREESELF(S_B_U(c));
474 }
475 else
476 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),c);
477
478 if (
479 INTEGRALP(S_B_O(a)) && INTEGRALP(S_B_U(a))
480 &&
481 INTEGRALP(S_B_O(b)) && INTEGRALP(S_B_U(b))
482 ) {
483 OP d = CALLOCOBJECT();
484 OP e = CALLOCOBJECT();
485
486 GGT(S_B_O(a),S_B_U(b),d);
487 if (not EINSP(d)) {
488 GANZDIV(S_B_O(a),d,S_B_O(c));
489 GANZDIV(S_B_U(b),d,S_B_U(c));
490 }
491 else {
492 COPY(S_B_O(a),S_B_O(c));
493 COPY(S_B_U(b),S_B_U(c));
494 }
495 FREESELF(d);
496 GGT(S_B_U(a),S_B_O(b),d);
497 if (not EINSP(d)) {
498 GANZDIV(S_B_O(b),d,e);
499 MULT_APPLY(e,S_B_O(c));
500 }
501 else {
502 MULT_APPLY(S_B_O(b),S_B_O(c));
503 }
504 FREESELF(e);
505 if (not EINSP(d)) {
506 GANZDIV(S_B_U(a),d,e);
507 MULT_APPLY(e,S_B_U(c));
508 }
509 else {
510 MULT_APPLY(S_B_U(a),S_B_U(c));
511 }
512 if (NEGP(S_B_O(c)) && NEGP(S_B_U(c)))
513 {
514 ADDINVERS_APPLY(S_B_O(c));
515 ADDINVERS_APPLY(S_B_U(c));
516 }
517 C_B_I(c,GEKUERZT);
518 FREEALL(e);
519 FREEALL(d);
520 goto ende;
521 }
522
523 MULT(S_B_O(a),S_B_O(b),S_B_O(c));
524 MULT(S_B_U(a),S_B_U(b),S_B_U(c));
525 erg += kuerzen(c);
526 ende:
527 ENDR("mult_bruch_bruch");
528 }
529
530
531
tex_bruch(a)532 INT tex_bruch(a) OP a;
533 /* AK 070291 V1.2 */ /* AK 300791 V1.3 */ /* AK 200891 V1.3 */
534 {
535 INT erg = OK,merk;
536 CTO(BRUCH,"tex_bruch(1)",a);
537 merk = texmath_yn;
538 if (texmath_yn != (INT)1)
539 { fprintf(texout,"$"); texmath_yn = (INT)1; }
540 fprintf(texout,"{");
541 erg += tex(S_B_O(a));
542 fprintf(texout," \\over ");
543 erg += tex(S_B_U(a));
544 fprintf(texout,"}");
545 texposition += (INT)10;
546 texmath_yn = merk;
547 if (texmath_yn != (INT)1) /* d.h. no math mode any more */
548 fprintf(texout,"$");
549 ENDR("tex_bruch");
550 }
551
552
553
fprint_bruch(a,b)554 INT fprint_bruch(a,b) FILE *a; OP b;
555 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 040391 V1.2 */
556 /* AK 200891 V1.3 */
557 {
558 extern INT zeilenposition;
559
560 fprint(a,S_B_O(b));
561 fprintf(a,"/");
562 if (a == stdout)
563 {
564 if (zeilenposition > 70L)
565 {
566 zeilenposition = 0L;
567 fprintf(a,"\n");
568 }
569 else
570 zeilenposition++;
571 }
572 fprint(a,S_B_U(b));
573 return OK;
574 }
575
576
577
freeself_bruch(bruch)578 INT freeself_bruch(bruch) OP bruch;
579 /* AK 050789 V1.0 */ /* AK 211189 V1.1 */ /* AK 200891 V1.3 */
580 {
581 INT erg = OK;
582
583 FREEALL(S_B_O(bruch));
584 FREEALL(S_B_U(bruch));
585
586 erg += freebruch(S_O_S(bruch).ob_bruch);
587 C_O_K(bruch,EMPTY);
588 ENDR("freeself_bruch");
589 }
590
591
copy_bruch(von,nach)592 INT copy_bruch(von,nach) OP von, nach;
593 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
594 {
595 INT erg = OK;
596 CTO(BRUCH,"copy_bruch(1)",von);
597 CTO(EMPTY,"copy_bruch(2)",nach);
598
599 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),nach);
600 COPY(S_B_O(von),S_B_O(nach));
601 COPY(S_B_U(von),S_B_U(nach));
602 C_B_I(nach,S_B_I(von));
603 ENDR("copy_bruch");
604 }
605
606
607
callocbruch()608 static struct bruch * callocbruch()
609 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
610 {
611 struct bruch *ergebnis;
612
613 mem_counter_bruch++;
614
615
616 if (bruch_speicherindex >= 0) /* AK 301001 */
617 return bruch_speicher[bruch_speicherindex--];
618
619
620
621 ergebnis = (struct bruch *)
622 SYM_malloc( sizeof(struct bruch));
623
624 if (ergebnis == NULL) no_memory();
625
626 return ergebnis;
627 }
628
freebruch(v)629 static INT freebruch(v) struct bruch *v;
630 /* AK 231001 */
631 {
632 INT erg = OK;
633 if (bruch_speicherindex+1 == bruch_speichersize) {
634 if (bruch_speichersize == 0) {
635 bruch_speicher = (struct bruch **) SYM_malloc(100 * sizeof(struct bruch *));
636 if (bruch_speicher == NULL) {
637 erg += error("no memory");
638 goto endr_ende;
639 }
640 bruch_speichersize = 100;
641 }
642 else {
643 bruch_speicher = (struct bruch **) SYM_realloc (bruch_speicher,
644 2 * bruch_speichersize * sizeof(struct bruch *));
645 if (bruch_speicher == NULL) {
646 erg += error("no memory");
647 goto endr_ende;
648 }
649 bruch_speichersize = 2 * bruch_speichersize;
650 }
651 }
652
653 mem_counter_bruch--;
654
655 bruch_speicher[++bruch_speicherindex] = v;
656 ENDR("freebruch");
657 }
658
659
660
661
662
m_ou_b(oben,unten,ergebnis)663 INT m_ou_b(oben,unten,ergebnis) OP oben, unten,ergebnis;
664 /* AK 221190 V1.1 */ /* AK 200891 V1.3 */
665 {
666 INT erg = OK;
667 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),ergebnis);
668 COPY(oben, S_B_O(ergebnis));
669 COPY(unten, S_B_U(ergebnis));
670 CTO(BRUCH,"m_ou_b(3-end)",ergebnis);
671 ENDR("m_ou_b");
672 }
673
674
675
b_ou_b(oben,unten,ergebnis)676 INT b_ou_b(oben,unten,ergebnis) OP oben, unten,ergebnis;
677 /* AK 050789 V1.0 */ /* AK 071289 V1.1 */ /* AK 200891 V1.3 */
678 {
679 INT erg = OK;
680 OBJECTSELF d;
681 if (oben == unten) {
682 erg += error("b_ou_b:identical objects");
683 goto endr_ende;
684 }
685
686 d.ob_bruch = callocbruch();
687 erg += b_ks_o(BRUCH, d, ergebnis);
688 C_B_O(ergebnis,oben);
689 C_B_U(ergebnis,unten);
690 C_B_I(ergebnis,NGEKUERZT);
691 ENDR("b_ou_b");
692 }
693
694
695
m_ioiu_b(oben,unten,ergebnis)696 INT m_ioiu_b(oben,unten,ergebnis) INT oben,unten; OP ergebnis;
697 /* AK 030389
698 ein bruch mit einem integer eintrag im zaehler und einem
699 integer eintrag im nenner z.b. oben = 3 unten = 5 --> 3/5 */
700 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
701 {
702 INT erg = OK;
703 erg += b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),ergebnis);
704 M_I_I(oben,S_B_O(ergebnis));
705 M_I_I(unten,S_B_U(ergebnis));
706 return erg;
707 }
708
709
710
711
scan_bruch(a)712 INT scan_bruch(a) OP a;
713 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
714 /* AK 220998 V2.0 */
715 {
716 OBJECTKIND kind;
717 INT erg = OK;
718 CTO(EMPTY,"scan_bruch(1)",a);
719
720 erg += b_ou_b(callocobject(),callocobject(),a);
721 erg += printeingabe("input of a fractional number");
722 erg += printeingabe("input of the nominator");
723 kind = scanobjectkind();
724 erg += scan(kind,S_B_O(a));
725 erg += printeingabe("input of the denominator");
726 kind = scanobjectkind();
727 erg += scan(kind,S_B_U(a));
728 erg += kuerzen(a);
729 ENDR("scan_bruch");
730 }
731
scan_integerbruch(a)732 INT scan_integerbruch(a) OP a;
733 /* AK 220998 V2.0 */
734 {
735 INT erg = OK;
736 CTO(EMPTY,"scan_integerbruch(1)",a);
737
738 erg +=b_ou_b(CALLOCOBJECT(),CALLOCOBJECT(),a);
739 erg += printeingabe("input of a fraction two INTEGER objects");
740 erg += printeingabe("input of the nominator");
741 erg += scan(INTEGER,S_B_O(a));
742 erg += printeingabe("input of the denominator");
743 erg += scan(INTEGER,S_B_U(a));
744 CTO(BRUCH,"scan_integerbruch(i)",a);
745 erg += kuerzen_integral(a);
746 ENDR("scan_integerbruch");
747 }
748
749
750
751
s_b_o(a)752 OP s_b_o(a) OP a;
753 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
754 {
755
756 OBJECTSELF c;
757 INT erg = OK;
758 CTO(BRUCH, "s_b_o",a);
759 c = s_o_s(a);
760 return(c.ob_bruch->b_oben);
761 ENDO("s_b_o");
762 }
763
s_b_u(a)764 OP s_b_u(a) OP a;
765 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
766 {
767
768 OBJECTSELF c;
769 INT erg = OK;
770 CTO(BRUCH, "s_b_u(1)",a);
771 c = s_o_s(a);
772 return(c.ob_bruch->b_unten);
773 ENDO("s_b_u");
774 }
775
s_b_i(a)776 INT s_b_i(a) OP a;
777 /* notiert gekuerzt oder nicht */
778 {
779 INT erg = OK;
780 OBJECTSELF c;
781 CTO(BRUCH, "s_b_i(1)",a);
782 c = s_o_s(a);
783 return(c.ob_bruch->b_info);
784 ENDR("s_b_i")
785 }
786
787
s_b_oi(a)788 INT s_b_oi(a) OP a;
789 /* AK 240789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
790 {
791 return(s_i_i(s_b_o(a)));
792 }
793
s_b_ui(a)794 INT s_b_ui(a) OP a;
795 /* AK 240789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
796 {
797 return(s_i_i(s_b_u(a)));
798 }
799
c_b_o(a,b)800 INT c_b_o(a,b) OP a,b;
801 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
802 {
803
804 OBJECTSELF c;
805 c = s_o_s(a);
806
807 c.ob_bruch->b_oben = b;
808 return(OK);
809 }
810
c_b_u(a,b)811 INT c_b_u(a,b) OP a,b;
812 /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
813 {
814
815 OBJECTSELF c;
816 c = s_o_s(a);
817
818 c.ob_bruch->b_unten = b;
819 return(OK);
820 }
821
822
823
posp_bruch(a)824 INT posp_bruch(a) OP a;
825 /* AK 040590 V1.1 */ /* AK 200891 V1.3 */
826 /* AK 190298 V2.0 */
827 /* TRUE if >= 0 */
828 {
829 INT erg = OK;
830 CTO(BRUCH,"posp_bruch",a);
831
832 if (NULLP(S_B_O(a)))
833 return TRUE;
834
835 if (posp(S_B_O(a))) {
836 if (posp(S_B_U(a)))
837 return TRUE;
838 else
839 return FALSE;
840 }
841
842 if (negp(S_B_U(a)))
843 return TRUE;
844 else
845 return FALSE;
846
847 ENDR("posp_bruch");
848 }
849
850
851
comp_bruch(a,b)852 INT comp_bruch(a,b) OP a,b;
853 /* AK 050789 V1.0 */
854 /* AK 310190 V1.1 */ /* fehler beseitigt von Isabel Klein */
855 /* AK 200891 V1.3 */
856 {
857 INT erg = OK;
858 CTO(BRUCH,"comp_bruch(1)",a);
859 if (S_O_K(b) == BRUCH)
860 {
861 /* a/b < c/d <==> ad < cb */
862 INT ret;
863 OP c,d;
864 c = CALLOCOBJECT();
865 d = CALLOCOBJECT();
866 MULT(S_B_O(a),S_B_U(b),c);
867 MULT(S_B_O(b),S_B_U(a),d);
868 if (
869 (NEGP(S_B_U(a)) && NEGP(S_B_U(b)))
870 ||
871 (POSP(S_B_U(a)) && POSP(S_B_U(b)))
872 )
873 ret = comp(c,d);
874 else
875 ret = comp(d,c);
876 FREEALL(c);
877 FREEALL(d);
878 return(ret);
879 }
880 else if (scalarp(b))
881 return comp_bruch_scalar(a,b);
882 else
883 WTO("comp_bruch(2)",b);
884
885 ENDR("comp_bruch");
886 }
887
888
889
comp_bruch_scalar(a,b)890 INT comp_bruch_scalar(a,b) OP a,b;
891 /* AK 050789 V1.0 */ /* AK 310190 V1.1 */ /* AK 200891 V1.3 */
892 {
893 INT erg=0;
894 OP c;
895 CTO(BRUCH,"comp_bruch_scalar(1)",a);
896 c = CALLOCOBJECT();
897 MULT(S_B_U(a),b,c);
898 erg = COMP(S_B_O(a),c);
899 FREEALL(c);
900 if (NEGP(S_B_U(a))) erg = -erg; /* AK 271192 */
901 return(erg);
902 ENDR("comp_bruch_scalar");
903 }
904
905
906
907
908 INT kuerzen_integer_integer();
909 INT kuerzen_integer_longint();
910 INT kuerzen_longint_integer();
911 INT kuerzen_longint_longint();
912
kuerzen(bruch)913 INT kuerzen(bruch) OP bruch;
914 {
915 INT erg = OK;
916 CTTTO(LONGINT,INTEGER,BRUCH,"kuerzen(1)",bruch);
917
918 if (S_O_K(bruch) != BRUCH) goto ende;
919 if (kuerzen_yn == 1L) goto ende; /* d.h. nicht kuerzen */
920
921
922 if (S_O_K(S_B_O(bruch)) == INTEGER)
923 {
924 if (S_O_K(S_B_U(bruch)) == INTEGER)
925 {
926 erg += kuerzen_integer_integer(bruch);
927 goto ende;
928 }
929 else if (S_O_K(S_B_U(bruch)) == LONGINT)
930 {
931 erg += kuerzen_integer_longint(bruch);
932 goto ende;
933 }
934 else
935 goto nf;
936 }
937 else if (S_O_K(S_B_O(bruch)) == LONGINT)
938 {
939 if (S_O_K(S_B_U(bruch)) == INTEGER)
940 {
941 erg += kuerzen_longint_integer(bruch);
942 goto ende;
943 }
944 else if (S_O_K(S_B_U(bruch)) == LONGINT)
945 {
946 erg += kuerzen_longint_longint(bruch);
947 goto ende;
948 }
949 else
950 goto nf;
951 }
952
953
954 nf:
955 erg += krz(bruch);
956 ende:
957 ENDR("kuerzen");
958 }
959
kuerzen_integer_integer(bruch)960 INT kuerzen_integer_integer(bruch) OP bruch;
961 {
962 INT erg = OK;
963 INT ggterg;
964 CTO(BRUCH,"kuerzen_integer_integer(1)",bruch);
965 CTO(INTEGER,"kuerzen_integer_integer(1-nominator)",S_B_O(bruch));
966 CTO(INTEGER,"kuerzen_integer_integer(1-denominator)",S_B_U(bruch));
967 if (kuerzen_yn == 1L) { goto ende; /* d.h. nicht kuerzen */ }
968
969 if (NULLP_INTEGER(S_B_O(bruch))) {
970 freeself_bruch(bruch);
971 M_I_I(0,bruch);
972 goto ende;
973 }
974
975 ggterg = ggt_i(S_B_UI(bruch),S_B_OI(bruch));
976
977 if (ggterg == S_B_UI(bruch)) {
978 INT tmp = S_B_OI(bruch);
979 freeself_bruch(bruch);
980 M_I_I(tmp / ggterg,bruch);
981 goto ende;
982 }
983
984 if (-ggterg == S_B_UI(bruch)) {
985 INT tmp = S_B_OI(bruch);
986 freeself_bruch(bruch);
987 M_I_I(- tmp / ggterg,bruch);
988 goto ende;
989 }
990
991 if (ggterg != 1) {
992 M_I_I(S_B_OI(bruch)/ggterg,S_B_O(bruch));
993 M_I_I(S_B_UI(bruch)/ggterg,S_B_U(bruch));
994 }
995 if (NEGP_INTEGER(S_B_O(bruch)) && NEGP_INTEGER(S_B_U(bruch)))
996 {
997 ADDINVERS_APPLY_INTEGER(S_B_O(bruch));
998 ADDINVERS_APPLY_INTEGER(S_B_U(bruch));
999 }
1000 C_B_I(bruch,GEKUERZT);
1001
1002 ende:
1003 ENDR("kuerzen_integer_integer");
1004 }
1005
kuerzen_integer_longint(bruch)1006 INT kuerzen_integer_longint(bruch) OP bruch;
1007 {
1008 INT erg = OK;
1009 OP ggterg;
1010 CTO(BRUCH,"kuerzen_integer_longint(1)",bruch);
1011 CTO(INTEGER,"kuerzen_integer_longint(1-nominator)",S_B_O(bruch));
1012 CTO(LONGINT,"kuerzen_integer_longint(1-denominator)",S_B_U(bruch));
1013 if (kuerzen_yn == 1L) { goto ende; /* d.h. nicht kuerzen */ }
1014
1015 if (NULLP_INTEGER(S_B_O(bruch))) {
1016 freeself_bruch(bruch);
1017 M_I_I(0,bruch);
1018 goto ende;
1019 }
1020 if (EINSP_INTEGER(S_B_O(bruch))) {
1021 C_B_I(bruch,GEKUERZT);
1022 goto ende;
1023 }
1024
1025
1026 ggterg = CALLOCOBJECT();
1027 erg += ggt_integer_longint(S_B_O(bruch),S_B_U(bruch),ggterg);
1028 CTO(INTEGER,"kuerzen_integer_longint(i1)",ggterg);
1029 if (S_I_I(ggterg) != 1) {
1030 GANZDIV_APPLY_INTEGER(S_B_O(bruch),ggterg);
1031 GANZDIV_APPLY_LONGINT(S_B_U(bruch),ggterg);
1032 }
1033 FREEALL(ggterg);
1034
1035 if (S_O_K(S_B_U(bruch)) == INTEGER)
1036 if (S_B_UI(bruch) == 1) {
1037 INT tmp = S_B_OI(bruch);
1038 freeself_bruch(bruch);
1039 M_I_I(tmp,bruch);
1040 goto ende; }
1041 else if (S_B_UI(bruch) == -1) {
1042 INT tmp = S_B_OI(bruch);
1043 freeself_bruch(bruch);
1044 M_I_I( - tmp,bruch);
1045 goto ende; }
1046 if (NEGP(S_B_O(bruch)) && NEGP(S_B_U(bruch)))
1047 {
1048 ADDINVERS_APPLY(S_B_O(bruch));
1049 ADDINVERS_APPLY(S_B_U(bruch));
1050 }
1051 C_B_I(bruch,GEKUERZT);
1052
1053 ende:
1054 CTO(ANYTYPE,"kuerzen_integer_longint(e1)",bruch);
1055 ENDR("kuerzen_integer_longint");
1056 }
1057
kuerzen_longint_integer(bruch)1058 INT kuerzen_longint_integer(bruch) OP bruch;
1059 {
1060 INT erg = OK;
1061 OP ggterg;
1062 CTO(BRUCH,"kuerzen_longint_integer(1)",bruch);
1063 CTO(LONGINT,"kuerzen_longint_integer(1-nominator)",S_B_O(bruch));
1064 CTO(INTEGER,"kuerzen_longint_integer(1-denominator)",S_B_U(bruch));
1065 if (kuerzen_yn == 1L) { goto ende; /* d.h. nicht kuerzen */ }
1066
1067 if (NULLP_LONGINT(S_B_O(bruch))) {
1068 freeself_bruch(bruch);
1069 M_I_I(0,bruch);
1070 goto ende;
1071 }
1072
1073 ggterg = CALLOCOBJECT();
1074 erg += ggt_integer_longint(S_B_U(bruch),S_B_O(bruch),ggterg);
1075 CTO(INTEGER,"kuerzen_integer_longint(i1)",ggterg);
1076 if (S_I_I(ggterg) != 1)
1077 {
1078 GANZDIV_APPLY_INTEGER(S_B_U(bruch),ggterg);
1079 GANZDIV_APPLY_LONGINT(S_B_O(bruch),ggterg);
1080 }
1081 FREEALL(ggterg);
1082
1083 if (S_B_UI(bruch) == 1) {
1084 if (S_O_K(S_B_O(bruch)) == INTEGER)
1085 {
1086 INT wi = S_B_OI(bruch);
1087 freeself_bruch(bruch);
1088 M_I_I(wi,bruch);
1089 }
1090 else /* LONGINT */
1091 {
1092 OP d;
1093 d = CALLOCOBJECT();
1094 SWAP(S_B_O(bruch),d);
1095 erg += freeself_bruch(bruch);
1096 SWAP(d,bruch);
1097 FREEALL(d);
1098 }
1099 goto ende;
1100 }
1101 else if (S_B_UI(bruch) == -1) {
1102 if (S_O_K(S_B_O(bruch)) == INTEGER)
1103 {
1104 INT wi = S_B_OI(bruch);
1105 freeself_bruch(bruch);
1106 M_I_I(-wi,bruch);
1107 }
1108 else /* LONGINT */
1109 {
1110 OP d;
1111 d = CALLOCOBJECT();
1112 SWAP(S_B_O(bruch),d);
1113 erg += freeself_bruch(bruch);
1114 ADDINVERS_APPLY(d);
1115 SWAP(d,bruch);
1116 FREEALL(d);
1117 }
1118 goto ende;
1119 }
1120 if (NEGP(S_B_O(bruch)) && NEGP(S_B_U(bruch)))
1121 {
1122 ADDINVERS_APPLY(S_B_O(bruch));
1123 ADDINVERS_APPLY(S_B_U(bruch));
1124 }
1125 C_B_I(bruch,GEKUERZT);
1126 ende:
1127 ENDR("kuerzen_longint_integer");
1128 }
1129
kuerzen_longint_longint(bruch)1130 INT kuerzen_longint_longint(bruch) OP bruch;
1131 {
1132 INT erg = OK;
1133 OP ggterg;
1134 CTO(BRUCH,"kuerzen_longint_longint(1)",bruch);
1135 CTO(LONGINT,"kuerzen_longint_longint(1-nominator)",S_B_O(bruch));
1136 CTO(LONGINT,"kuerzen_longint_longint(1-denominator)",S_B_U(bruch));
1137 if (kuerzen_yn == 1L) { goto ende; /* d.h. nicht kuerzen */ }
1138
1139 if (NULLP_LONGINT(S_B_O(bruch))) {
1140 freeself_bruch(bruch);
1141 M_I_I(0,bruch);
1142 goto ende;
1143 }
1144
1145 ggterg = CALLOCOBJECT();
1146 erg += ggt_longint_longint(S_B_U(bruch),S_B_O(bruch),ggterg);
1147 if (not EINSP(ggterg)) {
1148 GANZDIV_APPLY_LONGINT(S_B_U(bruch),ggterg);
1149 GANZDIV_APPLY_LONGINT(S_B_O(bruch),ggterg);
1150 }
1151 FREEALL(ggterg);
1152
1153 if (S_O_K(S_B_U(bruch))== INTEGER)
1154 if (S_B_UI(bruch) == 1) {
1155 if (S_O_K(S_B_O(bruch)) == INTEGER)
1156 {
1157 INT wi = S_B_OI(bruch);
1158 freeself_bruch(bruch);
1159 M_I_I(wi,bruch);
1160 }
1161 else /* LONGINT */
1162 {
1163 OP d;
1164 d = CALLOCOBJECT();
1165 SWAP(S_B_O(bruch),d);
1166 erg += freeself_bruch(bruch);
1167 SWAP(d,bruch);
1168 FREEALL(d);
1169 }
1170 goto ende;
1171 }
1172 else if (S_B_UI(bruch) == -1) {
1173 if (S_O_K(S_B_O(bruch)) == INTEGER)
1174 {
1175 INT wi = S_B_OI(bruch);
1176 freeself_bruch(bruch);
1177 M_I_I(-wi,bruch);
1178 }
1179 else /* LONGINT */
1180 {
1181 OP d;
1182 d = CALLOCOBJECT();
1183 SWAP(S_B_O(bruch),d);
1184 erg += freeself_bruch(bruch);
1185 ADDINVERS_APPLY(d);
1186 SWAP(d,bruch);
1187 FREEALL(d);
1188 }
1189 goto ende;
1190 }
1191 if (NEGP(S_B_O(bruch)) && NEGP(S_B_U(bruch)))
1192 {
1193 ADDINVERS_APPLY(S_B_O(bruch));
1194 ADDINVERS_APPLY(S_B_U(bruch));
1195 }
1196 C_B_I(bruch,GEKUERZT);
1197 ende:
1198 ENDR("kuerzen_longint_longint");
1199 }
1200
1201
kuerzen_integral(bruch)1202 INT kuerzen_integral(bruch) OP bruch;
1203 /* AK 050789 V1.0 */ /* AK 061289 V1.1 */ /* AK 100791 V1.3 */
1204 /* bruch is a BRUCH object
1205 with oben and unten both are integral, i.e. INTEGER or LONGINT
1206 */
1207 {
1208 return kuerzen(bruch);
1209 }
1210
1211
1212
m_scalar_bruch(a,b)1213 INT m_scalar_bruch(a,b) OP a,b;
1214 /* AK 210387 macht aus scalar bruch */
1215 /* die integerzahl 5 wird z.B. 5/1 */
1216 /* AK 050789 V1.0 */ /* AK 040590 V1.1 */
1217 /* AK 050789 V1.0 */ /* AK 061289 V1.1 */ /* AK 100791 V1.3 */
1218 {
1219 return m_ou_b(a,cons_eins,b);
1220 }
1221
1222 #define MAS_B_CO(b)\
1223 if (S_O_K(S_B_U(b)) == INTEGER)\
1224 if (S_B_UI(b) == (INT)1)\
1225 {\
1226 c = CALLOCOBJECT();\
1227 SWAP(S_B_O(b),c);\
1228 FREESELF(b);\
1229 SWAP(c,b);\
1230 FREEALL(c);\
1231 }\
1232 else if (S_B_UI(b) == (INT)-1)\
1233 {\
1234 c = CALLOCOBJECT();\
1235 SWAP(S_B_O(b),c);\
1236 FREESELF(b);\
1237 SWAP(c,b);\
1238 FREEALL(c);\
1239 ADDINVERS_APPLY(b);\
1240 }
1241
mult_apply_scalar_bruch(a,b)1242 INT mult_apply_scalar_bruch(a,b) OP a,b;
1243 /* AK 150290 V1.1 */ /* AK 100791 V1.3 */
1244 {
1245 INT erg = OK;
1246 OP c;
1247 CTO(BRUCH,"mult_apply_scalar_bruch(2)",b);
1248
1249 c = CALLOCOBJECT();
1250 erg += ggt(a,S_B_U(b),c);
1251 GANZDIV_APPLY(S_B_U(b),c);
1252 erg += ganzdiv(a,c,c);
1253 erg += mult_apply(c,S_B_O(b));
1254 FREEALL(c);
1255 MAS_B_CO(b); /* check on 1 in denominator */
1256 /* ist bereits gekuerzt */
1257
1258 ENDR("mult_apply_scalar_bruch");
1259 }
1260
mult_apply_integer_bruch(a,b)1261 INT mult_apply_integer_bruch(a,b) OP a,b;
1262 /* AK 251001 */
1263 {
1264 INT erg = OK;
1265 OP c,d;
1266 CTO(INTEGER,"mult_apply_integer_bruch(1)",a);
1267 CTO(BRUCH,"mult_apply_integer_bruch(2)",b);
1268
1269 if (INTEGRALP(S_B_O(b)) && INTEGRALP(S_B_U(b)))
1270 {
1271 c = CALLOCOBJECT();
1272 GGT_INTEGER(a,S_B_U(b),c);
1273 GANZDIV_APPLY(S_B_U(b),c);
1274 d = CALLOCOBJECT();
1275 GANZDIV(a,c,d);
1276 MULT_APPLY_INTEGER(d,S_B_O(b));
1277 FREEALL(c);
1278 FREEALL(d);
1279 MAS_B_CO(b); /* check on 1 in denominator */
1280 /* ist bereits gekuerzt */
1281 goto ende;
1282 }
1283 /* nominator or denominator is not integer */
1284 /* AK 060502 */
1285 MULT_APPLY_INTEGER(a,S_B_O(b));
1286 erg += kuerzen(b);
1287
1288 ende:
1289 ENDR("mult_apply_integer_bruch");
1290 }
1291
mult_apply_longint_bruch(a,b)1292 INT mult_apply_longint_bruch(a,b) OP a,b;
1293 /* AK 291001 */
1294 {
1295 INT erg = OK;
1296 OP c,d;
1297 CTO(LONGINT,"mult_apply_longint_bruch(1)",a);
1298 CTO(BRUCH,"mult_apply_longint_bruch(2)",b);
1299
1300 c = CALLOCOBJECT();
1301 GGT_LONGINT(a,S_B_U(b),c);
1302 GANZDIV_APPLY(S_B_U(b),c);
1303 d = CALLOCOBJECT();
1304 GANZDIV(a,c,d);
1305 MULT_APPLY(d,S_B_O(b));
1306 FREEALL(c);
1307 FREEALL(d);
1308
1309 MAS_B_CO(b); /* check on 1 in denominator */
1310
1311 /* ist bereits gekuerzt */
1312
1313 ENDR("mult_apply_longint_bruch");
1314 }
1315
1316
mult_apply_bruch_integer(a,b)1317 INT mult_apply_bruch_integer(a,b) OP a,b;
1318 /* AK 251001 */
1319 {
1320 INT erg = OK;
1321 OP c,d;
1322 CTO(BRUCH,"mult_apply_bruch_integer(1)",a);
1323 CTO(INTEGER,"mult_apply_bruch_integer(2)",b);
1324
1325 if (NULLP_INTEGER(b)) goto ae;
1326
1327 c = CALLOCOBJECT();
1328 GGT_INTEGER(b,S_B_U(a),c);
1329 CTO(INTEGER,"mult_apply_bruch_integer:internal",c);
1330
1331 if (EQ_INTEGER(c,S_B_U(a)))
1332 {
1333 M_I_I(S_I_I(b)/S_I_I(c),b);
1334 FREEALL(c);
1335 MULT_APPLY(S_B_O(a),b);
1336 goto ae;
1337 }
1338
1339
1340 d = CALLOCOBJECT();
1341 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),d);
1342
1343 GANZDIV(S_B_U(a),c,S_B_U(d));
1344 M_I_I(S_I_I(b)/S_I_I(c),c);
1345 MULT_INTEGER(c,S_B_O(a),S_B_O(d));
1346 if (NEGP(S_B_O(d)) && NEGP(S_B_U(d)))
1347 {
1348 ADDINVERS_APPLY(S_B_O(d));
1349 ADDINVERS_APPLY(S_B_U(d));
1350 }
1351 C_B_I(d,GEKUERZT);
1352 FREEALL(c);
1353 SWAP(d,b);
1354 FREEALL(d);
1355
1356
1357
1358 C_B_I(b,GEKUERZT);
1359 /* ist bereits gekuerzt */
1360 ae:
1361 ENDR("mult_apply_bruch_integer");
1362 }
1363
mult_apply_bruch_longint(a,b)1364 INT mult_apply_bruch_longint(a,b) OP a,b;
1365 /* AK 251001 */
1366 {
1367 INT erg = OK;
1368 OP c,d;
1369 CTO(BRUCH,"mult_apply_bruch_longint(1)",a);
1370 CTO(LONGINT,"mult_apply_bruch_longint(2)",b);
1371
1372 c = CALLOCOBJECT();
1373 GGT_LONGINT(b,S_B_U(a),c);
1374
1375 if (EQ(c,S_B_U(a)))
1376 {
1377 GANZDIV_APPLY(b,c);
1378 FREEALL(c);
1379 MULT_APPLY(S_B_O(a),b);
1380 goto ende;
1381 }
1382
1383
1384 d = CALLOCOBJECT();
1385 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),d);
1386
1387 GANZDIV(S_B_U(a),c,S_B_U(d));
1388 ganzdiv(b,c,c); /* AK 121201 */
1389 MULT(c,S_B_O(a),S_B_O(d));
1390 FREEALL(c);
1391 SWAP(d,b);
1392 FREEALL(d);
1393
1394
1395
1396 /* ist bereits gekuerzt */
1397 C_B_I(b,GEKUERZT);
1398 if (NEGP(S_B_O(b)) && NEGP(S_B_U(b)))
1399 {
1400 ADDINVERS_APPLY(S_B_O(b));
1401 ADDINVERS_APPLY(S_B_U(b));
1402 }
1403 ende:
1404 ENDR("mult_apply_bruch_longint");
1405 }
1406
mult_apply_bruch_bruch(a,b)1407 INT mult_apply_bruch_bruch(a,b) OP a,b;
1408 /* AK 281001 */
1409 {
1410 INT erg = OK;
1411 OP c,d;
1412 CTO(BRUCH,"mult_apply_bruch_bruch(1)",a);
1413 CTO(BRUCH,"mult_apply_bruch_bruch(2)",b);
1414 c = CALLOCOBJECT();
1415 d = CALLOCOBJECT();
1416 GGT(S_B_O(a),S_B_U(b),c);
1417 GANZDIV(S_B_O(a),c,d);
1418 GANZDIV_APPLY(S_B_U(b),c);
1419
1420 FREESELF(c);
1421
1422 GGT(S_B_O(b),S_B_U(a),c);
1423 GANZDIV_APPLY(S_B_O(b),c);
1424 MULT_APPLY(d,S_B_O(b));
1425
1426 FREESELF(d);
1427 GANZDIV(S_B_U(a),c,d);
1428 MULT_APPLY(d,S_B_U(b));
1429
1430 if (EINSP(S_B_U(b))) {
1431 SWAP(S_B_O(b),c);
1432 FREESELF(b);
1433 SWAP(c,b);
1434 }
1435 else if (NEGEINSP(S_B_U(b))) {
1436 SWAP(S_B_O(b),c);
1437 FREESELF(b);
1438 ADDINVERS_APPLY(c);
1439 SWAP(c,b);
1440 }
1441
1442 FREEALL(c);
1443 FREEALL(d);
1444
1445
1446 CTO(ANYTYPE,"mult_apply_bruch_bruch(e2)",b);
1447 ENDR("mult_apply_bruch_bruch");
1448 }
1449
1450
1451
1452
mult_apply_bruch_scalar(a,b)1453 INT mult_apply_bruch_scalar(a,b) OP a,b;
1454 /* AK 140290 V1.1 */ /* AK 200891 V1.3 */
1455 /* b = b*a */
1456 {
1457 INT erg = OK;
1458 OP c;
1459 CTO(BRUCH,"mult_apply_bruch_scalar",a);
1460
1461 c = callocobject();
1462 *c = *b;
1463 C_O_K(b,EMPTY);
1464 erg += copy_bruch(a,b);
1465 erg += mult_apply_scalar_bruch(c,b); /* hat kuerzen */
1466 erg += freeall(c);
1467 ENDR("mult_apply_bruch_scalar");
1468 }
1469
1470
1471
add_apply_bruch_bruch_pre261101(a,b)1472 INT add_apply_bruch_bruch_pre261101(a,b) OP a,b;
1473 /* b = b + a */
1474 /* AK 220390 V1.1 */ /* AK 200891 V1.3 */
1475 {
1476 INT erg = OK;
1477 OP c;
1478 CTO(BRUCH,"add_apply_bruch_bruch(1)",a);
1479 CTO(BRUCH,"add_apply_bruch_bruch(2)",b);
1480
1481
1482 SYMCHECK((S_B_I(a) != GEKUERZT),"add_apply_bruch_bruch:(1) not reduced");
1483 SYMCHECK((S_B_I(b) != GEKUERZT),"add_apply_bruch_bruch:(2) not reduced");
1484
1485 c = CALLOCOBJECT();
1486
1487 MULT(S_B_O(a),S_B_U(b),c);
1488 MULT_APPLY(S_B_U(a), S_B_U(b));
1489 MULT_APPLY(S_B_U(a), S_B_O(b));
1490 ADD_APPLY(c,S_B_O(b));
1491 FREEALL(c);
1492
1493 if (NULLP(S_B_O(b)) ) {
1494 FREESELF(b);
1495 M_I_I(0,b);
1496 }
1497 else {
1498 C_B_I(b,NGEKUERZT);
1499 KUERZEN(b);
1500 }
1501 ENDR("add_apply_bruch_bruch");
1502 }
1503
add_apply_bruch_bruch(a,b)1504 INT add_apply_bruch_bruch(a,b) OP a,b;
1505 /* b = b + a */
1506 /* AK 220390 V1.1 */ /* AK 200891 V1.3 */
1507 {
1508 INT erg = OK;
1509 OP c,d,e;
1510 CTO(BRUCH,"add_apply_bruch_bruch(1)",a);
1511 CTO(BRUCH,"add_apply_bruch_bruch(2)",b);
1512
1513 if (S_B_I(a) != GEKUERZT) goto safe;
1514 if (S_B_I(b) != GEKUERZT) goto safe;
1515 /*
1516 SYMCHECK((S_B_I(a) != GEKUERZT),"add_apply_bruch_bruch:(1) not reduced");
1517 SYMCHECK((S_B_I(b) != GEKUERZT),"add_apply_bruch_bruch:(2) not reduced");
1518 */
1519 if (INTEGRALP(S_B_O(a)) && INTEGRALP(S_B_U(a))
1520 && INTEGRALP(S_B_O(b)) && INTEGRALP(S_B_U(b)) )
1521 {
1522
1523 c = CALLOCOBJECT();
1524 GGT(S_B_U(a), S_B_U(b), c);
1525
1526 if (not EINSP(c)) {
1527 d = CALLOCOBJECT();
1528 GANZDIV(S_B_U(a),c,d); /* damit wir der bruch b erweitert */
1529
1530 e = CALLOCOBJECT();
1531 GANZDIV(S_B_U(b),c,e); /* dmit wird der bruch a erweitert */
1532
1533 MULT_APPLY(d,S_B_U(b));
1534 MULT_APPLY(d,S_B_O(b));
1535 FREESELF(c);
1536 MULT(S_B_O(a),e,c);
1537 ADD_APPLY(c,S_B_O(b));
1538 FREEALL(d);
1539 FREEALL(e);
1540 }
1541 else {
1542 FREESELF(c);
1543 MULT(S_B_O(a),S_B_U(b),c);
1544 MULT_APPLY(S_B_U(a),S_B_O(b));
1545 ADD_APPLY(c,S_B_O(b));
1546 MULT_APPLY(S_B_U(a),S_B_U(b));
1547 }
1548
1549 FREEALL(c);
1550
1551 if (NULLP(S_B_O(b)) ) { FREESELF(b); M_I_I(0,b); }
1552 else { C_B_I(b,NGEKUERZT); KUERZEN(b); }
1553 goto ende;
1554 }
1555 /* nominator or denominator not integer */
1556 /* AK 060502 */
1557 safe:
1558 c = CALLOCOBJECT();
1559 SWAP(c,b);
1560 erg += add_bruch_bruch(a,c,b);
1561 FREEALL(c);
1562 ende:
1563 ENDR("add_apply_bruch_bruch");
1564 }
1565
1566
1567
1568
1569
1570
add_apply_bruch_scalar(a,b)1571 INT add_apply_bruch_scalar(a,b) OP a,b;
1572 /* AK 220390 V1.1 */ /* AK 200891 V1.3 */
1573 {
1574 INT erg = OK;
1575 OP c;
1576 CTO(BRUCH,"add_apply_bruch_scalar(1)",a);
1577
1578 c = CALLOCOBJECT();
1579 *c = *b;
1580 C_O_K(b,EMPTY);
1581 erg += add_bruch_scalar(a,c,b);
1582 FREEALL(c);
1583
1584 ENDR("add_apply_bruch_scalar");
1585 }
1586
add_apply_bruch_integer(a,b)1587 INT add_apply_bruch_integer(a,b) OP a,b;
1588 /* AK 251001 */
1589 {
1590 INT erg = OK;
1591 OP c;
1592 CTO(BRUCH,"add_apply_bruch_integer(1)",a);
1593 CTO(INTEGER,"add_apply_bruch_integer(2)",b);
1594
1595 c = CALLOCOBJECT();
1596 MULT_INTEGER(b,S_B_U(a),c);
1597
1598
1599 C_O_K(b,EMPTY);
1600 B_OU_B(CALLOCOBJECT(),CALLOCOBJECT(),b);
1601
1602 ADD(c,S_B_O(a),S_B_O(b));
1603 FREEALL(c);
1604
1605 COPY(S_B_U(a),S_B_U(b));
1606 KUERZEN(b);
1607
1608 ENDR("add_apply_bruch_integer");
1609 }
1610
1611
add_apply_scalar_bruch(a,b)1612 INT add_apply_scalar_bruch(a,b) OP a,b;
1613 /* AK 220390 V1.1 */ /* AK 050791 V1.3 */
1614 {
1615 OP c;
1616 INT erg = OK;
1617 c = CALLOCOBJECT();
1618 *c = *b;
1619 C_O_K(b,EMPTY);
1620 erg += add_bruch_scalar(c,a,b);
1621 FREEALL(c);
1622 ENDR("add_apply_scalar_bruch");
1623 }
1624
add_apply_integer_bruch(a,b)1625 INT add_apply_integer_bruch(a,b) OP a,b;
1626 /* AK 251001 */
1627 /* not yet optimal, better with ggt */
1628 {
1629 OP c;
1630 INT erg = OK;
1631 CTO(INTEGER,"add_apply_integer_bruch(1)",a);
1632 CTO(BRUCH,"add_apply_integer_bruch(2)",b);
1633
1634 c = CALLOCOBJECT();
1635 MULT_INTEGER(a,S_B_U(b),c);
1636 ADD_APPLY(c,S_B_O(b));
1637
1638 FREEALL(c);
1639 C_B_I(b,NGEKUERZT);
1640 KUERZEN(b);
1641
1642 ENDR("add_apply_integer_bruch");
1643 }
1644
1645
1646
1647
add_apply_bruch(a,b)1648 INT add_apply_bruch(a,b) OP a,b;
1649 /* AK 220390 V1.1 */ /* AK 190291 V1.2 */ /* AK 050791 V1.3 */
1650 /* a is bruch */
1651 {
1652 INT erg = OK;
1653 CTO(BRUCH,"add_apply_bruch(1)",a);
1654
1655 switch (S_O_K(b)) {
1656 case BRUCH:
1657 erg += add_apply_bruch_bruch(a,b); /* hat kuerzen */
1658 break;
1659
1660 case LONGINT:
1661 erg += add_apply_bruch_scalar(a,b); /* hat kuerzen */
1662 break;
1663
1664 case INTEGER:
1665 erg += add_apply_bruch_integer(a,b); /* hat kuerzen */
1666 break;
1667
1668 default:
1669 {
1670 OP c = callocobject();
1671 *c = *b;
1672 C_O_K(b,EMPTY);
1673 erg += add_bruch(a,c,b); /* hat kuerzen */
1674 erg += freeall(c);
1675 break;
1676 }
1677 }
1678 ENDR("add_apply_bruch");
1679 }
1680
1681
1682
1683
mult_apply_bruch(a,b)1684 INT mult_apply_bruch(a,b) OP a,b;
1685 /* a is BRUCHobject */
1686 /* AK 140290 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
1687 {
1688 OP c;
1689 INT erg=OK;
1690 CTO(BRUCH,"mult_apply_bruch(1)",a);
1691
1692 /*CC 260696*/
1693 if(bruch_not_scalar(a))
1694 {
1695 erg += mult_apply(S_B_O(a),b);
1696 c=callocobject();
1697 erg += copy(b,c);
1698 erg += m_ou_b(c,S_B_U(a),b);
1699 erg += kuerzen(b);
1700 erg += freeall(c);
1701 goto endr_ende;
1702 }
1703
1704
1705 switch (S_O_K(b)) {
1706 case BRUCH:
1707 erg += mult_apply(S_B_O(a),S_B_O(b));
1708 erg += mult_apply(S_B_U(a),S_B_U(b));
1709 C_B_I(b,NGEKUERZT);
1710 erg += kuerzen(b);
1711 break;
1712
1713 case INTEGER:
1714 erg+= mult_apply_bruch_integer(a,b);
1715 break;
1716
1717 case LONGINT:
1718 erg+= mult_apply_bruch_longint(a,b);
1719 break;
1720
1721 #ifdef MATRIXTRUE
1722 case KRANZTYPUS :
1723 case MATRIX:
1724 erg += mult_apply_scalar_matrix(a,b);
1725 break;
1726 #endif /* MATRIXTRUE */
1727
1728 #ifdef MONOMTRUE
1729 case MONOM:
1730 erg += mult_apply_bruch_monom(a,b);
1731 break;
1732 #endif /* MONOMTRUE */
1733
1734 #ifdef CHARTRUE
1735 case SYMCHAR:
1736 erg += mult_apply_scalar_symchar(a,b);
1737 break;
1738 #endif /* CHARTRUE */
1739
1740
1741 #ifdef POLYTRUE
1742 case SCHUR:
1743 case POW_SYM:
1744 case ELM_SYM:
1745 case HOM_SYM:
1746 case MONOMIAL:
1747 case SCHUBERT:
1748 case GRAL:
1749 case MONOPOLY:
1750 case POLYNOM:
1751 erg += mult_apply_bruch_polynom(a,b);
1752 break;
1753 #endif /* POLYTRUE */
1754
1755 #ifdef NUMBERTRUE
1756 case SQ_RADICAL:
1757 erg += mult_apply_scalar_sqrad(a,b);
1758 break;
1759 case CYCLOTOMIC:
1760 erg += mult_apply_scalar_cyclo(a,b);
1761 break;
1762 #endif /* NUMBERTRUE */
1763
1764 #ifdef VECTORTRUE
1765 case INTEGERVECTOR:
1766 case COMPOSITION:
1767 case WORD:
1768 case VECTOR:
1769 erg += mult_apply_scalar_vector(a,b);
1770 break;
1771 case HASHTABLE:
1772 erg += mult_apply_bruch_hashtable(a,b);
1773 break;
1774
1775 #endif /* VECTORTRUE */
1776
1777 default:
1778 c = callocobject();
1779 erg+=mult(a,b,c);
1780 erg+=freeself(b);
1781 *b = *c;
1782 C_O_K(c,EMPTY);
1783 erg += freeall(c);
1784 }
1785 ENDR("mult_apply_bruch");
1786 }
1787
1788 #endif /* BRUCHTRUE */
1789
1790 #ifdef BRUCHTRUE
mult_bruch(a,b,c)1791 INT mult_bruch(a,b,c) OP a,b,c;
1792 /* AK 050789 V1.0 */ /* AK 140290 V1.1 */ /* AK 200891 V1.3 */
1793 {
1794 INT erg = OK;
1795 CTO(BRUCH,"mult_bruch(1)",a);
1796 CTO(EMPTY,"mult_bruch(3)",c);
1797
1798 switch( S_O_K(b)) {
1799
1800 case BRUCH:
1801 erg += mult_bruch_bruch(a,b,c);
1802 break;
1803
1804 #ifdef LONGINTTRUE
1805 case LONGINT:
1806 erg += mult_bruch_longint(a,b,c);
1807 break;
1808 #endif /* LONGINTTRUE */
1809
1810 #ifdef INTEGERTRUE
1811 case INTEGER:
1812 erg += mult_bruch_integer(a,b,c);
1813 break;
1814 #endif /* INTEGERTRUE */
1815
1816 #ifdef MATRIXTRUE
1817 case MATRIX:
1818 erg += mult_scalar_matrix(a,b,c);
1819 break;
1820 #endif /* MATRIXTRUE */
1821
1822 #ifdef MONOMTRUE
1823 case MONOM:
1824 erg += mult_scalar_monom(a,b,c);
1825 break;
1826 #endif /* MONOMTRUE */
1827
1828 case LAURENT:
1829 erg += copy(a,c);
1830 erg += mult(b,S_B_O(c), S_B_O(c));
1831 break;
1832
1833 #ifdef POLYTRUE
1834 case POLYNOM:
1835 if (
1836 (has_one_variable(b))
1837 &&
1838 ((!scalarp(S_B_O(a))) ||(!scalarp(S_B_U(a))))
1839 )
1840 {
1841 OP tp2;
1842 tp2=callocobject();
1843 erg += m_ou_b(b,cons_eins,tp2);
1844 erg += mult_bruch_bruch(a,tp2,c);
1845 erg += freeall(tp2);
1846 }
1847 else
1848 erg += mult_scalar_polynom(a,b,c);
1849 goto ende;
1850 case GRAL:
1851 erg += mult_scalar_gral(a,b,c);
1852 goto ende;
1853 #ifdef SCHUBERTTRUE
1854 case SCHUBERT:
1855 erg += mult_scalar_schubert(a,b,c);
1856 goto ende;
1857 #endif
1858 #endif /* POLYTRUE */
1859
1860 #ifdef SQRADTRUE
1861 case SQ_RADICAL:
1862 erg += mult_scalar_sqrad(a,b,c);
1863 goto ende;
1864 #endif /* SQRADTRUE */
1865
1866 #ifdef CYCLOTRUE
1867 case CYCLOTOMIC:
1868 erg += mult_scalar_cyclo(a,b,c);
1869 goto ende;
1870 #endif /* CYCLOTRUE */
1871
1872
1873 #ifdef SCHURTRUE
1874 case ELM_SYM:
1875 erg += mult_elmsym_scalar(b,a,c);
1876 goto ende;
1877 case HOM_SYM:
1878 erg += mult_homsym_scalar(b,a,c);
1879 goto ende;
1880 case POW_SYM:
1881 erg += mult_powsym_scalar(b,a,c);
1882 goto ende;
1883 case MONOMIAL:
1884 erg += mult_monomial_scalar(b,a,c);
1885 goto ende;
1886 case SCHUR:
1887 erg += mult_schur_scalar(b,a,c);
1888 goto ende;
1889 #endif /* SCHURTRUE */
1890
1891 #ifdef CHARTRUE
1892 case SYMCHAR:
1893 erg += mult_scalar_symchar(a,b,c);
1894 goto ende;
1895 #endif /* CHARTRUE */
1896
1897 #ifdef VECTORTRUE
1898 case VECTOR:
1899 erg += mult_scalar_vector(a,b,c);
1900 break;
1901 #endif /* VECTORTRUE */
1902
1903 default:
1904 WTO("mult_bruch(2)",b);
1905 goto ende;
1906 };
1907 ende:
1908 ENDR("mult_bruch");
1909 }
1910
1911
1912
test_bruch()1913 INT test_bruch()
1914 /* AK 150290 V1.1 */ /* AK 200891 V1.3 */
1915 {
1916 OP a= callocobject();
1917 OP b= callocobject();
1918 OP c= callocobject();
1919
1920 printf("test_bruch:scan(a) ");
1921 scan(BRUCH,a);
1922 println(a);
1923 printf("test_bruch:scan(b) ");
1924 scan(BRUCH,b);
1925 println(b);
1926 printf("test_bruch:posp(a) ");
1927 if (posp(a)) {
1928 printf(" a ist positiv\n");
1929 }
1930 else {
1931 printf(" a ist nicht positiv\n");
1932 }
1933 printf("test_bruch:einsp(a) ");
1934 if (einsp(a)) {
1935 printf(" a ist eins\n");
1936 }
1937 else {
1938 printf(" a ist nicht eins\n");
1939 }
1940
1941 printf("test_bruch:add(a,b,c) ");
1942 add(a,b,c);
1943 println(c);
1944 printf("test_bruch:mult(a,b,c) ");
1945 mult(a,b,c);
1946 println(c);
1947 printf("test_bruch:kuerzen(c) ");
1948 kuerzen(c);
1949 println(c);
1950 freeall(a);
1951 freeall(b);
1952 freeall(c);
1953 return(OK);
1954 }
1955
1956
1957
1958
objectwrite_bruch(f,a)1959 INT objectwrite_bruch(f,a) FILE *f; OP a;
1960 /* AK 200690 V1.1 */ /* AK 200891 V1.3 */
1961 {
1962 INT erg = OK;
1963 CTO(BRUCH,"objectwrite_bruch(2)",a);
1964 fprintf(f, "%" PRIINT "\n" , (INT)BRUCH);
1965 erg += objectwrite(f,S_B_O(a));
1966 erg += objectwrite(f,S_B_U(a));
1967 ENDR("objectwrite_bruch");
1968 }
1969
1970
1971
1972
objectread_bruch(f,a)1973 INT objectread_bruch(f,a) FILE *f; OP a;
1974 /* AK 200690 V1.1 */ /* AK 200891 V1.3 */
1975 {
1976 INT erg = OK;
1977 COP("objectread_bruch(1)",f);
1978 erg += b_ou_b(callocobject(),callocobject(),a);
1979 erg += objectread(f,S_B_O(a));
1980 erg += objectread(f,S_B_U(a));
1981 CTO(BRUCH,"objectread_bruch(i)",a);
1982 erg += kuerzen(a);
1983 ENDR("objectread_bruch");
1984 }
1985
1986
cast_apply_bruch(a)1987 INT cast_apply_bruch(a) OP a;
1988 /* AK 210294 */
1989 {
1990 INT erg = OK;
1991 EOP("cast_apply_bruch(1)",a);
1992 switch S_O_K(a) {
1993 case BRUCH:
1994 break;
1995 case INTEGER:
1996 erg += m_ioiu_b(S_I_I(a), (INT) 1, a);
1997 break;
1998 case LONGINT:
1999 erg += m_ou_b(a,cons_eins,a);
2000 break;
2001 }
2002 CTO(BRUCH,"cast_apply_bruch(e1)",a);
2003 ENDR("cast_apply_bruch");
2004 }
2005 #endif /* BRUCHTRUE */
2006
2007
2008
2009 /*
2010 Met dans dg le degre du monopoly mp
2011 */
2012
dg_mp(mp,dg)2013 INT dg_mp(mp,dg) OP mp,dg;
2014 {
2015
2016 OP z,za=NULL;
2017 if(not EMPTYP(dg)) freeself(dg);
2018 z=mp;
2019 while(z !=NULL)
2020 {
2021 za=z;
2022 z=S_L_N(z);
2023 }
2024 copy(S_PO_S(za),dg);
2025 return(OK);
2026 }
2027
2028
2029 /*
2030 Met dans ld le coefficient du terme maximal du monopoly mp
2031 */
2032
ldcf_mp(mp,ld)2033 INT ldcf_mp(mp,ld) OP mp,ld;
2034 {
2035
2036 OP z,za=NULL;
2037 if(not EMPTYP(ld)) freeself(ld);
2038 z=mp;
2039 while(z !=NULL)
2040 {
2041 za=z;
2042 z=S_L_N(z);
2043 }
2044 copy(S_PO_K(za),ld);
2045 return(OK);
2046 }
2047
2048
t_POLYNOM_MONOPOLY(a,b)2049 INT t_POLYNOM_MONOPOLY(a,b) OP a,b;
2050 /* CC */
2051 /* take only the first variable */
2052 {
2053 OP z,hh;
2054 INT erg = OK;
2055 CTO(POLYNOM,"t_POLYNOM_MONOPOLY(1)",a);
2056 CE2(a,b,t_POLYNOM_MONOPOLY);
2057
2058 init(MONOPOLY,b);
2059 if (not NULLP(a)) {
2060 z=a;
2061 while(z!=NULL)
2062 {
2063 hh=callocobject();
2064 erg += m_sk_mo(S_V_I(S_PO_S(z),0L),S_PO_K(z),hh);
2065 insert(hh,b,add_koeff,NULL);
2066 z=S_PO_N(z);
2067 }
2068 }
2069 ENDR("t_POLYNOM_MONOPOLY");
2070 }
2071
2072
2073 /*
2074 n est de type INTEGER
2075 po est de type POLYNOM ou MONOPOLY
2076 pg est le pgcd de n et des coefficients de po
2077 Retourne ERROR si le pgcd n'est pas definie
2078 */
2079
gcd_int_po(n,po,pg)2080 INT gcd_int_po(n,po,pg) OP n,po,pg;
2081 {
2082 OP z,tmp,k;
2083
2084 if(not EMPTYP(pg)) freeself(pg);
2085 z=po;
2086 if(NULLP(z)){ copy(n,pg);return(OK);}
2087 tmp=callocobject();
2088 copy(n,tmp);
2089 while(z!=NULL)
2090 {
2091 k=S_PO_K(z);
2092 if(S_O_K(k)==BRUCH)
2093 krz(k);
2094 if(S_O_K(k)!=INTEGER)
2095 return ERROR;
2096 ggt(tmp,k,tmp);
2097 z=S_L_N(z);
2098 }
2099 copy(tmp,pg);
2100 freeall(tmp);
2101 return(OK);
2102 }
2103
2104 /*
2105 Calcule le pgcd de a et b qui sont de type quelconque.
2106 Retourne ERROR si le pgcd de a et b n'existe pas
2107 */
2108
pgcd(a,b,c)2109 INT pgcd(a,b,c) OP a,b,c;
2110 {
2111 OP aa,bb,nb;
2112 if(S_O_K(a)==BRUCH) krz(a);
2113 if(S_O_K(b)==BRUCH) krz(b);
2114 if((S_O_K(a)==BRUCH)||(S_O_K(b)==BRUCH))
2115 return ERROR;
2116 if((S_O_K(a)==INTEGER)&&(S_O_K(b)==INTEGER))
2117 {
2118 ggt(a,b,c);return(OK);
2119 }
2120 if(NULLP(a))
2121 {
2122 if(has_one_variable(b)==TRUE)
2123 {
2124 copy(b,c);return(OK);
2125 }
2126 else
2127 return ERROR;
2128 }
2129 if(NULLP(b))
2130 {
2131 if(has_one_variable(a)==TRUE)
2132 {
2133 copy(a,c);return(OK);
2134 }
2135 else
2136 return ERROR;
2137 }
2138 if(scalarp(a))
2139 {
2140 copy(a,c);
2141 return(OK);
2142 }
2143 if(scalarp(b))
2144 {
2145 copy(b,c);
2146 return(OK);
2147 }
2148
2149 if(S_O_K(a)==POLYNOM)
2150 {
2151 nb=callocobject();
2152 numberofvariables(a,nb);
2153 if(S_I_I(nb)>1L)
2154 {
2155 freeall(nb);
2156 return(ERROR);
2157 }
2158 else
2159 {
2160 freeall(nb);
2161 aa=callocobject();
2162 t_POLYNOM_MONOPOLY(a,aa);
2163 }
2164 }
2165 else
2166 {
2167 aa=callocobject();
2168 copy(a,aa);
2169 }
2170
2171 if(S_O_K(b)==POLYNOM)
2172 {
2173 nb=callocobject();
2174 numberofvariables(b,nb);
2175 if(S_I_I(nb)>1L)
2176 {
2177 freeall(nb);
2178 return(ERROR);
2179 }
2180 else
2181 {
2182 freeall(nb);
2183 bb=callocobject();
2184 t_POLYNOM_MONOPOLY(b,bb);
2185 }
2186 }
2187 else
2188 {
2189 bb=callocobject();
2190 copy(b,bb);
2191 }
2192 ggt_mp(aa,bb,c);
2193 freeall(aa);freeall(bb);
2194 return OK;
2195 }
2196
2197
2198
2199
2200
2201
2202 /*
2203 Lance le pgcd de 2 polynomes non nuls de type MONOPOLY
2204 Computes the gcd of 2 MONOPOLY objects
2205 */
2206
ggt_mp(a,b,c)2207 static INT ggt_mp(a,b,c) OP a,b,c;
2208 {
2209 OP dg1,dg2;
2210 INT dgi1,dgi2;
2211 dg1=callocobject();dg2=callocobject();
2212 dg_mp(a,dg1); dg_mp(b,dg2);
2213 dgi1=S_I_I(dg1); dgi2=S_I_I(dg2);
2214 if(dgi1==0)
2215 copy(a,c);
2216 else if(dgi2==0)
2217 copy(b,c);
2218 else if(dgi1>dgi2)
2219 gcd_mp(a,b,c);
2220 else
2221 gcd_mp(b,a,c);
2222 freeall(dg1);freeall(dg2);
2223 return(OK);
2224 }
2225
2226
2227 /*
2228 Calcule le pgcd de 2 polynomes de type MONOPOLY a et b
2229 degre(a)>degre(b)>0
2230 Algo d'Euclide non optimise
2231 */
2232
2233
gcd_mp_lent(a,b,c)2234 INT gcd_mp_lent(a,b,c) OP a,b,c;
2235 {
2236 OP aa,bb,qp,rp;
2237 aa=callocobject(); qp=callocobject(); rp=callocobject(); bb=callocobject();
2238 copy(a,aa);copy(b,bb);
2239 while(1)
2240 {
2241 quores_monopoly(aa,bb,qp,rp);
2242 if(nullp_monopoly(rp)) break;
2243 copy(bb,aa);
2244 copy(rp,bb);
2245 }
2246 copy(bb,c);
2247 freeall(bb);freeall(aa);
2248 return OK;
2249 }
2250
2251
2252
2253 /*
2254 Calcule le pgcd de 2 polynomes de type MONOPOLY a et b
2255 degre(a)>degre(b)>0
2256 */
2257
gcd_mp(a,b,c)2258 INT gcd_mp(a,b,c) OP a,b,c;
2259 {
2260 OP av,nv,ld,dlt,tp,aa,bb,qp,rp;
2261 INT avi,nvi,dlti;
2262 INT erg = OK;
2263 CTO(MONOPOLY,"gcd_mp(1)",a);
2264 CTO(MONOPOLY,"gcd_mp(2)",b);
2265
2266 tp=callocobject(); aa=callocobject(); bb=callocobject();
2267 av=callocobject(); nv=callocobject(); ld=callocobject();
2268 dlt=callocobject(); qp=callocobject(); rp=callocobject();
2269 dg_mp(a,av);avi=S_I_I(av);
2270 dg_mp(b,nv);nvi=S_I_I(nv);
2271 copy(a,aa);copy(b,bb);
2272 while(nvi>0)
2273 {
2274 dlti=avi-nvi+1;
2275 M_I_I(dlti,dlt);
2276 ldcf_mp(b,ld);
2277 hoch(ld,dlt,tp);
2278 MULT_APPLY(tp,aa);
2279 FREESELF(qp);
2280 FREESELF(rp);
2281 quores_monopoly(aa,bb,qp,rp);
2282
2283 if(nullp_monopoly(rp)) break;
2284 else
2285 {
2286 copy(bb,aa);
2287 copy(rp,bb);
2288 avi=nvi;
2289 dg_mp(bb,nv);
2290 nvi=S_I_I(nv);
2291 }
2292 }
2293 copy(bb,c);
2294 freeall(tp); freeall(aa);
2295 freeall(ld); freeall(dlt);
2296 freeall(bb); freeall(av);
2297 freeall(nv);
2298 freeall(qp); /* AK 130297 */
2299 freeall(rp); /* AK 130297 */
2300 ENDR("gcd_mp");
2301 }
2302
2303
2304 /*
2305 mp est de type MONOPOLY.
2306 Renvoie TRUE si mp est une constante
2307 FALSE sinon
2308 */
2309
mp_is_cst(mp)2310 INT mp_is_cst(mp) OP mp;
2311 {
2312 OP z;
2313 INT i,boo;
2314 z=mp;i=0L;boo=0L;
2315 while(z!=NULL)
2316 {
2317 if(i > 0L) return FALSE;
2318 if(S_I_I(S_PO_S(z))==0L)
2319 boo=1L;
2320 z=S_L_N(z);
2321 i++;
2322 }
2323 if(boo==1L) return TRUE;
2324 else return FALSE;
2325 }
2326
2327 /*Simplifie fc3
2328 renvoie ERROR si fc3 est une fraction rationnelle avec 0 au denominateur
2329 */
2330
bruch_not_scalar(a)2331 INT bruch_not_scalar(a) OP a;
2332 /*
2333 Returns 1 if a is built with MONOPOLY or POLYNOM object.
2334 Returns 0 if not.
2335 */
2336 {
2337 INT tp1,tp2;
2338 if(S_O_K(S_B_O(a))==MONOPOLY || S_O_K(S_B_O(a))==POLYNOM
2339 ||S_O_K(S_B_U(a))==MONOPOLY || S_O_K(S_B_U(a))==POLYNOM)
2340 return 1;
2341 tp1=tp2=0L;
2342 if(
2343 (S_O_K(S_B_O(a))==BRUCH && bruch_not_scalar(S_B_O(a)))
2344 ||
2345 (S_O_K(S_B_U(a))==BRUCH && bruch_not_scalar(S_B_U(a)))
2346 ) return 1;
2347 return 0;
2348 }
2349
2350
2351 /*
2352 ma0 est une matrice de polynomes, fractions rationnelles, entiers...
2353 Transforme les types MONOPOLY de ma0
2354 en type POLYNOM dans ma
2355 */
2356
t_MA_MONOPOLY_MA_POLYNOM(ma0,ma)2357 INT t_MA_MONOPOLY_MA_POLYNOM(ma0,ma) OP ma0, ma;
2358 {
2359 INT i,j;
2360 OP tp,ttp1,tp1,ttp2,tp2;
2361
2362 m_ilih_m(S_M_LI(ma0),S_M_HI(ma0),ma);
2363 for(i=0L;i<S_M_LI(ma0);i++)
2364 for(j=0L;j<S_M_LI(ma0);j++)
2365 {
2366 tp=S_M_IJ(ma0,i,j);
2367 if(S_O_K(tp)==MONOPOLY)
2368 {
2369 tp=callocobject();
2370 t_MONOPOLY_POLYNOM(S_M_IJ(ma0,i,j),tp);
2371 copy(tp,S_M_IJ(ma,i,j));
2372 freeall(tp);
2373 }
2374 else if (S_O_K(tp)==BRUCH)
2375 {
2376 tp1=S_B_O(tp); ttp1=callocobject();
2377 if(S_O_K(tp1)==MONOPOLY)
2378 {
2379 t_MONOPOLY_POLYNOM(tp1,ttp1);
2380 }
2381 else copy(tp1,ttp1);
2382 tp2=S_B_U(tp); ttp2=callocobject();
2383 if(S_O_K(tp2)==MONOPOLY)
2384 {
2385 t_MONOPOLY_POLYNOM(tp2,ttp2);
2386 }
2387 else copy(tp2,ttp2);
2388 b_ou_b(ttp1,ttp2,S_M_IJ(ma,i,j));
2389 }
2390 else copy(tp,S_M_IJ(ma,i,j));
2391 }
2392 return OK;
2393 }
2394
2395 /*
2396 met 0 a la place de empty_list dans la matrice ma
2397 */
2398
en_forme(ma)2399 INT en_forme(ma) OP ma;
2400 {
2401 INT i,j;
2402 INT erg = OK;
2403 CTO(MATRIX,"en_forme(1)",ma);
2404
2405 for(i=0L;i<S_M_LI(ma);i++)
2406 for(j=0L;j<S_M_LI(ma);j++)
2407 if(EMPTYP(S_M_IJ(ma,i,j)))
2408 M_I_I(0L,S_M_IJ(ma,i,j));
2409 else if (empty_listp(S_M_IJ(ma,i,j)))
2410 erg += m_i_i(0L,S_M_IJ(ma,i,j));
2411 else if (NULLP(S_M_IJ(ma,i,j)))
2412 erg += m_i_i(0L,S_M_IJ(ma,i,j));
2413 ENDR("en_forme");
2414 }
2415
2416
2417
krz(fc3)2418 INT krz(fc3) OP fc3;
2419 {
2420 OP oo,uu,pg,tp,r,dgu,dgo,dgpg=NULL,tpu,tpo,tmp;
2421 INT erg = OK;
2422
2423 if(S_O_K(fc3)!=BRUCH) return OK;
2424
2425 oo=S_B_O(fc3);
2426 uu=S_B_U(fc3);
2427
2428 SYMCHECK(NULLP(uu)," krz:zero nominator");
2429
2430 if(NULLP(oo))
2431 {
2432 FREESELF(fc3);
2433 M_I_I(0L,fc3);
2434 goto endr_ende;
2435 }
2436
2437 if(
2438 ((S_O_K(oo)==INTEGER)||(S_O_K(oo) == LONGINT))
2439 &&
2440 ((S_O_K(uu)==INTEGER)||(S_O_K(uu) == LONGINT))
2441 )
2442 {
2443 erg += kuerzen_integral(fc3);
2444 goto endr_ende;
2445 }
2446
2447 /* CC 28/09/95*/
2448 if(S_O_K(oo)==BRUCH) krz(oo);
2449 if(S_O_K(uu)==BRUCH) krz(uu);
2450 if((S_O_K(oo)==BRUCH)||(S_O_K(uu)==BRUCH))
2451 {
2452 tp=callocobject();
2453 if(S_O_K(uu)==BRUCH)
2454 m_ou_b(S_B_U(uu),S_B_O(uu),tp);
2455 else
2456 m_ou_b(cons_eins,uu,tp);
2457 kuerzen(tp);
2458 mult_apply(oo,tp);
2459 copy(tp,fc3);
2460 freeall(tp);
2461 return(krz(fc3));
2462 }
2463
2464 if(scalarp(uu))
2465 {
2466 tp=callocobject();
2467 div(oo,uu,tp);
2468 copy(tp,fc3);
2469 freeall(tp);
2470 sp_br(fc3);
2471 return(OK);
2472 }
2473 if(scalarp(oo))
2474 {
2475 tp=callocobject();
2476 div(uu,oo,tp);
2477
2478 /*CC 28/09/95*/
2479 if(S_O_K(tp)==BRUCH)
2480 m_ou_b(S_B_U(tp),S_B_O(tp),fc3);
2481 else
2482 m_ou_b(cons_eins,tp,fc3);
2483 sp_br(fc3);
2484 freeall(tp);
2485
2486 return(OK);
2487 }
2488 if (S_O_K(uu) == LAURENT)
2489 {
2490 tpo=callocobject();
2491 tp=callocobject();
2492 copy(oo,tp);
2493 t_LAURENT_OBJ(uu,tpo);
2494 m_ou_b(tp,tpo,fc3);
2495 freeall(tpo);
2496 freeall(tp);
2497 krz(fc3);
2498 return(OK);
2499 }
2500
2501 if (S_O_K(oo) == LAURENT)
2502 {
2503 tpo=callocobject();
2504 tp=callocobject();
2505 copy(uu,tp);
2506 t_LAURENT_OBJ(oo,tpo);
2507 m_ou_b(tpo,tp,fc3);
2508 freeall(tpo);
2509 freeall(tp);
2510 krz(fc3);
2511 return(OK);
2512 }
2513
2514 pg=callocobject();
2515 if(pgcd(oo,uu,pg)==ERROR) return ERROR;
2516
2517 /*CC 28/09/95*/
2518 if(scalarp(pg))
2519 {
2520 sp_br(fc3);
2521 freeall(pg);
2522 return(OK);
2523 }
2524 if(S_O_K(pg)==MONOPOLY)
2525 {
2526 dgpg=callocobject();
2527 degree_monopoly(pg,dgpg);
2528 if(nullp(dgpg))
2529 {
2530 sp_br(fc3);
2531 freeall(pg);
2532 freeall(dgpg);
2533 return(OK);
2534 }
2535 }
2536 if(S_O_K(pg)==POLYNOM)
2537 {
2538 dgpg=callocobject();
2539 degree_polynom(pg,dgpg);
2540 if(NULLP(dgpg)==TRUE)
2541 {
2542 sp_br(fc3);
2543 freeall(dgpg);
2544 freeall(pg);
2545 return OK;
2546 }
2547 }
2548
2549 tpu=callocobject();
2550 if(S_O_K(uu)==POLYNOM)
2551 t_POLYNOM_MONOPOLY(uu,tpu);
2552 else
2553 copy(uu,tpu);
2554 tpo=callocobject();
2555 if(S_O_K(oo)==POLYNOM)
2556 t_POLYNOM_MONOPOLY(oo,tpo);
2557 else
2558 copy(oo,tpo);
2559
2560 dgu=callocobject();
2561 degree_monopoly(tpu,dgu);
2562 if(S_I_I(dgu)==S_I_I(dgpg))
2563 {
2564 freeself(fc3);
2565 r=callocobject();
2566 tmp=callocobject();
2567 quores_monopoly(tpo,tpu,tmp,r);
2568 copy(tmp,fc3);
2569
2570 freeall(tmp);
2571 freeall(r);freeall(pg);
2572 freeall(tpo);freeall(tpu);
2573 freeall(dgu);freeall(dgpg);
2574 return(OK);
2575 }
2576
2577 dgo=callocobject();
2578 degree_monopoly(tpo,dgo);
2579 if(S_I_I(dgo)==S_I_I(dgpg))
2580 {
2581 r=callocobject();
2582 tmp=callocobject();
2583 quores_monopoly(tpu,tpo,tmp,r);
2584
2585 div(cons_eins,tmp,fc3);
2586 C_B_I(fc3,GEKUERZT);
2587
2588 freeall(r);freeall(pg);freeall(tmp);
2589 freeall(dgu);freeall(dgo);freeall(dgpg);
2590 freeall(tpu);freeall(tpo);
2591 return(OK);
2592 }
2593 r=callocobject();
2594 FREESELF(oo);
2595 quores_monopoly(tpo,pg,oo,r);
2596 FREESELF(uu);
2597 FREESELF(r);
2598 quores_monopoly(tpu,pg,uu,r);
2599
2600 /*CC 28/09/95*/
2601 sp_br(fc3);
2602
2603 freeall(r);freeall(dgo);freeall(dgu);freeall(dgpg);
2604 freeall(tpo);freeall(tpu);freeall(pg);
2605 ENDR("internal routine:krz");
2606 }
2607
2608 /*
2609 CC 28/09/95
2610 If br is a bruch with monopoly or polynom in the numerator or denominator.
2611 Try to remove bruch in the numerator and denominator
2612 */
sp_br(br)2613 INT sp_br(br) OP br;
2614 {
2615 OP cf,tp1,tp2;
2616 if(S_O_K(br)!=BRUCH)return OK;
2617 if((S_O_K(S_B_O(br))!=MONOPOLY && S_O_K(S_B_O(br))!=POLYNOM)
2618 ||(S_O_K(S_B_U(br))!=MONOPOLY && S_O_K(S_B_U(br))!=POLYNOM))
2619 {
2620 C_B_I(br,GEKUERZT);
2621 return OK;
2622 }
2623 cf=callocobject();
2624 lowcf_br(br,cf);
2625 if(comp(cons_eins,cf)!=0L)
2626 {
2627 tp1=callocobject();tp2=callocobject();
2628 div(S_B_O(br),cf,tp1);
2629 div(S_B_U(br),cf,tp2);
2630 m_ou_b(tp1,tp2,br);
2631 freeall(tp1);freeall(tp2);
2632 }
2633 freeall(cf);
2634 C_B_I(br,GEKUERZT);
2635 return OK;
2636 }
2637
2638 /*
2639 CC 28/09/95
2640 mp is a polynom or a monopoly with scalar coefficient.
2641 cf will be the smallest coefficient different from 0 in mp.
2642 */
2643
lowcf_mp(mp,cf)2644 static INT lowcf_mp(mp,cf) OP mp,cf;
2645 {
2646 OP z;
2647 INT boo;
2648 if(not EMPTYP(cf)) freeself(cf);
2649 z=mp;
2650 boo=0L;
2651 while(z!=NULL)
2652 {
2653 if(NULLP(S_PO_K(z))==FALSE)
2654 {
2655 if(boo==0L)
2656 {
2657 copy(S_PO_K(z),cf);
2658
2659 boo=1L;
2660 }
2661 else if(lt(S_PO_K(z),cf)==TRUE)
2662 {
2663 copy(S_PO_K(z),cf);
2664 }
2665 }
2666 z=S_L_N(z);
2667 }
2668 return OK;
2669 }
2670
2671 /*
2672 CC 28/09/95
2673 br is a bruch with monopoly or polynom in the numerator or denominator.
2674 cf will be the smallest coefficient different from 0 in br.
2675 */
2676
lowcf_br(br,cf)2677 static INT lowcf_br(br,cf) OP br,cf;
2678 {
2679 OP cf1,cf2;
2680 INT erg = OK;
2681 CTO(BRUCH,"lowcf_br(1)",br);
2682 cf1=callocobject();
2683 cf2=callocobject();
2684 erg += lowcf_mp(S_B_O(br),cf1);
2685 erg += lowcf_mp(S_B_U(br),cf2);
2686 if(lt(cf1,cf2)==TRUE)
2687 erg += copy(cf1,cf);
2688 else
2689 erg += copy(cf2,cf);
2690 FREEALL(cf1);
2691 FREEALL(cf2);
2692 ENDR("internal func: lowcf_br");
2693 }
2694
2695