From: Jan@Bytesmiths.com (Jan Steinman)
Date: 1996/02/01
MessageID: Jan-0102962057300001@206.116.214.1
organization: Bytesmiths, the Smalltalk start-up specialists
reply-to: Jan@Bytesmiths.com
newsgroups: comp.lang.smalltalk
'From VisualWorks(R) Release 2.0 of 4 August 1994 on 6 November 1995 at
5:27:43 pm'!
Stream subclass: #Random
instanceVariableNames: 'seed transform '
classVariableNames: ''
poolDictionaries: ''
category: 'Magnitude-Numbers'!
Random comment: 'This is an adaptation of the Park and Miller (CACM
31:10:1192-1201, Oct 1988) random number generator posted to
comp.lang.smalltalk by Jeff Sutherland. We''ve re-written Jeff''s
implementation, following the Blue Book [GOLD89] convention by making it a
Stream subclass, and we''ve added the ability to transform the normalized
Doubles produced with an arbitrary block.
The following comment is from Jeff''s implementation, and is assumed to be
from Park and Miller: "In summary... [this is] a generator which has a
full period, is demonstrably random, and can be implemented correctly on
almost any system. The generator has been exhaustively tested and its
characteristics are well understood... Moreover, it has become a
standard... subroutine DNUN in the IMSL library and... DRAND in the
simulation language SLAM II... we feel confident in recommending this
random number generator as a minimal standard against which all others
should be judged."
This entire implementation of Random is Copyright 1995, Bytesmiths. It may
be used for any legal purpose, as long as this entire paragraph remains
intact and no portion of this class is copied or re-distributed without
this paragraph. Bytesmiths is a technical services company specializing in
Smalltalk process, methodology, architecture, design, and implementation.
This is a component of the Bytesmiths Toolkit, which we provide to
long-term clients. Bugs, comments, and information requests should be sent
to <Jan.Bytesmiths@acm.org> or by phone at +1 503 657 7703.
Diagram:
This interaction diagram shows the internal workings of a Random.
Examples:
This example drawing of a Random, shows its basic structure.
Tests:
Run all tests defined for Random and view the results.
Run all tests
Examine the specifications of all tests defined for Random.
Test specifications
Variables:
Examine the specifications of variables within the scope of Random and its
instances.
Variable specifications
'!
!Random methodsFor: 'accessing'!
next
"Answer the next random element, as transformed from a normalized
random Double in the open interval 0..1."
^transform == nil
ifTrue: [self nextNormal]
ifFalse: [transform value: self nextNormal value: self]!
nextNormal
"Answer the next normalized random Double in the open interval 0..1.
This uses the Park & Miller RNG described in CACM 31:10:1192-1201, Oct
1988. This is adapted from an implementation posted to comp.lang.smalltalk
by Jeff Sutherland."
"For speed and readability, constants are used instead of the class
variables in Jeff's implementation."
| hi test |
hi := seed quo: 127773.
test := (16807 * (seed - (127773 * hi))) - (2836 * hi).
seed := test > 0.0
ifTrue: [test]
ifFalse: [test + 2147483647d].
^seed / 2147483647d!
nextPut: newSeed
"Normally, I should not have my seed changed once I'm initialized, but
what the heck!!"
^seed := newSeed asInteger! !
!Random methodsFor: 'initialize-release'!
seed: newSeed transform: twoArgTransform
"Initialize me so I am ready to answer new random objects.
<newSeed> must be a Number, typically a SmallInteger from some
quasi-random source, such as the number of seconds since midnight.
<twoArgTransform> may be nil, in which case I produce normalized
Doubles in the open interval 0..1 when I am sent #next. If it is a two
argument block, it is passed a normalized Double and myself as arguments
when I am sent #next, and the evaluation of <twoArgTransform> is answered.
"
seed := newSeed.
transform := twoArgTransform! !
!Random methodsFor: 'printing'!
printOn: aStream
"Plase a printable representation of myself on <aStream>."
super printOn: aStream.
transform == nil ifFalse:
[aStream nextPutAll: ' transformed by '.
transform printNameOn: aStream inClass: nil]! !
!Random methodsFor: 'QA'!
seed
"Private -- answer my current seed. This is for testing only, and
should NOT be used except for white-box testing!!"
^seed! !
!Random methodsFor: 'testing'!
atEnd
"Am I at my end? No, I have no end."
^false!
isReadable
"Am I readable? Certainly!!"
^true!
isWritable
"Am I writable? Well, not practically, but I'll let you change my seed
this way if you must."
^true! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Random class
instanceVariableNames: ''!
!Random class methodsFor: 'compatibility'!
fromGenerator: ignore seededWith: s
"This is for compatibility with VisualWorks Random class. Simply answer
a new instance with the given seed."
^self seed: s onNextDo: nil! !
!Random class methodsFor: 'examples'!
essay
"This method is required for meeting Bytesmiths documentation standards."
| essay words word sentence paragraph punctuation emphasis |
essay := TextStream on: (String new: 6000).
words := self fakeWords.
sentence := self truth: 0.1. "10% of words end a sentence,"
paragraph := self truth: 0.2. "20% of sentences end a paragraph,"
punctuation := self onNextDo: [:next :ignored |
next > 0.9 "10% of sentences end in an exclam,"
ifTrue: [$!!] ifFalse:
[next > 0.8 "another 10% of sentences form a question."
ifTrue: [$?]
ifFalse: [$.]]].
emphasis := self onNextDo: [:r :ignored |
r > 0.03 ifTrue:
[] ifFalse:
[r > 0.02 ifTrue:
[#bold] ifFalse:
[r > 0.01 ifTrue:
[#italic] ifFalse:
"r <= 0.01 ifTrue:"
[#underline]]]].
word := words next.
word at: 1 put: word first asUppercase.
essay emphasis: (Array with: #large with: #bold with:
#color->ColorValue red); nextPutAll: 'Report on the '; nextPutAll: word;
nextPutAll: ' Project'; emphasis: nil; cr; cr.
word := words next.
word at: 1 put: word first asUppercase.
essay space; space; space; nextPutAll: word.
1000 timesRepeat:
[word := words next.
sentence next ifTrue:
[word at: 1 put: word first asUppercase.
essay nextPut: punctuation next.
paragraph next ifTrue:
[essay cr; cr; space; space; space]].
essay
space;
emphasis: emphasis next;
nextPutAll: word;
emphasis: nil].
^essay nextPut: $.; contents!
fakeWords
"Answer an instance that is initialized in such a way that it creates
Strings that are somewhat like English (yea, right!!) words."
| consonants vowels all |
consonants := 'bcdfghjklmnpqrstvwxyz'.
vowels := 'aeiou'.
all := vowels, consonants.
^self onNextDo: [:rn :rng | | word charSet |
word := String new: (rn * 8 + 2) truncated.
word at: 1 put: (all at: (rng nextNormal * all size + 1) truncated).
2 to: word size do: [:i |
charSet := (word at: i - 1) isVowel ifTrue: [consonants] ifFalse:
[vowels].
word at: i put: (charSet at: (rng nextNormal * charSet size + 1)
truncated)].
word]!
proverb
"Supply a fortune."
^self onNextDo: [:ignored1 :ignored2 |
(UnixProcess cshOne: '/usr/local/games/fortune') copyReplaceAll: '
' with: ' ']! !
!Random class methodsFor: 'instance creation'!
delayUpTo: maxDelay
"Create and answer an instance of me that suspends the sender for a
random number of milliseconds less than maxDelay."
^self onNextDo: [:f :ignore | | delay |
(delay ? [delay := Delay new])
delay: (f * maxDelay) asInteger;
wait]!
from: collection
"Create and answer a instance of me that answers random objects from
the given <collection>."
| sequence range |
sequence := collection isSequenceable
ifTrue: [collection]
ifFalse: [collection asArray].
range := sequence size.
^self onNextDo: [:random :ignored |
sequence at: (random * range + 1) truncated]!
new
"Answer a new generator, seeded from some number that is unlikely to be
repeated soon. For performance, try to keep things within a SmallInteger."
^self basicNew seed: Time millisecondClockValue transform: nil!
onNextDo: twoArgBlock
"Create and answer a instance of me that answers random objects that
have been transformed from normal random numbers (which are Doubles
between zero and one, non-inclusive) according to <twoArgBlrock>.
The first argument is a normal random number, as defined above.
The second argument is the new instance of me, which can be sent
#normalNext in order to provide more than one normal random number. (Do
not send the second argument #next inside the block!!)
When the new instance is sent #next, <twoArgBlock> is evaluated with
the above arguments, and the result of the last statement is answered."
^self seed: Time millisecondClockValue onNextDo: twoArgBlock!
pointsWithin: rectangle
"Create and answer a instance of me that answers random Float Points
within the given <rectangle>, non-inclusive of the edges."
| xMin yMin xRange yRange |
xMin := rectangle top.
yMin := rectangle left.
xRange := rectangle extent x.
yRange := rectangle extent y.
^self onNextDo: [:x :yGenerator |
(x * xRange + xMin) @ (yGenerator nextNormal * yRange + yMin)]!
seed: s onNextDo: twoArgBlock
"Create and answer a instance of me that answers random objects that
have been transformed from normal random numbers (which are Doubles
between zero and one, non-inclusive) according to <twoArgBlrock>.
The first argument is a normal random number, as defined above.
The second argument is the new instance of me, which can be sent
#normalNext in order to provide more than one normal random number. (Do
not send the second argument #next inside the block!!)
When the new instance is sent #next, <twoArgBlock> is evaluated with
the above arguments, and the result of the last statement is answered."
^self basicNew seed: s transform: twoArgBlock!
smallIntegers
"Create and answer a instance of me that answers random SmallIntegers"
^self within: (SmallInteger minVal to: SmallInteger maxVal)!
truth: probability
"Create and answer a instance of me that answers random true or false,
with the given <probability> of truth."
^self onNextDo: [:next :ignored | next <= probability]!
within: interval
"Create and answer a instance of me that answers random numbers within
the given <interval>. If both ends of the interval are Integers, then the
answers will be Integers, inclusive of the ends, otherwise the answers
will be Floats strictly within the interval, non-inclusive of the ends."
| head range |
head := interval first.
range := interval last - interval first.
^self onNextDo: [:random :ignored |
head isInteger
ifTrue: [(random * range + head) rounded]
ifFalse: [random * range + head]]! !
!Random class methodsFor: 'QA'!
testCoverage
"Visual coverage test -- make this window full-screen size before
starting. Let it run overnight."
"self testCoverage"
| activeView points gc |
activeView := ScheduledControllers activeController view.
points := self pointsWithin: activeView bounds.
gc := activeView graphicsContext.
gc paint: ColorValue darkRed.
[InputState default shiftDown] whileFalse:
[gc primDisplayRectangleOrigin: points next extent: 1@1].
activeView refresh!
testValidity
"Validity test for random number generator."
|num t |
num := self basicNew.
num seed: 1 transform: nil.
t := Time millisecondsToRun: [10000 timesRepeat: [num next]].
^(1043618065 = num seed)
ifTrue: [t]
ifFalse: ['Bad result. Fix this generator by referring to Park &
Miller, Comm ACM 31:10:1192-1201, 1988.']! !
!Collection methodsFor: 'Bytesmiths enhancements'!
randomStream
"Answer a random stream on my contents."
^Random from: self! !
: Jan Steinman <mailto:Jan@Bytesmiths.com>
: Bytesmiths, the Smalltalk specialists <http://www.bytesmiths.com>
: 2002 Parkside Court, West Linn, OR 97068 USA +1 503 657 7703