Re: [Help-smalltalk] More odd float results

[Paolo Bonzini]

> Now that fast LargeIntegers are part of the system it's actually 
> possible to write a better (and still simple) algorithm to print floats.
Such as this one.  Unfortunately it is three times slower than the 
previous one.  While implementing it, I took the occasion to fix another 
bug in #floorLog: and add a corresponding method #ceilingLog: which is 
needed to print floating-point values.

(BTW, the old one mistakenly printed 1e17 for 1e16.  So thanks even more 
for reporting this bug).

Paolo

2006-11-08  Paolo Bonzini  <address@hidden>

        * kernel/Float.st: Rewrite printing to round correctly and never
        divide a floating-point number.
        * kernel/Number.st: Fix problems in #floorLog:, add #ceilingLog:.
        Never divide.
        * kernel/Integer.st: Likewise.

--- orig/kernel/Float.st
+++ mod/kernel/Float.st
@@ -370,8 +368,11 @@ printOn: aStream special: whatToPrintArr
     "Private - Print a decimal representation of the receiver on aStream,
      printing one of the three elements of whatToPrintArray if it is
      infinity, negative infinity, or a NaN"
-    | num str exp digits decimalDigits |
+    | me exponential small num den gcd
+      intFactor precision int rounding digits digitStream exponent
+      dotPrinted |
 
+    "First, take care of the easy cases."
     self isNaN ifTrue: [
        ^aStream nextPutAll:
            ((whatToPrintArray at: 3) bindWith: self class) ].
@@ -382,64 +383,77 @@ printOn: aStream special: whatToPrintArr
        ^aStream nextPutAll:
            ((whatToPrintArray at: 2) bindWith: self class) ].
 
+    "We deal only with positive values."
+    me := self abs.
     self negative ifTrue: [ aStream nextPut: $- ].
     self = self zero ifTrue: [ aStream nextPutAll: '0.0'. ^self ].
 
