Fraction.st
author Claus Gittinger <cg@exept.de>
Wed, 09 Jul 2014 18:21:06 +0200
changeset 16729 0cf2bfd45072
parent 15278 ddf05cd996da
child 16938 ffe3202e45bd
permissions -rw-r--r--
comment/format only
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
     3
              All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
    12
"{ Package: 'stx:libbasic' }"
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
    13
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
Number subclass:#Fraction
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
    15
	instanceVariableNames:'numerator denominator'
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    16
	classVariableNames:'FractionOne FractionZero PrintWholeNumbers'
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
    17
	poolDictionaries:''
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
    18
	category:'Magnitude-Numbers'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
    21
!Fraction class methodsFor:'documentation'!
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    22
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    23
copyright
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    24
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    25
 COPYRIGHT (c) 1989 by Claus Gittinger
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    26
              All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    27
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    28
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    29
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    31
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    32
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    33
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    34
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    35
!
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    36
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    37
documentation
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    38
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    39
    Instances of Fraction represent fractional numbers consisting of
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    40
    a numerator and denominator. Both are themselfes arbitrary precision
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    41
    integers. 
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    42
    Fractions are usually created by dividing Integers using / (for exact division).
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    43
    Notice, that all operations on fractions reduce their result; this means, that
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    44
    the result of a fraction-operation may return an integer.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    45
    Aka:
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    46
        (1 / 7) * 7   ->  1  (not 0.99999999...)
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    47
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
    48
    Mixed mode arithmetic:
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    49
        fraction op fraction    -> fraction/integer
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    50
        fraction op fix         -> fix; scale is fix's scale
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    51
        fraction op integer     -> fraction/integer
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    52
        fraction op float       -> float
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
    53
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    54
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    55
    [classVariables:]
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    56
        PrintWholeNumbers       Booolean        experimental: 
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    57
                                                controls how fractions which are greater than 1 are printed.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    58
                                                if true, print them as a sum of an integral and the fractional part. 
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    59
                                                (Large ones are easier to read this way)
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    60
                                                     (17/3) printString  -> '(5+(2/3))'  
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    61
                                                for now, the default is false, for backward compatibility
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
    62
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    63
    [author:]
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    64
        Claus Gittinger
1556
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    65
134d96466f5a commentary
Claus Gittinger <cg@exept.de>
parents: 1555
diff changeset
    66
    [see also:]
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    67
        Number
7380
c704ff45bb80 documentation
Claus Gittinger <cg@exept.de>
parents: 7355
diff changeset
    68
        FixedPoint Float ShortFloat LongFloat Integer Complex
1295
83f594f05c52 documentation
Claus Gittinger <cg@exept.de>
parents: 1264
diff changeset
    69
"
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    70
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
    72
!Fraction class methodsFor:'instance creation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
new
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
    "create and return a new fraction with value 0"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
    77
    ^ self numerator:0 denominator:1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
numerator:num denominator:den
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    81
    "create and return a new fraction with numerator num and denominator den.
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    82
     Notice: stc inlines this message if sent to the global named Fraction."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
    84
    |newFraction|
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
    85
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
%{  /* NOCONTEXT */
369
claus
parents: 359
diff changeset
    87
13
62303f84ff5f *** empty log message ***
claus
parents: 5
diff changeset
    88
    /* this check allows subclassing .. */
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
    if (self == Fraction) {
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
    90
        if (__bothSmallInteger(num, den)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8629
diff changeset
    91
            if (den != __mkSmallInteger(0)) {
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    92
                if (__CanDoQuickAlignedNew(sizeof(struct __Fraction))) {    /* OBJECT ALLOCATION */
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    93
                    OBJ newFraction;
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    94
                    int spc;
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    95
                    INT iDen;
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    97
                    __qCheckedAlignedNew(newFraction, sizeof(struct __Fraction));
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    98
                    __InstPtr(newFraction)->o_class = self;
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
    99
                    __qSTORE(newFraction, self);
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   100
                    iDen = __intVal(den);
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   101
                    if (iDen != 0) {
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   102
                        if (iDen < 0) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8629
diff changeset
   103
                            __FractionInstPtr(newFraction)->f_numerator = __mkSmallInteger(- __intVal(num));
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8629
diff changeset
   104
                            __FractionInstPtr(newFraction)->f_denominator = __mkSmallInteger(- iDen);
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   105
                        } else {
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   106
                            __FractionInstPtr(newFraction)->f_numerator = num;
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   107
                            __FractionInstPtr(newFraction)->f_denominator = den;
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   108
                        }
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8629
diff changeset
   109
                        if (num == __mkSmallInteger(1)) {
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   110
                            /* no need to reduce */
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   111
                            RETURN ( newFraction );
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   112
                        }
7140
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   113
                    }
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   114
                }
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   115
            }
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   116
        }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
    }
2790
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
   118
%}.
8629
07ece572135f care for zeroDivide
penk
parents: 8395
diff changeset
   119
    den = 0 ifTrue:[
7140
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   120
        ^ ZeroDivide raiseRequestWith:thisContext.
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   121
    ].
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   122
    newFraction isNil ifTrue:[
7140
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   123
        newFraction := self basicNew setNumerator:num denominator:den.
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   124
    ].
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   125
    ^ newFraction reduced
7140
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   126
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   127
    "
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   128
     Fraction numerator:1 denominator:3
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   129
     Fraction numerator:2 denominator:6
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   130
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   131
     Fraction numerator:1 denominator:0
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   132
     Fraction numerator:2 denominator:0
f65ec31fc081 oops - noone cared for generating fractions with 0 denominator
Claus Gittinger <cg@exept.de>
parents: 7139
diff changeset
   133
    "
11899
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   134
!
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   135
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   136
readFrom:aStringOrStream onError:exceptionBlock
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   137
    |s numerator denominator|
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   138
11901
285349acebd8 readFrom
Claus Gittinger <cg@exept.de>
parents: 11899
diff changeset
   139
    "/ sigh - care for subclasses...
285349acebd8 readFrom
Claus Gittinger <cg@exept.de>
parents: 11899
diff changeset
   140
    self == Fraction ifFalse:[
285349acebd8 readFrom
Claus Gittinger <cg@exept.de>
parents: 11899
diff changeset
   141
        ^ super readFrom:aStringOrStream onError:exceptionBlock
285349acebd8 readFrom
Claus Gittinger <cg@exept.de>
parents: 11899
diff changeset
   142
    ].
