RandomLaggedFibonacci.st
author Claus Gittinger <cg@exept.de>
Sat, 02 May 2020 21:40:13 +0200
changeset 5476 7355a4b11cb6
parent 2290 5c14b7344d5c
permissions -rw-r--r--
#FEATURE by cg class: Socket class added: #newTCPclientToHost:port:domain:domainOrder:withTimeout: changed: #newTCPclientToHost:port:domain:withTimeout:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2290
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:libbasic2' }"
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Random subclass:#RandomLaggedFibonacci
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'values drift'
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'Magnitude-Numbers'
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!RandomLaggedFibonacci class methodsFor:'documentation'!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
documentation
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
    The lagged Fibonacci additive generator is described in 
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
    TAOCP vol. 2 by Donald Knuth, with lags 83 and 258.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
"
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
! !
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!RandomLaggedFibonacci methodsFor:'accessing'!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
drift
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    ^ drift
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
drift:something
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
    drift := something.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
next
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
    | answer |
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    answer := self nextValue.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
    self increaseDrift.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
    self values at: self drift put: answer.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
    ^ answer
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
nextValue
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
    | answer |
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    answer := self smallLagValue - self largeLagValue.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    answer < 0.0 ifTrue: [answer := answer + 1.0].
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    ^ answer
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
setSeed: aNumber
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    super setSeed: aNumber.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    self initializeValues
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
values
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    ^ values
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
values:something
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    values := something.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
! !
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
!RandomLaggedFibonacci methodsFor:'initialization'!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
initialize
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    super initialize.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
    self drift: 1.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    self setSeed: (OperatingSystem getMicrosecondTime).
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
    self initializeValueStorage.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    self initializeValues
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
initializeValueStorage
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    |newValues|
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
    newValues := Array new:self largeLag.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    self values:newValues
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
initializeValues
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    |random|
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    random := RandomParkMiller new.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
    random seed:self seed.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
    1 to:self values size do:[:eachIndex | 
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
        self values at:eachIndex put:random next
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    ]
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
! !
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
!RandomLaggedFibonacci methodsFor:'private'!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
increaseDrift
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
    |newDrift|
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
    newDrift := self drift = self largeLag 
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
                    ifTrue:[1] 
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
                    ifFalse:[self drift + 1].
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    self drift:newDrift
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
indexForLag: aLag
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
    | answer |
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    answer := self drift - aLag.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    ^ answer > 0
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
        ifTrue: [answer]
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
        ifFalse: [answer + self largeLag]
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
largeLag
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    ^ 258
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
largeLagValue
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
    ^ self values at: self drift
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
smallLag
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    ^ 83
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
smallLagValue
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
    | index |
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    index := self indexForLag: self smallLag.
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    ^ self values at: index
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
! !
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
!RandomLaggedFibonacci class methodsFor:'documentation'!
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
version_CVS
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    ^ '$Header: /cvs/stx/stx/libbasic2/RandomLaggedFibonacci.st,v 1.1 2009-10-04 20:05:58 cg Exp $'
5c14b7344d5c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
! !