Exactly Printing Double Trouble

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
9 messages Options
Reply | Threaded
Open this post in threaded view
|

Exactly Printing Double Trouble

Stew MacLean

Hi,

 

I’m attempting to implement the Squeak version of exactly printing Doubles, please see below.

I’m reconciling an upgrade of an accounting system that uses Floats for monetary values (don’t ask!), and when I print mismatches they appear the same. (I’m using an epsilon factor to cater for the innate inaccuracy of Floats).

 

The trouble is that it calls a method that attempts to access the bytes, which returns an error.

 

The offending method is

 

LimitedPrecisionReal >>significandAsInteger

 

            | exp sig |

            exp := self exponent.

            sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self at: 2).

            exp > -1023

                        ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].

            ^ sig.

 

It fails on “at:” has been overridden:

 

LimitedPrecisionReal >>at: index

            "Override implementation in Object since general instances

             of LimitedPrecisionReal are not element indexable."

 

        ^self shouldNotImplement

 

 

I’m out of my depth here, and would appreciate some help.

 

Thanks,

 

Stewart

 

 

 

 

 

absPrintExactlyOn: aStream base: base

            "Print my value on a stream in the given base.  Assumes that my value

is strictly

            positive; negative numbers, zero, and NaNs have already been handled

elsewhere.

            Based upon the algorithm outlined in:

            Robert G. Burger and R. Kent Dybvig

            Printing Floating Point Numbers Quickly and Accurately

            ACM SIGPLAN 1996 Conference on Programming Language Design and

Implementation

            June 1996.

            This version guarantees that the printed representation exactly

represents my value

            by using exact integer arithmetic."

 

            | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale

roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit

shead MinValLogBase2 |

            MinValLogBase2 := -1074.

            self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].

            fBase := base asFloat.

            significand := self significandAsInteger.

            roundingIncludesLimits := significand even.

            exp := (self exponent - 52) max: MinValLogBase2.

            baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -

1.0e-10) ceiling.

            exp >= 0

                        ifTrue:

                                    [be := 1 << exp.

                                    significand ~= 16r10000000000000

                                                ifTrue:

                                                            [r := significand * be * 2.

                                                            s := 2.

                                                            mPlus := be.

                                                            mMinus := be]

                                                ifFalse:

                                                            [be1 := be * 2.

                                                            r := significand * be1 * 2.

                                                            s := 4.

                                                            mPlus := be1.

                                                            mMinus := be]]

                        ifFalse:

                                    [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])

                                                ifTrue:

                                                            [r := significand * 2.

                                                            s := (1 << (exp negated)) * 2.

                                                            mPlus := 1.

                                                            mMinus := 1]

                                                ifFalse:

                                                            [r := significand * 4.

                                                            s := (1 << (exp negated + 1)) * 2.

                                                            mPlus := 2.

                                                            mMinus := 1]].

            baseExpEstimate >= 0

                        ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]

                        ifFalse:

                                    [scale := base raisedToInteger: baseExpEstimate negated.

                                    r := r * scale.

                                    mPlus := mPlus * scale.

                                    mMinus := mMinus * scale].

            ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >

s]])

                        ifTrue: [baseExpEstimate := baseExpEstimate + 1]

                        ifFalse:

                                    [r := r * base.

                                    mPlus := mPlus * base.

                                    mMinus := mMinus * base].

            (fixedFormat := baseExpEstimate between: -3 and: 6)

                        ifTrue:

                                    [decPointCount := baseExpEstimate.

                                    baseExpEstimate <= 0

                                                ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -

baseExpEstimate)]]

                        ifFalse:

                                    [decPointCount := 1].

            slowbit := s lowBit - 1.

            shead := s >> slowbit.

            [d := (r >> slowbit) // shead.

            r := r - (d*s).

            (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <

mMinus]]) |

            (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +

mPlus > s]])] whileFalse:

                        [aStream nextPut: (Character digitValue: d).

                        r := r * base.

                        mPlus := mPlus * base.

                        mMinus := mMinus * base.

                        decPointCount := decPointCount - 1.

                        decPointCount = 0 ifTrue: [aStream nextPut: $.]].

            tc2 ifTrue:

                        [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].

            aStream nextPut: (Character digitValue: d).

            decPointCount > 0

                        ifTrue:

                        [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].

                        aStream nextPutAll: '.0'].

            fixedFormat ifFalse:

                        [aStream nextPut: $e.

                        aStream nextPutAll: (baseExpEstimate - 1) printString]


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Stew MacLean

I forgot to add that I have tried implementing at: in Double (copied from Object).

 

It prints, but the number is very different from the standard print.

 

Eg

 

2.4008776180001d8 - standard

1.342330880000046e8 - exact

 

-----Original Message-----
From: [hidden email] [mailto:[hidden email]] On Behalf Of Stewart MacLean
Sent:
29 September 2013 12:48 p.m.
To: [hidden email]
Subject: [vwnc] Exactly Printing Double Trouble

 

Hi,

 

I’m attempting to implement the Squeak version of exactly printing Doubles, please see below.

I’m reconciling an upgrade of an accounting system that uses Floats for monetary values (don’t ask!), and when I print mismatches they appear the same. (I’m using an epsilon factor to cater for the innate inaccuracy of Floats).

 

The trouble is that it calls a method that attempts to access the bytes, which returns an error.

 

The offending method is

 

LimitedPrecisionReal >>significandAsInteger

 

          | exp sig |

          exp := self exponent.

          sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self at: 2).

          exp > -1023

                      ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].

          ^ sig.

 

It fails on “at:” has been overridden:

 

LimitedPrecisionReal >>at: index

          "Override implementation in Object since general instances

           of LimitedPrecisionReal are not element indexable."

 

        ^self shouldNotImplement

 

 

I’m out of my depth here, and would appreciate some help.

 

Thanks,

 

Stewart

 

 

 

 

 

absPrintExactlyOn: aStream base: base

          "Print my value on a stream in the given base.  Assumes that my value

is strictly

          positive; negative numbers, zero, and NaNs have already been handled

