On Tue, 2007-04-10 at 08:06 +0200, Paolo Bonzini wrote: > The best way to do so would be the other way round: > subclass OrderedCollection, wrapping all the "add" methods > with a test for inclusion (using the hashed collection), > and redefining #includes: so that it uses the hashed > collection. This would have the advantage that you > could use the same class for both OrderedSet and > OrderedIdentitySet.
Since I wrote OrderedSet for the core as a subclass of OrderedCollection, I thought I might ask what specifically would be more useful: 1. An OrderedCollection that does not allow two "equal" elements (at:put: fails if element is already present and not at that position, add: ignores argument if already present). 2. A <Set> that remembers the order in which elements were added (the OrderedCollection protocols missing from Set are self shouldNotImplement) The difference is that the attached follows 1 and supports all of OrderedCollection's operations (forgive the usingSet: nonsense that is just there until I come up with something better). After writing them, I thought that maybe they should not be supported at all (except for the index = collection size case). -- ;;; Stephen Compall ** http://scompall.nocandysw.com/blog ** Failure to imagine vast possibilities usually stems from a lack of imagination, not a lack of possibility.
"======================================================================
|
| OrderedSet Method Definitions
|
|
======================================================================"
"======================================================================
|
| Copyright (C) 2006
| Free Software Foundation, Inc.
| Written by Stephen Compall.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
|
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
| General Public License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.
|
======================================================================"
OrderedCollection variableSubclass: #OrderedSet
instanceVariableNames: 'unorderedSet'
classVariableNames: ''
poolDictionaries: ''
category: 'Collections-Sequenceable'
!
OrderedSet comment:
'My instances represent sets of unique objects that may be accessed by
an arbitrary index. Besides allowing addition, removal, and insertion
of objects at indexed locations in my instances, I impose the
invariant that a particular element cannot appear more than once.
This invariant leads to varying behavior, as in some cases it makes
sense to behave as an OrderedCollection, whereas in others it makes
more sense to behave as a Set. For example, #collect: may answer an
OrderedSet with fewer elements than the receiver, #at:put: will signal
an error if its put: argument is already present as a different
element, and #with:with: may potentially answer an OrderedSet with
only one element.
I use a Set, called "unordered set", to decide whether an element is
already present.'
!
!OrderedSet class methodsFor: 'instance creation'!
new: anInteger
"Answer an OrderedSet of size anInteger."
^(super new: anInteger)
unorderedSet: (self setFactory new: anInteger);
yourself
!
new: anInteger usingSet: anEmptySet
"Answer an OrderedSet of size anInteger, that uses anEmptySet as
an unordered set to maintain my set-property."
^(super new: anInteger)
unorderedSet: anEmptySet;
yourself
!
usingSet: anEmptySet
"Answer an OrderedSet that uses anEmptySet as an unordered set to
maintain my set-property."
^self new unorderedSet: anEmptySet; yourself
!
setFactory
"Answer a class (<Set factory>) that can create a default
unordered Set for new instances."
^Set
! !
!OrderedSet methodsFor: 'accessing'!
at: anIndex put: anObject
"Store anObject at the anIndex-th item of the receiver, answer
anObject. Signal an error if anObject is already present as
another element of the receiver."
| oldElement |
oldElement := self at: anIndex.
"Though it is somewhat inefficient to remove then possibly readd
the old element, the case is rare enough that the precision of
unorderedSet-based comparison is worth it."
unorderedSet remove: oldElement.
(unorderedSet includes: anObject)
ifTrue: [unorderedSet add: oldElement.
^self error: 'anObject is already present'].
unorderedSet add: anObject.
^super at: anIndex put: anObject
! !
!OrderedSet methodsFor: 'copying'!
postCopy
super postCopy.
unorderedSet := unorderedSet copy.
!
copyEmpty: newSize
"Answer an empty copy of the receiver."
^(self species basicNew: newSize)
unorderedSet: (unorderedSet copyEmpty: newSize);
yourself
! !
!OrderedSet methodsFor: 'searching for elements'!
includes: anObject
"Answer whether anObject is one of my elements, according to my
'unordered set'."
^unorderedSet includes: anObject
!
occurrencesOf: anObject
"Answer how many of anObject I contain. As I am a set, this is
always 0 or 1."
^(self includes: anObject) ifTrue: [1] ifFalse: [0]
!
indexOf: anElement startingAt: anIndex ifAbsent: exceptionBlock
"Answer the first index > anIndex which contains anElement.
Invoke exceptionBlock and answer its result if no item is found."
^((self includes: anElement)
or: [(anIndex between: 1 and: self size + 1) not])
"if anIndex isn't valid, super method will catch it. Also,
super method may not find the element, which is fine"
ifTrue: [super indexOf: anElement startingAt: anIndex
ifAbsent: exceptionBlock]
ifFalse: [exceptionBlock value]
! !
!OrderedSet methodsFor: 'adding'!
add: anObject
"Add anObject in the receiver if it is not already present, and
answer it."
(unorderedSet includes: anObject)
ifFalse: [super add: anObject.
unorderedSet add: anObject.].
^anObject
!
add: newObject afterIndex: i
"Add newObject in the receiver just after the i-th, unless it is
already present, and answer it. Fail if i < 0 or i > self size "
(unorderedSet includes: newObject)
ifFalse: [super add: newObject afterIndex: i.
unorderedSet add: newObject.].
^newObject
!
addAll: aCollection
"Add every item of aCollection to the receiver that is not already
present, and answer it."
^self addAllLast: aCollection
!
addAll: newCollection afterIndex: i
"Add every item of newCollection to the receiver just after
the i-th, answer it. Fail if i < 0 or i > self size"
| index |
(i between: 0 and: self size) ifFalse: [
^SystemExceptions.IndexOutOfRange signalOn: self withIndex: i
].
index := i + firstIndex.
self makeRoomLastFor: newCollection size.
lastIndex to: index by: -1 do: [ :i |
self basicAt: i + newCollection size put: (self basicAt: i)
].
lastIndex := lastIndex + newCollection size.
newCollection do: [:each |
(unorderedSet includes: each) ifFalse:
[unorderedSet add: each.
self basicAt: index put: each.
index := 1 + index.]].
self closeGapFrom: index - firstIndex + 1
to: i + newCollection size.
^newCollection
!
addAllFirst: aCollection
"Add every item of newCollection to the receiver right at the start
of the receiver. Answer aCollection"
| index |
self makeRoomFirstFor: aCollection size.
firstIndex := index := firstIndex - aCollection size.
aCollection do: [:elt |
(unorderedSet includes: elt) ifFalse:
[self basicAt: index put: elt.
unorderedSet add: elt.
index := index + 1]].
self closeGapFrom: index - firstIndex + 1 to: aCollection size.
^aCollection
!
addAllLast: aCollection
"Add every item of newCollection to the receiver right at the end
of the receiver. Answer aCollection"
| index newElements newElementCount |
"might be too big, but probably not too much"
self makeRoomLastFor: aCollection size.
aCollection do: [ :element |
(unorderedSet includes: element)
ifFalse: [lastIndex := lastIndex + 1.
self basicAt: lastIndex put: element.
unorderedSet add: element]].
^aCollection
!
addFirst: newObject
"Add newObject to the receiver right at the start of the receiver,
unless it is already present as an element. Answer newObject"
(unorderedSet includes: newObject)
ifFalse: [unorderedSet add: newObject.
super addFirst: newObject].
^newObject
!
addLast: newObject
"Add newObject to the receiver right at the end of the receiver,
unless it is already present as an element. Answer newObject"
(unorderedSet includes: newObject)
ifFalse: [unorderedSet add: newObject.
super addLast: newObject].
^newObject
! !
!OrderedSet methodsFor: 'removing'!
removeFirst
"Remove an object from the start of the receiver. Fail if the receiver
is empty"
^unorderedSet remove: super removeFirst
!
removeLast
"Remove an object from the end of the receiver. Fail if the receiver
is empty."
^unorderedSet remove: super removeLast
!
removeAtIndex: anIndex
"Remove the object at index anIndex from the receiver. Fail if the
index is out of bounds."
^unorderedSet remove: (super removeAtIndex: anIndex)
! !
!OrderedSet methodsFor: 'private methods'!
closeGapFrom: gapStart to: gapEnd
"Remove all elements between gapStart and gapEnd, inclusive,
without modifying the unordered set. I simply ignore this
message if gapStart or gapEnd is bad."
| realStart realEnd |
"these vars are almost always exactly the current basic gap"
realStart := firstIndex + gapStart - 1.
realEnd := firstIndex + gapEnd - 1.
"trivial cases"
(gapStart <= gapEnd and:
[(realStart between: firstIndex and: lastIndex) and:
[realEnd between: firstIndex and: lastIndex]])
ifFalse: [^self].
realEnd = lastIndex ifTrue: [lastIndex := realStart - 1. ^self].
realStart = firstIndex ifTrue: [firstIndex := realEnd + 1. ^self].
"shift from before?"
(gapStart - 1) < (lastIndex - realEnd)
ifTrue:
[[self basicAt: realEnd
put: (self basicAt: (realStart := realStart - 1)).
realEnd := realEnd - 1.
realStart = firstIndex] whileFalse.
firstIndex := realEnd + 1]
ifFalse:
["shift from after"
[self basicAt: realStart
put: (self basicAt: (realEnd := realEnd + 1)).
realStart := realStart + 1.
realEnd = lastIndex] whileFalse.
lastIndex := realStart - 1].
"help the gc"
realStart to: realEnd do: [:i | self basicAt: i put: nil].
!
growBy: delta shiftBy: shiftCount
"This may be private to OrderedCollection, but its inlining of
new-instance filling breaks me."
| uSet |
uSet := unorderedSet.
super growBy: delta shiftBy: shiftCount.
"effectively copy after #become: invocation"
unorderedSet := uSet.
!
unorderedSet: aSet
unorderedSet := aSet
! !
signature.asc
Description: This is a digitally signed message part
_______________________________________________ help-smalltalk mailing list [EMAIL PROTECTED] http://lists.gnu.org/mailman/listinfo/help-smalltalk