285349acebd8 readFrom
Claus Gittinger <cg@exept.de>
parents: 11899
diff changeset
   143
11899
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   144
    s := aStringOrStream readStream.
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   145
    s skipSeparators.
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   146
    s peek == $( ifTrue:[
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   147
        s next.
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   148
        
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   149
    ].
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   150
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   151
    numerator := super readFrom:s onError:[^ exceptionBlock value].
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   152
    numerator isInteger ifTrue:[
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   153
        s skipSeparators.
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   154
        (s peek == $/) ifTrue:[
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   155
            s next.
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   156
            denominator := Integer readFrom:s onError:[^ exceptionBlock value].
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   157
            ^ self numerator:numerator denominator:denominator
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   158
        ].
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   159
        ^ numerator
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   160
    ].
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   161
    ^ numerator asFraction
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   162
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   163
    "
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   164
     Fraction readFrom:'1'      
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   165
     Fraction readFrom:'2'      
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   166
     Fraction readFrom:'1.5'    
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   167
     Fraction readFrom:'1/5'    
ad777208fdb5 added fraction-readFrom
Claus Gittinger <cg@exept.de>
parents: 11734
diff changeset
   168
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   171
!Fraction class methodsFor:'class initialization'!
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   172
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   173
initialize
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   174
    FractionZero isNil ifTrue:[
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   175
        FractionZero := self numerator:0 denominator:1.
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   176
        FractionOne := self numerator:1 denominator:1
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   177
    ]
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   178
! !
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   179
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   180
!Fraction class methodsFor:'constants'!
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   181
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   182
pi
11671
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   183
    "return an approximation of the constant pi as Fraction.
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   184
     The approx. returned here has an error smaller than representable by float instances"
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   185
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   186
    ^ self 
11671
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   187
        numerator:314159265358979323846264343
6063
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   188
        denominator:100000000000000000000000000
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   189
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   190
"/    ^ self 
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   191
"/        numerator:  314159265358979323846264338327950288419716939937510582097494459
Claus Gittinger <cg@exept.de>
parents: 5552
diff changeset
   192
"/        denominator:100000000000000000000000000000000000000000000000000000000000000
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   193
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   194
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   195
     Fraction pi         
13357
487c502b40b7 comment/format in: #pi
Claus Gittinger <cg@exept.de>
parents: 11901
diff changeset
   196
     Fraction pi asFloat - Float pi
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   197
     Float pi            
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   198
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   199
13357
487c502b40b7 comment/format in: #pi
Claus Gittinger <cg@exept.de>
parents: 11901
diff changeset
   200
    "Modified: / 03-05-2011 / 11:08:46 / cg"
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   201
!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   202
11671
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   203
pi_approximation
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   204
    "return an approximation of the constant pi as Fraction.
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   205
     The approx. returned is good for 6 valid digits and has an error of less than -2.67-07.
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   206
     The value might be useful to avoid floating point numbers in graphic rendering code,
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   207
     where 6 digits of precision are usually good enough."
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   208
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   209
    ^ self 
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   210
        numerator:355
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   211
        denominator:113
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   212
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   213
    "
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   214
     Fraction pi         
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   215
     Fraction pi asFloat
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   216
     Float pi - Fraction pi_approximation asFloat            
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   217
    "
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   218
!
6901343001b6 approx pi
Claus Gittinger <cg@exept.de>
parents: 11250
diff changeset
   219
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   220
unity
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   221
    "return the neutral element for multiplication (1 / 1)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   222
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   223
    ^ FractionOne
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   224
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   225
    "Modified: 18.7.1996 / 12:26:06 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   226
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   227
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   228
zero
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   229
    "return the neutral element for addition (0 / 1)"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   230
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   231
    ^ FractionZero
1555
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   232
316491c1b216 commentary
Claus Gittinger <cg@exept.de>
parents: 1295
diff changeset
   233
    "Modified: 18.7.1996 / 12:26:12 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   234
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   235
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   236
!Fraction class methodsFor:'queries'!
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   237
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   238
isBuiltInClass
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   239
    "return true if this class is known by the run-time-system.
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   240
     Here, true is returned for myself, false for subclasses."
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   241
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   242
    ^ self == Fraction
1264
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   243
8d916aa63bce commentary
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   244
    "Modified: 23.4.1996 / 15:59:10 / cg"
3
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   245
! !
24d81bf47225 *** empty log message ***
claus
parents: 2
diff changeset
   246
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
!Fraction methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
denominator
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
    "return the denominator"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
a27a279701f8 Initial revision
claus
parents:
diff changeset
   252
    ^ denominator
a27a279701f8 Initial revision
claus
parents:
diff changeset
   253
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   254
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   255
numerator
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   256
    "return the numerator"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   257
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   258
    ^ numerator
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   259
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   260
a27a279701f8 Initial revision
claus
parents:
diff changeset
   261
!Fraction methodsFor:'arithmetic'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   262
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   263
* aNumber
11734
7c2cc71aabc9 comment
Claus Gittinger <cg@exept.de>
parents: 11722
diff changeset
   264
    "return the product of the receiver and the argument."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   265
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   266
    "/ notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   267
    "/ the following code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   268
    "/ and exists as an optimization, to speed up those cases.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   269
    "/ also notice, that checks for those cases must be inlinable without
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   270
    "/ a message send; otherwise double-dispatch is just as fast.
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   271
    "/
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   272
    "/ Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   273
    "/ mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   274
    "/ (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   275
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   276
    (aNumber isMemberOf:SmallInteger) ifTrue:[
6646
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   277
        ^ self class 
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   278
                numerator:(numerator * aNumber)
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   279
                denominator:denominator
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   280
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   281
    (aNumber isMemberOf:Float) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   282
        ^ (numerator * aNumber) / denominator
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   283
    ].
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   284
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   285
    ^ aNumber productFromFraction:self
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   286
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   287
    "Modified: 28.7.1997 / 19:09:23 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   288
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   289
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
+ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
    "return the sum of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   293
    "/ notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   294
    "/ the following code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   295
    "/ and exists as an optimization, to speed up those cases.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   296
    "/ also notice, that checks for those cases must be inlinable without
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   297
    "/ a message send; otherwise double-dispatch is just as fast.
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   298
    "/
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   299
    "/ Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   300
    "/ mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   301
    "/ (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   302
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   303
    (aNumber isMemberOf:SmallInteger) ifTrue:[
6646
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   304
        ^ self class 
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   305
            numerator:(numerator + (denominator * aNumber))
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   306
            denominator:denominator
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   307
    ].
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   308
    (aNumber isMemberOf:Float) ifTrue:[
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   309
        ^ (numerator asFloat / denominator asFloat) + aNumber
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   310
    ].
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   311
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   312
    ^ aNumber sumFromFraction:self
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   313
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   314
    "Modified: 28.7.1997 / 19:09:16 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   315
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   316
a27a279701f8 Initial revision
claus
parents:
diff changeset
   317
- aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   318
    "return the difference of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   319
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   320
    "/ notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   321
    "/ the following code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   322
    "/ and exists as an optimization, to speed up those cases.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   323
    "/ also notice, that checks for those cases must be inlinable without
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   324
    "/ a message send; otherwise double-dispatch is just as fast.
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   325
    "/
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   326
    "/ Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   327
    "/ mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   328
    "/ (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   329
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   330
    (aNumber isMemberOf:SmallInteger) ifTrue:[
6646
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   331
        ^ self class 
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   332
                numerator:(numerator - (denominator * aNumber))
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   333
                denominator:denominator
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   334
    ].
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   335
    (aNumber isMemberOf:Float) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   336
        ^ (numerator asFloat / denominator asFloat) - aNumber
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   337
    ].
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   338
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   339
    ^ aNumber differenceFromFraction:self
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   340
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   341
    "
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   342
     (1/3) - (1/9)      
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   343
     (1/9) - (1/3)      
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   344
     (999/1000) - (1/1000)      
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   345
     (999/1000) - (1/1000000)      
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   346
     (999000/1000000) - (1/1000000)      
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   347
    "
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   348
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   349
    "Modified: 28.7.1997 / 19:09:11 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   350
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   351
a27a279701f8 Initial revision
claus
parents:
diff changeset
   352