elsewhere.

          Based upon the algorithm outlined in:

          Robert G. Burger and R. Kent Dybvig

          Printing Floating Point Numbers Quickly and Accurately

          ACM SIGPLAN 1996 Conference on Programming Language Design and

Implementation

          June 1996.

          This version guarantees that the printed representation exactly

represents my value

          by using exact integer arithmetic."

 

          | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale

roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit

shead MinValLogBase2 |

          MinValLogBase2 := -1074.

          self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].

          fBase := base asFloat.

          significand := self significandAsInteger.

          roundingIncludesLimits := significand even.

          exp := (self exponent - 52) max: MinValLogBase2.

          baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -

1.0e-10) ceiling.

          exp >= 0

                      ifTrue:

                                  [be := 1 << exp.

                                  significand ~= 16r10000000000000

                                              ifTrue:

                                                          [r := significand * be * 2.

                                                          s := 2.

                                                          mPlus := be.

                                                          mMinus := be]

                                              ifFalse:

                                                          [be1 := be * 2.

                                                          r := significand * be1 * 2.

                                                          s := 4.

                                                          mPlus := be1.

                                                          mMinus := be]]

                      ifFalse:

                                  [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])

                                              ifTrue:

                                                          [r := significand * 2.

                                                          s := (1 << (exp negated)) * 2.

                                                          mPlus := 1.

                                                          mMinus := 1]

                                              ifFalse:

                                                          [r := significand * 4.

                                                          s := (1 << (exp negated + 1)) * 2.

                                                          mPlus := 2.

                                                          mMinus := 1]].

          baseExpEstimate >= 0

                      ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]

                      ifFalse:

                                  [scale := base raisedToInteger: baseExpEstimate negated.

                                  r := r * scale.

                                  mPlus := mPlus * scale.

                                  mMinus := mMinus * scale].

          ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >

s]])

                      ifTrue: [baseExpEstimate := baseExpEstimate + 1]

                      ifFalse:

                                  [r := r * base.

                                  mPlus := mPlus * base.

                                  mMinus := mMinus * base].

          (fixedFormat := baseExpEstimate between: -3 and: 6)

                      ifTrue:

                                  [decPointCount := baseExpEstimate.

                                  baseExpEstimate <= 0

                                              ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -

baseExpEstimate)]]

                      ifFalse:

                                  [decPointCount := 1].

          slowbit := s lowBit - 1.

          shead := s >> slowbit.

          [d := (r >> slowbit) // shead.

          r := r - (d*s).

          (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <

mMinus]]) |

          (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +

mPlus > s]])] whileFalse:

                      [aStream nextPut: (Character digitValue: d).

                      r := r * base.

                      mPlus := mPlus * base.

                      mMinus := mMinus * base.

                      decPointCount := decPointCount - 1.

                      decPointCount = 0 ifTrue: [aStream nextPut: $.]].

          tc2 ifTrue:

                      [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].

          aStream nextPut: (Character digitValue: d).

          decPointCount > 0

                      ifTrue:

                      [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].

                      aStream nextPutAll: '.0'].

          fixedFormat ifFalse:

                      [aStream nextPut: $e.

                      aStream nextPutAll: (baseExpEstimate - 1) printString]


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Andres Valloud-4
1.  LimitedPrecisionReals are an array of bytes, not an array of small
integers.

2.  You shouldn't rely on the order of said bytes, because they change
depending on whether the platform is little endian or big endian.

3.  Look at messages such as signedMantissa, exponent, etc.

On 9/28/13 17:05 , Stewart MacLean wrote:

> I forgot to add that I have tried implementing at: in Double (copied
> from Object).
>
> It prints, but the number is very different from the standard print.
>
> Eg
>
> 2.4008776180001d8 - standard
>
> 1.342330880000046e8 - exact
>
> -----Original Message-----
> *From:* [hidden email] [mailto:[hidden email]] *On
> Behalf Of *Stewart MacLean
> *Sent:* 29 September 201312:48 p.m.
> *To:* [hidden email]
> *Subject:* [vwnc] Exactly Printing Double Trouble
>
> Hi,
>
> I’m attempting to implement the Squeak version of exactly printing
> Doubles, please see below.
>
> I’m reconciling an upgrade of an accounting system that uses Floats for
> monetary values (don’t ask!), and when I print mismatches they appear
> the same. (I’m using an epsilon factor to cater for the innate
> inaccuracy of Floats).
>
> The trouble is that it calls a method that attempts to access the bytes,
> which returns an error.
>
> The offending method is
>
> LimitedPrecisionReal >>significandAsInteger
>
> | exp sig |
>
> exp := self exponent.
>
> sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self
> at: 2).
>
> exp > -1023
>
> ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].
>
> ^ sig.
>
> It fails on “at:” has been overridden:
>
> LimitedPrecisionReal >>at: index
>
> "Override implementation in Object since general instances
>
> of LimitedPrecisionReal are not element indexable."
>
> ^self shouldNotImplement
>
> I’m out of my depth here, and would appreciate some help.
>
> Thanks,
>
> Stewart
>
> absPrintExactlyOn: aStream base: base
>
> "Print my value on a stream in the given base.Assumes that my value
>
> is strictly
>
> positive; negative numbers, zero, and NaNs have already been handled
>
> elsewhere.
>
> Based upon the algorithm outlined in:
>
> Robert G. Burger and R. Kent Dybvig
>
> Printing Floating Point Numbers Quickly and Accurately
>
> ACM SIGPLAN 1996 Conference on Programming Language Design and
>
> Implementation
>
> June 1996.
>
> This version guarantees that the printed representation exactly
>
> represents my value
>
> by using exact integer arithmetic."
>
> | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale
>
> roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit
>
> shead MinValLogBase2 |
>
> MinValLogBase2 := -1074.
>
> self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
>
> fBase := base asFloat.
>
> significand := self significandAsInteger.
>
> roundingIncludesLimits := significand even.
>
> exp := (self exponent - 52) max: MinValLogBase2.
>
> baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -
>
> 1.0e-10) ceiling.
>
> exp >= 0
>
> ifTrue:
>
> [be := 1 << exp.
>
> significand ~= 16r10000000000000
>
> ifTrue:
>
> [r := significand * be * 2.
>
> s := 2.
>
> mPlus := be.
>
> mMinus := be]
>
> ifFalse:
>
> [be1 := be * 2.
>
> r := significand * be1 * 2.
>
> s := 4.
>
> mPlus := be1.
>
> mMinus := be]]
>
> ifFalse:
>
> [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
>
> ifTrue:
>
> [r := significand * 2.
>
> s := (1 << (exp negated)) * 2.
>
> mPlus := 1.
>
> mMinus := 1]
>
> ifFalse:
>
> [r := significand * 4.
>
> s := (1 << (exp negated + 1)) * 2.
>
> mPlus := 2.
>
> mMinus := 1]].
>
> baseExpEstimate >= 0
>
> ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
>
> ifFalse:
>
> [scale := base raisedToInteger: baseExpEstimate negated.
>
> r := r * scale.
>
> mPlus := mPlus * scale.
>
> mMinus := mMinus * scale].
>
> ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >
>
> s]])
>
> ifTrue: [baseExpEstimate := baseExpEstimate + 1]
>
> ifFalse:
>
> [r := r * base.
>
> mPlus := mPlus * base.
>
> mMinus := mMinus * base].
>
> (fixedFormat := baseExpEstimate between: -3 and: 6)
>
> ifTrue:
>
> [decPointCount := baseExpEstimate.
>
> baseExpEstimate <= 0
>
> ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -
>
> baseExpEstimate)]]
>
> ifFalse:
>
> [decPointCount := 1].
>
> slowbit := s lowBit - 1.
>
> shead := s >> slowbit.
>
> [d := (r >> slowbit) // shead.
>
> r := r - (d*s).
>
> (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <
>
> mMinus]]) |
>
> (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +
>
> mPlus > s]])] whileFalse:
>
> [aStream nextPut: (Character digitValue: d).
>
> r := r * base.
>
> mPlus := mPlus * base.
>
> mMinus := mMinus * base.
>
> decPointCount := decPointCount - 1.
>
> decPointCount = 0 ifTrue: [aStream nextPut: $.]].
>
> tc2 ifTrue:
>
> [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].
>
> aStream nextPut: (Character digitValue: d).
>
> decPointCount > 0
>
> ifTrue:
>
> [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
>
> aStream nextPutAll: '.0'].
>
> fixedFormat ifFalse:
>
> [aStream nextPut: $e.
>
> aStream nextPutAll: (baseExpEstimate - 1) printString]
>
_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

