Generalised floating point addition: Difference between revisions
m (Link to new local page: balanced ternary.) |
m (→{{header|ALGOL 68}}: reordered code, renames, reduced DIGITS type definition added subtraction operators.) |
||
Line 31: | Line 31: | ||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{works with|ALGOL 68|Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.}} |
{{works with|ALGOL 68|Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.}} |
||
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.3.2].}} |
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.3.3 algol68g-2.3.3].}} |
||
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}} |
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}} |
||
''Note:'' This code stores the digits as array of digits with the "most significant digit" on the "left" as per normal "human" form. The net effect is that whole numbers (such as 100) are stored in the negative array positions, eg -2, -1 & 0, or [-2:0], And the fractional part of the floating point numbers are stored from index 1, eg. 1, 2, 3 etc. or [1:]. |
''Note:'' This code stores the digits as array of digits with the "most significant digit" on the "left" as per normal "human" form. The net effect is that whole numbers (such as 100) are stored in the negative array positions, eg -2, -1 & 0, or [-2:0], And the fractional part of the floating point numbers are stored from index 1, eg. 1, 2, 3 etc. or [1:]. |
||
'''File: Template.Big_float.Addition.a68''' - task code<lang algol68>######################################## |
|||
'''File: Mixin_Big_float_base.a68''' |
|||
<lang algol68>################################################ |
|||
# Define the basic operators and routines for # |
|||
# manipulating DIGITS in a generalised base # |
|||
################################################ |
|||
MODE STRUCTDIGIT = STRUCT(DIGIT digit); |
|||
MODE DIGITS = STRUCT(FLEX[0]STRUCTDIGIT digits); |
|||
BOOL balanced arithmetic = FALSE; |
|||
INT digit order = -1; |
|||
OP ZERO = (STRUCTDIGIT skip)STRUCTDIGIT: INITSTRUCTDIGIT 0; |
|||
OP ONE = (STRUCTDIGIT skip)STRUCTDIGIT: INITSTRUCTDIGIT 1; |
|||
# STRUCTDIGIT OPerators # |
|||
OP INITSTRUCTDIGIT = (#LONG# INT i)STRUCTDIGIT: (STRUCTDIGIT out; digit OF out := #SHORTEN# i; out); |
|||
#OP INITSTRUCTDIGIT = (INT i)STRUCTDIGIT: INITSTRUCTDIGIT LENG i;# |
|||
OP /= = (STRUCTDIGIT a,b)BOOL: digit OF a /= digit OF b; |
|||
# Define additive and multiplicative identities # |
|||
OP ZERO = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(0), |
|||
ONE = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(1); |
|||
# Define OPerators for Least and Most Significant DIGIT # |
|||
OP MSD = (DIGITS t)INT: LWB digits OF t, |
|||
LSD = (DIGITS t)INT: UPB digits OF t; |
|||
# Define the requitred coercion/casting operators # |
|||
OP INITDIGITS = ([]DIGIT in)DIGITS: |
|||
(STRUCT(FLEX[LWB in:UPB in]STRUCTDIGIT digits)out; digit OF digits OF out := in; out); |
|||
OP INITDIGITS = (DIGIT in)DIGITS: INITDIGITS []DIGIT(in); |
|||
OP INITDIGITS = ([]STRUCTDIGIT in)DIGITS: |
|||
(DIGITS out; digits OF out := in; out); |
|||
# A routine for removing leadng and trailing zeros # |
|||
PROC digits normalise = ([]DIGIT in)[]DIGIT: ( |
|||
DIGIT zero = 0 # ZERO LOC DIGIT#; |
|||
INT highest := LWB in, lowest := UPB in; |
|||
FOR place FROM highest BY -digit order TO lowest DO |
|||
IF in[place] /= zero THEN |
|||
highest := place; |
|||
done highest |
|||
FI |
|||
OD; |
|||
highest := lowest+digit order; |
|||
done highest: |
|||
FOR place FROM lowest BY digit order TO highest DO |
|||
IF in[place] /= zero THEN |
|||
lowest := place; |
|||
done lowest |
|||
FI |
|||
OD; |
|||
lowest := highest+digit order; |
|||
done lowest: |
|||
IF highest=lowest+digit order THEN # normalise zero's exponent # |
|||
in[highest:lowest][@0] |
|||
ELSE |
|||
in[highest:lowest][@highest] |
|||
FI |
|||
);</lang>'''File: Mixin_Big_float_addition.a68''' |
|||
<lang algol68>######################################## |
|||
# Define the basic addition operators # |
# Define the basic addition operators # |
||
# for the generalised base # |
# for the generalised base # |
||
######################################## |
######################################## |
||
# derived DIGIT operators # |
|||
# Note: +:= returns carry # |
|||
OP + |
OP + = (DIGIT arg)DIGIT: arg; |
||
OP + = (DIGIT a,b)DIGIT: (DIGIT out := a; MOID(out +:= b); out); |
|||
STRUCTDIGIT carry; |
|||
digit OF carry := digit OF lhs +:= digit OF arg; |
|||
carry |
|||
); |
|||
# derived hybrid of DIGIT & DIGITS operators # |
|||
OP +:= = (REF DIGITS lhs, DIGITS arg)DIGITS: lhs := lhs + arg; |
|||
OP + = (DIGITS a, DIGIT b)DIGITS: a + INITDIGITS b; |
|||
OP + = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a + a; |
|||
OP +:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs + arg; |
|||
# derived DIGITS operators # |
|||
OP + = (DIGITS arg)DIGITS: arg; |
OP + = (DIGITS arg)DIGITS: arg; |
||
OP +:= = (REF DIGITS lhs, DIGITS arg)DIGITS: lhs := lhs + arg; |
|||
#################################### |
|||
OP + = (DIGITS in a, in b)DIGITS: ( |
|||
# TASK CODE # |
|||
# Note: []STRUCTDIGIT(~) cast removes FLEX # |
|||
# Actual generic addition operator # |
|||
[]DIGIT a = digit OF []STRUCTDIGIT(digits OF in a); |
|||
#################################### |
|||
[]DIGIT b = digit OF []STRUCTDIGIT(digits OF in b); |
|||
OP + = (DIGITS a, b)DIGITS: ( |
|||
INT extreme highest = MSD in a MIN MSD in b, |
|||
IF SIGN a = 0 THEN b ELIF SIGN b = 0 THEN a |
|||
ELSE |
|||
overlap lowest = LSD in a MIN LSD in b, |
|||
MODE SIGNED = DIGIT; |
|||
extreme lowest = LSD in a MAX LSD in b; |
|||
INT extreme highest = MSD a MIN MSD b, |
|||
DIGIT zero = 0 # ZERO LOC DIGIT#; # "a" can be zero length # |
|||
overlap highest = MSD a MAX MSD b, |
|||
# DIGITS out; # |
|||
overlap lowest = LSD a MIN LSD b, |
|||
extreme lowest = LSD a MAX LSD b; |
|||
SIGNED zero = ZERO LOC SIGNED; |
|||
IF overlap highest > overlap lowest THEN # Either: NO overlapping digits # |
|||
INT order = digit order OF arithmetic; |
|||
DIGITS out; |
|||
IF |
IF overlap highest > overlap lowest THEN # Either: NO overlapping digits # |
||
# out := # in b |
|||
[extreme highest:extreme lowest]SIGNED a plus b; |
|||
ELIF MSD in b > LSD in b THEN # b = 0 # |
|||
# out := # in a |
|||
ELSE |
|||
[extreme highest:extreme lowest]DIGIT a plus b; |
|||
# First: simply insert the known digits # |
# First: simply insert the known digits with their correct sign # |
||
a plus b[MSD |
a plus b[MSD a:LSD a] := a[@1]; |
||
a plus b[MSD |
a plus b[MSD b:LSD b] := b[@1]; |
||
# Next: Zero any totally non overlapping digit # |
# Next: Zero any totally non overlapping digit # |
||
FOR place FROM overlap highest+ |
FOR place FROM overlap highest+order BY order TO overlap lowest-order |
||
DO a plus b[place] := zero OD; |
DO a plus b[place] := zero OD; |
||
# Finally: normalise by removing leading & trailing "zero" digit # |
# Finally: normalise by removing leading & trailing "zero" digit # |
||
out := INITDIGITS a plus b |
|||
FI |
|||
ELSE # Or: Add ALL overlapping digits # |
ELSE # Or: Add ALL overlapping digits # |
||
[extreme highest+( |
[extreme highest+(carry OF arithmetic|order|0):extreme lowest]SIGNED a plus b; |
||
# First: Deal with the non overlapping Least Significant Digits # |
# First: Deal with the non overlapping Least Significant Digits # |
||
a plus b[overlap lowest- |
a plus b[overlap lowest-order:] := (LSD a > LSD b|a|b) [overlap lowest-order:]; |
||
# Or: Add any overlapping digits # |
# Or: Add any overlapping digits # |
||
SIGNED carry := zero; |
|||
FOR place FROM overlap lowest BY |
FOR place FROM overlap lowest BY order TO overlap highest DO |
||
SIGNED digit a = a[place], digit b = b[place]; |
|||
REF SIGNED result = a plus b[place]; |
|||
IF carry OF arithmetic THEN # used in big float # |
|||
REF DIGIT result = a plus b[place]; |
|||
result := carry; |
|||
result := |
carry := ( result +:= digit a ); |
||
carry := ( result +:= digit |
MOID( carry +:= ( result +:= (digit b) ) ) |
||
ELSE |
|||
MOID( carry +:= ( result +:= (digit b) ) ) |
|||
result := digit a; |
|||
MOID( result +:= digit b ) |
|||
FI |
|||
OD; |
|||
OD; |
|||
# Next: Deal with the non overlapping Most Significant digits # |
# Next: Deal with the non overlapping Most Significant digits # |
||
FOR place FROM overlap highest+ |
FOR place FROM overlap highest+order BY order TO extreme highest DO |
||
[]DIGIT etc = (MSD a < MSD b|a|b); |
|||
REF SIGNED result = a plus b[place]; |
|||
IF digit carry THEN |
|||
IF carry OF arithmetic THEN |
|||
result := carry; |
|||
carry := ( result +:= etc[place] ) |
|||
ELSE |
|||
ELSE |
|||
result := (MSD in a < MSD in b|a|b)[place] |
|||
result := etc[place] |
|||
FI |
|||
FI |
|||
OD; |
|||
# Next: Deal with the carry # |
# Next: Deal with the carry # |
||
IF carry OF arithmetic THEN |
|||
a plus b[extreme highest+ |
a plus b[extreme highest+order] := carry |
||
FI; |
FI; |
||
# Finally: normalise by removing leading & trailing "zero" digits # |
# Finally: normalise by removing leading & trailing "zero" digits # |
||
out := INITDIGITS a plus b |
|||
FI; |
|||
out # EXIT # |
|||
FI |
FI |
||
);</lang>'''File: Template.Big_float.Base.a68''' - task utility code<lang algol68># -*- coding: utf-8 -*- # |
|||
# out EXIT # |
|||
################################################ |
|||
);</lang>'''File: Mixin_Big_float_subtraction.a68''' |
|||
# Define the basic operators and routines for # |
|||
<lang algol68>OP - = (DIGITS arg)DIGITS: ( |
|||
DIGITS |
# manipulating DIGITS in a generalised base # |
||
################################################ |
|||
FOR digit FROM LSD arg TO MSD arg DO digit OF (digits OF out)[digit]:=-digit OF (digits OF arg)[digit] OD; |
|||
out |
|||
STRUCT ( |
|||
BOOL balanced, |
|||
carry, # aka "carry" between digits # |
|||
INT base, |
|||
digit width, |
|||
digit places, |
|||
digit order, |
|||
USTRING repr |
|||
) arithmetic := ( |
|||
FALSE, TRUE, |
|||
10, 1, 81, -1, # Default is BCD/Hex # |
|||
USTRING( # Note that the "circled" digits are negative - used in balance arithmetic # |
|||
"ⓩ","ⓨ","ⓧ","ⓦ","ⓥ","ⓤ","ⓣ","ⓢ","ⓡ","ⓠ","ⓟ","ⓞ","ⓝ","ⓜ","ⓛ","ⓚ","ⓙ","ⓘ","ⓗ","ⓖ","ⓕ","ⓔ","ⓓ","ⓒ","ⓑ","ⓐ", |
|||
"Ⓩ","Ⓨ","Ⓧ","Ⓦ","Ⓥ","Ⓤ","Ⓣ","Ⓢ","Ⓡ","Ⓠ","Ⓟ","Ⓞ","Ⓝ","Ⓜ","Ⓛ","Ⓚ","Ⓙ","Ⓘ","Ⓗ","Ⓖ","Ⓕ","Ⓔ","Ⓓ","Ⓒ","Ⓑ","Ⓐ", |
|||
"⑨","⑧","⑦","⑥","⑤","④","③","②","①", "0", "1","2","3","4","5","6","7","8","9", |
|||
"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z", |
|||
"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z" |
|||
)[@-(26*2+9)] |
|||
); |
); |
||
MODE DIGITS = FLEX[0]DIGIT; |
|||
OP SIGN = (DIGITS arg)INT: |
|||
IF LSD arg - MSD arg = digit order THEN 0 ELSE SIGN digit OF (digits OF arg)[MSD arg] FI; |
|||
# DIGIT OPerators # |
|||
OP ABS = (DIGITS arg)DIGITS: |
|||
OP INITDIGIT = (#LONG# INT i)DIGIT: (DIGIT out; digit OF out := #SHORTEN# i; out); |
|||
IF SIGN arg < 0 THEN -arg ELSE arg FI; |
|||
#OP INITDIGIT = (INT i)DIGIT: INITDIGIT LENG i;# |
|||
OP |
OP /= = (DIGIT a,b)BOOL: digit OF a /= digit OF b; |
||
OP -:= = (REF DIGITS a, DIGITS b)DIGITS: a := a + -b;</lang> |
|||
'''Start of test case:''' |
|||
# Define additive and multiplicative identities # |
|||
'''File: Big_float_BCD_base.a68''' |
|||
OP ZERO = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(ZERO LOC DIGIT), |
|||
<lang algol68>################################################ |
|||
IDENTITY = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(IDENTITY LOC DIGIT); |
|||
OP SIGN = (DIGIT digit)INT: SIGN digit OF digit; |
|||
# Define OPerators for Least and Most Significant DIGIT # |
|||
OP MSD = (DIGITS t)INT: LWB t, |
|||
EXP = (DIGITS t)INT: digit order OF arithmetic * LWB t, # exponent # |
|||
LSD = (DIGITS t)INT: UPB t; |
|||
OP INITDIGITS = (DIGIT in)DIGITS: INITDIGITS []DIGIT(in)[@0]; |
|||
OP INITDIGITS = ([]DIGIT digits)DIGITS: ( |
|||
### normalise digits: |
|||
A) removed leading & trailing zeros |
|||
B) IF not balanced arithmetic |
|||
THEN make all digits positive and set sign bit FI |
|||
### |
|||
MODE SIGNED = DIGIT; |
|||
DIGIT zero = ZERO LOC DIGIT; |
|||
DIGIT one = IDENTITY LOC DIGIT; |
|||
DIGIT base digit = INITDIGIT base OF arithmetic; |
|||
INT base = base OF arithmetic; |
|||
INT half base = base % 2; |
|||
INT order = digit order OF arithmetic; |
|||
INT msd := LWB digits + int width*order, lsd := UPB digits; # XXX # |
|||
# create an array with some "extra" significant digits incase there is a "big" input value # |
|||
[msd:lsd]SIGNED signed; signed[LWB digits:UPB digits] := digits[@1]; |
|||
FOR place FROM LWB signed TO LWB digits+order DO |
|||
signed[place] := zero |
|||
OD; |
|||
IF msd + order /= lsd THEN |
|||
# Trim leading zeros # |
|||
FOR place FROM msd BY -order TO lsd DO |
|||
IF SIGN signed[place] /= 0 THEN msd := place; done msd FI |
|||
OD; |
|||
msd := lsd-order; |
|||
done msd: |
|||
# Trim trailing zeros # |
|||
FOR place FROM lsd BY order TO msd DO |
|||
IF SIGN signed[place] /= 0 THEN lsd := place; done lsd FI |
|||
OD; |
|||
lsd := msd+order; |
|||
done lsd: |
|||
IF msd + order /= lsd THEN # not zero # |
|||
IF carry OF arithmetic THEN # Normalise to the "base OF arithmetic": # |
|||
INT sign msd := SIGN digits[msd]; # first non zero digit # |
|||
INT lwb digit := (balanced OF arithmetic|-half base|:sign msd < 0 |1-base|0); |
|||
INT upb digit := (balanced OF arithmetic| half base|:sign msd > 0 |base-1|0); |
|||
SIGNED carry := zero; |
|||
FOR place FROM lsd BY order WHILE SIGN carry /=0 OR place >= LWB digits DO |
|||
SIGNED digit := signed[place]; |
|||
carry := digit +:= carry; |
|||
WHILE digit OF digit < lwb digit DO |
|||
MOID(digit +:= base digit); |
|||
MOID(carry -:= one) |
|||
OD; |
|||
WHILE digit OF digit > upb digit DO |
|||
MOID(digit -:= base digit); |
|||
MOID(carry +:= one) |
|||
OD; |
|||
signed[place] := digit; # normalised # |
|||
IF SIGN digit /= 0 THEN msd := place FI |
|||
OD |
|||
FI |
|||
FI; |
|||
signed[msd:lsd][@msd] |
|||
FI |
|||
); |
|||
# re anchor the array with a shift # |
|||
OP SHL = (DIGITS in, INT shl)DIGITS: in[@MSD in-shl]; |
|||
OP SHR = (DIGITS in, INT shr)DIGITS: in[@MSD in+shr];</lang>'''File: Template.Big_float_BCD.Base.a68 - test case code'''<lang algol68>################################################ |
|||
# Define the basic operators and routines for # |
# Define the basic operators and routines for # |
||
# manipulating DIGITS specific to a BCD base # |
# manipulating DIGITS specific to a BCD base # |
||
################################################ |
################################################ |
||
#################################################### |
|||
# BCD noramlly means Binary Coded Decimal, but... # |
|||
# this code handles "Balanced Coded Data", meaning # |
|||
# Data can be in any numerical bases, and the data # |
|||
# can optionally be stored as Balanced about zero # |
|||
#################################################### |
|||
# define the basic axioms of the number system you are extending # |
# define the basic axioms of the number system you are extending # |
||
MODE DIGIT = #LONG# INT; |
MODE DIGIT = STRUCT(#LONG# INT digit); |
||
# Note: If the +:= and *:= operators for INT are being "overloaded", |
|||
DIGIT digit base = #LONG# 10 ** digit width; |
|||
then it is sometimes necessary to wrap an INT in a STRUCT to |
|||
protect the builtin definitions of the INT OPerators |
|||
# |
|||
# mixin the Big_float base definitions # |
# mixin the Big_float base definitions # |
||
PR READ " |
PR READ "Template.Big_float.Base.a68" PR |
||
MODE BIGREAL = DIGITS; |
MODE BIGREAL = DIGITS; |
||
BOOL digit carry = TRUE; |
|||
# Most Significant Digit of the left = -1 # |
|||
# the Yoneda ambiguity forces the peculiar coercion n the body of OP # |
|||
OP ZERO = (DIGIT skip)DIGIT: 0; |
|||
OP |
OP ZERO = (DIGIT skip)DIGIT: (DIGIT out; digit OF out := 0; out); |
||
OP IDENTITY = (DIGIT skip)DIGIT: (DIGIT out; digit OF out := 1; out); |
|||
# define the basis operators # |
|||
OP ABS = (DIGIT a)INT: ABS digit OF a; |
|||
OP - = (DIGIT a)DIGIT: INITDIGIT -digit OF a; |
|||
#################################################################### |
|||
# Important: Operator +:= is required by Template_Big_float_addition. # |
|||
#################################################################### |
|||
# Note: +:= returns carry DIGIT # |
|||
OP +:= = (REF DIGIT lhs, DIGIT arg)DIGIT: ( |
|||
# Todo: Implement balanced arithmetic # |
|||
INT sum = digit OF lhs + digit OF arg; # arg may be -ve # |
|||
INT carry := sum % base OF arithmetic; |
|||
INT digit := sum - carry * base OF arithmetic; |
|||
IF balanced OF arithmetic THEN |
|||
INT half base = base OF arithmetic OVER 2; |
|||
IF digit > half base THEN |
|||
digit -:= base OF arithmetic; |
|||
carry +:= 1 |
|||
ELIF digit < -half base THEN |
|||
digit +:= base OF arithmetic; |
|||
carry -:= 1 |
|||
FI |
|||
FI; |
|||
lhs := INITDIGIT digit; INITDIGIT carry |
|||
); |
|||
INT half = base OF arithmetic OVER 2; |
|||
# ASSERT NOT balanced OF arithmetic OR ODD base OF arithmetic # |
|||
########################################################################## |
|||
# Important: Operator *:= is required by Template_Big_float_multiplication. # |
|||
########################################################################## |
|||
# Note: *:= returns carry DIGIT # |
|||
OP *:= = (REF DIGIT lhs, DIGIT arg)DIGIT: ( |
|||
# Todo: Implement balanced arithmetic # |
|||
INT product = digit OF lhs * digit OF arg; # arg may be -ve # |
|||
INT carry = product % base OF arithmetic; |
|||
lhs := INITDIGIT(product - carry * base OF arithmetic); |
|||
INITDIGIT carry |
|||
); |
|||
########################################################## |
########################################################## |
||
Line 231: | Line 314: | ||
########################################################## |
########################################################## |
||
OP INITLONGREAL = (BIGREAL a)LONG REAL: |
OP INITLONGREAL = (BIGREAL a)LONG REAL: |
||
IF |
IF SIGN a = 0 THEN 0 |
||
ELSE |
ELSE |
||
INT lsd a = LSD a; # Todo: Optimise/reduce to match "long real width" # |
|||
LONG REAL out := digit OF (digits OF a)[MSD a]; |
|||
LONG REAL out := digit OF a[MSD a]; |
|||
FOR place FROM MSD a - digit order OF arithmetic BY -digit order OF arithmetic TO lsd a DO |
|||
out := out * base OF arithmetic + digit OF a[place] |
|||
OD; |
OD; |
||
out * LONG REAL( |
out * LONG REAL(base OF arithmetic) ** -LSD a |
||
FI; |
FI; |
||
OP INITREAL = (BIGREAL r)REAL: |
|||
CO |
|||
SHORTEN INITLONGREAL r; |
|||
OP INITBIGREAL = (INT in int)BIGREAL: |
|||
INITBIGREAL #LENG# in int; |
|||
END CO |
|||
OP |
OP MSD = (LONG INT i)INT: ( |
||
LONG INT remainder := i; INT count := 0; |
|||
WHILE remainder /= 0 DO |
|||
remainder %:= base OF arithmetic; |
|||
MOID(count +:= 1) |
|||
OD; |
|||
count |
|||
); |
|||
OP INITBIGREAL = (LONG INT in int)BIGREAL: ( |
|||
INT remainder := i, count := 0; |
|||
WHILE remainder /= 0 DO |
|||
remainder %:= digit base; |
|||
MOID(count +:= 1) |
|||
OD; |
|||
count |
|||
); |
|||
INT max = MSD in int; |
|||
[1-max:0]DIGIT out; |
|||
INT |
LONG INT int := ABS in int; |
||
[1-max:0]STRUCTDIGIT out; |
|||
BIGREAL bigreal; |
|||
#LONG# INT int := ABS in int; |
|||
INT sign = SIGN in int; |
INT sign = SIGN in int; |
||
FOR |
FOR place FROM UPB out BY digit order OF arithmetic TO LWB out WHILE int /= 0 DO |
||
INT digit := SHORTEN (int MOD base OF arithmetic); |
|||
int := (int-digit) OVER |
int := (int-digit) OVER base OF arithmetic; |
||
(digit OF out)[ |
(digit OF out)[place] := sign * digit |
||
IF int = 0 THEN done FI |
|||
OD; |
OD; |
||
done: |
done: |
||
INITDIGITS out # normalise # |
|||
digits OF bigreal := out; |
|||
bigreal |
|||
); |
); |
||
OP INITBIGREAL = ( |
OP INITBIGREAL = (INT in int)BIGREAL: |
||
INITBIGREAL LENG in |
INITBIGREAL LENG in int; |
||
OP INITBIGREAL = (LONG REAL in real)BIGREAL: |
OP INITBIGREAL = (LONG REAL in real)BIGREAL: ( |
||
SKIP; # TODO # |
|||
INT sign = SIGN in real; |
|||
OP INITBIGREAL = ([]DIGIT digits)BIGREAL: ( |
|||
LONG REAL real := ABS in real; |
|||
# Note: assumes digits have been normalised ! # |
|||
LONG REAL frac := real - ENTIER real; |
|||
STRUCT(FLEX[LWB digits:UPB digits]STRUCTDIGIT digits)out; |
|||
BIGREAL whole = INITBIGREAL ENTIER real; |
|||
digit OF digits OF out := digits; |
|||
out |
|||
); |
|||
#################################################################### |
|||
# Important: Operator +:= is required by Mixin_Big_float_addition. # |
|||
#################################################################### |
|||
# Note: +:= returns carry # |
|||
OP +:= = (REF DIGIT lhs, DIGIT arg)DIGIT: ( |
|||
DIGIT out := lhs + arg; |
|||
lhs := ABS out %* digit base * SIGN out; |
|||
(out-lhs) % digit base * SIGN out |
|||
); |
|||
INT base = base OF arithmetic, |
|||
########################################################################## |
|||
order = digit order OF arithmetic, |
|||
# Important: Operator *:= is required by Mixin_Big_float_multiplication. # |
|||
lsd = digit places OF arithmetic; # Todo: can be optimised/reduced # |
|||
########################################################################## |
|||
[MSD whole:lsd]DIGIT out; out[:0] := whole[@1]; |
|||
# Note: *:= returns carry # |
|||
OP *:= = (REF DIGIT lhs, DIGIT arg)DIGIT: ( |
|||
FOR place FROM -order BY -order TO lsd DO |
|||
DIGIT out = lhs * arg; |
|||
frac *:= base; |
|||
#LONG# INT digit := SHORTEN ENTIER frac; |
|||
frac -:= digit; |
|||
(digit OF out)[place] := digit; |
|||
IF frac = 0 THEN done FI |
|||
OD; |
|||
done: |
|||
IF sign > 1 THEN INITDIGITS out ELSE - INITDIGITS out FI |
|||
); |
); |
||
OP INITBIGREAL = (REAL in real)BIGREAL: |
|||
FORMAT big digit fmt = $n(digit width)(d)$; |
|||
INITBIGREAL LENG in real; |
|||
FORMAT big real fmt = $g(-digit width)","$; |
|||
#FORMAT digit fmt = $n(digit width OF arithmetic+ABS balanced OF arithmetic)(d)$;# |
|||
OP REPR = (STRUCTDIGIT digit)STRING: |
|||
FORMAT big real fmt = $g((digit width OF arithmetic+ABS balanced OF arithmetic))","$; |
|||
whole(ABS digit OF digit,-digit width); |
|||
OP REPR = ( |
OP REPR = (DIGIT digit)STRING: |
||
IF LWB repr OF arithmetic <= digit OF digit AND digit OF digit <= UPB repr OF arithmetic THEN |
|||
(repr OF arithmetic)[digit OF digit] |
|||
ELIF balanced OF arithmetic THEN |
|||
whole(digit OF digit,digit width OF arithmetic+1) |
|||
ELSE |
|||
whole(digit OF digit,-digit width OF arithmetic) |
|||
FI; |
|||
OP REPR = (BIGREAL real)STRING:( |
|||
CHAR repr 0 = "0"; |
|||
STRING out; |
STRING out; |
||
FOR place FROM MSD |
FOR place FROM MSD real BY -digit order OF arithmetic TO LSD real DO |
||
IF place = 1 AND place = MSD real THEN out +:= "." FI; |
|||
out +:= REPR(real[place]); |
|||
IF place = 0 AND place /= LSD real THEN out +:= "." FI |
|||
OD; |
OD; |
||
IF out = "" THEN out := |
IF out = "" THEN out := repr 0 FI; |
||
IF SIGN |
IF SIGN real<0 THEN "-" +=: out FI; |
||
IF MSD |
IF MSD real > 1 AND LSD real > 1 OR |
||
MSD |
MSD real < 0 AND LSD real < 0 THEN |
||
# No decimal point yet, so add an exponent # |
# No decimal point yet, so maybe we need to add an exponent # |
||
out+ |
out+IF digit order OF arithmetic*LSD real = 1 THEN repr 0 |
||
ELSE "e"+REPR INITBIGREAL(digit order OF arithmetic*LSD real) FI |
|||
# ELSE "E"+whole(digit order OF arithmetic*LSD real,0) FI # |
|||
ELSE |
ELSE |
||
out |
out |
||
FI |
FI |
||
);</lang>'''File: Template.Big_float.Subtraction.a68''' - bonus subtraction definitions<lang algol68>OP - = (DIGITS arg)DIGITS: ( |
|||
);</lang>'''File: test_Big_float_BCD_addition.a68''' |
|||
DIGITS out := arg; |
|||
<lang algol68>#!/usr/local/bin/a68g --script # |
|||
FOR digit FROM LSD arg BY digit order OF arithmetic TO MSD arg DO |
|||
out[digit]:= -out[digit] |
|||
OD; |
|||
out |
|||
); |
|||
OP SIGN = (DIGITS arg)INT: |
|||
IF LSD arg - MSD arg = digit order OF arithmetic THEN 0 # empty array # |
|||
ELSE # balanced artihmetic # SIGN arg[MSD arg] FI; |
|||
OP ABS = (DIGITS arg)DIGITS: |
|||
IF SIGN arg < 0 THEN -arg ELSE arg FI; |
|||
# derived DIGIT operators # |
|||
OP - = (DIGIT a, b)DIGIT: a + -b; |
|||
OP -:= = (REF DIGIT a, DIGIT b)DIGIT: a := a + -b; |
|||
# derived DIGITS operators # |
|||
OP - = (DIGITS a, b)DIGITS: a + -b; |
|||
OP -:= = (REF DIGITS a, DIGITS b)DIGITS: a := a + -b; |
|||
# derived hybrid DIGIT and DIGITS operators # |
|||
OP - = (DIGITS a, DIGIT b)DIGITS: a - INITDIGITS b; |
|||
OP - = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a - a; |
|||
OP -:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs - arg;</lang>'''File: test.Big_float_BCD.Addition.a68''' - test case code main program<lang algol68>#!/usr/local/bin/a68g --script # |
|||
################################################################## |
################################################################## |
||
# TEST CASE # |
|||
# A program to test abritary length BCD floating point addition. # |
# A program to test abritary length BCD floating point addition. # |
||
################################################################## |
################################################################## |
||
PR READ "prelude/general.a68" PR |
PR READ "prelude/general.a68" PR # [[rc:Template:ALGOL 68/prelude]] # |
||
################################################################## |
|||
INT digit width := 1; # define how decimal digits each "big" DIGIT is # |
|||
# READ Template for doing the actual arbitary precsion addition. # |
|||
################################################################## |
|||
PR READ "Template.Big_float.Addition.a68" PR |
|||
# include the basic axioms of the digits being used # |
# include the basic axioms of the digits being used # |
||
PR READ " |
PR READ "Template.Big_float_BCD.Base.a68" PR |
||
PR READ " |
PR READ "Template.Big_float.Subtraction.a68" PR |
||
PR READ "Mixin_Big_float_subtraction.a68" PR # need SIGN # |
|||
test: ( |
test: ( |
||
Line 354: | Line 465: | ||
sum := INITBIGREAL 0, |
sum := INITBIGREAL 0, |
||
shifted pattern := pattern, |
shifted pattern := pattern, |
||
shifted tiny := INITBIGREAL 1; # typically 0.000.....00001 # |
shifted tiny := INITBIGREAL 1; # typically 0.000.....00001 etc # |
||
FOR term FROM -8 TO 20 DO |
FOR term FROM -8 TO 20 DO |
||
# First make shifted pattern smaller by shifting right by the pattern width # |
# First make shifted pattern smaller by shifting right by the pattern width # |
||
shifted pattern := (shifted pattern)[@term*pattern width+2]; |
|||
shifted tiny := (shifted tiny)[@(term+1)*pattern width]; |
|||
MOID(sum +:= shifted pattern); |
MOID(sum +:= shifted pattern); |
||
Line 372: | Line 483: | ||
BIGREAL total = prod + shifted tiny; |
BIGREAL total = prod + shifted tiny; |
||
IF term < -4 THEN |
IF term < -4 THEN |
||
print(( REPR sum," x 81 gives: ", REPR prod, ", Plus ",REPR shifted tiny," gives: ")) |
print(( REPR sum," x 81 gives: ", REPR prod, ", Plus ",REPR shifted tiny," gives: ")) |
||
ELSE |
ELSE |
||
print((LSD prod - MSD prod + 1," digit test result: ")) |
print((LSD prod - MSD prod + 1," digit test result: ")) |
||
Line 379: | Line 490: | ||
printf(($g$, REPR total, $" => "b("Passed","Failed")"!"$, LSD total = MSD total, $l$)) |
printf(($g$, REPR total, $" => "b("Passed","Failed")"!"$, LSD total = MSD total, $l$)) |
||
OD |
OD |
||
)</lang> |
)</lang>'''Output:''' |
||
'''Output:''' |
|||
<pre style="height:15ex;overflow:scroll"> |
<pre style="height:15ex;overflow:scroll"> |
||
12345679e63 x 81 gives: 999999999e63, Plus 1e63 gives: 1e72 => Passed! |
12345679e63 x 81 gives: 999999999e63, Plus 1e63 gives: 1e72 => Passed! |
Revision as of 07:12, 15 November 2011
If possible, define addition for floating point numbers where the digits are stored in an arbitrary base. eg. the digits can be stored as binary, decimal, binary-coded decimal, or even balanced ternary.
Implement the code in a generalised form (such as a Template, Module or Mixin etc) that permits reusing of the code for different Bases.
If it is not possible to implement code in syntax of the specific language then:
- note the reason.
- perform test case using a built-in or external library.
Test case:
Use the Template to define Arbitrary precision addition on numbers stored in Binary Coded Decimal. Calculate the terms for -7 to 21 in this sequence of calculations:
Number | Term calculation | Result |
---|---|---|
-7 | 12345679e63 × 81 + 1e63 | 1e72 |
-6 | 12345679012345679e54 × 81 + 1e54 | 1e72 |
-5 | 12345679012345679012345679e45 × 81 + 1e45 | 1e72 |
-4 | 12345679012345679012345679012345679e36 × 81 + 1e36 | 1e72 |
etc. | The final calculation will be over 256 digits wide | 1e72 |
Perform the multiplication of 81 by repeated additions. The results will always be 1e72.
Ideally the template should be able to successfully handle other bases - such as Balanced ternary - to perform the above test case.
ALGOL 68
Note: This code stores the digits as array of digits with the "most significant digit" on the "left" as per normal "human" form. The net effect is that whole numbers (such as 100) are stored in the negative array positions, eg -2, -1 & 0, or [-2:0], And the fractional part of the floating point numbers are stored from index 1, eg. 1, 2, 3 etc. or [1:].
File: Template.Big_float.Addition.a68 - task code<lang algol68>########################################
- Define the basic addition operators #
- for the generalised base #
- derived DIGIT operators #
OP + = (DIGIT arg)DIGIT: arg; OP + = (DIGIT a,b)DIGIT: (DIGIT out := a; MOID(out +:= b); out);
- derived hybrid of DIGIT & DIGITS operators #
OP + = (DIGITS a, DIGIT b)DIGITS: a + INITDIGITS b; OP + = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a + a; OP +:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs + arg;
- derived DIGITS operators #
OP + = (DIGITS arg)DIGITS: arg; OP +:= = (REF DIGITS lhs, DIGITS arg)DIGITS: lhs := lhs + arg;
- TASK CODE #
- Actual generic addition operator #
OP + = (DIGITS a, b)DIGITS: (
IF SIGN a = 0 THEN b ELIF SIGN b = 0 THEN a ELSE MODE SIGNED = DIGIT;
INT extreme highest = MSD a MIN MSD b, overlap highest = MSD a MAX MSD b, overlap lowest = LSD a MIN LSD b, extreme lowest = LSD a MAX LSD b;
SIGNED zero = ZERO LOC SIGNED; INT order = digit order OF arithmetic; DIGITS out;
IF overlap highest > overlap lowest THEN # Either: NO overlapping digits #
[extreme highest:extreme lowest]SIGNED a plus b;
- First: simply insert the known digits with their correct sign #
a plus b[MSD a:LSD a] := a[@1]; a plus b[MSD b:LSD b] := b[@1];
- Next: Zero any totally non overlapping digit #
FOR place FROM overlap highest+order BY order TO overlap lowest-order DO a plus b[place] := zero OD;
- Finally: normalise by removing leading & trailing "zero" digit #
out := INITDIGITS a plus b
ELSE # Or: Add ALL overlapping digits #
[extreme highest+(carry OF arithmetic|order|0):extreme lowest]SIGNED a plus b;
- First: Deal with the non overlapping Least Significant Digits #
a plus b[overlap lowest-order:] := (LSD a > LSD b|a|b) [overlap lowest-order:];
- Or: Add any overlapping digits #
SIGNED carry := zero; FOR place FROM overlap lowest BY order TO overlap highest DO SIGNED digit a = a[place], digit b = b[place]; REF SIGNED result = a plus b[place]; IF carry OF arithmetic THEN # used in big float # result := carry; carry := ( result +:= digit a ); MOID( carry +:= ( result +:= (digit b) ) ) ELSE result := digit a; MOID( result +:= digit b ) FI OD;
- Next: Deal with the non overlapping Most Significant digits #
FOR place FROM overlap highest+order BY order TO extreme highest DO []DIGIT etc = (MSD a < MSD b|a|b); REF SIGNED result = a plus b[place]; IF carry OF arithmetic THEN result := carry; carry := ( result +:= etc[place] ) ELSE result := etc[place] FI OD;
- Next: Deal with the carry #
IF carry OF arithmetic THEN a plus b[extreme highest+order] := carry FI;
- Finally: normalise by removing leading & trailing "zero" digits #
out := INITDIGITS a plus b
FI; out # EXIT # FI
);</lang>File: Template.Big_float.Base.a68 - task utility code<lang algol68># -*- coding: utf-8 -*- #
- Define the basic operators and routines for #
- manipulating DIGITS in a generalised base #
STRUCT (
BOOL balanced, carry, # aka "carry" between digits # INT base, digit width, digit places, digit order, USTRING repr
) arithmetic := (
FALSE, TRUE, 10, 1, 81, -1, # Default is BCD/Hex # USTRING( # Note that the "circled" digits are negative - used in balance arithmetic # "ⓩ","ⓨ","ⓧ","ⓦ","ⓥ","ⓤ","ⓣ","ⓢ","ⓡ","ⓠ","ⓟ","ⓞ","ⓝ","ⓜ","ⓛ","ⓚ","ⓙ","ⓘ","ⓗ","ⓖ","ⓕ","ⓔ","ⓓ","ⓒ","ⓑ","ⓐ", "Ⓩ","Ⓨ","Ⓧ","Ⓦ","Ⓥ","Ⓤ","Ⓣ","Ⓢ","Ⓡ","Ⓠ","Ⓟ","Ⓞ","Ⓝ","Ⓜ","Ⓛ","Ⓚ","Ⓙ","Ⓘ","Ⓗ","Ⓖ","Ⓕ","Ⓔ","Ⓓ","Ⓒ","Ⓑ","Ⓐ", "⑨","⑧","⑦","⑥","⑤","④","③","②","①", "0", "1","2","3","4","5","6","7","8","9", "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z", "a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z" )[@-(26*2+9)]
);
MODE DIGITS = FLEX[0]DIGIT;
- DIGIT OPerators #
OP INITDIGIT = (#LONG# INT i)DIGIT: (DIGIT out; digit OF out := #SHORTEN# i; out);
- OP INITDIGIT = (INT i)DIGIT: INITDIGIT LENG i;#
OP /= = (DIGIT a,b)BOOL: digit OF a /= digit OF b;
- Define additive and multiplicative identities #
OP ZERO = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(ZERO LOC DIGIT),
IDENTITY = (DIGITS skip)DIGITS: INITDIGITS []DIGIT(IDENTITY LOC DIGIT);
OP SIGN = (DIGIT digit)INT: SIGN digit OF digit;
- Define OPerators for Least and Most Significant DIGIT #
OP MSD = (DIGITS t)INT: LWB t,
EXP = (DIGITS t)INT: digit order OF arithmetic * LWB t, # exponent # LSD = (DIGITS t)INT: UPB t;
OP INITDIGITS = (DIGIT in)DIGITS: INITDIGITS []DIGIT(in)[@0];
OP INITDIGITS = ([]DIGIT digits)DIGITS: (
- normalise digits:
A) removed leading & trailing zeros B) IF not balanced arithmetic THEN make all digits positive and set sign bit FI
MODE SIGNED = DIGIT; DIGIT zero = ZERO LOC DIGIT; DIGIT one = IDENTITY LOC DIGIT; DIGIT base digit = INITDIGIT base OF arithmetic; INT base = base OF arithmetic; INT half base = base % 2; INT order = digit order OF arithmetic;
INT msd := LWB digits + int width*order, lsd := UPB digits; # XXX #
- create an array with some "extra" significant digits incase there is a "big" input value #
[msd:lsd]SIGNED signed; signed[LWB digits:UPB digits] := digits[@1]; FOR place FROM LWB signed TO LWB digits+order DO signed[place] := zero OD; IF msd + order /= lsd THEN
- Trim leading zeros #
FOR place FROM msd BY -order TO lsd DO IF SIGN signed[place] /= 0 THEN msd := place; done msd FI OD; msd := lsd-order; done msd:
- Trim trailing zeros #
FOR place FROM lsd BY order TO msd DO IF SIGN signed[place] /= 0 THEN lsd := place; done lsd FI OD; lsd := msd+order; done lsd: IF msd + order /= lsd THEN # not zero # IF carry OF arithmetic THEN # Normalise to the "base OF arithmetic": # INT sign msd := SIGN digits[msd]; # first non zero digit # INT lwb digit := (balanced OF arithmetic|-half base|:sign msd < 0 |1-base|0); INT upb digit := (balanced OF arithmetic| half base|:sign msd > 0 |base-1|0); SIGNED carry := zero; FOR place FROM lsd BY order WHILE SIGN carry /=0 OR place >= LWB digits DO SIGNED digit := signed[place]; carry := digit +:= carry; WHILE digit OF digit < lwb digit DO MOID(digit +:= base digit); MOID(carry -:= one) OD; WHILE digit OF digit > upb digit DO MOID(digit -:= base digit); MOID(carry +:= one) OD; signed[place] := digit; # normalised # IF SIGN digit /= 0 THEN msd := place FI OD FI FI; signed[msd:lsd][@msd] FI );
- re anchor the array with a shift #
OP SHL = (DIGITS in, INT shl)DIGITS: in[@MSD in-shl]; OP SHR = (DIGITS in, INT shr)DIGITS: in[@MSD in+shr];</lang>File: Template.Big_float_BCD.Base.a68 - test case code<lang algol68>################################################
- Define the basic operators and routines for #
- manipulating DIGITS specific to a BCD base #
- BCD noramlly means Binary Coded Decimal, but... #
- this code handles "Balanced Coded Data", meaning #
- Data can be in any numerical bases, and the data #
- can optionally be stored as Balanced about zero #
- define the basic axioms of the number system you are extending #
MODE DIGIT = STRUCT(#LONG# INT digit);
- Note: If the +:= and *:= operators for INT are being "overloaded",
then it is sometimes necessary to wrap an INT in a STRUCT to protect the builtin definitions of the INT OPerators
- mixin the Big_float base definitions #
PR READ "Template.Big_float.Base.a68" PR
MODE BIGREAL = DIGITS;
- the Yoneda ambiguity forces the peculiar coercion n the body of OP #
OP ZERO = (DIGIT skip)DIGIT: (DIGIT out; digit OF out := 0; out); OP IDENTITY = (DIGIT skip)DIGIT: (DIGIT out; digit OF out := 1; out);
- define the basis operators #
OP ABS = (DIGIT a)INT: ABS digit OF a; OP - = (DIGIT a)DIGIT: INITDIGIT -digit OF a;
- Important: Operator +:= is required by Template_Big_float_addition. #
- Note: +:= returns carry DIGIT #
OP +:= = (REF DIGIT lhs, DIGIT arg)DIGIT: (
- Todo: Implement balanced arithmetic #
INT sum = digit OF lhs + digit OF arg; # arg may be -ve # INT carry := sum % base OF arithmetic; INT digit := sum - carry * base OF arithmetic; IF balanced OF arithmetic THEN INT half base = base OF arithmetic OVER 2; IF digit > half base THEN digit -:= base OF arithmetic; carry +:= 1 ELIF digit < -half base THEN digit +:= base OF arithmetic; carry -:= 1 FI FI; lhs := INITDIGIT digit; INITDIGIT carry
);
INT half = base OF arithmetic OVER 2;
- ASSERT NOT balanced OF arithmetic OR ODD base OF arithmetic #
- Important: Operator *:= is required by Template_Big_float_multiplication. #
- Note: *:= returns carry DIGIT #
OP *:= = (REF DIGIT lhs, DIGIT arg)DIGIT: (
- Todo: Implement balanced arithmetic #
INT product = digit OF lhs * digit OF arg; # arg may be -ve # INT carry = product % base OF arithmetic; lhs := INITDIGIT(product - carry * base OF arithmetic); INITDIGIT carry
);
- Define the basic coersion/casting rules between types. #
OP INITLONGREAL = (BIGREAL a)LONG REAL:
IF SIGN a = 0 THEN 0 ELSE INT lsd a = LSD a; # Todo: Optimise/reduce to match "long real width" # LONG REAL out := digit OF a[MSD a]; FOR place FROM MSD a - digit order OF arithmetic BY -digit order OF arithmetic TO lsd a DO out := out * base OF arithmetic + digit OF a[place] OD; out * LONG REAL(base OF arithmetic) ** -LSD a FI;
OP INITREAL = (BIGREAL r)REAL:
SHORTEN INITLONGREAL r;
OP MSD = (LONG INT i)INT: (
LONG INT remainder := i; INT count := 0; WHILE remainder /= 0 DO remainder %:= base OF arithmetic; MOID(count +:= 1) OD; count
);
OP INITBIGREAL = (LONG INT in int)BIGREAL: (
INT max = MSD in int; [1-max:0]DIGIT out;
LONG INT int := ABS in int; INT sign = SIGN in int;
FOR place FROM UPB out BY digit order OF arithmetic TO LWB out WHILE int /= 0 DO INT digit := SHORTEN (int MOD base OF arithmetic); int := (int-digit) OVER base OF arithmetic; (digit OF out)[place] := sign * digit OD;
done:
INITDIGITS out # normalise #
);
OP INITBIGREAL = (INT in int)BIGREAL:
INITBIGREAL LENG in int;
OP INITBIGREAL = (LONG REAL in real)BIGREAL: (
INT sign = SIGN in real; LONG REAL real := ABS in real; LONG REAL frac := real - ENTIER real; BIGREAL whole = INITBIGREAL ENTIER real;
INT base = base OF arithmetic, order = digit order OF arithmetic, lsd = digit places OF arithmetic; # Todo: can be optimised/reduced # [MSD whole:lsd]DIGIT out; out[:0] := whole[@1];
FOR place FROM -order BY -order TO lsd DO frac *:= base; #LONG# INT digit := SHORTEN ENTIER frac; frac -:= digit; (digit OF out)[place] := digit; IF frac = 0 THEN done FI OD;
done:
IF sign > 1 THEN INITDIGITS out ELSE - INITDIGITS out FI
);
OP INITBIGREAL = (REAL in real)BIGREAL:
INITBIGREAL LENG in real;
- FORMAT digit fmt = $n(digit width OF arithmetic+ABS balanced OF arithmetic)(d)$;#
FORMAT big real fmt = $g((digit width OF arithmetic+ABS balanced OF arithmetic))","$;
OP REPR = (DIGIT digit)STRING:
IF LWB repr OF arithmetic <= digit OF digit AND digit OF digit <= UPB repr OF arithmetic THEN (repr OF arithmetic)[digit OF digit] ELIF balanced OF arithmetic THEN whole(digit OF digit,digit width OF arithmetic+1) ELSE whole(digit OF digit,-digit width OF arithmetic) FI;
OP REPR = (BIGREAL real)STRING:(
CHAR repr 0 = "0"; STRING out; FOR place FROM MSD real BY -digit order OF arithmetic TO LSD real DO IF place = 1 AND place = MSD real THEN out +:= "." FI; out +:= REPR(real[place]); IF place = 0 AND place /= LSD real THEN out +:= "." FI OD; IF out = "" THEN out := repr 0 FI; IF SIGN real<0 THEN "-" +=: out FI; IF MSD real > 1 AND LSD real > 1 OR MSD real < 0 AND LSD real < 0 THEN # No decimal point yet, so maybe we need to add an exponent # out+IF digit order OF arithmetic*LSD real = 1 THEN repr 0 ELSE "e"+REPR INITBIGREAL(digit order OF arithmetic*LSD real) FI # ELSE "E"+whole(digit order OF arithmetic*LSD real,0) FI # ELSE out FI
);</lang>File: Template.Big_float.Subtraction.a68 - bonus subtraction definitions<lang algol68>OP - = (DIGITS arg)DIGITS: (
DIGITS out := arg; FOR digit FROM LSD arg BY digit order OF arithmetic TO MSD arg DO out[digit]:= -out[digit] OD; out
);
OP SIGN = (DIGITS arg)INT:
IF LSD arg - MSD arg = digit order OF arithmetic THEN 0 # empty array # ELSE # balanced artihmetic # SIGN arg[MSD arg] FI;
OP ABS = (DIGITS arg)DIGITS:
IF SIGN arg < 0 THEN -arg ELSE arg FI;
- derived DIGIT operators #
OP - = (DIGIT a, b)DIGIT: a + -b; OP -:= = (REF DIGIT a, DIGIT b)DIGIT: a := a + -b;
- derived DIGITS operators #
OP - = (DIGITS a, b)DIGITS: a + -b; OP -:= = (REF DIGITS a, DIGITS b)DIGITS: a := a + -b;
- derived hybrid DIGIT and DIGITS operators #
OP - = (DIGITS a, DIGIT b)DIGITS: a - INITDIGITS b; OP - = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a - a; OP -:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs - arg;</lang>File: test.Big_float_BCD.Addition.a68 - test case code main program<lang algol68>#!/usr/local/bin/a68g --script #
- TEST CASE #
- A program to test abritary length BCD floating point addition. #
PR READ "prelude/general.a68" PR # rc:Template:ALGOL 68/prelude #
- READ Template for doing the actual arbitary precsion addition. #
PR READ "Template.Big_float.Addition.a68" PR
- include the basic axioms of the digits being used #
PR READ "Template.Big_float_BCD.Base.a68" PR PR READ "Template.Big_float.Subtraction.a68" PR
test: (
BIGREAL pattern = INITBIGREAL 012345679, INT pattern width = 9;
BIGREAL sum := INITBIGREAL 0, shifted pattern := pattern, shifted tiny := INITBIGREAL 1; # typically 0.000.....00001 etc #
FOR term FROM -8 TO 20 DO
# First make shifted pattern smaller by shifting right by the pattern width # shifted pattern := (shifted pattern)[@term*pattern width+2]; shifted tiny := (shifted tiny)[@(term+1)*pattern width];
MOID(sum +:= shifted pattern);
# Manually multiply by 81 by repeated addition # BIGREAL prod := sum + sum + sum; MOID(prod +:= prod + prod); MOID(prod +:= prod + prod); MOID(prod +:= prod + prod);
BIGREAL total = prod + shifted tiny;
IF term < -4 THEN print(( REPR sum," x 81 gives: ", REPR prod, ", Plus ",REPR shifted tiny," gives: ")) ELSE print((LSD prod - MSD prod + 1," digit test result: ")) FI; printf(($g$, REPR total, $" => "b("Passed","Failed")"!"$, LSD total = MSD total, $l$)) OD
)</lang>Output:
12345679e63 x 81 gives: 999999999e63, Plus 1e63 gives: 1e72 => Passed! 12345679012345679e54 x 81 gives: 999999999999999999e54, Plus 1e54 gives: 1e72 => Passed! 12345679012345679012345679e45 x 81 gives: 999999999999999999999999999e45, Plus 1e45 gives: 1e72 => Passed! 12345679012345679012345679012345679e36 x 81 gives: 999999999999999999999999999999999999e36, Plus 1e36 gives: 1e72 => Passed! +45 digit test result: 1e72 => Passed! +54 digit test result: 1e72 => Passed! +63 digit test result: 1e72 => Passed! +72 digit test result: 1e72 => Passed! +81 digit test result: 1e72 => Passed! +90 digit test result: 1e72 => Passed! +99 digit test result: 1e72 => Passed! +108 digit test result: 1e72 => Passed! +117 digit test result: 1e72 => Passed! +126 digit test result: 1e72 => Passed! +135 digit test result: 1e72 => Passed! +144 digit test result: 1e72 => Passed! +153 digit test result: 1e72 => Passed! +162 digit test result: 1e72 => Passed! +171 digit test result: 1e72 => Passed! +180 digit test result: 1e72 => Passed! +189 digit test result: 1e72 => Passed! +198 digit test result: 1e72 => Passed! +207 digit test result: 1e72 => Passed! +216 digit test result: 1e72 => Passed! +225 digit test result: 1e72 => Passed! +234 digit test result: 1e72 => Passed! +243 digit test result: 1e72 => Passed! +252 digit test result: 1e72 => Passed! +261 digit test result: 1e72 => Passed!
J
I am not currently able to implement the task exactly because I do not quite understand what is being asked for (nor why it would be useful).
That said, the task does specify some calculations to be performed.
Given
<lang j>e=: 2 : 0
u * 10x ^ v
)</lang>
In other words, given a parse time word (e
) which combines its two arguments as numbers, multiplying the number on its left by the exact exponent of 10 given on the right, I can do:
<lang> 1 e 63 + 12345679 e 63 * 81 1000000000000000000000000000000000000000000000000000000000000000000000000
1 e 54 + 12345679012345679 e 54 * 81
1000000000000000000000000000000000000000000000000000000000000000000000000
1 e 45 + 12345679012345679012345679x e 45 * 81
1000000000000000000000000000000000000000000000000000000000000000000000000
1 e 36 + 12345679012345679012345679012345679x e 36 * 81
1000000000000000000000000000000000000000000000000000000000000000000000000</lang>
So, ok, let's turn this into a sequence:
<lang j>factor=: [: +/ [: 12345679 e ] _9 * 1 + i.&.(+&8) adjust=: 1 e (_9&*)</lang>
Here we show some examples of what these words mean:
<lang j> factor _4 NB. this is the number we multiply by 81 12345679012345679012345679012345679000000000000000000000000000000000000
factor _3
12345679012345679012345679012345679012345679000000000000000000000000000
factor 2 NB. here we see that we are using rational numbers
12345679012345679012345679012345679012345679012345679012345679012345679012345679012345679r1000000000000000000
90j18 ": factor 2 NB. formatted as decimal in 90 characters with 18 characters after the decimal point
12345679012345679012345679012345679012345679012345679012345679012345679.012345679012345679
adjust _4 NB. this is the number we add to the result of multiplying our factor by 81
1000000000000000000000000000000000000
adjust _3
1000000000000000000000000000</lang>
Given these words:
<lang j>
_7+i.29 NB. these are the sequence elements we are going to generate
_7 _6 _5 _4 _3 _2 _1 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
#(adju + 81 * factor)&> _7+i.29 NB. we generate a sequence of 29 numbers
29
~.(adju + 81 * factor)&> _7+i.29 NB. here we see that they are all the same number
1000000000000000000000000000000000000000000000000000000000000000000000000</lang>
Note that ~. list
returns the unique elements from that list.