/ aNumber
a27a279701f8 Initial revision
claus
parents:
diff changeset
   353
    "return the quotient of the receiver and the argument, aNumber"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   354
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   355
    "/ notice:
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   356
    "/ the following code handles some common cases,
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   357
    "/ and exists as an optimization, to speed up those cases.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   358
    "/ also notice, that checks for those cases must be inlinable without
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   359
    "/ a message send; otherwise double-dispatch is just as fast.
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   360
    "/
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   361
    "/ Conceptionally, (and for most other argument types),
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   362
    "/ mixed arithmetic is implemented by double dispatching
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   363
    "/ (see the message send at the bottom)
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   364
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   365
    (aNumber isMemberOf:SmallInteger) ifTrue:[
6646
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   366
        ^ self class 
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   367
                numerator:numerator
875d9668d82b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6576
diff changeset
   368
                denominator:(denominator * aNumber)
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   369
    ].
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   370
    (aNumber isMemberOf:Float) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   371
        ^ numerator / (denominator * aNumber)
16
a580032d04f6 *** empty log message ***
claus
parents: 13
diff changeset
   372
    ].
6064
04bde2eeb749 comments about double dispatching
Claus Gittinger <cg@exept.de>
parents: 6063
diff changeset
   373
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   374
    ^ aNumber quotientFromFraction:self
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   375
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   376
    "Modified: 28.7.1997 / 19:09:06 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   377
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
a27a279701f8 Initial revision
claus
parents:
diff changeset
   379
// aNumber
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   380
    "return the integer quotient of dividing the receiver by aNumber with
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   381
     truncation towards negative infinity."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   382
a27a279701f8 Initial revision
claus
parents:
diff changeset
   383
    ^ (numerator * aNumber denominator) // (denominator * aNumber numerator)
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   384
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   385
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   386
     0.5 // 1
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   387
     -0.5 // 1
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3899
diff changeset
   388
     (1/2) // 1  = 0 ifFalse:[self halt].
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3899
diff changeset
   389
     (-1/2) // 1 = -1 ifFalse:[self halt].
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   390
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   391
3984
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3899
diff changeset
   392
    "Modified: / 5.11.1996 / 11:47:14 / cg"
45a76e2f4236 Fix so that // and \\ truncate towards negative infinity and
Stefan Vogel <sv@exept.de>
parents: 3899
diff changeset
   393
    "Modified: / 13.2.1998 / 09:15:35 / stefan"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
negated
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
    "optional - could use inherited method ..."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   399
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   400
        numerator:(numerator negated)
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   401
        denominator:denominator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   402
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   403
    "Modified: 5.11.1996 / 10:29:11 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   404
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   405
a27a279701f8 Initial revision
claus
parents:
diff changeset
   406
reciprocal
a27a279701f8 Initial revision
claus
parents:
diff changeset
   407
    "optional - could use inherited method ..."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   408
a27a279701f8 Initial revision
claus
parents:
diff changeset
   409
    numerator == 1 ifTrue:[^ denominator].
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   410
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   411
        numerator:denominator
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   412
        denominator:numerator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   413
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   414
    "Modified: 5.11.1996 / 10:29:22 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   415
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   417
!Fraction methodsFor:'coercing & converting'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   418
1892
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   419
asFixedPoint
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   420
    "return the receiver as fixedPoint number.
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   421
     Q: what should the scale be here ?"
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   422
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   423
    ^ FixedPoint numerator:numerator denominator:denominator scale:2
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   424
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   425
    "
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   426
     (1/2) asFixedPoint
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   427
    "
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   428
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   429
    "Created: 5.11.1996 / 15:15:54 / cg"
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   430
!
d3564145c15c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1878
diff changeset
   431
2140
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   432
asFixedPoint:scale
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   433
    "return the receiver as fixedPoint number, with the given number
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   434
     of post-decimal-point digits."
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   435
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   436
    ^ FixedPoint numerator:numerator denominator:denominator scale:scale
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   437
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   438
    "
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   439
     (1/2) asFixedPoint:2 
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   440
     (1/3) asFixedPoint:2 
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   441
     (1/3) asFixedPoint:5 
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   442
     (2/3) asFixedPoint:2 
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   443
     (2/3) asFixedPoint:5 
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   444
    "
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   445
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   446
    "Created: 5.11.1996 / 15:15:54 / cg"
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   447
    "Modified: 10.1.1997 / 19:54:50 / cg"
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   448
!
5e2def558185 added #asFixedPoint:
Claus Gittinger <cg@exept.de>
parents: 1893
diff changeset
   449
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   450
asFloat
11239
951d0e92ab3d comment
Claus Gittinger <cg@exept.de>
parents: 10486
diff changeset
   451
    "return a float with (approximately) my value.