davidbuck
In reply to this post by Stew MacLean
When printing mismatches, try printing with a different number of digits.  The default for Double is 14. 
| stream |
stream :=  WriteStream on: String new.
3.1415926535897932384626d printOn: stream digits: 18.
stream contents   --> '3.14159265358979356d'
Compared to:
3.1415926535897932384626d printString --> '3.1415926535898d'

The last few digits may be meaningless but two doubles that aren't equal should at least print different values.

For your question, try basicAt: instead of at:.

David Buck
Simberon Incorporated

On 2013-09-28 8:05 PM, Stewart MacLean wrote:

I forgot to add that I have tried implementing at: in Double (copied from Object).

 

It prints, but the number is very different from the standard print.

 

Eg

 

2.4008776180001d8 - standard

1.342330880000046e8 - exact

 

-----Original Message-----
From: [hidden email] [[hidden email]] On Behalf Of Stewart MacLean
Sent:
29 September 2013 12:48 p.m.
To: [hidden email]
Subject: [vwnc] Exactly Printing Double Trouble

 

Hi,

 

I’m attempting to implement the Squeak version of exactly printing Doubles, please see below.

I’m reconciling an upgrade of an accounting system that uses Floats for monetary values (don’t ask!), and when I print mismatches they appear the same. (I’m using an epsilon factor to cater for the innate inaccuracy of Floats).

 

The trouble is that it calls a method that attempts to access the bytes, which returns an error.

 

The offending method is

 

LimitedPrecisionReal >>significandAsInteger

 

          | exp sig |

          exp := self exponent.

          sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self at: 2).

          exp > -1023

                      ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].

          ^ sig.

 

It fails on “at:” has been overridden:

 

LimitedPrecisionReal >>at: index

          "Override implementation in Object since general instances

           of LimitedPrecisionReal are not element indexable."

 

        ^self shouldNotImplement

 

 

I’m out of my depth here, and would appreciate some help.

 

Thanks,

 

Stewart

 

 

 

 

 

absPrintExactlyOn: aStream base: base

          "Print my value on a stream in the given base.  Assumes that my value

is strictly

          positive; negative numbers, zero, and NaNs have already been handled

elsewhere.

          Based upon the algorithm outlined in:

          Robert G. Burger and R. Kent Dybvig

          Printing Floating Point Numbers Quickly and Accurately

          ACM SIGPLAN 1996 Conference on Programming Language Design and

Implementation

          June 1996.

          This version guarantees that the printed representation exactly

represents my value

          by using exact integer arithmetic."

 

          | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale

roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit

shead MinValLogBase2 |

          MinValLogBase2 := -1074.

          self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].

          fBase := base asFloat.

          significand := self significandAsInteger.

          roundingIncludesLimits := significand even.

          exp := (self exponent - 52) max: MinValLogBase2.

          baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -

1.0e-10) ceiling.

          exp >= 0

                      ifTrue:

                                  [be := 1 << exp.

                                  significand ~= 16r10000000000000

                                              ifTrue:

                                                          [r := significand * be * 2.

                                                          s := 2.

                                                          mPlus := be.

                                                          mMinus := be]

                                              ifFalse:

                                                          [be1 := be * 2.

                                                          r := significand * be1 * 2.

                                                          s := 4.

                                                          mPlus := be1.

                                                          mMinus := be]]

                      ifFalse:

                                  [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])

                                              ifTrue:

                                                          [r := significand * 2.

                                                          s := (1 << (exp negated)) * 2.

                                                          mPlus := 1.

                                                          mMinus := 1]

                                              ifFalse:

                                                          [r := significand * 4.

                                                          s := (1 << (exp negated + 1)) * 2.

                                                          mPlus := 2.

                                                          mMinus := 1]].

          baseExpEstimate >= 0

                      ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]

                      ifFalse:

                                  [scale := base raisedToInteger: baseExpEstimate negated.

                                  r := r * scale.

                                  mPlus := mPlus * scale.

                                  mMinus := mMinus * scale].

          ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >

s]])

                      ifTrue: [baseExpEstimate := baseExpEstimate + 1]

                      ifFalse:

                                  [r := r * base.

                                  mPlus := mPlus * base.

                                  mMinus := mMinus * base].

          (fixedFormat := baseExpEstimate between: -3 and: 6)

                      ifTrue:

                                  [decPointCount := baseExpEstimate.

                                  baseExpEstimate <= 0

                                              ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -

baseExpEstimate)]]

                      ifFalse:

                                  [decPointCount := 1].

          slowbit := s lowBit - 1.

          shead := s >> slowbit.

          [d := (r >> slowbit) // shead.

          r := r - (d*s).

          (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <

mMinus]]) |

          (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +

mPlus > s]])] whileFalse:

                      [aStream nextPut: (Character digitValue: d).

                      r := r * base.

                      mPlus := mPlus * base.

                      mMinus := mMinus * base.

                      decPointCount := decPointCount - 1.

                      decPointCount = 0 ifTrue: [aStream nextPut: $.]].

          tc2 ifTrue:

                      [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].

          aStream nextPut: (Character digitValue: d).

          decPointCount > 0

                      ifTrue:

                      [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].

                      aStream nextPutAll: '.0'].

          fixedFormat ifFalse:

                      [aStream nextPut: $e.

                      aStream nextPutAll: (baseExpEstimate - 1) printString]



_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Niall Ross
In reply to this post by Stew MacLean
Dear Stewart,
    not sure exactly what your aim is here.  Using Floats for money, you
have from 6 to 8 digits of accuracy, so a large money amount could be
imprecise in its lowest units whereas a small one could have meaningless
trailing 3rd and subsequent digits after the decimal point.  If you are
writing to and reading from a database, the same float can cease to be
equal to itself in all but the first 6 digits.  Doubles give you maybe
14 digits of accuracy but have the same issues otherwise.

I would therefore round the reals to FixedPoints as soon as possible.  
If you are on VisualWorks 7.10, the implementation of
#asFixedPointOfPrecision: may help you (see the ReleaseNotes7.10.pdf
description of that method).  If you're on an older version of
VisualWorks and cannot upgrade in a convenient timescale, by all means
email me - or your support contact - your version number and I'll check
the implementations of that method backport and supply them to you.

                      HTH
                         Niall Ross

>Hi,
>
>I'm attempting to implement the Squeak version of exactly printing
>Doubles, please see below.
>I'm reconciling an upgrade of an accounting system that uses Floats for
>monetary values (don't ask!), and when I print mismatches they appear
>the same. (I'm using an epsilon factor to cater for the innate
>inaccuracy of Floats).
>
>The trouble is that it calls a method that attempts to access the bytes,
>which returns an error.
>
>The offending method is
>
>LimitedPrecisionReal >>significandAsInteger
>
>            | exp sig |
>            exp := self exponent.
>            sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32)
>bitOr: (self at: 2).
>            exp > -1023
>                        ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].
>            ^ sig.
>
>It fails on "at:" has been overridden:
>
>LimitedPrecisionReal >>at: index
>            "Override implementation in Object since general instances
>             of LimitedPrecisionReal are not element indexable."
>
>        ^self shouldNotImplement
>
>
>I'm out of my depth here, and would appreciate some help.
>
>Thanks,
>
>Stewart
>
>
>
>
>
>absPrintExactlyOn: aStream base: base
>            "Print my value on a stream in the given base.  Assumes that
>my value
>is strictly
>            positive; negative numbers, zero, and NaNs have already been
>handled
>elsewhere.
>            Based upon the algorithm outlined in:
>            Robert G. Burger and R. Kent Dybvig
>            Printing Floating Point Numbers Quickly and Accurately
>            ACM SIGPLAN 1996 Conference on Programming Language Design
>and
>Implementation
>            June 1996.
>            This version guarantees that the printed representation
>exactly
>represents my value
>            by using exact integer arithmetic."
>
>            | fBase significand exp baseExpEstimate be be1 r s mPlus
>mMinus scale
>roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit
>shead MinValLogBase2 |
>            MinValLogBase2 := -1074.
>            self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^
>self].
>            fBase := base asFloat.
>            significand := self significandAsInteger.
>            roundingIncludesLimits := significand even.
>            exp := (self exponent - 52) max: MinValLogBase2.
>            baseExpEstimate := (self exponent * fBase reciprocalLogBase2
>-
>1.0e-10) ceiling.
>            exp >= 0
>                        ifTrue:
>                                    [be := 1 << exp.
>                                    significand ~= 16r10000000000000
>                                                ifTrue:
>                                                            [r :=
>significand * be * 2.
>                                                            s := 2.
>                                                            mPlus := be.
>                                                            mMinus :=
>be]
>                                                ifFalse:
>                                                            [be1 := be *
>2.
>                                                            r :=
>significand * be1 * 2.
>                                                            s := 4.
>                                                            mPlus :=
>be1.
>                                                            mMinus :=
>be]]
>                        ifFalse:
>                                    [(exp = MinValLogBase2 or:
>[significand ~= 16r10000000000000])
>                                                ifTrue:
>                                                            [r :=
>significand * 2.
>                                                            s := (1 <<
>(exp negated)) * 2.
>                                                            mPlus := 1.
>                                                            mMinus := 1]
>                                                ifFalse:
>                                                            [r :=
>significand * 4.
>                                                            s := (1 <<
>(exp negated + 1)) * 2.
>                                                            mPlus := 2.
>                                                            mMinus :=
>1]].
>            baseExpEstimate >= 0
>                        ifTrue: [s := s * (base raisedToInteger:
>baseExpEstimate)]
>                        ifFalse:
>                                    [scale := base raisedToInteger:
>baseExpEstimate negated.
>                                    r := r * scale.
>                                    mPlus := mPlus * scale.
>                                    mMinus := mMinus * scale].
>            ((r + mPlus < s) not and: [roundingIncludesLimits or: [r +
>mPlus >
>s]])
>                        ifTrue: [baseExpEstimate := baseExpEstimate + 1]
>                        ifFalse:
>                                    [r := r * base.
>                                    mPlus := mPlus * base.
>                                    mMinus := mMinus * base].
>            (fixedFormat := baseExpEstimate between: -3 and: 6)
>                        ifTrue:
>                                    [decPointCount := baseExpEstimate.
>                                    baseExpEstimate <= 0
>                                                ifTrue: [aStream
>nextPutAll: ('0.000000' truncateTo: 2 -
>baseExpEstimate)]]
>                        ifFalse:
>                                    [decPointCount := 1].
>            slowbit := s lowBit - 1.
>            shead := s >> slowbit.
>            [d := (r >> slowbit) // shead.
>            r := r - (d*s).
>            (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r
><
>mMinus]]) |
>            (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or:
>[r +
>mPlus > s]])] whileFalse:
>                        [aStream nextPut: (Character digitValue: d).
>                        r := r * base.
>                        mPlus := mPlus * base.
>                        mMinus := mMinus * base.
>                        decPointCount := decPointCount - 1.
>                        decPointCount = 0 ifTrue: [aStream nextPut:
>$.]].
>            tc2 ifTrue:
>                        [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].
>            aStream nextPut: (Character digitValue: d).
>            decPointCount > 0
>                        ifTrue:
>                        [decPointCount - 1 to: 1 by: -1 do: [:i |
>aStream nextPut: $0].
>                        aStream nextPutAll: '.0'].
>            fixedFormat ifFalse:
>                        [aStream nextPut: $e.
>                        aStream nextPutAll: (baseExpEstimate - 1)
>printString]
>
>  
>
>------------------------------------------------------------------------
>
>_______________________________________________
>vwnc mailing list
>[hidden email]
>http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
>  
>


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Stew MacLean
In reply to this post by Andres Valloud-4
Hi Andres,

