Rosetta Code

Generalised floating point addition: Difference between revisions

Page Discussion

Generalised floating point addition (view source)

Revision as of 18:43, 22 December 2020

6,189 bytes added ,  3 years ago
→‎any base: changed the output for this example to base 72, added/changed whitespace and comments.
m (→‎base ten only: separated the boxed comments to the REXX section header, added/changed whitespace and comments.)
(→‎any base: changed the output for this example to base 72, added/changed whitespace and comments.)
Line 1,101:
 
===any base===
<lang rexx>/*REXX pgmprogram toperforms perform generalized floating point addition using BCD nums numbers. */
parse arg base . /*obtain optional argument from the CL.*/
if base=='' | base=="," then base= 10 /*Not specified? Then use the default.*/
maxW= linesize() - 1 /*maximum width allowed for displays. */
/*Not all REXXes have the LINESIZE BIF.*/
_123= 012345679; reps= 0; mult= 63 /*vars used to construct test cases. */
say ' # addend uncompressed (zoned) BCD number' /*display the header*/
say left('── ────── ─', maxW, '─') /* " header sep*/
 
do j=-7 to 21 /*traipse through the test cases. */
/*┌────────────────────────────────────────────────────────────────────┐
reps= reps + 1 /*increase number of repetitions. */
┌─┘ This REXX program uses an uncompressed (or zoned) BCD which └─┐
BCD.j= strip(copies(_123, reps)'^'mult,'L',0) /*construct a zoned BCD. */
│ consumes one byte for each represented digit. A leading sign (+ or -) │
if j//3==0 then BCD.J= '+'BCD.j /*add a leading plus sign every 3rd #. */
│ is optional. An exponent is also allowed which is preceded by a ^. │
│ The value ofparse thevar exponentBCD.j may'^' havepow a leading sign (+ or -). │ /*get the exponent part of the number. */
addend.j= '1e'pow /*build exponent addend the hard way. */
│ Each numeral (digit) is stored as its own character (glyph), as well │
_= right(j, 2) right(addend.j, 6) /*construct the prefix for a line. */
│ as the signs and exponent indicator. There is essentially no limit on │
aLine= _ BCD.j /*construct a line for the output. */
│ the number of digits in the mantissa or the exponent, but the value of │
if length(aLine)<maxW then say aLine /*Does it fit on a line? Display it. */
│ the exponent is limited to around 16 million. The mantissa may also │
│ have a decimal point (.). else say _ ' ['length(BCD.j) "digits]" │/*otherwise...*/
│ mult= mult - 9 /*decrease the multiplier's exponent. │*/
maxDigs= length(BCD.j) + abs(pow) + 5 /*compute the maximum precision needed.*/
│ Method: a table of twenty-eight BCD numbers is built, and a test case │
if maxDigs>digits() then numeric digits maxDigs /*increase digits if needed.*/
│ of adding that BCD number 81 times (essentially multiplying by 81), │
│ and then a number is added to that sum, and the resultant sum should │
│ result in the final sum of 1e72 (for all cases). │
│ │
│ The (input) numbers may be in any base; the REXX variable BASE │
│ (below) is the value of the base (radix) that the numbers are expressed│
│ in. │
└─┐ The number of digits for the precision is automatically adjusted. ┌─┘
└────────────────────────────────────────────────────────────────────┘*/
 
maxW=linesize()-1 /*max width allowed for displays.*/
/*Not all REXXes have LINESIZE. */
base=10 /*radix that the numbers are in. */
_123=012345679; reps=0; mult=63 /*used to construct test cases. */
say ' # addend uncompressed (zoned) BCD number' /*header.*/
say left('── ────── ─',maxW,'─') /*hdr sep*/
 
