2. Hierarchies¶
2.1. Magnitude hierarchy¶
"EssentialsObjectTest, protocol tests"
testMagnitudeSubclasses
^ self exportShapeOf: Magnitude accessorBlock: #asShapeSubclasses
2.1.1. The character π¶
"EssentialsObjectTest, protocol tests"
testInspectCharacterPi
^ self exportSlotsGraphOf: $π
2.1.2. DateAndTime, now¶
"EssentialsObjectTest, protocol tests"
testInspectDatetimeNow
^ self exportSlotsGraphOf: DateAndTime now
2.1.3. The integer 13 in various representations¶
"EssentialsObjectTest, protocol tests"
testInspectInteger13
^ self exportSlotsGraphOf: 13
"EssentialsObjectTest, protocol tests"
testInspectInteger13Detailed
^ self
exportSlotsGraphOf: 13
slotDescriptorsVisitor: CTSlotDescriptorsVisitorDetails new
2.1.4. The irrational π¶
"EssentialsObjectTest, protocol tests"
testInspectFloatPi
^ self exportSlotsGraphOf: Float π
2.1.5. A (reflective) Association¶
"EssentialsObjectTest, protocol tests"
testInspectAssociation
^ self exportSlotsGraphOf: 42 -> thisContext method
2.1.6. Some Fractions, with kisses by mediants¶
Have a look at the fraction \(- {{1} \over {2}}\) by the following inspector,
"EssentialsObjectTest, protocol tests"
testInspectFraction
^ self exportSlotsGraphOf: -1 / 2
Some fractions kiss each other, here we see kisses by mediants via the
polymorphism of the message #\/,
"Fraction, protocol *Containers-Essentials"
\/ anObject
^ anObject mediantFraction: self
"Integer, protocol *Containers-Essentials"
\/ anObject
^ anObject mediantInteger: self
that both implementations dispatch back to their arguments according to
"Integer, protocol *Containers-Essentials"
mediantFraction: aFraction
^ aFraction numerator + self / (aFraction denominator + self)
"Fraction, protocol *Containers-Essentials"
mediantFraction: aFraction
^ aFraction numerator + self numerator
/ (aFraction denominator + self denominator)
for the former and to
"Integer, protocol *Containers-Essentials"
mediantInteger: anInteger
^ self + anInteger / 2
"Fraction, protocol *Containers-Essentials"
mediantInteger: anInteger
^ self numerator + anInteger numerator
/ (self denominator + anInteger denominator)
for the latter. Now we can see some kisses,
"EssentialsObjectTest, protocol tests"
testInspectFractionKissingEnumeration
| fractions n |
n := 7.
fractions := [ :f :seen :frontier :level | level < n ]
kissingFractions.
self assert: fractions size equals: 1 << (n - 1) - 1.
self assert: fractions equals: {
(1 / 7).
(1 / 6).
(2 / 11).
(1 / 5).
(3 / 14).
(2 / 9).
(3 / 13).
(1 / 4).
(4 / 15).
(3 / 11).
(5 / 18).
(2 / 7).
(5 / 17).
(3 / 10).
(4 / 13).
(1 / 3).
(5 / 14).
(4 / 11).
(7 / 19).
(3 / 8).
(8 / 21).
(5 / 13).
(7 / 18).
(2 / 5).
(7 / 17).
(5 / 12).
(8 / 19).
(3 / 7).
(7 / 16).
(4 / 9).
(5 / 11).
(1 / 2).
(6 / 11).
(5 / 9).
(9 / 16).
(4 / 7).
(11 / 19).
(7 / 12).
(10 / 17).
(3 / 5).
(11 / 18).
(8 / 13).
(13 / 21).
(5 / 8).
(12 / 19).
(7 / 11).
(9 / 14).
(2 / 3).
(9 / 13).
(7 / 10).
(12 / 17).
(5 / 7).
(13 / 18).
(8 / 11).
(11 / 15).
(3 / 4).
(10 / 13).
(7 / 9).
(11 / 14).
(4 / 5).
(9 / 11).
(5 / 6).
(6 / 7) }.
^ self exportShapeOf: fractions accessorBlock: #asShapeFordCircles
where
"BlockClosure, protocol *Containers-Essentials"
kissingFractions
| fractions news level |
level := 1.
fractions := SortedCollection with: 0 with: 1.
[
news := OrderedCollection new.
fractions overlappingPairsDo: [ :a :b |
| f |
f := a \/ b.
(self
cull: f
cull: fractions
cull: news
cull: level) ifTrue: [ news add: f ] ].
news isEmpty ] whileFalse: [
fractions addAll: news.
level := level + 1 ].
^ fractions
removeFirst;
removeLast;
asArray
lies on the utility message
"SequenceableCollection, protocol enumerating"
overlappingPairsDo: aBlock
"Emit overlapping pairs of my elements into aBlock"
"(Array streamContents: [:stream | #(1 2 3 4) overlappingPairsDo: [:first :second| stream nextPut: (first + second)]]) >>> #(3 5 7)"
1 to: self size - 1 do: [ :i |
aBlock value: (self at: i) value: (self at: i + 1) ]
understood by objects that play the role of a container, the subject of the next section.
See also
On one hand, more kissing fractions by Diophantine equations are the subject of the section Kissing Fractions; on the other hand, both [Wei12] and [BS14] are inspired by the seminal work [For38].
2.1.7. Magnitude hierarchy, again¶
"EssentialsObjectTest, protocol tests"
testMagnitudeSubclassesSlotsGraph
^ self
exportSlotsGraphOf: Magnitude
slotDescriptorsVisitor: CTSlotDescriptorsVisitorClassHierarchy new
2.2. Link hierarchy¶
"EssentialsObjectTest, protocol tests"
testLinkSubclasses
^ self exportShapeOf: Link accessorBlock: #asShapeSubclasses
2.3. Collection hierarchy¶
"EssentialsObjectTest, protocol tests"
testCollectionSubclasses
^ self exportShapeOf: Collection accessorBlock: #asShapeSubclasses
2.3.1. Lorem ipsum¶
"EssentialsObjectTest, protocol tests"
testInspectString
^ self exportSlotsGraphOf: (String loremIpsum: 100)
2.3.2. An Array of (generalized) Fibonacci numbers¶
Two famous sequences of numbers [Slod] and [Sloe], of Fibonacci numbers
"EssentialsObjectTest, protocol tests"
testInspect20FibonacciNumbers
| fibs |
fibs := 20 fibonacciNumbers.
self
assert: -3 fibonacciNumbers equals: #( );
assert: 0 fibonacciNumbers equals: #( );
assert: 1 fibonacciNumbers equals: #( 0 );
assert: 2 fibonacciNumbers equals: #( 0 1 );
assert: fibs
equals:
#( 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 ).
^ self exportSlotsGraphOf: fibs
and of Lucas numbers
"EssentialsObjectTest, protocol tests"
testInspect20LucasNumbers
| lucas |
lucas := 20 lucasNumbers.
self
assert: -3 lucasNumbers equals: #( );
assert: 0 lucasNumbers equals: #( );
assert: 1 lucasNumbers equals: #( 2 );
assert: 2 lucasNumbers equals: #( 2 1 );
assert: lucas
equals:
#( 2 1 3 4 7 11 18 29 47 76 123 199 322 521 843 1364 2207 3571 5778
9349 ).
^ self exportSlotsGraphOf: lucas
respectively, where both of them
"Integer, protocol *Containers-Essentials"
fibonacciNumbers
^ self gibonacciNumbersFirst: 0 second: 1 do: [ :a :b | a + b ]
"Integer, protocol *Containers-Essentials"
lucasNumbers
^ self gibonacciNumbersFirst: 2 second: 1 do: [ :a :b | a + b ]
lie on
"Integer, protocol *Containers-Essentials"
gibonacciNumbersFirst: first second: second do: aBlock
^ self
ifPositive: [
Array streamContents: [ :aStream |
| a |
a := first.
aStream nextPut: a.
self > 1 ifTrue: [
| b |
b := second.
aStream nextPut: b.
3 to: self do: [ :each |
| c v |
c := aBlock value: a value: b.
aStream nextPut: c.
a := b.
b := c ] ] ] ]
ifNotPositive: [ #( ) ]
Another famous sequence [Slob] reads as
"EssentialsObjectTest, protocol tests"
testInspect20CatalanNumbers
| catalan |
catalan := 20 catalanNumbers.
self
assert: -3 catalanNumbers equals: #( );
assert: 0 catalanNumbers equals: #( );
assert: catalan
equals:
#( 1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900 2674440
9694845 35357670 129644790 477638700 1767263190 ).
^ self exportSlotsGraphOf: catalan
2.3.3. 2-Dimensional arrays¶
"EssentialsObjectTest, protocol tests"
testInspectPascalArray
^ self exportSlotsGraphOf: (Array2D pascal: 1 << 4)
"EssentialsObjectTest, protocol tests"
testInspectCatalanArray
^ self exportSlotsGraphOf: (Array2D catalan: 1 << 4)
2.3.4. Golden ratios¶
The well known Golden ratio looks like
"EssentialsObjectTest, protocol tests"
testInspectGoldenRatio
^ self exportSlotsGraphOf: Float goldenRatio
and also the following golden ratios
"EssentialsObjectTest, protocol tests"
testInspect10GoldenRatios
| ratios |
ratios := 10 goldenRatiosLower.
self
assert: ratios
equals:
#( 1.618033988749895 1 0.6180339887498949 0.3819660112501051
0.2360679774997898 0.1458980337503153 0.09016994374947451
0.05572809000084078 0.03444185374863373 0.021286236252207047 ).
^ self exportSlotsGraphOf: ratios
are generated by the message
"Integer, protocol *Containers-Essentials"
goldenRatiosLower
^ self
gibonacciNumbersFirst: Float goldenRatio
second: 1
do: [ :a :b | a - b ]
that uses the same message and can be used to generate the following golden rectangles
"EssentialsObjectTest, protocol tests"
testInspect10GoldenRectangles
| rectangles |
rectangles := RSGroup withAll:
(self testInspect10GoldenRatios
overlappingPairsCollect: [ :width :height |
RSBox new
cornerRadius: Float goldenRatio double;
extent: width @ height * 100;
color: Color white;
withBorder;
yourself ]).
^ self exportSlotsGraphOf: rectangles
consequently. The previous rectangles can be nested
"EssentialsObjectTest, protocol tests"
testInspect10GoldenRectanglesNested
| rectangles |
rectangles := self testInspect10GoldenRectangles foldr1: [ :each :aBox |
aBox rotateByRadians: Float pi halved negated.
RSLocation new left stick: aBox on: each.
RSComposite new
shapes: {
each.
aBox };
yourself ].
^ self exportShapeOf: rectangles
to have a comprehensive representation.
2.3.4.1. One-to-Many descriptors¶
"EssentialsObjectTest, protocol tests"
testInspectOneToMany
^ self
exportSlotsGraphOf: { 'hello'. 'world' } ~~> ({
42 asValueHolder.
Float goldenRatio asValueHolder } ~~> nil)
slotDescriptorsVisitor:
CTEssentialsOneToManyValueLinksSlotDescriptorsVisitor new
2.3.5. Some ByteArrays¶
On one hand, the combination of the previous two types of objects allows us to inspect a ByteArray object,
"EssentialsObjectTest, protocol tests"
testByteArrayLoremIpsum
^ self exportSlotsGraphOf: (String loremIpsum: 50) asByteArray
On the other hand, a bare bone array of bytes can be built as in
"EssentialsObjectTest, protocol tests"
testByteArrayLiteral
^ self exportSlotsGraphOf: (ByteArray with: 18 with: 10 with: 253)
and, in more simpler terms, even an Integer can be seen as an array of this type
"EssentialsObjectTest, protocol tests"
testByteArrayInteger
^ self exportSlotsGraphOf: 50 fibonacciNumbers last asByteArray
2.3.6. Binary Reflected Gray Codes¶
In [Gra53], Frank Gray introduces “an ordering of the binary numeral system such that two successive values differ in only one bit” – from Wikipedia,
"EssentialsObjectTest, protocol tests"
testInspectBRGCodes
| n |
n := 15.
self
exportSlotsGraphOf: n asBRGCCollection
pathSuffix: 'changing-bits'.
^ self exportSlotsGraphOf: ((0 to: n)
collect: [ :each | each asShapeBRGCDots: CTDfsWalker new ]
as: RSGroup)
also known as [Sloa], where the sequence of bit-changing indexes in adjacent representations,
also known as [Sloc]. The message
"Integer, protocol *Containers-Essentials-Visualizations"
asShapeBRGCDots: aDfsWalker
^ self
asShapeBinaryDots: (self bitBRGC printStringBase: 2) asArray
walker: aDfsWalker
relies on both
"Integer, protocol *Containers-Essentials"
bitBRGC
^ self bitXor: self >> 1
that computes the Gray representation corresponding to the receiver Integer, and
"Integer, protocol *Containers-Essentials-Visualizations"
asShapeBinaryDots: repr walker: aDfsWalker
| dots radiusOrPadding |
radiusOrPadding := aDfsWalker shapeBuilder radiusOrPadding.
dots := repr collect: [ :each |
| int circle color |
int := Integer readFrom: each asString.
circle := RSCircle new
model: int;
radius: radiusOrPadding * 2;
color: Color white;
withBorder;
yourself.
color := int
ifZero: [ Color white ]
ifOne: [ circle border color ]
ifTwo: [
circle border
color: Color black;
color ]
otherwise: [ Error signal ].
circle color: color.
circle ].
RSHorizontalLineLayout new
gapSize: radiusOrPadding / 2;
on: dots.
^ RSComposite new
model: repr;
shapes: dots;
yourself
that computes the dots-oriented representation, empty dots stand for 0s while full dots stand for 1s.
2.3.7. A Heap, step by step construction¶
Here we construct a heap according to the given sequence (order matters),
"EssentialsObjectTest, protocol tests"
testInspectHeap
| array random heap |
random := Random seed: 11.
array := (1 to: 30) asArray shuffleBy: random.
self
assert: array
equals:
#( 12 16 22 30 8 17 15 4 20 19 28 18 27 21 24 10 7 3 14 5 6 26 25
29 11 23 2 9 13 1 ).
heap := Heap new.
self exportSlotsGraphOf: heap.
array withIndexDo: [ :each :i |
heap add: each
"self exportSlotsGraphOf: heap pathSuffix: i asString " ].
self exportSlotsGraphOf: heap pathSuffix: 'final'
step by step; first, the empty heap
second,
which is the final object.
2.3.8. A Set¶
"EssentialsObjectTest, protocol tests"
testInspectSet
| random sample n |
n := 20.
random := Random seed: 11.
sample := (1 to: n) collect: [ :i | random nextInteger: n ].
self
assert: sample
equals: #( 1 9 7 1 18 9 11 10 10 6 5 15 3 8 12 17 8 2 5 15 ).
^ self exportSlotsGraphOf: sample asSet
2.3.9. A Dictionary¶
"EssentialsObjectTest, protocol tests"
testInspectDictionary
^ self exportSlotsGraphOf: (Dictionary new
at: 1 put: 'Hello';
at: 2 -> 3 put: 4;
at: 'World' put: #Smalltalk;
yourself)
2.3.10. A Bag¶
"EssentialsObjectTest, protocol tests"
testInspectBag
^ self exportSlotsGraphOf: (Bag withAll: String loremIpsum)
2.4. Random hierarchy¶
"EssentialsObjectTest, protocol tests"
testRandomSubclasses
^ self exportShapeOf: Random accessorBlock: #asShapeSubclasses
2.4.1. The uniform distribution¶
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testUniform
| gen |
gen := Random seed: 13.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testUniform
where both messages
"Random, protocol accessing"
next
"Answer a random Float in the interval [0 to 1)."
^ self privateNextValue
"Random, protocol private"
privateNextValue
"Answer a random Float in the interval [0 to 1)."
^ (seed := self privateNextSeed) / m
lie on the message
"Random, protocol private"
privateNextSeed
"This method generates random instances of Integer in the interval
0 to 16r7FFFFFFF. This method does NOT update the seed; repeated sends
answer the same value. The algorithm is described in detail in [1]"
| lo hi aLoRHi |
hi := (seed quo: q) asFloat.
lo := seed - (hi * q). " = seed rem: q"
aLoRHi := a * lo - (r * hi).
^ aLoRHi > 0.0
ifTrue: [ aLoRHi ]
ifFalse: [ aLoRHi + m ]
which finally provides the implementation according to [PM88] as the message’s comment states.
2.4.2. The Bernoulli distribution¶
Using a fair coin,
"Random, protocol *Containers-Essentials"
fairCoin
^ (RandomBernoulli seed: seed)
p: 0.5;
yourself
we simulate some tosses
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testBernoulli
| gen |
gen := (Random seed: 13) fairCoin.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testBernoulli
where
"RandomBernoulli, protocol accessing"
next
^ (super next < p) asInteger
2.4.3. The binomial distribution¶
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testBinomial
| gen |
gen := (RandomBinomial seed: 13)
p: 0.7;
n: 20;
yourself.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testBinomial
where
"RandomBinomial, protocol accessing"
next
^ (1 to: n)
inject: 0
into: [ :successes :each | successes + super next asInteger ]
2.4.4. The geometric distribution¶
RandomBernoulli subclass: #RandomGeometric
instanceVariableNames: ''
classVariableNames: ''
package: 'Containers-Essentials-Random'
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testGeometric
| gen |
gen := (RandomGeometric seed: 13)
p: 0.2;
yourself.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testGeometric
where
"RandomGeometric, protocol accessing"
next
| failures |
failures := 0.
[
failures := failures + 1.
super next = 0 ] whileTrue.
^ failures
2.4.5. The exponential distribution¶
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testExponential
| gen |
gen := RandomExponential seed: 13.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testExponential
where
"RandomExponential, protocol accessing"
next
^ (1 - super next) ln negated / lambda
2.4.6. The gaussian distribution¶
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testGaussian
| gen |
gen := RandomGaussian seed: 13.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testGaussian
where
"RandomGaussian, protocol accessing"
next
| z |
[
| u1 u2 |
u1 := super next.
u2 := 1.0 - super next.
z := u1 - 0.5 * magic / u2.
(z / 2) squared > u2 log negated ] whileTrue.
^ z * sigma + mu
2.4.7. The bivariate gaussian distribution¶
A sample from a bivariate Gaussian distribution can be inspected by
"RandomTestDistributions, protocol *Containers-Essentials-Tests"
testGaussianBoxMuller
| gen |
gen := RandomBoxMullerBivariateGaussian seed: 13.
self exportSlotsGraphOf: gen.
self
assert: ((1 to: 1000) collect: [ :each1 | gen next ])
equals: self expectedValue_testGaussianBoxMuller
where the message
"RandomBoxMullerBivariateGaussian, protocol accessing"
next
| u1 u2 z0 z1 z w |
u1 := super next.
u2 := super next.
z := (-2 * u1 ln) sqrt.
w := 2 * Float pi * u2.
z0 := w cos * z.
z1 := w sin * z.
^ z0 @ z1
implements the algorithm described in [BM58].
2.5. RBNode hierarchy¶
"EssentialsObjectTest, protocol tests"
testRBNodeSubclasses
^ self exportShapeOf: RBNode accessorBlock: #asShapeSubclasses
2.5.1. A quine RBProgramNode¶
The Scheme expression
(define quine ((lambda (x) (list x (list (quote quote) x)))
(quote (lambda (x) (list x (list (quote quote) x))))))
defines a binding such that
(equal? (eval quine) quine)
evaluates to #t; in parallel, our Smalltalk implementation
"EssentialsObjectTest, protocol tests"
testInspectRBNodesQuine
| quine aQuineBlock evalBlock |
aQuineBlock := [ :x |
RBMessageNode
receiver: x
selector: #value:
arguments:
{ (RBMessageNode receiver: x selector: #sourceNode) } ].
quine := aQuineBlock value: aQuineBlock sourceNode.
evalBlock := OpalCompiler new
source:
(RBBlockNode body:
(RBSequenceNode statements: { quine }))
formattedCode;
evaluate.
self assert: evalBlock value equals: quine
behaves the same, as required.
2.6. A miscellanea of some objects¶
2.6.1. A Point¶
"EssentialsObjectTest, protocol tests"
testInspectPoint
^ self exportSlotsGraphOf: 42 @ 24
2.6.2. The Color gray, translucent¶
"EssentialsObjectTest, protocol tests"
testInspectColorGray
^ self exportSlotsGraphOf: Color gray translucent
2.6.3. A RSShape of a polygon, quoting itself¶
"EssentialsObjectTest, protocol tests"
testInspectRSPolygon
^ self exportSlotsGraphOf: (RSPolygon new
points: {
(0 @ 0).
(100 @ 25).
(200 @ 0) };
cornerRadii: Float goldenRatio double;
yourself)
2.6.4. A Context¶
"EssentialsObjectTest, protocol tests"
testInspectContext
self timeLimit: 25 seconds.
^ self exportSlotsGraphOf: thisContext
2.6.5. A Git repository¶
"EssentialsObjectTest, protocol tests"
testInspectIceRepositoryCommitsGraph
^ self
exportShapeOf: (IceRepository registry detect: [ :each |
each name = 'Containers-HeapQ' ])
accessorBlock: #asShapeCommitsGraph
