(* ----------------------------------------------------------------------------
* $Id: SACRN.mi,v 1.3 1992/10/15 16:28:21 kredel Exp $
* ----------------------------------------------------------------------------
* This file is part of MAS.
* ----------------------------------------------------------------------------
* Copyright (c) 1989 - 1992 Universitaet Passau
* ----------------------------------------------------------------------------
* $Log: SACRN.mi,v $
* Revision 1.3 1992/10/15 16:28:21 kredel
* Changed rcsid variable
*
* Revision 1.2 1992/02/12 13:19:18 pesch
* Moved CONST Definition to the right place.
*
* Revision 1.1 1992/01/22 15:08:46 kredel
* Initial revision
*
* ----------------------------------------------------------------------------
*)
IMPLEMENTATION MODULE SACRN;
(* SAC Rational Number Implementation Module. *)
(* Import lists and declarations. *)
FROM MASELEM IMPORT MASABS;
FROM MASBIOS IMPORT SWRITE, CWRITE, CREADB, MASORD, BKSP, BLINES;
FROM MASSTOR IMPORT LIST, ADV, COMP, FIRST;
FROM SACLIST IMPORT OWRITE, SECOND, FIRST2, LIST2, AWRITE;
FROM SACI IMPORT IQR, ISIGNF, ISUM, IPROD, ICOMP, INEG,
IEXP, IDPR, IWRITE, IREAD, IFCL2, IABSF,
IGCDCF, IRAND, IGCD, IQ, IMP2;
CONST rcsidi = "$Id: SACRN.mi,v 1.3 1992/10/15 16:28:21 kredel Exp $";
CONST copyrighti = "Copyright (c) 1989 - 1992 Universitaet Passau";
PROCEDURE RIRNP(I,CL: LIST): LIST;
(*Rational interval rational number product. I is an interval with
rational endpoints. c is a rational number. J is the interval I*c.*)
VAR AL, ALP, BL, BLP, J: LIST;
BEGIN
(*1*) FIRST2(I,AL,BL); ALP:=RNPROD(AL,CL); BLP:=RNPROD(BL,CL);
IF RNSIGN(CL) >= 0 THEN J:=LIST2(ALP,BLP); ELSE
J:=LIST2(BLP,ALP); END;
RETURN(J);
(*4*) END RIRNP;
PROCEDURE RNABS(R: LIST): LIST;
(*Rational number absolute value. R is a rational number. S is the
absolute value of R.*)
VAR S: LIST;
BEGIN
(*1*) IF RNSIGN(R) >= 0 THEN S:=R; ELSE S:=RNNEG(R); END;
RETURN(S);
(*4*) END RNABS;
PROCEDURE RNCEIL(RL: LIST): LIST;
(*Rational number, ceiling of. r is a rational number. a=CEILING(r),
an integer.*)
VAR AL, BL, RL1, RL2, SL: LIST;
BEGIN
(*1*) (*rl=0.*)
IF RL = 0 THEN AL:=0; RETURN(AL); END;
(*2*) (*rl ne 0.*) FIRST2(RL,RL1,RL2); IQR(RL1,RL2,AL,BL);
SL:=ISIGNF(BL);
IF SL > 0 THEN AL:=ISUM(AL,SL); END;
RETURN(AL);
(*5*) END RNCEIL;
PROCEDURE RNCOMP(R,S: LIST): LIST;
(*Rational number comparison. R and S are rational numbers.
t=SIGN(R-S).*)
VAR J1Y, J2Y, R1, R2, RL, S1, S2, SL, TL: LIST;
BEGIN
(*1*) (*r or s zero.*)
IF R = 0 THEN J1Y:=RNSIGN(S); TL:=-J1Y; RETURN(TL); END;
IF S = 0 THEN TL:=RNSIGN(R); RETURN(TL); END;
(*2*) (*opposite signs.*) FIRST2(R,R1,R2); FIRST2(S,S1,S2);
RL:=ISIGNF(R1); SL:=ISIGNF(S1); J1Y:=RL-SL; TL:=J1Y DIV 2;
IF TL <> 0 THEN RETURN(TL); END;
(*3*) (*same sign.*) J1Y:=IPROD(R1,S2); J2Y:=IPROD(R2,S1);
TL:=ICOMP(J1Y,J2Y); RETURN(TL);
(*6*) END RNCOMP;
PROCEDURE RNDEN(R: LIST): LIST;
(*Rational number denominator. R is a rational number. b is the
denominator of R, a positive integer.*)
VAR BL: LIST;
BEGIN
(*1*) IF R = 0 THEN BL:=1; ELSE BL:=SECOND(R); END;
RETURN(BL);
(*4*) END RNDEN;
PROCEDURE RNDIF(R,S: LIST): LIST;
(*Rational number difference. R and S are rational numbers. T=R-S.*)
VAR J1Y, T: LIST;
BEGIN
(*1*) J1Y:=RNNEG(S); T:=RNSUM(R,J1Y); RETURN(T);
(*4*) END RNDIF;
PROCEDURE RNDWR(R,NL: LIST);
(*Rational number decimal write. R is a rational number. n is a
non-negative integer. R is approximated by a decimal fraction D with
n decimal digits following the decimal point and D is written in the
output stream. The inaccuracy of the approximation is at most
(1/2)*10**-n. If ABS(D) is greater than ABS(R) then the last digit is
followed by a minus sign, if ABS(D) is less than ABS(R) then by a
plus sign.*)
VAR A, B, D, DL, F, IL, M, SL, TL: LIST;
BEGIN
(*1*) (*compute approximation.*)
IF R = 0 THEN A:=0; B:=1; ELSE FIRST2(R,A,B); END;
SL:=ISIGNF(A);
IF SL < 0 THEN A:=INEG(A); END;
M:=IEXP(10,NL); A:=IPROD(A,M); IQR(A,B,D,F); F:=IDPR(F,2);
IF F = 0 THEN TL:=0; ELSE TL:=ICOMP(B,F);
IF TL = 0 THEN TL:=1; ELSE
IF TL < 0 THEN D:=ISUM(D,1); END;
END;
END;
(*2*) (*convert and write.*)
IF SL < 0 THEN SWRITE("-"); END;
IQR(D,M,D,F); IWRITE(D); SWRITE(".");
FOR IL:=1 TO NL DO F:=IDPR(F,10); IQR(F,M,DL,F); CWRITE(DL); END;
IF TL > 0 THEN SWRITE("+"); ELSE
IF TL < 0 THEN SWRITE("-"); END;
END;
RETURN;
(*5*) END RNDWR;
PROCEDURE RNFCL2(AL: LIST; VAR ML,NL: LIST);
(*Rational number floor and ceiling of logarithm, base 2. a is a non-
zero rational number. m=FLOOR(LOG2(ABS(a))) and n=CEILING(LOG2(ABS(a)))
are gamma-integers.*)
VAR AL1, AL2, ALP1, CL, DL, J1Y, ML1, ML2, NL1, NL2, SL: LIST;
BEGIN
(*1*) (*apply ifcl2 to numerator and denominator.*) FIRST2(AL,AL1,AL2);
IFCL2(AL1,ML1,NL1); IFCL2(AL2,ML2,NL2); ML:=ML1-NL2; NL:=NL1-ML2;
(*2*) (*nl le ml+1.*)
IF NL <= ML+1 THEN RETURN; END;
(*3*) (*resolve uncertainty.*) ALP1:=IABSF(AL1);
IF ML+1 >= 0 THEN CL:=ALP1; J1Y:=ML+1; DL:=IMP2(AL2,J1Y); ELSE
J1Y:=-ML; J1Y:=J1Y-1; CL:=IMP2(ALP1,J1Y); DL:=AL2; END;
SL:=ICOMP(CL,DL);
IF SL < 0 THEN NL:=NL-1; ELSE ML:=ML+1; END;
RETURN;
(*6*) END RNFCL2;
PROCEDURE RNFLOR(RL: LIST): LIST;
(*Rational number, floor of. r is a rational number. a=FLOOR(r),
an integer.*)
VAR AL, BL, RL1, RL2, SL: LIST;
BEGIN
(*1*) (*rl=0.*)
IF RL = 0 THEN AL:=0; RETURN(AL); END;
(*2*) (*rl ne 0.*) FIRST2(RL,RL1,RL2); IQR(RL1,RL2,AL,BL);
SL:=ISIGNF(BL);
IF SL < 0 THEN AL:=ISUM(AL,SL); END;
RETURN(AL);
(*5*) END RNFLOR;
PROCEDURE RNINT(A: LIST): LIST;
(*Rational number from integer. A is an integer. R is the rational
number A/1.*)
VAR R: LIST;
BEGIN
(*1*) IF A = 0 THEN R:=0; ELSE R:=LIST2(A,1); END;
RETURN(R);
(*4*) END RNINT;
PROCEDURE RNINV(R: LIST): LIST;
(*Rational number inverse. R is a non-zero rational number. S=1/R.*)
VAR R1, R2, S, S1, S2: LIST;
BEGIN
(*1*) FIRST2(R,R1,R2);
IF ISIGNF(R1) > 0 THEN S1:=R2; S2:=R1; ELSE S1:=INEG(R2);
S2:=INEG(R1); END;
S:=LIST2(S1,S2); RETURN(S);
(*4*) END RNINV;
PROCEDURE RNNEG(R: LIST): LIST;
(*Rational number negative. R is a rational number. S=-R.*)
VAR R1, RP, RP1, S: LIST;
BEGIN
(*1*) IF R = 0 THEN S:=0; ELSE ADV(R,R1,RP); RP1:=INEG(R1);
S:=COMP(RP1,RP); END;
RETURN(S);
(*4*) END RNNEG;
PROCEDURE RNNUM(R: LIST): LIST;
(*Rational number numerator. R is a rational number. a is the
numerator of R, an integer.*)
VAR AL: LIST;
BEGIN
(*1*) IF R = 0 THEN AL:=0; ELSE AL:=FIRST(R); END;
RETURN(AL);
(*4*) END RNNUM;
PROCEDURE RNPROD(R,S: LIST): LIST;
(*Rational number product. R and S are rational numbers. T=R*S.*)
VAR D1, D2, R1, R2, RB1, RB2, S1, S2, SB1, SB2, T, T1, T2: LIST;
BEGIN
(*1*) (*r=0 or s=0.*)
IF (R = 0) OR (S = 0) THEN T:=0; RETURN(T); END;
(*2*) (*obtain numerators and denominators.*) FIRST2(R,R1,R2);
FIRST2(S,S1,S2);
(*3*) (*r and s integers.*)
IF (R2 = 1) AND (S2 = 1) THEN T1:=IPROD(R1,S1);
T:=LIST2(T1,1); RETURN(T); END;
(*4*) (*r or s an integer.*)
IF R2 = 1 THEN IGCDCF(R1,S2,D1,RB1,SB2); T1:=IPROD(RB1,S1);
T:=LIST2(T1,SB2); RETURN(T); END;
IF S2 = 1 THEN IGCDCF(S1,R2,D2,SB1,RB2); T1:=IPROD(SB1,R1);
T:=LIST2(T1,RB2); RETURN(T); END;
(*5*) (*general case.*) IGCDCF(R1,S2,D1,RB1,SB2);
IGCDCF(S1,R2,D2,SB1,RB2); T1:=IPROD(RB1,SB1); T2:=IPROD(RB2,SB2);
T:=LIST2(T1,T2); RETURN(T);
(*8*) END RNPROD;
PROCEDURE RNP2(KL: LIST): LIST;
(*Rational number power of 2. k is a gamma-integer. r=2**k, a
rational number.*)
VAR AL, HL, RL: LIST;
BEGIN
(*1*) HL:=MASABS(KL); AL:=IMP2(1,HL);
IF KL >= 0 THEN RL:=LIST2(AL,1); ELSE RL:=LIST2(1,AL); END;
RETURN(RL);
(*4*) END RNP2;
PROCEDURE RNQ(R,S: LIST): LIST;
(*Rational number quotient. R and S are rational numbers, S non-zero.
T=R/S.*)
VAR J1Y, T: LIST;
BEGIN
(*1*) IF R = 0 THEN T:=0; ELSE J1Y:=RNINV(S); T:=RNPROD(R,J1Y); END;
RETURN(T);
(*4*) END RNQ;
PROCEDURE RNRAND(NL: LIST): LIST;
(*Rational number, random. n is a positive beta-integer. Random
integers A and B are generated using IRAND(n). Then R=A/(ABS(B)+1),
reduced to lowest terms.*)
VAR A, B, R: LIST;
BEGIN
(*1*) A:=IRAND(NL); B:=IRAND(NL); B:=IABSF(B); B:=ISUM(B,1);
R:=RNRED(A,B); RETURN(R);
(*4*) END RNRAND;
PROCEDURE RNREAD(): LIST;
(*Rational number read. The rational number R is read from the input
stream. Any preceding blanks are skipped.*)
VAR C, IDUM, R, R1, R2: LIST;
BEGIN
(*1*) R1:=IREAD(); C:=CREADB();
IF C = MASORD("/") THEN R2:=IREAD(); ELSE R2:=1; BKSP; END;
IF R1 = 0 THEN R:=0; ELSE R:=LIST2(R1,R2); END;
RETURN(R);
(*4*) END RNREAD;
PROCEDURE RNRED(A,B: LIST): LIST;
(*Rational number reduction to lowest terms. A and B are integers,
B non-zero. R is the rational number A/B in canonical form.*)
VAR AB, BB, C, R: LIST;
BEGIN
(*1*) IF A = 0 THEN R:=0; RETURN(R); END;
C:=IGCD(A,B); AB:=IQ(A,C); BB:=IQ(B,C);
IF ISIGNF(B) < 0 THEN AB:=INEG(AB); BB:=INEG(BB); END;
R:=LIST2(AB,BB); RETURN(R);
(*4*) END RNRED;
PROCEDURE RNSIGN(R: LIST): LIST;
(*Rational number sign. R is a rational number. s=SIGN(R).*)
VAR J1Y, SL: LIST;
BEGIN
(*1*) IF R = 0 THEN SL:=0; ELSE J1Y:=FIRST(R); SL:=ISIGNF(J1Y); END;
RETURN(SL);
(*4*) END RNSIGN;
PROCEDURE RNSUM(R,S: LIST): LIST;
(*Rational number sum. R and S are rational numbers. T=R+S.*)
VAR D, E, J1Y, J2Y, R1, R2, RB2, S1, S2, SB2, T, T1, T2: LIST;
BEGIN
(*1*) (*r=0 or s=0.*)
IF R = 0 THEN T:=S; RETURN(T); END;
IF S = 0 THEN T:=R; RETURN(T); END;
(*2*) (*obtain numerators and denominators.*) FIRST2(R,R1,R2);
FIRST2(S,S1,S2);
(*3*) (*r and s integers.*)
IF (R2 = 1) AND (S2 = 1) THEN T1:=ISUM(R1,S1);
IF T1 = 0 THEN T:=0; ELSE T:=LIST2(T1,1); END;
RETURN(T); END;
(*4*) (*r or s an integer.*)
IF R2 = 1 THEN T1:=IPROD(R1,S2); T1:=ISUM(T1,S1);
T:=LIST2(T1,S2); RETURN(T); END;
IF S2 = 1 THEN T1:=IPROD(R2,S1); T1:=ISUM(T1,R1);
T:=LIST2(T1,R2); RETURN(T); END;
(*5*) (*general case.*) IGCDCF(R2,S2,D,RB2,SB2); J1Y:=IPROD(R1,SB2);
J2Y:=IPROD(RB2,S1); T1:=ISUM(J1Y,J2Y);
IF T1 = 0 THEN T:=0; RETURN(T); END;
IF D <> 1 THEN E:=IGCD(T1,D);
IF E <> 1 THEN T1:=IQ(T1,E); R2:=IQ(R2,E); END;
END;
T2:=IPROD(R2,SB2); T:=LIST2(T1,T2); RETURN(T);
(*8*) END RNSUM;
PROCEDURE RNWRIT(R: LIST);
(*Rational number write. R is a rational number. R is converted
to decimal and written in the output stream.*)
VAR R1, R2: LIST;
BEGIN
(*1*) IF R = 0 THEN AWRITE(R); ELSE FIRST2(R,R1,R2); IWRITE(R1);
IF R2 <> 1 THEN SWRITE("/"); IWRITE(R2); END;
END;
RETURN;
(*4*) END RNWRIT;
END SACRN.
(* -EOF- *)