951d0e92ab3d comment
Claus Gittinger <cg@exept.de>
parents: 10486
diff changeset
   452
     Since floats have a limited precision, you usually loose bits when doing this."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   453
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   454
    |num den numShift denShift bits rslt|
6571
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   455
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   456
    (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   457
        ^ (numerator asFloat) / (denominator asFloat)
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   458
    ].
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   459
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   460
    "Do it the hard way: reduce magnitude and undo reduction on the quotient"
6571
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   461
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   462
    bits := Float precision * 2.    "number of bits to preserve (conservative)"
6571
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   463
    num := numerator abs.
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   464
    numShift := bits - num highBit. "(num highBit - bits) negated"
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   465
    numShift < 0 ifTrue:[num := num bitShift:numShift] ifFalse:[numShift := 0].
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   466
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   467
    den :=  denominator.
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   468
    denShift := bits - den highBit. "(den highBit - bits) negated"
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   469
    denShift < 0 ifTrue:[den := den bitShift:denShift] ifFalse:[denShift := 0].
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   470
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   471
    rslt := (num asFloat / den asFloat) * (2 raisedToInteger:denShift-numShift).
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   472
    numerator negative ifTrue:[ ^ rslt negated ].
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   473
    ^ rslt.
6571
101905a14870 Fix #asFloat for non-trivial Fractions
Stefan Vogel <sv@exept.de>
parents: 6486
diff changeset
   474
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   475
    " 
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   476
      (5/9) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   477
      (-5/9) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   478
      (500000000000/900000000000) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   479
      (-500000000000/900000000000) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   480
      (500000000000/9) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   481
      (5/900000000000) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   482
      89012345678901234567 asFloat / 123456789123456789 asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   483
      (89012345678901234567 / 123456789123456789) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   484
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   485
      (
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   486
       180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   487
        /
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   488
       180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   489
      ) asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   490
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   491
      180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   492
         asFloat /
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   493
      180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   494
         asFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   495
    "
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   496
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   497
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   498
asFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   499
    "return the receiver as fraction - thats itself"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   500
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   501
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   502
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   503
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   504
asInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   505
    "return an integer with my value - will usually truncate"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   506
a27a279701f8 Initial revision
claus
parents:
diff changeset
   507
    ^ numerator // denominator
a27a279701f8 Initial revision
claus
parents:
diff changeset
   508
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   509
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   510
asLargeFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   511
    "return a large float with (approximately) my value"
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   512
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   513
    ^ (numerator asLargeFloat) / (denominator asLargeFloat)
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   514
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   515
    "
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   516
      (5/9) asLargeFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   517
      (500000000000/900000000000) asLargeFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   518
      (500000000000/9) asLargeFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   519
    "
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   520
!
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   521
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   522
asLargeInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   523
    "return an integer with my value - will usually truncate"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   524
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   525
    ^ self asInteger asLargeInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   526
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   527
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   528
asLongFloat
15278
ddf05cd996da class: Fraction
Claus Gittinger <cg@exept.de>
parents: 13357
diff changeset
   529
    "return a long float with (approximately) my value.
ddf05cd996da class: Fraction
Claus Gittinger <cg@exept.de>
parents: 13357
diff changeset
   530
     Since floats have a limited precision, you usually loose bits when doing this."
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   531
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   532
    |num den numShift denShift numBits rslt|
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   533
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   534
    (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   535
        ^ (numerator asLongFloat) / (denominator asLongFloat)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   536
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   537
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   538
    "Do it the hard way: reduce magnitude and undo reduction on the quotient"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   539
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   540
    numBits := LongFloat precision * 2.    "number of bits to preserve (conservative)"
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   541
    num := numerator abs.
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   542
    numShift := numBits - num highBit. "(num highBit - bits) negated"
15278
ddf05cd996da class: Fraction
Claus Gittinger <cg@exept.de>
parents: 13357
diff changeset
   543
    numShift < 0 ifTrue:[num := num bitShift:numShift] ifFalse:[ numShift := 0].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   544
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   545
    den :=  denominator.
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   546
    denShift := numBits - den highBit. "(den highBit - bits) negated"
15278
ddf05cd996da class: Fraction
Claus Gittinger <cg@exept.de>
parents: 13357
diff changeset
   547
    denShift < 0 ifTrue:[den := den bitShift:denShift] ifFalse:[denShift := 0].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   548
7730
dda82553acc7 make #asLongFloat return a LongFloat (returned Float)
Stefan Vogel <sv@exept.de>
parents: 7571
diff changeset
   549
    rslt := (num asLongFloat / den asLongFloat) * (2 raisedToInteger:denShift-numShift).
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   550
    numerator negative ifTrue:[ ^ rslt negated ].
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   551
    ^ rslt.
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   552
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   553
    " 
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   554
      (5/9) asLongFloat                        
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   555
      (-5/9) asLongFloat   
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   556
      (Fraction basicNew setNumerator:500000000000 denominator:900000000000) asLongFloat = (5/9) asLongFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   557
      (Fraction basicNew setNumerator:500000000001 denominator:900000000000) asLongFloat = (5/9) asLongFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   558
      (500000000001/900000000000) asLongFloat  
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   559
      (-500000000001/900000000000) asLongFloat 
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   560
      (500000000001/900000000000) asLongFloat = (5/9) asLongFloat
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   561
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   562
      (500000000000/9) asLongFloat             
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   563
      (5/900000000000) asLongFloat     
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   564
      89012345678901234567 asFloat / 123456789123456789 asLongFloat 
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   565
      (89012345678901234567 / 123456789123456789) asLongFloat        
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   566
      (-89012345678901234567 / 123456789123456789) asLongFloat       
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   567
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   568
      (
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   569
       180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   570
        /
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   571
       180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   572
      ) asLongFloat    
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   573
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   574
      180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   575
         asLongFloat /
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   576
      180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   577
         asLongFloat
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   578
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   579
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   580
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   581
asShortFloat
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   582
    "return a short float with (approximately) my value"
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   583
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   584
    (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   585
        ^ (numerator asShortFloat) / (denominator asShortFloat)
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   586
    ].
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   587
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   588
    ^ self asFloat asShortFloat
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   589
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   590
    "
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   591
      (5/9) asShortFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   592
      (500000000000/900000000000) asShortFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   593
      (500000000000/9) asShortFloat
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
   594
    "
1200
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   595
!
cc16f7a00b52 limited shortFloat support
Claus Gittinger <cg@exept.de>
parents: 1133
diff changeset
   596
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   597
coerce:aNumber
11722
d32d16dd6384 comment
Claus Gittinger <cg@exept.de>
parents: 11671
diff changeset
   598
    "convert the argument aNumber into an instance of the receivers class and return it."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   599
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   600
    ^ aNumber asFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   601
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   602
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   603
generality
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   604
    "return the generality value - see ArithmeticValue>>retry:coercing:"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   605
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   606
    ^ 60
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   607
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   608
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   609
!Fraction methodsFor:'comparing'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   610
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   611
< aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   612
    "return true if the receiver is less
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   613
     than aNumber, false otherwise."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   614
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   615
    (aNumber isMemberOf:SmallInteger) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   616
        ^ numerator < (denominator * aNumber)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   617
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   618
    ^ aNumber lessFromFraction:self
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   619
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   620
    "Modified: 5.11.1996 / 10:30:52 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   621
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   622
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   623
= aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   624
    "return true, if the argument represents the same numeric value
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   625
     as the receiver, false otherwise"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   626
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   627
    (aNumber isMemberOf:SmallInteger) ifTrue:[
6891
212aa8576cf7 oops - did not compare correctly against unnormalized numbers
Claus Gittinger <cg@exept.de>
parents: 6675
diff changeset
   628
        (denominator == 1) ifFalse:[
212aa8576cf7 oops - did not compare correctly against unnormalized numbers
Claus Gittinger <cg@exept.de>
parents: 6675
diff changeset
   629
            ^ numerator = (aNumber * denominator)
212aa8576cf7 oops - did not compare correctly against unnormalized numbers
Claus Gittinger <cg@exept.de>
parents: 6675
diff changeset
   630
        ].
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   631
        ^ numerator = aNumber
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   632
    ].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   633
    ^ aNumber equalFromFraction:self
3631
26a44b284912 handle largeInteger case in Fraction =
Claus Gittinger <cg@exept.de>
parents: 2894
diff changeset
   634
26a44b284912 handle largeInteger case in Fraction =
Claus Gittinger <cg@exept.de>
parents: 2894
diff changeset
   635
    "Modified: / 7.7.1998 / 17:17:07 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   636
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   637
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   638
> aNumber
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   639
    "return true if the receiver is greater
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   640
     than aNumber, false otherwise."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   641
    "optional - could use inherited method ..."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   642
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   643
    (aNumber isMemberOf:SmallInteger) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   644
        ^ numerator > (denominator * aNumber)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   645
    ].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   646
    ^ aNumber < self
