Generalised floating point multiplication: Difference between revisions

From Rosetta Code
Content added Content deleted
m (a sequence of -7 to 21 will work here too.)
(Change the test case to Balance Ternary. Generate a 'Balance Ternary' multiplication table)
Line 1: Line 1:
{{Template:Draft task}}
{{Template:Draft task}}
[[wp:Balanced ternary|Balanced ternary]] is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary "real" is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 3<sup>2</sup> + 3<sup>1</sup> − 3<sup>0</sup>, thus can be written as "++−", while 6 = 3<sup>2</sup> − 3<sup>1</sup> + 0 × 3<sup>0</sup>, i.e., "+−0" and for an actual real number 6⅓ the ''exact'' representation is 3<sup>2</sup> − 3<sup>1</sup> + 0 × 3<sup>0</sup> + 1 × 3<sup>-1</sup> i.e., "+−0.+"
If possible, define ''multiplication'' for floating point numbers where the digits are stored in an arbitrary base. eg. the digits cab be stored as binary, decimal, [[wp:Binary-coded decimal|Binary-coded decimal]], or even [[wp:Balanced ternary|Balanced ternary]].

For this task, implement balanced ternary representation of real numbers with the following:

'''Requirements'''
# Support arbitrary precision real numbers, both positive and negative;
# Provide ways to convert to and from text strings, using digits '+', '-' and '0' (unless you are already using strings to represent balanced ternary; but see requirement 5).
# Provide ways to convert to and from native integer and real type (unless, improbably, your platform's native integer type ''is'' balanced ternary). If your native integers can't support arbitrary length, overflows during conversion must be indicated.
# Provide ways to perform addition, negation and multiplication directly on balanced ternary integers; do ''not'' convert to native integers first.
# Make your implementation efficient, with a reasonable definition of "efficient" (and with a reasonable definition of "reasonable").
# The Template should successfully handle these multiplications in other bases. In particular [[wp:Septemvigesimal|Septemvigesimal]] and "Balanced base-27".

'''Test case 1''' - With balanced ternaries ''a'' from string "+-0++0+.+-0++0+", ''b'' from native real -436.436, ''c'' "+-++-.+-++-":
* write out ''a'', ''b'' and ''c'' in decimal notation.
* calculate ''a'' × (''b'' − ''c''), write out the result in both ternary and decimal notations.
* In the above limit the precision to 81 ternary digits after the point.

'''Test case 2''' - Generate a multiplication table of balanced ternaries where the rows of the table are for a 1st factor of 1 to 27, and the column of the table are for the second factor of 1 to 12.


