During February 2002, [Gerald Lester] posted version 0.1 of the following code, 
designed to be a script level package for performing precise math
against decimal numbers.

For more precision from a C based extension, check out [mpexpr].

A similar Tcl-based implementation is at [Arbitrary precision math procedures].

----


   package provide packedDecimal 0.1
   
   namespace eval packedDecimal {
       namespace export add subtract multiply divide setDecimals
   
       variable decimals 2
       variable formatString {%d.%2.2d}
       variable carry 100
   }
   
   proc packedDecimal::add {a b} {
       variable decimals
       variable formatString
   
       scan $a %d.%d a1 a2
       scan $b %d.%d b1 b2
       incr a2 $b2
       if {[string length $a2] > $decimals} then {
           incr a1 1
           set a2 [string range $a2 1 end]
       }
       incr a1 $b1
       return [format $formatString $a1 $a2]
   }
   
   proc packedDecimal::subtract {a b} {
       variable decimals
       variable formatString
       variable carry
   
       scan $a %d.%d a1 a2
       scan $b %d.%d b1 b2
       incr a2 -$b2
       if {$a2 < 0} then {
           incr b1 1
           set a2 [expr {$carry + $a2}]
       }
       incr a1 -$b1
       return [format $formatString $a1 $a2]
   }
   
   # This is not really right yet!
   proc packedDecimal::roundingRule {a b} {
       variable carry
   
       while {$b >= $carry/2} {
           incr a 1
           incr b -$carry
       }
       return [list $a $b]
   }
   
   # Does not handle negative values - DKF
   proc packedDecimal::multiply {a b} {
       variable decimals
       variable formatString
       variable carry
   
       scan $a %u.%u a1 a2
       scan $b %u.%u b1 b2
   
       set c1 [expr {$a1*$b1}]
       set c2 [expr {$a1*$b2 + $b1*$a2}]
       set c3 [expr {$a2*$b2}]
       foreach {c2 c3} [roundingRule $c2 $c3] {break}
       foreach {c1 c2} [roundingRule $c1 $c2] {break}
       if {$c2 < 0} {
           incr c1 -1
           incr c2 $carry
       }
       return [format $formatString $c1 $c2]
   }
   
   proc packedDecimal::divide {a b} {
       variable decimals
       variable formatString
   
       return -code error {Sorry, Divide is not yet implemented!}
   }
   
   proc packedDecimal::setDecimals {a} {
       variable decimals
       variable formatString
       variable carry 100
   
       set formatString [format {%%d.%%%d.%dd} $a $a]
       set decimals $a
       set carry [format "1%${a}.${a}d" 0]
       return;
   }
   
   proc packedDecimal::getDecimals {} {
       variable decimals
   
       return $decimals
   }

----
[AM] A FAQ that deals with decimal arithmetic can be found at [http://speleotrove.com/decimal/decifaq.html]. There is also a formal specification available 
(and an implementation in C, with a "renewable" licence) [http://speleotrove.com/decimal/].
----
[beernutmark] I have worked up a [Decimal Arithmetic Package for tcl 8.5]
----
[Sarnold] I have been doing some [Decimal arithmetic] with bignums.
----
[Gerald Lester]

<<categories>> Package | Mathematics