-    num := self abs.
-
-    decimalDigits := self ten raisedToInteger: self class decimalDigits - 1.
-
-    num exponent abs > self class precision ifTrue: [
-       "Print in scientific notation"
-       exp := 0.
-       num < self unity
-           ifTrue: [
-               [ num := num * self ten. exp := exp - 1. num < self unity ] 
whileTrue
-           ]
-           ifFalse: [
-               [ num := num / self ten. exp := exp + 1. num < self ten ] 
whileFalse
-           ].
-
-       "Produce the digits, up to a maximum of 14 = -1 + log10 (2^52)."
-       num := (num * decimalDigits) asInteger.
-       num = decimalDigits
-           ifTrue: [ num := num // 10. exp := exp + 1 ].
-
-       str := num printString.
-       str := str copyFrom: 1 to: (2 max: (str findLast: [ :each | each ~= $0 
])).
-
-       str keysAndValuesDo: [ :n :ch |
-           aStream nextPut: ch.
-           n = 1 ifTrue: [ aStream nextPut: $. ].
-       ].
-       aStream nextPut: self exponentLetter; print: exp.
-       ^self
-    ].
-
-    "Print a not-so-big number"
-    num >= self unity ifTrue: [
-       str := num truncated printString.
-       aStream nextPutAll: str; nextPut: $. .
-
-       digits := self class decimalDigits - str size.
-       digits = 0 ifTrue: [ ^self ].
-       num := num fractionPart *
-           (10 raisedToInteger: digits).
-
-       str := num truncated printString.
-       digits := digits - str size.
-       str := str copyFrom: 1 to: (1 max: (str findLast: [ :each | each ~= $0 
])).
-       aStream next: digits put: $0; nextPutAll: str.
-       ^self
-    ].
-
-    "Print a not-so-small number"
-    str := (num * decimalDigits) rounded printString.
-    aStream nextPutAll: '0.'.
-
-    digits := self class decimalDigits - 1 - str size.
-    str := str copyFrom: 1 to: (1 max: (str findLast: [ :each | each ~= $0 ])).
-    aStream next: digits put: $0; nextPutAll: str.
+    "Figure out some quantities and the way we'll print the number."
+    exponential := me exponent abs > me class precision.
+    small := me < me unity.
+    exponent := (me floorLog: 10) + 1.
+
+    "Compute a rational form of the number we will print..."
+    (exponential and: [ small not ])
+        ifTrue: [ num := me asInteger. den := 1 ]
+       ifFalse: [
+           num := (me timesTwoPower: me class precision - me exponent) 
asInteger.
+           den := 2 raisedToInteger: me class precision - me exponent.
+
+            "(The mantissa if printing a small number in exponential 
notation)."
+            exponential ifTrue: [ num := num * (10 raisedTo: -1 - exponent) ] 
].
+
+    gcd := num gcd: den.
+    num := num // gcd.
+    den := den // gcd.
+
+    "To round correctly, make sure den is even."
+    (den bitAnd: 1) = 1 ifTrue: [ num := num * 2. den := den * 2 ].
+
+    "Get the first `me class decimalDigits' base-10 digits of num // den,
+     appropriately rounded"
+    intFactor := 10 raisedToInteger: (den ceilingLog: 10).
+    rounding := (10 raisedToInteger: (num ceilingLog: 10)
+                                    - me class decimalDigits) + 1.
+
+    int := ((num * intFactor) + ((den // 2) * rounding)) // den.
+    digits := int printString.
+    digits size > me class decimalDigits
+        ifTrue: [ digits := digits copyFrom: 1 to: me class decimalDigits ].
+
+    "Print the non-significant zeros."
+    dotPrinted := false.
+    (small and: [ exponential not ]) ifTrue: [
+        (me floorLog: 10) negated timesRepeat: [
+            aStream nextPut: $0.
+           dotPrinted ifFalse: [ dotPrinted := true. aStream nextPut: $. ].
+            int := int // 10.
+           exponent := exponent + 1 ] ].
+
+    "Make a stream with the significant digits."
+    precision := digits findLast: [ :ch | ch ~= $0 ].
+    digitStream := ReadStream on: digits from: 1 to: precision.
+
+    "Print the integer part (only one digit if using exponential notation)."
+    [
+        digitStream atEnd
+            ifTrue: [ aStream nextPut: $0 ]
+            ifFalse: [ aStream nextPut: digitStream next ].
+
+       exponent := exponent - 1.
+        exponent > 0 and: [ exponential not ] ] whileTrue.
+
+    "Print the fractional part."
+    digitStream atEnd
+       ifTrue: [
+            dotPrinted ifFalse: [ aStream nextPutAll: '.0' ] ]
+       ifFalse: [
+            dotPrinted ifFalse: [ aStream nextPut: $. ].
+           digitStream do: [ :each | aStream nextPut: each ] ].
+
+    "Finally, print the exponent if necessary."
+    exponential ifTrue: [
+        aStream nextPut: me exponentLetter; print: exponent ].
 ! !
 
 


--- orig/kernel/Integer.st
+++ mod/kernel/Integer.st
@@ -316,10 +316,10 @@ floorLog: radix
            ifTrue: [ ^self arithmeticError: 'base of a logarithm cannot be 
negative' ].
        (radix = radix unity)
            ifTrue: [ ^self arithmeticError: 'base of a logarithm cannot be 1' 
].
-       ^(self floorLog: radix reciprocal) negated
+       ^(self ceilingLog: radix reciprocal) negated
     ].
     radix isInteger ifFalse: [
-       ^(self coerce: radix) floorLog: radix
+       ^(radix coerce: self) floorLog: radix
     ].
 
     me := self.
@@ -331,6 +331,35 @@ floorLog: radix
     ^answer
 !
 
+ceilingLog: radix
+    "Answer (self log: radix) ceiling. Optimized to answer an integer."
+
+    | me answer |
+
+    self < self zero ifTrue: [
+       ^self arithmeticError: 'cannot extract logarithm of a negative number'
+    ].
+
+    radix <= radix unity ifTrue: [
+       (radix <= radix zero)
+           ifTrue: [ ^self arithmeticError: 'base of a logarithm cannot be 
negative' ].
+       (radix = radix unity)
+           ifTrue: [ ^self arithmeticError: 'base of a logarithm cannot be 1' 
].
+       ^(self floorLog: radix reciprocal) negated
+    ].
+    radix isInteger ifFalse: [
+       ^(radix coerce: self) ceilingLog: radix
+    ].
+
+    me := self.
+    answer := 1.
+    [   me > radix ] whileTrue: [
+       me := me // radix.
+       answer := answer + 1
+    ].
+    ^answer
+!
+
 gcd: anInteger
     "Return the greatest common divisor (Euclid's algorithm) between the
      receiver and anInteger"


--- orig/kernel/Number.st
+++ mod/kernel/Number.st
@@ -638,7 +638,7 @@ log: aNumber
 floorLog: radix
     "Answer (self log: radix) floor. Optimized to answer an integer."
 
-    | me answer |
+    | me that answer |
 
     self < self zero ifTrue: [
        ^self arithmeticError: 'cannot extract logarithm of a negative number'
@@ -646,21 +646,21 @@ floorLog: radix
     radix <= radix unity ifTrue: [
        (radix <= radix zero) ifTrue: [ ^self arithmeticError: 'bad radix' ].
        (radix = radix unity) ifTrue: [ ^self arithmeticError: 'bad radix' ].
-       ^(self floorLog: radix reciprocal) negated
+       ^(self ceilingLog: radix reciprocal) negated
     ].
 
-    me := self.
+    answer := -1.
     self < self unity
        ifTrue: [
-           answer := -1.
+           me := self.
            [   me := me * radix. me < me unity ] whileTrue: [
                answer := answer - 1
            ]
        ]
        ifFalse: [
-           answer := 0.
-           [   me > radix ] whileTrue: [
-               me := me / radix.
+           that := 1.
+           [   that <= self ] whileTrue: [
+               that := that * radix.
                answer := answer + 1
            ]
        ].
@@ -668,6 +668,38 @@ floorLog: radix
    ^answer
 !
 
+ceilingLog: radix
+    "Answer (self log: radix) ceiling. Optimized to answer an integer."
+
+    | me that answer |
+    self < self zero ifTrue: [
+       ^self arithmeticError: 'cannot extract logarithm of a negative number'
+    ].
+    radix <= radix unity ifTrue: [
+       (radix <= radix zero) ifTrue: [ ^self arithmeticError: 'bad radix' ].
+       (radix = radix unity) ifTrue: [ ^self arithmeticError: 'bad radix' ].
+       ^(self floorLog: radix reciprocal) negated
+    ].
+
+    answer := 0.
+    self < self unity
+       ifTrue: [
+           me := self.
+           [ me := me * radix. me <= me unity ] whileTrue: [
+               answer := answer - 1
+           ].
+       ]
+       ifFalse: [
+           that := 1.
+           [ that < self ] whileTrue: [
+               that := that * radix.
+               answer := answer + 1.
+           ].
+       ].
+
+   ^answer
+!
+
 raisedTo: aNumber
     "Return self raised to aNumber power"
 


--- orig/tests/floatmath.ok
+++ mod/tests/floatmath.ok
@@ -199,3 +199,34 @@ Execution begins...
 (-0.0 0.0 true true true )
 (0.0 -0.0 true true true )
 returned value is Array new: 2 "<0>"
+
+Execution begins...
+returned value is Float
+
+Execution begins...
+true->1.0e16
+returned value is 1.00000e+16
+
+Execution begins...
+true->1.2345e16
+returned value is 1.23450e+16
+
+Execution begins...
+true->10.0
+returned value is 10.0000
+
+Execution begins...
+true->17.7674749
+returned value is 17.7675
+
+Execution begins...
+true->0.12345
+returned value is 0.123450
+
+Execution begins...
+true->0.0000000012345
+returned value is 1.23450d-09
+
+Execution begins...
+true->1.2345e-9
+returned value is 1.23450e-09


--- orig/tests/floatmath.st
+++ mod/tests/floatmath.st
@@ -157,3 +157,21 @@ ObjectMemory globalGarbageCollect.
    ((a negated + b) = (b - a)).
    ((a + b negated) = (a - b)) } printNl ]!
 
+
+
+
+"Fun with printing"
+  
+!Float methodsFor: 'testing'!
+
+test
+    (((Behavior evaluate: self printString) = self) -> self) printNl. 
+! !
+
+1e16 test!
+1.2345e16 test!
+10.0 test!
+(20 - 2.2325251) test!
+0.12345 test!
+0.12345d-8 test!
+0.12345e-8 test!