4593
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   647
!
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   648
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   649
hash
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   650
    "return a number for hashing; redefined, since fractions compare
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   651
     by numeric value (i.e. (9/3) = 3), therefore (9/3) hash must be the same
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   652
     as 3 hash."
4593
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   653
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   654
    (denominator = 1) ifTrue:[^ numerator hash].
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   655
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   656
    ^ self asFloat hash
4593
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   657
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   658
    "
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   659
     3 hash           
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   660
     (9/3) hash       
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   661
     3.0 hash         
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   662
     (1/2) hash       
4594
eb09f567a3bc float, shortFloat and fraction all hash alike
Claus Gittinger <cg@exept.de>
parents: 4593
diff changeset
   663
     (1/4) hash       
4593
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   664
     0.0 hash         
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   665
     0.5 hash         
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   666
     0.25 hash         
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   667
     0.4 hash         
1023fa0c779e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3984
diff changeset
   668
    "
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   669
!
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   670
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   671
sameFractionValueAs:aNumber
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   672
    "return true, if the argument represents the same numeric value
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   673
     as the receiver, false otherwise"
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   674
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   675
    |rSelf rNum|
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   676
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   677
    rSelf := self reduced.
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   678
    rNum := aNumber reduced.
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   679
    rSelf denominator = rNum denominator ifTrue:[
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   680
        ^ rSelf numerator = rNum numerator
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   681
    ].
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   682
    ^ false
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   683
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   684
a27a279701f8 Initial revision
claus
parents:
diff changeset
   685
!Fraction methodsFor:'double dispatching'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   686
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   687
differenceFromFixedPoint:aFixedPoint
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   688
    |n d otherDenominator otherNumerator|
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   689
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   690
    otherDenominator := aFixedPoint denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   691
    otherNumerator := aFixedPoint numerator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   692
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   693
    "save a multiplication if possible"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   694
    otherDenominator == denominator ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   695
        n := otherNumerator - numerator. 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   696
        d := otherDenominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   697
    ] ifFalse:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   698
        n := (otherNumerator * denominator) - (numerator * otherDenominator).
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   699
        d := otherDenominator * denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   700
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   701
    ^ aFixedPoint class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   702
        numerator:n
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   703
        denominator:d
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   704
        scale:(aFixedPoint scale)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   705
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   706
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   707
     ((1/3) asFixedPoint:2) - (1/3)        
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   708
     ((1/3) asFixedPoint:2) - (2/3) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   709
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   710
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   711
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   712
differenceFromFloat:aFloat
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   713
    "sent when a float does not know how to subtract the receiver, a fraction"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   714
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   715
    ^ (aFloat * denominator - numerator) / denominator
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   717
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   718
differenceFromFraction:aFraction
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   719
    |n d otherDenominator otherNumerator|
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   720
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   721
    otherDenominator := aFraction denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   722
    otherNumerator := aFraction numerator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   723
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   724
    "save a multiplication if possible"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   725
    otherDenominator == denominator ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   726
        n := otherNumerator - numerator. 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   727
        d := otherDenominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   728
    ] ifFalse:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   729
        n := (otherNumerator * denominator) - (numerator * otherDenominator).
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   730
        d := otherDenominator * denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   731
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   732
    ^ aFraction class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   733
        numerator:n
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   734
        denominator:d
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   735
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   736
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   737
     ((1/3) asFixedPoint:2) - (1/3)        
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   738
     ((1/3) asFixedPoint:2) - (2/3) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   739
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   740
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   741
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   742
differenceFromInteger:anInteger
213
3b56a17534fd *** empty log message ***
claus
parents: 92
diff changeset
   743
    "sent when an integer does not know how to subtract the receiver, a fraction"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   744
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   745
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   746
        numerator:((anInteger * denominator) - numerator)
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   747
        denominator:denominator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   748
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   749
    "Modified: 28.7.1997 / 19:08:53 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   750
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   751
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   752
equalFromFraction:aFraction
7571
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   753
    denominator = aFraction denominator ifFalse:[
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   754
        ^ false   " must always be reduced "
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   755
        "/ ^ (numerator * aFraction denominator) = (aFraction numerator * denominator)
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   756
    ].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   757
    ^ numerator = aFraction numerator
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   758
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   759
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   760
equalFromInteger:anInteger
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   761
    "sent when an integer does not know how to compare to the receiver, a fraction"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   762
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   763
    "as I am always reduced, this test should not be required.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   764
     However, it is here for subclasses and to allow comparing unnormalized fractions,
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   765
     which might be encountered internally"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   766