do j=-7 to 21 /*traipse through the test cases.*/
reps=reps+1 /*increase number of repetitions.*/
BCD.j=strip(copies(_123,reps)'^'mult,'L',0) /*construct zoned BCD.*/
if j//3==0 then BCD.J='+'BCD.j /*add a leading + sign every 3rd#*/
parse var BCD.j '^' pow /*get the exponent part of the #.*/
addend.j='1e'pow /*build the addend the hard way. */
_=right(j,2) right(addend.j,6) /*construct the prefix for a line*/
aLine=_ BCD.j /*construct a line of output. */
if length(aLine)<maxW then say aLine /*Fit on a line? Display it*/
else say _ ' ['length(BCD.j) 'digits]' /*other*/
mult=mult-9 /*decrease multiplier's exponent.*/
maxDigs=length(BCD.j)+abs(pow)+5 /*compute max precision needed. */
if maxDigs>digits() then numeric digits maxDigs /*inflate if needed.*/
end /*j*/
 
say copies('═', maxW) /*display a fence for separation. */
times= 81 /*the number of times to add it. */
 
do k=-7 to 21 /*traipse through the test cases. */
parse var BCD.k mantissa '^' pow exponent /*decompose the zoned BCD num number. */
exp10x=base(pow,,base) mantissa'e'exponent /*convertreconstitute the poweroriginal tonumber. base 10. */
sum= 0 /*prepare for the 81 additions. */
x=base(mantissa,,base) * 10**base(pow,,base) /*express without a ^ */
sum=0 /*prepare for the 81 additions. */
do times
sum= sum + x /*multiplying the hard way, yupyuppers! */
end
 
sum= (sum + addend.k) / 1 /*aone waymethod to elide trailing zeroes. */
_= format(sum, , , , 0) /*force sum ──►exponentional──► fmtexponential format. */
_baseX_bX= base(_ / 1, base) /*this expresses _ in base BASE. */
say right(k,3) 'sum=' translate(__bX, "e", 'E') /*letsuse a lowercase the"E" for Eexponents. */
end /*k*/ /*output is in base ten BASEX. */
 
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────BASE subroutine─────────────────────*/
base: procedure; parse arg x 1 s 2 1 ox,tt,ii,left_,right_; f= 'BASE'
@#= 0123456789; @abc='abcdefghijklmnopqrstuvwxyz'; @abcu= @abc; upper @abcu
$= $basex() /*charcharacter string of maxmaximum base. */
m= length($) - 1 /*"M": is the maximum base. that can be used*/
c= left_\=='' | right_\==''
if tt=='' then tt= 10 /*assume base 10 ten if omitted. */
if ii=='' then ii= 10 /*assume base 10 ten if omitted. */
i= abs(ii)
t= abs(tt)
if t==999 | t=="*" then t= m
if t>m & \c then call er81 t,2 m f'-to'
if i>m then call er81 i,2 m f'-from'
 
if \c then do /*build charcharacter strstring for base ? */
!= substr($, 1 + 10*(tt<0), t) /*the character string for base T. */
if tt<0 then != 0 ||! ! /*prefix a zero if neg negative base. */
end
 
if x=='' then if c then return left_ || t || right_
else return left(!, t)
 
@= substr($, 1 + 10*(ii<0), i) /*@: =legal charscharacters for base X. */
oS= /*the original sign placeholder. */
if s='-' | s="+" then do /*process the sign (if any). */
x= substr(x,2) /*strip the sign character. */
oS= s /*save the original sign glyph. */
end
 
if (ii>10 & ii<37) | (ii<0 & ii>-27) then upper x /*should we uppercase it ? */
 
/*if baseBase 10,? Then it must be a numnumber.*/
 
if pos('-', x)\==0 |, /*too many minus signs ? */
pos('+', x)\==0 |, /*too many plus signs ? */
x=='.' |, /*is it a single decimal point ? */
x=='' then call er53 ox /* ... or a single + or - sign ? */
 
parse var x w '.' g /*sep whole number from the fraction. */
if pos('.', g)\==0 then call er53 ox /*too many decimals points? */
items.1= 0 /*#number of whole part "digits". */
items.2= 0 /*#number of fractional "digitsdigitsd". */
 
