I am the abstract superclass of all classes that represent a group of elements.
ProtoObjectObjectCollection
- Bag
- CharacterSet
- SequenceableCollection
- Set
- WeakRegistry
RandomForPicking |
instance | class |
---|---|
accessing
|
instance creation
|
RandomForPicking |
---|
|
|
adding |
---|
, aCollection |
"Answer a copy of the receiver agregated with the argument, aCollection." ^self copy addAll: aCollection; yourself |
converting |
---|
flattened |
"Answer a new collection containing all my elements, flattened, which means: if an element is a collection, then flatten it as well (recursively). <#(1 #(2 3 4) #(10 #(12 13 14 #(#(100) 200 #(251 252) 300 400)))) flattened>" | newCollection | newCollection := self species new: self size. self do: [:each | each isCollection ifTrue: [newCollection addAll: each flattened] ifFalse: [newCollection add: each]]. ^newCollection |
set operations |
---|
intersectionWith: anotherCollection |
"Return the elements in common with receiver and anotherCollection as an appropriate collection with one instance of each element." ^anotherCollection intersectionWithSet: self asSet |
intersectionWithSet: aSet |
"Return the elements in common with receiver and anotherCollection as an appropriate collection with one instance of each element." ^self asSet intersectionWithSet: aSet |
testing |
---|
allSatisfy: aBlock |
"Note that an empty collection will return true! <'some' allSatisfy: [:each | each isCharacter]> <#() allSatisfy: [:each | each isNumber]> <'some' allSatisfy: [:each | each == true]>" ^(self select: aBlock) includesAll: self |
consistsOf: aCollection |
"Returns true if the contents of the receiver and <aCollection> are exactly the same - order doesn't matter." ^self size = aCollection size and: [self includesAllOccurrences: aCollection] |
includesAll: aCollection |
"Answer whether the receiver includes each element of aCollection." aCollection do: [:each | (self includes: each) ifFalse: [^false]]. ^true |
includesAllOccurrences: aCollection |
"Return true if the receiver includes all elements in aCollection. If aCollection contains duplicate elements, the receiver must have one for each of them." | meAsBag otherBag | aCollection size > self size ifTrue: [^false]. otherBag := aCollection asBag. meAsBag := self asBag. otherBag do: [:each | (meAsBag occurrencesOf: each) < (otherBag occurrencesOf: each) ifTrue: [^false]]. ^true |
includesAny: aCollection |
"Return true if the receiver includes any of the elements in aCollection." aCollection do: [:each | (self includes: each) ifTrue: [^true]]. ^false |
notEmpty |
"Answer whether the receiver contains at least one element." ^self isEmpty not |
instance creation |
---|
newLarge |
^self new: 100 |