7571
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   767
    denominator = 1 ifFalse:[
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   768
        ^ numerator = (anInteger * denominator)
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   769
    ].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   770
    ^ numerator = anInteger
7571
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   771
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   772
    "
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   773
     1 = (1 asFixedPoint:1)
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   774
     (1 asFixedPoint:1) = 1
57d86ad2aded fixed comparing agains integer for subclasses
Claus Gittinger <cg@exept.de>
parents: 7442
diff changeset
   775
    "
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   776
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   777
10486
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   778
lessEqFromInteger:anInteger
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   779
    "sent when an integer does not know how to compare to the receiver, a fraction"
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   780
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   781
    ^ (denominator * anInteger) <= numerator
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   782
!
ecab71364dab new: #lessEqFromInteger:
Stefan Vogel <sv@exept.de>
parents: 8913
diff changeset
   783
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   784
lessFromFraction:aFraction
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   785
    "sent when a fraction does not know how to compare to the receiver"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   786
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   787
    |n d|
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   788
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   789
    d := aFraction denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   790
    n := aFraction numerator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   791
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   792
    "/ save a multiplication if possible
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   793
    d == denominator ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   794
        ^ n < numerator
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   795
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   796
    ^ (denominator * n) < (numerator * d)  
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   797
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   798
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   799
lessFromInteger:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   800
    "sent when an integer does not know how to compare to the receiver, a fraction"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   801
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   802
    ^ (denominator * anInteger) < numerator
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   803
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   804
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   805
productFromFixedPoint:aFixedPoint
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   806
    ^ aFixedPoint class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   807
        numerator:(aFixedPoint numerator * numerator) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   808
        denominator:(aFixedPoint denominator * denominator)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   809
        scale:(aFixedPoint scale)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   810
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   811
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   812
     ((1/3) asFixedPoint:2) * 2       
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   813
     ((1/3) asFixedPoint:2) * (1/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   814
     ((1/3) asFixedPoint:2) * (3/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   815
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   816
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   817
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   818
productFromFloat:aFloat
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   819
    "sent when a float does not know how to multiply the receiver, a fraction"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   820
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   821
    ^ aFloat * numerator / denominator
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   822
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   823
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   824
productFromFraction:aFraction
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   825
    ^ aFraction class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   826
        numerator:(aFraction numerator * numerator) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   827
        denominator:(aFraction denominator * denominator)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   828
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   829
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   830
     ((1/3) asFixedPoint:2) * 2       
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   831
     ((1/3) asFixedPoint:2) * (1/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   832
     ((1/3) asFixedPoint:2) * (3/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   833
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   834
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   835
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   836
productFromInteger:anInteger
213
3b56a17534fd *** empty log message ***
claus
parents: 92
diff changeset
   837
    "sent when an integer does not know how to multiply the receiver, a fraction"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   838
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   839
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   840
        numerator:(anInteger * numerator)
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   841
        denominator:denominator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   842
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   843
    "Modified: 28.7.1997 / 19:06:22 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   844
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   845
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   846
quotientFromFixedPoint:aFixedPoint
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   847
    "Return the quotient of the argument, aFixedPoint and the receiver.
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   848
     Sent when aFixedPoint does not know how to divide by the receiver."
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   849
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   850
    ^ aFixedPoint class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   851
        numerator:(aFixedPoint numerator * denominator) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   852
        denominator:(aFixedPoint denominator * numerator)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   853
        scale:(aFixedPoint scale)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   854
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   855
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   856
     ((1/3) asFixedPoint:2) / 2       
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   857
     ((1/3) asFixedPoint:2) / (1/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   858
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   859
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   860
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   861
quotientFromFloat:aFloat
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   862
    "Return the quotient of the argument, aFloat and the receiver.
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   863
     Sent when aFloat does not know how to divide by the receiver."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   864
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   865
    ^ (aFloat * denominator) / numerator
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   866
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   867
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   868
quotientFromFraction:aFraction
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   869
    "Return the quotient of the argument, aFraction and the receiver.
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   870
     Sent when aFraction does not know how to divide by the receiver."
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   871
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   872
    ^ aFraction class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   873
        numerator:(aFraction numerator * denominator) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   874
        denominator:(aFraction denominator * numerator)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   875
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   876
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   877
     (1/3) / (1/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   878
     (1/3) / (3/2) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   879
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   880
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   881
324
290cfb34ec93 *** empty log message ***
claus
parents: 302
diff changeset
   882
quotientFromInteger:anInteger
7442
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   883
    "Return the quotient of the argument, anInteger and the receiver.
1b0a20747a64 double dispatching
Claus Gittinger <cg@exept.de>
parents: 7403
diff changeset
   884
     Sent when anInteger does not know how to divide by the receiver."
324
290cfb34ec93 *** empty log message ***
claus
parents: 302
diff changeset
   885
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   886
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   887
        numerator:(anInteger * denominator)
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   888
        denominator:numerator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   889
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   890
    "Modified: 28.7.1997 / 19:08:46 / cg"
324
290cfb34ec93 *** empty log message ***
claus
parents: 302
diff changeset
   891
!
290cfb34ec93 *** empty log message ***
claus
parents: 302
diff changeset
   892
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   893
sumFromFixedPoint:aFixedPoint
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   894
    |n d otherDenominator otherNumerator|
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   895
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   896
    otherDenominator := aFixedPoint denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   897
    otherNumerator := aFixedPoint numerator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   898
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   899
    "save a multiplication if possible"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   900
    otherDenominator == denominator ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   901
        n := otherNumerator + numerator. 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   902
        d := otherDenominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   903
    ] ifFalse:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   904
        n := (otherNumerator * denominator) + (numerator * otherDenominator).
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   905
        d := otherDenominator * denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   906
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   907
    ^ aFixedPoint class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   908
        numerator:n
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   909
        denominator:d
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   910
        scale:(aFixedPoint scale)
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   911
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   912
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   913
     ((1/3) asFixedPoint:2) + (1/3)        
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   914
     ((1/3) asFixedPoint:2) + (2/3) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   915
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   916
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   917
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   918
sumFromFloat:aFloat
213
3b56a17534fd *** empty log message ***
claus
parents: 92
diff changeset
   919
    "sent when a float does not know how to add the receiver, a fraction"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   920
a27a279701f8 Initial revision
claus
parents:
diff changeset
   921
    ^ (aFloat * denominator + numerator) / denominator
a27a279701f8 Initial revision
claus
parents:
diff changeset
   922
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   923
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   924
sumFromFraction:aFraction
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   925
    |n d otherDenominator otherNumerator|
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   926
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   927
    otherDenominator := aFraction denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   928
    otherNumerator := aFraction numerator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   929
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   930
    "save a multiplication if possible"
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   931
    otherDenominator == denominator ifTrue:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   932
        n := otherNumerator + numerator. 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   933
        d := otherDenominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   934
    ] ifFalse:[
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   935
        n := (otherNumerator * denominator) + (numerator * otherDenominator).
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   936
        d := otherDenominator * denominator.
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   937
    ].
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   938
    ^ aFraction class 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   939
        numerator:n
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   940
        denominator:d
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   941
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   942
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   943
     (1/3) + (1/3)        
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   944
     (1/3) + (2/3) 
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   945
    "
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   946
!
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   947
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   948
sumFromInteger:anInteger
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   949
    "sent when an integer does not know how to add the receiver, a fraction"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   950
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   951
    ^ self class 
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
   952
        numerator:(numerator + (anInteger * denominator))
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
   953
        denominator:denominator
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
   954
2792
2ae1f2e3d11f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2790
diff changeset
   955
    "Modified: 28.7.1997 / 19:08:40 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   956
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   957
92
0c73b48551ac *** empty log message ***
claus
parents: 88
diff changeset
   958
!Fraction methodsFor:'printing & storing'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   959
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   960
printOn:aStream
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   961
    "append a printed representation of the receiver to the
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   962
     argument, aStream"
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   963
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   964
    |t|
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   965
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   966
    PrintWholeNumbers == true ifTrue:[
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   967
        "/ experimental: print fractions which are greater than 1 as a sum of
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   968
        "/ an integral and the fractional part. They are easier to read this way.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   969
        numerator > denominator ifTrue:[
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   970
            aStream nextPut:$(.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   971
            t := numerator // denominator.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   972
            t printOn:aStream.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   973
            aStream nextPutAll:'+('.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   974
            (numerator - (t*denominator)) printOn:aStream.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   975
            aStream nextPut:$/.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   976
            denominator printOn:aStream.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   977
            aStream nextPutAll:'))'.
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   978
            ^ self
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   979
        ].
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   980
    ].
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   981
54
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   982
    aStream nextPut:$(.
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   983
    numerator printOn:aStream.
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   984
    aStream nextPut:$/.
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   985
    denominator printOn:aStream.
06dbdeeed4f9 *** empty log message ***
claus
parents: 44
diff changeset
   986
    aStream nextPut:$)
6675
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   987
c7e2757d5e80 documentation comment
Claus Gittinger <cg@exept.de>
parents: 6650
diff changeset
   988
    "Modified: / 31.7.2002 / 09:56:41 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   989
! !
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   990
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   991
!Fraction methodsFor:'private'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   992
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   993
reduced
7139
958ca5839e25 comment
Claus Gittinger <cg@exept.de>
parents: 6891
diff changeset
   994
    "reduce the receiver; divide the numerator and denominator by their
958ca5839e25 comment
Claus Gittinger <cg@exept.de>
parents: 6891
diff changeset
   995
     greatest common divisor; if the result is integral, return an Integer.
958ca5839e25 comment
Claus Gittinger <cg@exept.de>
parents: 6891
diff changeset
   996
     Otherwise, return the normalized receiver.
11250
9a962a088d30 comment
Claus Gittinger <cg@exept.de>
parents: 11239
diff changeset
   997
     CAVEAT: bad name; should be called reduce, as it has a side effect
9a962a088d30 comment
Claus Gittinger <cg@exept.de>
parents: 11239
diff changeset
   998
     (i.e. this is destructive wrt. the instance values)."
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   999
2790
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1000
    |gcd den|
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1001
2790
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1002
    den := denominator.
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1003
    den < 0 ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1004
        numerator := numerator negated.
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1005
        den := denominator := den negated.
2789
e3e8707d26b4 make certain, that denominator is positive (in #reduce)
Claus Gittinger <cg@exept.de>
parents: 2140
diff changeset
  1006
    ].
e3e8707d26b4 make certain, that denominator is positive (in #reduce)
Claus Gittinger <cg@exept.de>
parents: 2140
diff changeset
  1007
2790
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1008
    den == 1 ifTrue:[^ numerator].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1009
    numerator == 1 ifTrue:[^ self].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1010
    numerator == 0 ifTrue:[^ 0].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1011
2790
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1012
    gcd := numerator gcd:den.
495b8ea6a4cb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2789
diff changeset
  1013
    (gcd ~~ 1) ifTrue:[
6576
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
  1014
        gcd < 0 ifTrue:[
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
  1015
             gcd := gcd negated.
c28cdeb0bfb0 Fix asFloat
Stefan Vogel <sv@exept.de>
parents: 6571
diff changeset
  1016
        ].
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1017
        numerator := numerator // gcd.
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1018
        denominator := den := den // gcd.
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1019
        (den == 1) ifTrue:[^ numerator].
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1020
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1021
    ^ self
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1022
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1023
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1024
setNumerator:num denominator:den
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1025
    "set both numerator and denominator"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1026
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1027
    numerator := num.
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1028
    denominator := den
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1029
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1030
6650
35de1d8400b2 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 6646
diff changeset
  1031
!Fraction methodsFor:'testing'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1032
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1033
isFraction
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1034
    "return true, if the receiver is some kind of fraction;
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1035
     true is returned here - the method is redefined from Object."
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1036
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1037
    ^ true
6650
35de1d8400b2 *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 6646
diff changeset
  1038
!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1039
4658
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1040
isLiteral
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1041
    "return true, if the receiver can be used as a literal constant in ST syntax
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1042
     (i.e. can be used in constant arrays)"
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1043
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1044
    ^ true
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1045
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1046
!
1a74754fbe91 moved isLiteral (complex and FixedPoint are not)
Claus Gittinger <cg@exept.de>
parents: 4594
diff changeset
  1047
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1048
negative
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1049
    "return true if the receiver is negative"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1050
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1051
    (numerator < 0) ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1052
        ^ (denominator < 0) not
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1053
    ].
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1054
    ^ (denominator < 0)
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1055
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1056
5552
31b5cc144476 category changes
Claus Gittinger <cg@exept.de>
parents: 5364
diff changeset
  1057
!Fraction methodsFor:'truncation & rounding'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1058
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1059
fractionPart
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1060
    "extract the after-decimal fraction part,
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1061
     such that (self truncated + self fractionPart) = self"
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1062
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1063
    numerator abs < denominator abs ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1064
        ^ self
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1065
    ].
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1066
    ^ (numerator rem: denominator) / denominator
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1067
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1068
    "
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1069
     (3/2) fractionPart + (3/2) truncated    
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1070
     (-3/2) fractionPart + (-3/2) truncated    
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1071
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1072
     (3/2) fractionPart     
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1073
     (-3/2) fractionPart     
7355
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1074
     (3/2) asFloat fractionPart     
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1075
     (-3/2) asFloat fractionPart     
96f466eeddf5 double dispatching fixed;
Claus Gittinger <cg@exept.de>
parents: 7140
diff changeset
  1076
     (2/3) fractionPart          
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1077
     ((3/2)*(15/4)) fractionPart   
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1078
     ((2/3)*(4/15)) fractionPart   
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1079
    "
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1080
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1081
    "Modified: / 5.11.2001 / 17:55:25 / cg"
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1082
!
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1083
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1084
integerPart
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1085
    "extract the pre-decimal integer part."
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1086
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1087
    numerator abs < denominator abs ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1088
        ^ 0
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1089
    ].
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1090
    ^ super integerPart
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1091
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1092
    "
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1093
     (3/2) integerPart        
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1094
     (-3/2) integerPart        
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1095
     (2/3) integerPart           
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1096
     ((3/2)*(15/4)) integerPart   
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1097
     ((2/3)*(4/15)) integerPart   
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1098
    "
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1099
6153
e92766db42c6 integerPart and fractionPart fixed for negative numbers
Claus Gittinger <cg@exept.de>
parents: 6064
diff changeset
  1100
    "Modified: / 5.11.2001 / 17:55:01 / cg"
3899
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1101
!
aa9b50cdfced added #fractionPart and #integerPart
Claus Gittinger <cg@exept.de>
parents: 3631
diff changeset
  1102
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1103
rounded
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1104
    "return the receiver rounded to the nearest integer as integer"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1105
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1106
    "/ mhmh - what about -(1/2)
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1107
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1108
    |t|
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1109
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1110
    self negative ifTrue:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1111
        t := self - (1/2)
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1112
    ] ifFalse:[
5364
a27f5167822c *** empty log message ***
ps
parents: 5322
diff changeset
  1113
        t := self + (1/2)
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1114
    ].
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1115
    ^ t truncated.
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1116
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1117
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1118
     (1/3) rounded           
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1119
     (1/3) negated rounded     
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1120
     (1/2) rounded           
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1121
     (1/2) negated rounded   
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1122
     0.5 rounded  
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1123
     -0.5 rounded 
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1124
     (2/3) rounded             
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1125
     (2/3) negated rounded     
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1126
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1127
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1128
    "Modified: 5.11.1996 / 11:32:32 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1129
!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1130
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1131
truncated
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1132
    "return the receiver truncated towards zero as Integer"
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1133
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1134
    ^ numerator quo: denominator
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1135
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1136
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1137
     (3/2) truncated     
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1138
     (3/2) negated truncated  
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1139
    "
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1140
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1141
    "Modified: 5.11.1996 / 12:18:46 / cg"
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1142
! !
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1143
8395
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1144
!Fraction methodsFor:'visiting'!
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1145
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1146
acceptVisitor:aVisitor with:aParameter
16729
0cf2bfd45072 comment/format only
Claus Gittinger <cg@exept.de>
parents: 15278
diff changeset
  1147
    "dispatch for visitor pattern; send #visitFraction:with: to aVisitor"
8395
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1148
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1149
    ^ aVisitor visitFraction:self with:aParameter
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1150
! !
6bd97113cb4c Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 7859
diff changeset
  1151
1878
5615af5e7f47 fixed truncated & rounded for negative fractions
Claus Gittinger <cg@exept.de>
parents: 1556
diff changeset
  1152
!Fraction class methodsFor:'documentation'!
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1153
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1154
version
16729
0cf2bfd45072 comment/format only
Claus Gittinger <cg@exept.de>
parents: 15278
diff changeset
  1155
    ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.83 2014-07-09 16:21:06 cg Exp $'
13357
487c502b40b7 comment/format in: #pi
Claus Gittinger <cg@exept.de>
parents: 11901
diff changeset
  1156
!
487c502b40b7 comment/format in: #pi
Claus Gittinger <cg@exept.de>
parents: 11901
diff changeset
  1157
487c502b40b7 comment/format in: #pi
Claus Gittinger <cg@exept.de>
parents: 11901
diff changeset
  1158
version_CVS
16729
0cf2bfd45072 comment/format only
Claus Gittinger <cg@exept.de>
parents: 15278
diff changeset
  1159
    ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.83 2014-07-09 16:21:06 cg Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1160
! !
6891
212aa8576cf7 oops - did not compare correctly against unnormalized numbers
Claus Gittinger <cg@exept.de>
parents: 6675
diff changeset
  1161
15278
ddf05cd996da class: Fraction
Claus Gittinger <cg@exept.de>
parents: 13357
diff changeset
  1162
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
  1163
Fraction initialize!