if c then do /*any "digit" specifiers ? */
do forever do while w\=='' /*process the "whole" part. */
parse var w w.1 (left_) w.2 (right_) w
do j=1 to for 2; if w.j\=='' then call putit w.j,1
end /*j*/
end /*while*/
 
do forever do while g\=='' /*process the fractional part. */
parse var g g.1 (left_) g.2 (right_) g
do j=1 to for 2; if g.j\=='' then call putit g.j,2
end /*j*/
end /*while*/
 
_= 0; p=0 p= 0 /*convert the whole #number part. */
 
do j=items.1 to 1 by -1; _= _ + item.1.j * (i**p)
p= p + 1 /*increase the power of the base. */
end /*j*/
 
w=_; _=0; p=0 p= 0; _= 0 /*convert the fractional part. */
 
do j=1 to items.2; _=_+item.2.j/i**p
p= p + 1 /*increase power of the base. */
end /*j*/
 
g= strip( strip(_, 'L', 0), ," .") /*strip leading decdecimal point. */
if g=0 then g= /*no signifcant fract. part.*/
end
 
__= w ||g g /*verify re-composed number.*/
_= verify(__,@'.') /*# have any unusual digits?*/
if _\==0 then call er48,ox,substr(__, _, 1) '[for' f i"]" /*oops-seyoops─say.*/
 
if i\==10 then do /*convert #number base I──►baseI ──► base 10. */
/*... but only if not base 10. */
_= 0; p= 0 /*convert the whole #number part. */
 
do j=length(w) to 1 by -1 while w\==''
_= _ + ((pos( substr(w, j, 1), @) - 1) * i **p)
p= p + 1 /*increase the power of the base. */
end /*j*/
w= _; _= 0; p= 1 /*convert the fractional part. */
 
do j=1 for length(g);_=_+((pos(substr(g,j,1),@)-1)/i**p)
p=p+1 _= _ d + ( (pos( substr(g, j, 1), @) - 1) /*increase power of the basei*/*p)
p= p + 1 /*increase the power of the base. */
end
g=_ end /*j*/
end g= _
else if g\=='' then g="."g /*reinsert period if needed.*/end
else if g\=='' then g="."g /*reinsert the period if needed. */
 
if t\==10 then do /*convert base10 #number to base T. */
if w\=='' then do /*convert the whole number part. */
do j=1; _= t**j; if _>w then leave
end /*J*/
n=
do k=j-1 to 1 by -1; _= t**k; d= w % _
if c then n= n left_ || d || right_
else n= n || substr(!, 1 + d, 1)
w= w // _
end /*k*/
if c then w= n left_ || w || right_
else w= n || substr(!, 1 + w, 1)
end
 
if g\=='' then do; n= /*convert the fractional part. */
do digits()+1; if g==0 then leave
p= g * t; g = p // 1; d= trunc(p)
if c then n= n left_ || d || right_
else n= n || substr(!, d + 1, 1)
end /*digits···*/
if n==0 then n=
if n\=='' then n= '.'n /*is it only a fraction?*/
g= n
end
n=end
do k=j-1 to 1 by -1; _=t**k; d=w%_
if c then n=n left_||d||right_
else n=n||substr(!,1+d,1)
w=w//_
end
if c then w=n left_||w||right_
else w=n||substr(!,1+w,1)
end
 
if g\=='' then do; n= /*convert fractional part. */
do digits()+1; if g==0 then leave
p=g*t; g=p//1; d=trunc(p)
if c then n=n left_||d||right_
else n=n||substr(!,d+1,1)
end
if n==0 then n=
if n\=='' then n='.'n /*only a fraction?*/
g=n
end
end
 
return oS||p(strip(space(w),'L',0)strip(strip(g,,0),"T",'.') 0)
 