Thanks for the heads up re platform dependent format.

Cheers,

Stewart

>-----Original Message-----
>From: Andres Valloud [mailto:[hidden email]]
>Sent: 29 September 2013 1:38 p.m.
>To: [hidden email]; [hidden email]
>Subject: Re: [vwnc] Exactly Printing Double Trouble
>
>1.  LimitedPrecisionReals are an array of bytes, not an array of small
>integers.
>
>2.  You shouldn't rely on the order of said bytes, because they change
>depending on whether the platform is little endian or big endian.
>
>3.  Look at messages such as signedMantissa, exponent, etc.
>
>On 9/28/13 17:05 , Stewart MacLean wrote:
>> I forgot to add that I have tried implementing at: in Double (copied
>> from Object).
>>
>> It prints, but the number is very different from the standard print.
>>
>> Eg
>>
>> 2.4008776180001d8 - standard
>>
>> 1.342330880000046e8 - exact
>>
>> -----Original Message-----
>> *From:* [hidden email] [mailto:[hidden email]]
*On

>> Behalf Of *Stewart MacLean
>> *Sent:* 29 September 201312:48 p.m.
>> *To:* [hidden email]
>> *Subject:* [vwnc] Exactly Printing Double Trouble
>>
>> Hi,
>>
>> I'm attempting to implement the Squeak version of exactly printing
>> Doubles, please see below.
>>
>> I'm reconciling an upgrade of an accounting system that uses Floats
for
>> monetary values (don't ask!), and when I print mismatches they appear
>> the same. (I'm using an epsilon factor to cater for the innate
>> inaccuracy of Floats).
>>
>> The trouble is that it calls a method that attempts to access the
bytes,

>> which returns an error.
>>
>> The offending method is
>>
>> LimitedPrecisionReal >>significandAsInteger
>>
>> | exp sig |
>>
>> exp := self exponent.
>>
>> sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self
>> at: 2).
>>
>> exp > -1023
>>
>> ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].
>>
>> ^ sig.
>>
>> It fails on "at:" has been overridden:
>>
>> LimitedPrecisionReal >>at: index
>>
>> "Override implementation in Object since general instances
>>
>> of LimitedPrecisionReal are not element indexable."
>>
>> ^self shouldNotImplement
>>
>> I'm out of my depth here, and would appreciate some help.
>>
>> Thanks,
>>
>> Stewart
>>
>> absPrintExactlyOn: aStream base: base
>>
>> "Print my value on a stream in the given base.Assumes that my value
>>
>> is strictly
>>
>> positive; negative numbers, zero, and NaNs have already been handled
>>
>> elsewhere.
>>
>> Based upon the algorithm outlined in:
>>
>> Robert G. Burger and R. Kent Dybvig
>>
>> Printing Floating Point Numbers Quickly and Accurately
>>
>> ACM SIGPLAN 1996 Conference on Programming Language Design and
>>
>> Implementation
>>
>> June 1996.
>>
>> This version guarantees that the printed representation exactly
>>
>> represents my value
>>
>> by using exact integer arithmetic."
>>
>> | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale
>>
>> roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit
>>
>> shead MinValLogBase2 |
>>
>> MinValLogBase2 := -1074.
>>
>> self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
>>
>> fBase := base asFloat.
>>
>> significand := self significandAsInteger.
>>
>> roundingIncludesLimits := significand even.
>>
>> exp := (self exponent - 52) max: MinValLogBase2.
>>
>> baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -
>>
>> 1.0e-10) ceiling.
>>
>> exp >= 0
>>
>> ifTrue:
>>
>> [be := 1 << exp.
>>
>> significand ~= 16r10000000000000
>>
>> ifTrue:
>>
>> [r := significand * be * 2.
>>
>> s := 2.
>>
>> mPlus := be.
>>
>> mMinus := be]
>>
>> ifFalse:
>>
>> [be1 := be * 2.
>>
>> r := significand * be1 * 2.
>>
>> s := 4.
>>
>> mPlus := be1.
>>
>> mMinus := be]]
>>
>> ifFalse:
>>
>> [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
>>
>> ifTrue:
>>
>> [r := significand * 2.
>>
>> s := (1 << (exp negated)) * 2.
>>
>> mPlus := 1.
>>
>> mMinus := 1]
>>
>> ifFalse:
>>
>> [r := significand * 4.
>>
>> s := (1 << (exp negated + 1)) * 2.
>>
>> mPlus := 2.
>>
>> mMinus := 1]].
>>
>> baseExpEstimate >= 0
>>
>> ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
>>
>> ifFalse:
>>
>> [scale := base raisedToInteger: baseExpEstimate negated.
>>
>> r := r * scale.
>>
>> mPlus := mPlus * scale.
>>
>> mMinus := mMinus * scale].
>>
>> ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >
>>
>> s]])
>>
>> ifTrue: [baseExpEstimate := baseExpEstimate + 1]
>>
>> ifFalse:
>>
>> [r := r * base.
>>
>> mPlus := mPlus * base.
>>
>> mMinus := mMinus * base].
>>
>> (fixedFormat := baseExpEstimate between: -3 and: 6)
>>
>> ifTrue:
>>
>> [decPointCount := baseExpEstimate.
>>
>> baseExpEstimate <= 0
>>
>> ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -
>>
>> baseExpEstimate)]]
>>
>> ifFalse:
>>
>> [decPointCount := 1].
>>
>> slowbit := s lowBit - 1.
>>
>> shead := s >> slowbit.
>>
>> [d := (r >> slowbit) // shead.
>>
>> r := r - (d*s).
>>
>> (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <
>>
>> mMinus]]) |
>>
>> (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +
>>
>> mPlus > s]])] whileFalse:
>>
>> [aStream nextPut: (Character digitValue: d).
>>
>> r := r * base.
>>
>> mPlus := mPlus * base.
>>
>> mMinus := mMinus * base.
>>
>> decPointCount := decPointCount - 1.
>>
>> decPointCount = 0 ifTrue: [aStream nextPut: $.]].
>>
>> tc2 ifTrue:
>>
>> [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].
>>
>> aStream nextPut: (Character digitValue: d).
>>
>> decPointCount > 0
>>
>> ifTrue:
>>
>> [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
>>
>> aStream nextPutAll: '.0'].
>>
>> fixedFormat ifFalse:
>>
>> [aStream nextPut: $e.
>>
>> aStream nextPutAll: (baseExpEstimate - 1) printString]
>>