Implement the code in a generalised form (such as a [[wp:Template (programming)|Template]], [[wp:Modular programming|Module]] or [[wp:Mixin|Mixin]] etc) that permits reusing of the code for different [[wp:Base_(exponentiation)#In_numeral_systems|Bases]].
Implement the code in a generalised form (such as a [[wp:Template (programming)|Template]], [[wp:Modular programming|Module]] or [[wp:Mixin|Mixin]] etc) that permits reusing of the code for different [[wp:Base_(exponentiation)#In_numeral_systems|Bases]].
Line 6: Line 23:
If it is not possible to implement code in syntax of the specific language then:
If it is not possible to implement code in syntax of the specific language then:
* note the reason.
* note the reason.
* perform ''test case'' using a built-in or external library.
* perform the ''test case'' using a built-in or external library.
<!--

'''Test case:'''
'''Test case:'''


Use the Template to define [[wp:Arbitrary-precision arithmetic|Arbitrary precision multiplication]] on numbers stored in Binary Coded Decimal.
Use the Template to define [[wp:Arbitrary-precision arithmetic|Arbitrary precision multiplication]] on numbers stored in Balanced Ternary.


{|class="wikitable" style="text-align: center; margin: 1em auto 1em auto;"
{|class="wikitable" style="text-align: center; margin: 1em auto 1em auto;"
Line 28: Line 45:
|}
|}
Note: The results will always be 1e144.
Note: The results will always be 1e144.
-->

The Template should successfully handle these multiplications in other bases.
=={{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 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''.}}
'''File: Template.Big_float.Multiplication.a68'''<lang algol68># Kudos: use http://en.wikipedia.org/wiki/Karatsuba_algorithm #
'''File: Mixin_Big_float_multiplication.a68'''

<lang algol68>OP * = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a * b;
OP * = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a * b;
OP * = (DIGITS a, DIGIT b)DIGITS: a * INITDIGITS b;
OP * = (DIGITS a, DIGIT b)DIGITS: a * INITDIGITS b;


OP * = (DIGITS in a, in b)DIGITS:(
OP *:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs * INITDIGITS arg;
# Note: is cast really needed? eg. []STRUCTDIGIT(~) #
[]DIGIT a = digit OF []STRUCTDIGIT(digits OF in a);
[]DIGIT b = digit OF []STRUCTDIGIT(digits OF in b);
[digit order + MSD in a+MSD in b: LSD in a+LSD in b]DIGIT a times b;


##########################################
DIGIT zero := digit OF (INITSTRUCTDIGIT 0);
# TASK CODE #
# Actual generic mulitplication operator #
##########################################


OP * = (DIGITS a, b)DIGITS: (
FOR place FROM LSD in a+LSD in b BY digit order TO LSD in a+MSD in b DO
DIGITS minus one = -IDENTITY LOC DIGITS,
a times b[place] := zero
zero = ZERO LOC DIGITS,
OD;
FOR place a FROM LSD in a BY digit order TO MSD in a DO
one = IDENTITY LOC DIGITS;
DIGIT digit a = a[place a];
INT order = digit order OF arithmetic;
DIGIT carry := zero;
IF SIGN a = 0 OR SIGN b = 0 THEN zero
CO # Note: The following require the inequality operators #
FOR place b FROM LSD in b BY digit order TO MSD in b DO
ELIF a = one THEN b
DIGIT digit b = b[place b];
ELIF b = one THEN a
REF DIGIT digit ab = a times b[place a + place b];
ELIF a = minus one THEN -b
ELIF b = minus one THEN -a
END CO
ELSE
DIGIT zero = ZERO LOC DIGIT;
DIGIT one = IDENTITY LOC DIGIT;
[order + MSD a+MSD b: LSD a+LSD b]DIGIT a times b;


IF digit carry THEN # used for big number arithmetic #
FOR place FROM LSD a+LSD b BY order TO LSD a+MSD b DO
MOID(carry := ( digit ab +:= carry ));
a times b[place] := zero # pad the MSDs of the result wiht Zero #
DIGIT prod := digit a;
MOID(carry +:= ( prod *:= digit b ));
MOID(carry +:= ( digit ab +:= prod ))
ELSE
DIGIT prod := digit a;
MOID(prod *:= digit b);
MOID(digit ab +:= prod)
FI
OD;
OD;
a times b[place a + MSD in b + digit order] := carry
FOR place a FROM LSD a BY order TO MSD a DO
DIGIT digit a = a[place a];
OD;
DIGIT carry := zero;
FOR place b FROM LSD b BY order TO MSD b DO
DIGIT digit b = b[place b];
REF DIGIT digit ab = a times b[place a + place b];
IF SIGN digit b /= 0 THEN # zero optimisation #
IF carry OF arithmetic THEN # used for big number arithmetic #
MOID(carry := ( digit ab +:= carry ));
DIGIT prod := digit a;
MOID(carry +:= ( prod *:= digit b ));
MOID(carry +:= ( digit ab +:= prod ))
ELSE # carry = 0 so we can just ignore the carry #
DIGIT prod := digit a;
MOID(prod *:= digit b);
MOID(digit ab +:= prod)
FI
FI
OD;
a times b[place a + MSD b + order] := carry
OD;
INITDIGITS a times b # normalise #
FI
);</lang>'''File: Template.Balanced_ternary_float.Base.a68'''<lang algol68>PR READ "Template.Big_float_BCD.Base.a68" PR # [[rc:Generalised floating point addition]] #


################################################################
INITDIGITS digits normalise(a times b)
# First: define the attributes of the arithmetic we are using. #
);</lang>'''File: test_Big_float_BCD_multiplication.a68'''
################################################################
<lang algol68>#!/usr/local/bin/a68g --script #
CO STRUCT (
BOOL balanced,
carry, # aka "carry" between digits #
INT base,
digit width,
digit places,
digit order,
USTRING repr
) CO arithmetic := (
# balanced = # TRUE,
# carry = # TRUE,
# base = # 3, # width = # 1, # places = # 81, # order = # -1,
# repr = # USTRING("-","0","+")[@-1]
);


OP INITDIGIT = (CHAR c)DIGIT: (
##################################################################
DIGIT out;
# A program to test abritary length BCD floating point addition. #
digit OF out :=
##################################################################
IF c = "+" THEN +1
ELIF c = "0" THEN 0
ELIF c = "-" THEN -1
ELSE raise value error("Unknown digit :"""+c+""""); SKIP
FI;
out
);


OP INITBIGREAL = (STRING s)BIGREAL: (
PR READ "prelude/general.a68" PR
BIGREAL out;
BIGREAL base of arithmetic = INITBIGREAL base OF arithmetic; # Todo: Opt #
INT point := UPB s-1; # put the point on the extreme right #
FOR i FROM LWB s TO UPB s DO
IF s[i]="." THEN
point := i
ELSE
out := out SHR digit order OF arithmetic + INITDIGIT s[i]
FI
OD;
out SHR (UPB s-point)
);</lang>'''File: test.Balanced_ternary_float.Multiplication.a68'''<lang algol68>#!/usr/local/bin/a68g --script #


####################################################################
INT digit width := 1; # define how decimal digits each "big" DIGIT is #
# A program to test abritary length floating point multiplication. #
####################################################################


PR READ "prelude/general.a68" PR # [[rc:Template:ALGOL 68/prelude]] #


PR READ "Template.Big_float.Multiplication.a68" PR
COMMENT
Source code for Big_float_BCD_base, Mixin_Big_float_addition & subtraction is
located at: http://rosettacode.org/wiki/Generalised_floating_point_addition%23ALGOL_68
END COMMENT
# include the basic axioms of the digits being used #
PR READ "Big_float_BCD_base.a68" PR
PR READ "Mixin_Big_float_addition.a68" PR
PR READ "Mixin_Big_float_subtraction.a68" PR
# Generalised multiplication #
PR READ "Mixin_Big_float_multiplication.a68" PR


# INT digit width := 1; ## define how digits each "big" DIGIT is #
test: (
BIGREAL pattern = INITBIGREAL 111111111,
INT pattern width = 9;


# include the basic axioms of the digits being used #
BIGREAL
PR READ "Template.Balanced_ternary_float.Base.a68" PR
sum := INITBIGREAL 0,
PR READ "Template.Big_float.Addition.a68" PR # [[rc:Generalised floating point addition]] #
shifted pattern := pattern,
PR READ "Template.Big_float.Subtraction.a68" PR # [[rc:Generalised floating point addition]] #
tiny := INITBIGREAL 2, # typically 0.000.....00002 #
very tiny := INITBIGREAL -1;# typically 0.000.....00001 #


test1:( # Basic arithmetic #
INT start = -8;
INT rw = long real width;
BIGREAL a = INITBIGREAL "+-0++0+.+-0++0+", # 523.239... #
b = INITBIGREAL - LONG 436.436,
c = INITBIGREAL "+-++-.+-++-"; # 65.267... #
printf(($g 9k g(rw,rw-5)39kgl$,
"a =",INITLONGREAL a, REPR a,
"b =",INITLONGREAL b, REPR b,
"c =",INITLONGREAL c, REPR c,
"a*(b-c)",INITREAL(a*(b-c)), REPR(a*(b-c)),
$l$))
);


test2:( # A floating point Ternary multiplication table #
FOR term FROM start TO 20 DO
FORMAT s = $"|"$; # field seperator #


INT lwb = 1, tab = 8, upb = 12;
# First make shifted pattern smaller by shifting right by the pattern width #
digits OF shifted pattern := (digits OF shifted pattern)[@term*pattern width+1];
digits OF tiny := (digits OF tiny)[@(term+start+1)*pattern width];
digits OF very tiny := (digits OF very tiny)[@2*(term+1)*pattern width];


MOID(sum +:= shifted pattern);
printf($"# "f(s)" * "f(s)$);
FOR j FROM lwb TO upb DO
FORMAT col = $n(tab)k f(s)$;
printf(($g" #"g(0)f(col)$, REPR INITBIGREAL j,j))
OD;
printf($l$);
FOR i FROM lwb TO 27 DO
printf(($g(0) 3k f(s) g 9k f(s)$,i,REPR INITBIGREAL i));
FOR j FROM lwb TO i MIN upb DO
FORMAT col = $n(tab)k f(s)$;
BIGREAL product = INITBIGREAL i * INITBIGREAL j;
printf(($gf(col)$, REPR product))
OD;
IF upb > i THEN printf($n(upb-i)(n(tab-1)x f(s))$) FI;
printf($l$)
OD
)</lang>'''Output:'''
<pre>
a = +523.23914037494284407864655 +-0++0+.+-0++0+
b = -436.43600000000000000000000 --++-0--.--0+-00+++-0-+---0-+0++++0--0000+00-+-+--+0-0-00--++0-+00---+0+-+++0+-0----0++
c = +65.26748971193415637860082 +-++-.+-++-
a*(b-c) -385143.87484393900000000000 --+-+++0-00++-.0+0+0++-0++00+--00+--0-00++-++-00+-+--000---+--0----000+++-0++0-++00-++0+00-00-00++++


# | * |+ #1 |+- #2 |+0 #3 |++ #4 |+-- #5 |+-0 #6 |+-+ #7 |+0- #8 |+e+- #9|+0+ #10|++- #11|++0 #12|
# Manually multiply by 81 by repeated addition #
1 |+ |+ | | | | | | | | | | | |
BIGREAL prod := sum * sum * INITBIGREAL 81;
2 |+- |+- |++ | | | | | | | | | | |

3 |+0 |+0 |+-0 |+e+- | | | | | | | | | |
BIGREAL total = prod + tiny + very tiny;
4 |++ |++ |+0- |++0 |+--+ | | | | | | | | |

5 |+-- |+-- |+0+ |+--0 |+-+- |+0-+ | | | | | | | |
IF term < -4 THEN
6 |+-0 |+-0 |++0 |+-e+- |+0-0 |+0+0 |++e+- | | | | | | |
print(( REPR sum,"**2 x 81 gives: ", REPR prod,
7 |+-+ |+-+ |+--- |+-+0 |+00+ |++0- |+---0 |+--++ | | | | | |
", Plus:",REPR tiny, " + ",REPR very tiny, ", Gives: "))
8 |+0- |+0- |+--+ |+0-0 |++-- |++++ |+--+0 |+-0+- |+0+ | | | | |
ELSE
9 |+e+- |+e+- |+-e+- |+e+0 |++e+- |+--e+- |+-e+0 |+-+e+- |+0-e+- |+e++ | | | |
print((LSD prod - MSD prod + 1," digit test result: "))
10|+0+ |+0+ |+-+- |+0+0 |++++ |+-0-- |+-+-0 |+0--+ |+000- |+0+e+- |+-0-0+ | | |
FI;
11|++- |++- |+-++ |++-0 |+--0- |+-00+ |+-++0 |+00-- |++-+ |++-e+- |++0+- |+++++ | |
printf(($g$, REPR total, $" => "b("Passed","Failed")"!"$, LSD total = MSD total, $l$))
12|++0 |++0 |+0-0 |++e+- |+--+0 |+-+-0 |+0-e+- |+00+0 |++--0 |++e+0 |++++0 |+--0-0 |+--+e+-|

13|+++ |+++ |+00- |+++0 |+-0-+ |+-++- |+00-0 |+0+0+ |++0-- |+++e+- |+-+-++ |+--+0- |+-0-+0 |
OD
14|+--- |+--- |+00+ |+---0 |+-0+- |+0--+ |+00+0 |++-0- |--+0++ |+---e+-|+0+-- |+-0-0+ |+-0+-0 |
)</lang>
15|+--0 |+--0 |+0+0 |+--e+- |+-+-0 |+0-+0 |+0+e+- |++0-0 |--+++0 |+--e+0 |+-0--0 |+-00+0 |+-+-e+-|
'''Output:'''
16|+--+ |+--+ |++-- |+--+0 |+-+0+ |+000- |++--0 |++0++ |+-+- |+--+e+-|+-00-+ |+-+--- |+-+0+0 |
<pre style="height:15ex;overflow:scroll">
17|+-0- |+-0- |++-+ |+-0-0 |+0--- |+00++ |++-+0 |++++- |+--00+ |+-0-e+-|+++0- |+-+0-+ |+0---0 |
111111111e63**2 x 81 gives: 999999998000000001e126, Plus:2e135 + -1e126, Gives: 1e144 => Passed!
18|+-e+-|+-e+- |++e+- |+-e+0 |+0-e+- |+0+e+- |++e+0 |+---e+-|+--+e+-|+-e++ |+-+-e+-|+-++e+-|+0-e+0 |
111111111111111111e54**2 x 81 gives: 999999999999999998000000000000000001e108, Plus:2e126 + -1e108, Gives: 1e144 => Passed!
19|+-0+ |+-0+ |+++- |+-0+0 |+0-++ |++--- |+++-0 |+--0-+ |+0--0- |+-0+e+-|+-+00+ |+0--+- |+0-++0 |
111111111111111111111111111e45**2 x 81 gives: 999999999999999999999999998000000000000000000000000001e90, Plus:2e117 + -1e90, Gives: 1e144 => Passed!
20|+-+- |+-+- |++++ |+-+-0 |+000- |++-0+ |++++0 |+--+-- |+-00-+ |+-+-e+-|++-++- |+0-0++ |+000-0 |
111111111111111111111111111111111111e36**2 x 81 gives: 999999999999999999999999999999999998000000000000000000000000000000000001e72, Plus:2e108 + -1e72, Gives: 1e144 => Passed!
21|+-+0 |+-+0 |+---0 |+-+e+- |+00+0 |++0-0 |+---e+-|+--++0 |+-0+-0 |+-+e+0 |+----+0|+00--0 |+00+e+-|
+90 digit test result: 1e144 => Passed!
22|+-++ |+-++ |+--0- |+-++0 |+0+-+ |++0+- |+--0-0 |+-0-0+ |+00--- |+-++e+-|+---0++|+0000- |+0+-+0 |
+108 digit test result: 1e144 => Passed!
23|+0-- |+0-- |+--0+ |+0--0 |+0++- |+++-+ |+--0+0 |+-000- |+-++ |+0--e+-|+00--- |+00+0+ |+0++-0 |
+126 digit test result: 1e144 => Passed!
24|+0-0 |+0-0 |+--+0 |+0-e+- |++--0 |++++0 |+--+e+-|+-0+-0 |+0+0 |+0-e+0 |+000-0 |+0+-+0 |++--e+-|
+144 digit test result: 1e144 => Passed!
25|+0-+ |+0-+ |+-0-- |+0-+0 |++-0+ |+---0- |+-0--0 |+-0+++ |+++- |+0-+e+-|+00+-+ |+0++-- |++-0+0 |
+162 digit test result: 1e144 => Passed!
26|+00- |+00- |+-0-+ |+00-0 |++0-- |+---++ |+-0-+0 |+-+-+- |+0--0+ |+00-e+-|+0+-0- |++---+ |++0--0 |
+180 digit test result: 1e144 => Passed!
27|+e+0 |+e+0 |+-e+0 |+e++ |++e+0 |+--e+0 |+-e++ |+-+e+0 |+0-e+0 |+e+-- |+0+e+0 |++-e+0 |++e++ |
+198 digit test result: 1e144 => Passed!
+216 digit test result: 1e144 => Passed!
+234 digit test result: 1e144 => Passed!
+252 digit test result: 1e144 => Passed!
+270 digit test result: 1e144 => Passed!
+288 digit test result: 1e144 => Passed!
+306 digit test result: 1e144 => Passed!
+324 digit test result: 1e144 => Passed!
+342 digit test result: 1e144 => Passed!
+360 digit test result: 1e144 => Passed!
+378 digit test result: 1e144 => Passed!
+396 digit test result: 1e144 => Passed!
+414 digit test result: 1e144 => Passed!
+432 digit test result: 1e144 => Passed!
+450 digit test result: 1e144 => Passed!
+468 digit test result: 1e144 => Passed!
+486 digit test result: 1e144 => Passed!
+504 digit test result: 1e144 => Passed!
+522 digit test result: 1e144 => Passed!
</pre>
</pre>
[[Category:Arbitrary precision]]
[[Category:Arbitrary precision]]

Revision as of 09:02, 15 November 2011

Generalised floating point multiplication is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Balanced ternary is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary "real" is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 32 + 31 − 30, thus can be written as "++−", while 6 = 32 − 31 + 0 × 30, i.e., "+−0" and for an actual real number 6⅓ the exact representation is 32 − 31 + 0 × 30 + 1 × 3-1 i.e., "+−0.+"

For this task, implement balanced ternary representation of real numbers with the following:

Requirements

  1. Support arbitrary precision real numbers, both positive and negative;
  2. Provide ways to convert to and from text strings, using digits '+', '-' and '0' (unless you are already using strings to represent balanced ternary; but see requirement 5).
  3. Provide ways to convert to and from native integer and real type (unless, improbably, your platform's native integer type is balanced ternary). If your native integers can't support arbitrary length, overflows during conversion must be indicated.
  4. Provide ways to perform addition, negation and multiplication directly on balanced ternary integers; do not convert to native integers first.
  5. Make your implementation efficient, with a reasonable definition of "efficient" (and with a reasonable definition of "reasonable").
  6. The Template should successfully handle these multiplications in other bases. In particular Septemvigesimal and "Balanced base-27".

Test case 1 - With balanced ternaries a from string "+-0++0+.+-0++0+", b from native real -436.436, c "+-++-.+-++-":

  • write out a, b and c in decimal notation.
  • calculate a × (b − c), write out the result in both ternary and decimal notations.
  • In the above limit the precision to 81 ternary digits after the point.

Test case 2 - Generate a multiplication table of balanced ternaries where the rows of the table are for a 1st factor of 1 to 27, and the column of the table are for the second factor of 1 to 12.

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 the test case using a built-in or external library.

ALGOL 68

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.
Works with: ALGOL 68G version Any - tested with release algol68g-2.3.3.

File: Template.Big_float.Multiplication.a68<lang algol68># Kudos: use http://en.wikipedia.org/wiki/Karatsuba_algorithm #

OP * = (DIGIT a, DIGITS b)DIGITS: INITDIGITS a * b; OP * = (DIGITS a, DIGIT b)DIGITS: a * INITDIGITS b;

OP *:= = (REF DIGITS lhs, DIGIT arg)DIGITS: lhs := lhs * INITDIGITS arg;

  2. TASK CODE #
  3. Actual generic mulitplication operator #

OP * = (DIGITS a, b)DIGITS: ( 

 DIGITS minus one = -IDENTITY LOC DIGITS,
        zero = ZERO LOC DIGITS,
        one = IDENTITY LOC DIGITS;
 INT order = digit order OF arithmetic;
 IF SIGN a = 0 OR SIGN b = 0 THEN zero

CO # Note: The following require the inequality operators # 

 ELIF a = one THEN b
 ELIF b = one THEN a
 ELIF a = minus one THEN -b
 ELIF b = minus one THEN -a

END CO 

 ELSE
   DIGIT zero = ZERO LOC DIGIT;
   DIGIT one =  IDENTITY LOC DIGIT;
   [order + MSD a+MSD b: LSD a+LSD b]DIGIT a times b;

   FOR place FROM LSD a+LSD b BY order TO LSD a+MSD b DO
     a times b[place] := zero # pad the MSDs of the result wiht Zero #
   OD;
   FOR place a FROM LSD a BY order TO MSD a DO
     DIGIT digit a = a[place a];
     DIGIT carry := zero;
     FOR place b FROM LSD b BY order TO MSD b DO
       DIGIT digit b = b[place b];
       REF DIGIT digit ab = a times b[place a + place b];
       IF SIGN digit b /= 0 THEN # zero optimisation #
         IF carry OF arithmetic THEN # used for big number arithmetic #
           MOID(carry := ( digit ab +:= carry ));
           DIGIT prod := digit a;
           MOID(carry +:= ( prod *:= digit b ));
           MOID(carry +:= ( digit ab +:= prod ))
         ELSE # carry = 0 so we can just ignore the carry #
           DIGIT prod := digit a;
           MOID(prod *:= digit b);
           MOID(digit ab +:= prod)
         FI
       FI
     OD;
     a times b[place a + MSD b + order] := carry
   OD;
   INITDIGITS a times b # normalise #
 FI

);</lang>File: Template.Balanced_ternary_float.Base.a68<lang algol68>PR READ "Template.Big_float_BCD.Base.a68" PR # rc:Generalised floating point addition #

  2. First: define the attributes of the arithmetic we are using. #

CO STRUCT ( 

 BOOL balanced,
      carry, # aka "carry" between digits #
 INT base,
     digit width,
     digit places,
     digit order,
 USTRING repr

) CO arithmetic := ( 

 # balanced = # TRUE, 
 # carry = # TRUE, 
 # base = # 3, # width = # 1, # places = # 81, # order = # -1, 
 # repr = # USTRING("-","0","+")[@-1]

);

OP INITDIGIT = (CHAR c)DIGIT: ( 

 DIGIT out;
 digit OF out :=
   IF   c = "+" THEN +1
   ELIF c = "0" THEN  0
   ELIF c = "-" THEN -1
   ELSE raise value error("Unknown digit :"""+c+""""); SKIP
   FI;
 out

);

OP INITBIGREAL = (STRING s)BIGREAL: ( 

 BIGREAL out;
 BIGREAL base of arithmetic = INITBIGREAL base OF arithmetic; # Todo: Opt #
 INT point := UPB s-1; # put the point on the extreme right #
 FOR i FROM LWB s TO UPB s DO
   IF s[i]="." THEN
     point := i
   ELSE
     out := out SHR digit order OF arithmetic + INITDIGIT s[i]
   FI
 OD;
 out SHR (UPB s-point)

);</lang>File: test.Balanced_ternary_float.Multiplication.a68<lang algol68>#!/usr/local/bin/a68g --script #

  2. A program to test abritary length floating point multiplication. #

PR READ "prelude/general.a68" PR # rc:Template:ALGOL 68/prelude #

PR READ "Template.Big_float.Multiplication.a68" PR

  1. INT digit width := 1; ## define how digits each "big" DIGIT is #
  1. include the basic axioms of the digits being used #

PR READ "Template.Balanced_ternary_float.Base.a68" PR PR READ "Template.Big_float.Addition.a68" PR # rc:Generalised floating point addition # PR READ "Template.Big_float.Subtraction.a68" PR # rc:Generalised floating point addition #

test1:( # Basic arithmetic # 

 INT rw = long real width;
 BIGREAL a = INITBIGREAL "+-0++0+.+-0++0+", # 523.239... #
         b = INITBIGREAL - LONG 436.436,
         c = INITBIGREAL "+-++-.+-++-"; # 65.267... #
 printf(($g 9k g(rw,rw-5)39kgl$,
   "a =",INITLONGREAL a, REPR a,
   "b =",INITLONGREAL b, REPR b,
   "c =",INITLONGREAL c, REPR c,
   "a*(b-c)",INITREAL(a*(b-c)), REPR(a*(b-c)),
 $l$))

);

test2:( # A floating point Ternary multiplication table # 

 FORMAT s = $"|"$; # field seperator #

 INT lwb = 1, tab = 8, upb = 12;

 printf($"# "f(s)" *   "f(s)$);
 FOR j FROM lwb TO upb DO
   FORMAT col = $n(tab)k f(s)$;
   printf(($g" #"g(0)f(col)$, REPR INITBIGREAL j,j))
 OD;
 printf($l$);
 FOR i FROM lwb TO 27 DO
   printf(($g(0) 3k f(s) g 9k f(s)$,i,REPR INITBIGREAL i));
   FOR j FROM lwb TO i MIN upb DO
     FORMAT col = $n(tab)k f(s)$;
     BIGREAL product = INITBIGREAL i * INITBIGREAL j;
     printf(($gf(col)$, REPR product))
   OD;
   IF upb > i THEN printf($n(upb-i)(n(tab-1)x f(s))$) FI;
   printf($l$)
 OD

)</lang>Output: 

a =     +523.23914037494284407864655  +-0++0+.+-0++0+
b =     -436.43600000000000000000000  --++-0--.--0+-00+++-0-+---0-+0++++0--0000+00-+-+--+0-0-00--++0-+00---+0+-+++0+-0----0++
c =      +65.26748971193415637860082  +-++-.+-++-
a*(b-c) -385143.87484393900000000000  --+-+++0-00++-.0+0+0++-0++00+--00+--0-00++-++-00+-+--000---+--0----000+++-0++0-++00-++0+00-00-00++++

# | *   |+ #1   |+- #2  |+0 #3  |++ #4  |+-- #5 |+-0 #6 |+-+ #7 |+0- #8 |+e+- #9|+0+ #10|++- #11|++0 #12|
1 |+    |+      |       |       |       |       |       |       |       |       |       |       |       |
2 |+-   |+-     |++     |       |       |       |       |       |       |       |       |       |       |
3 |+0   |+0     |+-0    |+e+-   |       |       |       |       |       |       |       |       |       |
4 |++   |++     |+0-    |++0    |+--+   |       |       |       |       |       |       |       |       |
5 |+--  |+--    |+0+    |+--0   |+-+-   |+0-+   |       |       |       |       |       |       |       |
6 |+-0  |+-0    |++0    |+-e+-  |+0-0   |+0+0   |++e+-  |       |       |       |       |       |       |
7 |+-+  |+-+    |+---   |+-+0   |+00+   |++0-   |+---0  |+--++  |       |       |       |       |       |
8 |+0-  |+0-    |+--+   |+0-0   |++--   |++++   |+--+0  |+-0+-  |+0+    |       |       |       |       |
9 |+e+- |+e+-   |+-e+-  |+e+0   |++e+-  |+--e+- |+-e+0  |+-+e+- |+0-e+- |+e++   |       |       |       |
10|+0+  |+0+    |+-+-   |+0+0   |++++   |+-0--  |+-+-0  |+0--+  |+000-  |+0+e+- |+-0-0+ |       |       |
11|++-  |++-    |+-++   |++-0   |+--0-  |+-00+  |+-++0  |+00--  |++-+   |++-e+- |++0+-  |+++++  |       |
12|++0  |++0    |+0-0   |++e+-  |+--+0  |+-+-0  |+0-e+- |+00+0  |++--0  |++e+0  |++++0  |+--0-0 |+--+e+-|
13|+++  |+++    |+00-   |+++0   |+-0-+  |+-++-  |+00-0  |+0+0+  |++0--  |+++e+- |+-+-++ |+--+0- |+-0-+0 |
14|+--- |+---   |+00+   |+---0  |+-0+-  |+0--+  |+00+0  |++-0-  |--+0++ |+---e+-|+0+--  |+-0-0+ |+-0+-0 |
15|+--0 |+--0   |+0+0   |+--e+- |+-+-0  |+0-+0  |+0+e+- |++0-0  |--+++0 |+--e+0 |+-0--0 |+-00+0 |+-+-e+-|
16|+--+ |+--+   |++--   |+--+0  |+-+0+  |+000-  |++--0  |++0++  |+-+-   |+--+e+-|+-00-+ |+-+--- |+-+0+0 |
17|+-0- |+-0-   |++-+   |+-0-0  |+0---  |+00++  |++-+0  |++++-  |+--00+ |+-0-e+-|+++0-  |+-+0-+ |+0---0 |
18|+-e+-|+-e+-  |++e+-  |+-e+0  |+0-e+- |+0+e+- |++e+0  |+---e+-|+--+e+-|+-e++  |+-+-e+-|+-++e+-|+0-e+0 |
19|+-0+ |+-0+   |+++-   |+-0+0  |+0-++  |++---  |+++-0  |+--0-+ |+0--0- |+-0+e+-|+-+00+ |+0--+- |+0-++0 |
20|+-+- |+-+-   |++++   |+-+-0  |+000-  |++-0+  |++++0  |+--+-- |+-00-+ |+-+-e+-|++-++- |+0-0++ |+000-0 |
21|+-+0 |+-+0   |+---0  |+-+e+- |+00+0  |++0-0  |+---e+-|+--++0 |+-0+-0 |+-+e+0 |+----+0|+00--0 |+00+e+-|
22|+-++ |+-++   |+--0-  |+-++0  |+0+-+  |++0+-  |+--0-0 |+-0-0+ |+00--- |+-++e+-|+---0++|+0000- |+0+-+0 |
23|+0-- |+0--   |+--0+  |+0--0  |+0++-  |+++-+  |+--0+0 |+-000- |+-++   |+0--e+-|+00--- |+00+0+ |+0++-0 |
24|+0-0 |+0-0   |+--+0  |+0-e+- |++--0  |++++0  |+--+e+-|+-0+-0 |+0+0   |+0-e+0 |+000-0 |+0+-+0 |++--e+-|
25|+0-+ |+0-+   |+-0--  |+0-+0  |++-0+  |+---0- |+-0--0 |+-0+++ |+++-   |+0-+e+-|+00+-+ |+0++-- |++-0+0 |
26|+00- |+00-   |+-0-+  |+00-0  |++0--  |+---++ |+-0-+0 |+-+-+- |+0--0+ |+00-e+-|+0+-0- |++---+ |++0--0 |
27|+e+0 |+e+0   |+-e+0  |+e++   |++e+0  |+--e+0 |+-e++  |+-+e+0 |+0-e+0 |+e+--  |+0+e+0 |++-e+0 |++e++  |
Retrieved from "https://rosettacode.org/wiki/Generalised_floating_point_multiplication?oldid=204332"