return oS || p( strip( space(w), 'L', 0)strip( strip(g, , 0), "T",.) 0)
/*═════════════════════════════general 1-line subs══════════════════════*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
$basex: return @#||@abcu||@abc||space(translate(,
$basex: return @# || @abcu || @abc || space( translate(,
xrange('1'x,"fe"x),,@#'.+-'@abc||@abcu"0708090a0b0c0d"x),0)
xrange('1'x, "fe"x), , @#'.+-'@abc || @abcu"0708090a0b0c0d"x), 0)
/*──────────────────────────────────────────────────────────────────────────────────────*/
num: procedure; parse arg x .,f,q; if x=='' then return x
if isnum(x) then return x/1; x= space( translate(x, , ','), 0)
if isnum(x) then return x/1; return numnot()
/*──────────────────────────────────────────────────────────────────────────────────────*/
putit: parse arg px,which; if \isint(px) then px= numx(px)
items.which= items.which + 1; _= items.which; item.which._= px; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
er: say '***error!***'; say; say arg(1); say; exit 13
er48: call er arg(1) 'contains invalid characters:' arg(2)
er53: call er arg(1) 'not numeric'
er81: call er arg(1) 'must be in the range:' arg(2)
isint: return datatype( arg(1), 'W')
isnum: return datatype( arg(1), 'N')
numnot: if q==1 then return x; call er53 x
num: procedure; parse arg x .,f,q; if x=='' then return x
numx: return num( arg(1), arg(2), 1)
if isnum(x) then return x/1; x=space(translate(x,,','),0)
p: return subword( arg(1), 1, max(1, words( arg(1) ) - 1) )</lang>
if isnum(x) then return x/1; return numnot()
{{out|output|text=&nbsp; when using the (base) input of: &nbsp; &nbsp; <tt> 62 </tt>}}
numnot: if q==1 then return x; call er53 x
<pre>
numx: return num(arg(1),arg(2),1)
# addend uncompressed (zoned) BCD number
p: return subword(arg(1),1,max(1,words(arg(1))-1))
── ────── ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
putit: parse arg px,which;if \isint(px) then px=numx(px)
-7 1e63 12345679^63
items.which=items.which+1; _=items.which; item.which._=px; return</lang>
-6 1e54 +12345679012345679^54
'''output''' is identical to the previous version.
-5 1e45 12345679012345679012345679^45
<br><br>
-4 1e36 12345679012345679012345679012345679^36
-3 1e27 +12345679012345679012345679012345679012345679^27
-2 1e18 12345679012345679012345679012345679012345679012345679^18
-1 1e9 12345679012345679012345679012345679012345679012345679012345679^9
0 1e0 +12345679012345679012345679012345679012345679012345679012345679012345679^0
1 1e-9 12345679012345679012345679012345679012345679012345679012345679012345679012345679^-9
2 1e-18 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-18
3 1e-27 +12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-27
4 1e-36 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-36
5 1e-45 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-45
6 1e-54 +12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-54
7 1e-63 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-63
8 1e-72 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-72
9 1e-81 +12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-81
10 1e-90 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-90
11 1e-99 12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-99
12 1e-108 +12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679012345679^-108
13 1e-117 [193 digits]
14 1e-126 [202 digits]
15 1e-135 [212 digits]
16 1e-144 [220 digits]
17 1e-153 [229 digits]
18 1e-162 [239 digits]
19 1e-171 [247 digits]
20 1e-180 [256 digits]
21 1e-189 [266 digits]
═══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════
-7 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-6 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-5 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-4 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-3 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-2 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
-1 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
0 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
1 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
2 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
3 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
4 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
5 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
6 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
7 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
8 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
9 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
10 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
11 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
12 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
13 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
14 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
15 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
16 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
17 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
18 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
19 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
20 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
21 sum= 20wgMRBdL7rq2Kntz9B7xkSrr7S8ALuO5sk25dQY4
</pre>
 
=={{header|Ruby}}==
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/204194"