_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Stew MacLean
In reply to this post by davidbuck

Hi David,

 

I tried your suggestion, and indeed they show as different, which is essentially what I’m after.

 

Thanks,

 

Stewart

 

-----Original Message-----
From: [hidden email] [mailto:[hidden email]] On Behalf Of David Buck
Sent: 29 September 2013 1:41 p.m.
To: [hidden email]
Subject: Re: [vwnc] Exactly Printing Double Trouble

 

When printing mismatches, try printing with a different number of digits.  The default for Double is 14. 

| stream |
stream :=  WriteStream on: String new.
3.1415926535897932384626d printOn: stream digits: 18.
stream contents   --> '3.14159265358979356d'

Compared to:

3.1415926535897932384626d printString --> '3.1415926535898d'

The last few digits may be meaningless but two doubles that aren't equal should at least print different values.

For your question, try basicAt: instead of at:.

David Buck
Simberon Incorporated

On 2013-09-28 8:05 PM, Stewart MacLean wrote:

I forgot to add that I have tried implementing at: in Double (copied from Object).

 

It prints, but the number is very different from the standard print.

 

Eg

 

2.4008776180001d8 - standard

1.342330880000046e8 - exact

 

-----Original Message-----
From: [hidden email] [[hidden email]] On Behalf Of Stewart MacLean
Sent: 29 September 2013 12:48 p.m.
To: [hidden email]
Subject: [vwnc] Exactly Printing Double Trouble

 

Hi,

 

I’m attempting to implement the Squeak version of exactly printing Doubles, please see below.

I’m reconciling an upgrade of an accounting system that uses Floats for monetary values (don’t ask!), and when I print mismatches they appear the same. (I’m using an epsilon factor to cater for the innate inaccuracy of Floats).

 

The trouble is that it calls a method that attempts to access the bytes, which returns an error.

 

The offending method is

 

LimitedPrecisionReal >>significandAsInteger

 

         | exp sig |

         exp := self exponent.

         sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self at: 2).

         exp > -1023

                     ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].

         ^ sig.

 

It fails on “at:” has been overridden:

 

LimitedPrecisionReal >>at: index

         "Override implementation in Object since general instances

          of LimitedPrecisionReal are not element indexable."

 

        ^self shouldNotImplement

 

 

I’m out of my depth here, and would appreciate some help.

 

Thanks,

 

Stewart

 

 

 

 

 

absPrintExactlyOn: aStream base: base

         "Print my value on a stream in the given base.  Assumes that my value

is strictly

         positive; negative numbers, zero, and NaNs have already been handled

elsewhere.

         Based upon the algorithm outlined in:

         Robert G. Burger and R. Kent Dybvig

         Printing Floating Point Numbers Quickly and Accurately

         ACM SIGPLAN 1996 Conference on Programming Language Design and

Implementation

         June 1996.

         This version guarantees that the printed representation exactly

represents my value

         by using exact integer arithmetic."

 

         | fBase significand exp baseExpEstimate be be1 r s mPlus mMinus scale

roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit

shead MinValLogBase2 |

         MinValLogBase2 := -1074.

         self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].

         fBase := base asFloat.

         significand := self significandAsInteger.

         roundingIncludesLimits := significand even.

         exp := (self exponent - 52) max: MinValLogBase2.

         baseExpEstimate := (self exponent * fBase reciprocalLogBase2 -

1.0e-10) ceiling.

         exp >= 0

                     ifTrue:

                                 [be := 1 << exp.

                                 significand ~= 16r10000000000000

                                             ifTrue:

                                                         [r := significand * be * 2.

                                                         s := 2.

                                                         mPlus := be.

                                                         mMinus := be]

                                             ifFalse:

                                                         [be1 := be * 2.

                                                         r := significand * be1 * 2.

                                                         s := 4.

                                                         mPlus := be1.

                                                         mMinus := be]]

                     ifFalse:

                                 [(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])

                                             ifTrue:

                                                         [r := significand * 2.

                                                         s := (1 << (exp negated)) * 2.

                                                         mPlus := 1.

                                                         mMinus := 1]

                                             ifFalse:

                                                         [r := significand * 4.

                                                         s := (1 << (exp negated + 1)) * 2.

                                                         mPlus := 2.

                                                         mMinus := 1]].

         baseExpEstimate >= 0

                     ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]

                     ifFalse:

                                 [scale := base raisedToInteger: baseExpEstimate negated.

                                 r := r * scale.

                                 mPlus := mPlus * scale.

                                 mMinus := mMinus * scale].

         ((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus >

s]])

                     ifTrue: [baseExpEstimate := baseExpEstimate + 1]

                     ifFalse:

                                 [r := r * base.

                                 mPlus := mPlus * base.

                                 mMinus := mMinus * base].

         (fixedFormat := baseExpEstimate between: -3 and: 6)

                     ifTrue:

                                 [decPointCount := baseExpEstimate.

                                 baseExpEstimate <= 0

                                             ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 -

baseExpEstimate)]]

                     ifFalse:

                                 [decPointCount := 1].

         slowbit := s lowBit - 1.

         shead := s >> slowbit.

         [d := (r >> slowbit) // shead.

         r := r - (d*s).

         (tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r <

mMinus]]) |

         (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r +

mPlus > s]])] whileFalse:

                     [aStream nextPut: (Character digitValue: d).

                     r := r * base.

                     mPlus := mPlus * base.

                     mMinus := mMinus * base.

                     decPointCount := decPointCount - 1.

                     decPointCount = 0 ifTrue: [aStream nextPut: $.]].

         tc2 ifTrue:

                     [(tc1 not or: [r*2 >= s]) ifTrue: [d := d + 1]].

         aStream nextPut: (Character digitValue: d).

         decPointCount > 0

                     ifTrue:

                     [decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].

                     aStream nextPutAll: '.0'].

         fixedFormat ifFalse:

                     [aStream nextPut: $e.

                     aStream nextPutAll: (baseExpEstimate - 1) printString]




_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc

 


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Stew MacLean
In reply to this post by Niall Ross
Hi Niall,

Thanks for the explanation.

I have developed an accounting system for myself and I used fixed point
for monetary values. The system at work however (a trading system) uses
SQL Floats, yet to find out why.

I'm trying to reconcile V9 and V11 versions of the system by adding up
postings, and have used an epsilon to cater for the Float inaccuracies.
Nevertheless, using epsilon = ^0.00001 asDouble I'm still getting some
"mismatches".

I'm a bit concerned, as I believe the system uses a lot more decimal
places than that (currency conversions etc).

I'd like to try your suggestion of converting to FixedPoints and then
summing those to see if that gives better results. I'd be grateful if
you could send me the backports for 7.9.

Thanks,

Stewart

>-----Original Message-----
>From: Niall Ross [mailto:[hidden email]]
>Sent: 30 September 2013 6:23 a.m.
>To: [hidden email]
>Cc: [hidden email]
>Subject: Re: [vwnc] Exactly Printing Double Trouble
>
>Dear Stewart,
>    not sure exactly what your aim is here.  Using Floats for money,
you
>have from 6 to 8 digits of accuracy, so a large money amount could be
>imprecise in its lowest units whereas a small one could have
meaningless

>trailing 3rd and subsequent digits after the decimal point.  If you are
>writing to and reading from a database, the same float can cease to be
>equal to itself in all but the first 6 digits.  Doubles give you maybe
>14 digits of accuracy but have the same issues otherwise.
>
>I would therefore round the reals to FixedPoints as soon as possible.
>If you are on VisualWorks 7.10, the implementation of
>#asFixedPointOfPrecision: may help you (see the ReleaseNotes7.10.pdf
>description of that method).  If you're on an older version of
>VisualWorks and cannot upgrade in a convenient timescale, by all means
>email me - or your support contact - your version number and I'll check
>the implementations of that method backport and supply them to you.
>
>                      HTH
>                         Niall Ross
>
>>Hi,
>>
>>I'm attempting to implement the Squeak version of exactly printing
>>Doubles, please see below.
>>I'm reconciling an upgrade of an accounting system that uses Floats
for
>>monetary values (don't ask!), and when I print mismatches they appear
>>the same. (I'm using an epsilon factor to cater for the innate
>>inaccuracy of Floats).
>>
>>The trouble is that it calls a method that attempts to access the
bytes,

>>which returns an error.
>>
>>The offending method is
>>
>>LimitedPrecisionReal >>significandAsInteger
>>
>>            | exp sig |
>>            exp := self exponent.
>>            sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32)
>>bitOr: (self at: 2).
>>            exp > -1023
>>                        ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].
>>            ^ sig.
>>
>>It fails on "at:" has been overridden:
>>
>>LimitedPrecisionReal >>at: index
>>            "Override implementation in Object since general instances
>>             of LimitedPrecisionReal are not element indexable."
>>
>>        ^self shouldNotImplement
>>
>>
>>I'm out of my depth here, and would appreciate some help.
>>
>>Thanks,
>>
>>Stewart
>>
>>
>>
>>
>>
>>absPrintExactlyOn: aStream base: base
>>            "Print my value on a stream in the given base.  Assumes
that
>>my value
>>is strictly
>>            positive; negative numbers, zero, and NaNs have already
been

>>handled
>>elsewhere.
>>            Based upon the algorithm outlined in:
>>            Robert G. Burger and R. Kent Dybvig
>>            Printing Floating Point Numbers Quickly and Accurately
>>            ACM SIGPLAN 1996 Conference on Programming Language Design
>>and
>>Implementation
>>            June 1996.
>>            This version guarantees that the printed representation
>>exactly
>>represents my value
>>            by using exact integer arithmetic."
>>
>>            | fBase significand exp baseExpEstimate be be1 r s mPlus
>>mMinus scale
>>roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit
>>shead MinValLogBase2 |
>>            MinValLogBase2 := -1074.
>>            self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^
>>self].
>>            fBase := base asFloat.
>>            significand := self significandAsInteger.
>>            roundingIncludesLimits := significand even.
>>            exp := (self exponent - 52) max: MinValLogBase2.
>>            baseExpEstimate := (self exponent * fBase
reciprocalLogBase2

>>-
>>1.0e-10) ceiling.
>>            exp >= 0
>>                        ifTrue:
>>                                    [be := 1 << exp.
>>                                    significand ~= 16r10000000000000
>>                                                ifTrue:
>>                                                            [r :=
>>significand * be * 2.
>>                                                            s := 2.
>>                                                            mPlus :=
be.
>>                                                            mMinus :=
>>be]
>>                                                ifFalse:
>>                                                            [be1 := be
*

>>2.
>>                                                            r :=
>>significand * be1 * 2.
>>                                                            s := 4.
>>                                                            mPlus :=
>>be1.
>>                                                            mMinus :=
>>be]]
>>                        ifFalse:
>>                                    [(exp = MinValLogBase2 or:
>>[significand ~= 16r10000000000000])
>>                                                ifTrue:
>>                                                            [r :=
>>significand * 2.
>>                                                            s := (1 <<
>>(exp negated)) * 2.
>>                                                            mPlus :=
1.
>>                                                            mMinus :=
1]
>>                                                ifFalse:
>>                                                            [r :=
>>significand * 4.
>>                                                            s := (1 <<
>>(exp negated + 1)) * 2.
>>                                                            mPlus :=
2.

>>                                                            mMinus :=
>>1]].
>>            baseExpEstimate >= 0
>>                        ifTrue: [s := s * (base raisedToInteger:
>>baseExpEstimate)]
>>                        ifFalse:
>>                                    [scale := base raisedToInteger:
>>baseExpEstimate negated.
>>                                    r := r * scale.
>>                                    mPlus := mPlus * scale.
>>                                    mMinus := mMinus * scale].
>>            ((r + mPlus < s) not and: [roundingIncludesLimits or: [r +
>>mPlus >
>>s]])
>>                        ifTrue: [baseExpEstimate := baseExpEstimate +
1]

>>                        ifFalse:
>>                                    [r := r * base.
>>                                    mPlus := mPlus * base.
>>                                    mMinus := mMinus * base].
>>            (fixedFormat := baseExpEstimate between: -3 and: 6)
>>                        ifTrue:
>>                                    [decPointCount := baseExpEstimate.
>>                                    baseExpEstimate <= 0
>>                                                ifTrue: [aStream
>>nextPutAll: ('0.000000' truncateTo: 2 -
>>baseExpEstimate)]]
>>                        ifFalse:
>>                                    [decPointCount := 1].
>>            slowbit := s lowBit - 1.
>>            shead := s >> slowbit.
>>            [d := (r >> slowbit) // shead.
>>            r := r - (d*s).
>>            (tc1 := (r > mMinus) not and: [roundingIncludesLimits or:
[r
>><
>>mMinus]]) |
>>            (tc2 := (r + mPlus < s) not and: [roundingIncludesLimits
or:

>>[r +
>>mPlus > s]])] whileFalse:
>>                        [aStream nextPut: (Character digitValue: d).
>>                        r := r * base.
>>                        mPlus := mPlus * base.
>>                        mMinus := mMinus * base.
>>                        decPointCount := decPointCount - 1.
>>                        decPointCount = 0 ifTrue: [aStream nextPut:
>>$.]].
>>            tc2 ifTrue:
>>                        [(tc1 not or: [r*2 >= s]) ifTrue: [d := d +
1]].

>>            aStream nextPut: (Character digitValue: d).
>>            decPointCount > 0
>>                        ifTrue:
>>                        [decPointCount - 1 to: 1 by: -1 do: [:i |
>>aStream nextPut: $0].
>>                        aStream nextPutAll: '.0'].
>>            fixedFormat ifFalse:
>>                        [aStream nextPut: $e.
>>                        aStream nextPutAll: (baseExpEstimate - 1)
>>printString]
>>
>>
>>
>>----------------------------------------------------------------------
--
>>
>>_______________________________________________
>>vwnc mailing list
>>[hidden email]
>>http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
>>
>>


_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc
Reply | Threaded
Open this post in threaded view
|

Re: Exactly Printing Double Trouble

Ralf Propach
In reply to this post by Stew MacLean
Hi Stewart,

if you have support, you can download Resolution 100312,
which implements storeString on Float and Doubles as printing the exact
value.

Ralf

Am 29.09.2013 01:47, schrieb Stewart MacLean:

> Hi,
>
> I’m attempting to implement the Squeak version of exactly printing
> Doubles, please see below.
>
> I’m reconciling an upgrade of an accounting system that uses Floats for
> monetary values (don’t ask!), and when I print mismatches they appear
> the same. (I’m using an epsilon factor to cater for the innate
> inaccuracy of Floats).
>
> The trouble is that it calls a method that attempts to access the bytes,
> which returns an error.
>
> The offending method is
>
> LimitedPrecisionReal>>significandAsInteger
>
> | exp sig |
>
> exp := self exponent.
>
> sig := (((self at: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self
> at: 2).
>
> exp > -1023
>
> ifTrue: [sig :=sig bitOr: (1 bitShift: 52)].
>
> ^ sig.
>
> It fails on “at:” has been overridden:
>
> LimitedPrecisionReal>>at: index
>
> "Override implementation in Object since general instances
>
> of LimitedPrecisionReal are not element indexable."
>
> ^self shouldNotImplement
>
> I’m out of my depth here, and would appreciate some help.
>
> Thanks,
>
> Stewart
>

_______________________________________________
vwnc mailing list
[hidden email]
http://lists.cs.uiuc.edu/mailman/listinfo/vwnc