hg/stx-libbasic: comparison SortedCollection.st

equal deleted inserted replaced

-:d060f9801f9a
+:cd84f2138c53
+"{ Encoding: utf8 }"
 "
 COPYRIGHT (c) 1993 by Claus Gittinger
 	      All Rights Reserved
 This software is furnished under a license and may be used
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 "{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
 OrderedCollection subclass:#SortedCollection
 	instanceVariableNames:'sortBlock'
 	classVariableNames:'DefaultSortBlock'
 	poolDictionaries:''
 "/ which often happens.
 "/ so we allow the code to be a bit more complicated...
 (lastIndex < firstIndex "i.e. self size == 0"
 or:[
-lastElement := contentsArray at:lastIndex.
+lastElement := contentsArray basicAt:lastIndex.
 (sortBlock value:lastElement value:anObject)
 ]) ifTrue:[
 "/ empty or lastElement is smaller then newElement; add at the end
 index := lastIndex.
 (index == contentsArray size) ifTrue:[
 srcIndex1 := firstIndex.
 last1 := srcIndex1 + n1 -1.
 (srcIndex1 <= last1 and:[srcIndex2 <= last2]) ifTrue:[
-el1 := contentsArray at:srcIndex1.
+el1 := contentsArray basicAt:srcIndex1.
-el2 := contentsArray2 at:srcIndex2.
+el2 := contentsArray2 basicAt:srcIndex2.
 end1Reached := end2Reached := false.
 [end1Reached or:[end2Reached]] whileFalse:[
 (sortBlock value:el1 value:el2) ifTrue:[
 "/ el1 to come before el2
-newContentsArray at:destIndex put:el1. destIndex := destIndex + 1.
+newContentsArray basicAt:destIndex put:el1. destIndex := destIndex + 1.
 srcIndex1 := srcIndex1 + 1.
 srcIndex1 <= last1 ifTrue:[
-el1 := contentsArray at:srcIndex1.
+el1 := contentsArray basicAt:srcIndex1.
 ] ifFalse:[
 end1Reached := true
 ]
 ] ifFalse:[
 "/ el2 to come before el1
-newContentsArray at:destIndex put:el2. destIndex := destIndex + 1.
+newContentsArray basicAt:destIndex put:el2. destIndex := destIndex + 1.
 srcIndex2 := srcIndex2 + 1.
 srcIndex2 <= last2 ifTrue:[
-el2 := contentsArray2 at:srcIndex2.
+el2 := contentsArray2 basicAt:srcIndex2.
 ] ifFalse:[
 end2Reached := true
 ]
 ]
 ]
 |newCollection
 start  "{ Class:SmallInteger }"
 stop   "{ Class:SmallInteger }" |
-newCollection := OrderedCollection new:(self size).
+newCollection := self speciesForCollecting new:(self size).
 stop := lastIndex.
 start := firstIndex.
 start to:stop do:[:index |
-	newCollection add:(aBlock value:(contentsArray at:index)).
+newCollection add:(aBlock value:(contentsArray basicAt:index)).
 ].
 ^ newCollection
 ! !
 !SortedCollection methodsFor:'instance protocol'!
 "
 ! !
 !SortedCollection methodsFor:'private'!
+indexForInserting:anObject
+"search the index at which to insert anObject.
+Can also be used to search for an existing element
+by checking if the element at the returned index is the one we look for.
+Uses a binarySearch since we can depend on the elements being in sorted order.
+The returned index is a physical one, for accessing contentsArray."
+|low    "{ Class: SmallInteger}"
+high   "{ Class: SmallInteger}"
+middle "{ Class: SmallInteger}"
+element|
+"
+we can of course use a binary search - since the elements are sorted
+"
+low := firstIndex.
+high := lastIndex.
+[low > high] whileFalse:[
+middle := (low + high) // 2.
+element := contentsArray basicAt:middle.
+(sortBlock value:element value:anObject) ifTrue:[
+"middleelement is smaller than object"
+low := middle + 1
+] ifFalse:[
+high := middle - 1
+]
+].
+^ low
+"
+#(1 2 3 4 7 99 1313 981989 898989898) asSortedCollection indexForInserting:50
+#(1.0 2.0 3 4 7 49.0 51.0 99 1313 981989 898989898) asSortedCollection indexForInserting:50
+"
+"Modified: 12.4.1996 / 13:22:03 / cg"
+!
 setSortBlock: aSortBlock
 "set the sortblock without resorting - private only"
 sortBlock := aSortBlock
 ! !
 isSortedCollection
 "return true. if I am a sorted collection"
 ^ true
+!
+speciesForCollecting
+"Redefined to return an OrderedCollection;
+see X3J20 spec. (SortedCollection>>collect: should return an OrderedCollection)"
+^ OrderedCollection
 ! !
 !SortedCollection methodsFor:'searching'!
 after:anObject ifAbsent:exceptionBlock
 exceptionBlock."
 |index      "{ Class: SmallInteger }"
 last       "{ Class: SmallInteger }"|
-index := self indexForInserting:anObject.
+index := self indexOf:anObject.
-((index < firstIndex)
+index == 0 ifTrue:[
-or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
+^ exceptionBlock value.
+].
 "skip multiple occurrences of the same ..."
+index := index + firstIndex - 1.
 last := lastIndex.
-[(index <= last) and:[(contentsArray at:index) = anObject]] whileTrue:[
+[(index <= last) and:[(contentsArray basicAt:index) = anObject]] whileTrue:[
-	index := index + 1
+index := index + 1
 ].
-(index > last) ifTrue:[^ nil].
+(index > last) ifTrue:[^ exceptionBlock value].
-^ contentsArray at:index
+^ contentsArray basicAt:index
-"Modified: 12.4.1996 / 13:20:33 / cg"
+"
+#(7 3 9 10 99) asSortedCollection after:50
+#(7 3 9 10 99) asSortedCollection after:3
+#(7 3 9 10 99) asSortedCollection after:1
+#(7 3 9 10 99) asSortedCollection after:10
+#(7 3 9 10 99) asSortedCollection after:7
+#(7 3 9 10 99) asSortedCollection after:99
+#(7 10 3 10 9 10 10 99) asSortedCollection after:9
+#(7 10 3 10 9 10 10 99) asSortedCollection after:10
+"
 !
 before:anObject ifAbsent:exceptionBlock
 "return the element before the argument, anObject; or nil if there is none.
 If the receiver does not contain anObject, return the result from evaluating
 exceptionBlock."
 |index      "{ Class: SmallInteger }"|
-index := self indexForInserting:anObject.
+index := self indexOf:anObject.
-((index <= firstIndex)
+index <= 1 ifTrue:[
-or:[(contentsArray at:index) ~= anObject]) ifTrue:[^ exceptionBlock value].
+^ exceptionBlock value.
+].
-^ contentsArray at:index - 1
+^ contentsArray basicAt:firstIndex + index - 2
 "
 #(7 3 9 10 99) asSortedCollection before:50
+#(7 3 9 10 99) asSortedCollection before:3
 #(7 3 9 10 99) asSortedCollection before:1
 #(7 3 9 10 99) asSortedCollection before:10
 #(7 3 9 10 99) asSortedCollection before:7
 #(7 3 9 10 99) asSortedCollection before:99
 #(7 10 3 10 9 10 10 99) asSortedCollection before:9
 #(7 10 3 10 9 10 10 99) asSortedCollection before:10
 "
 !
-indexForInserting:anObject
+indexOf:anObject
-"search the index at which to insert anObject.
+"return true, if the argument, anObject is in the collection.
-Can also be used to search for an existing element
+Redefined, since due to being sorted, the inclusion check can
-by checking if the element at the returned index is the one we look for.
+be done with log-n compares i.e. much faster."
-Uses a binarySearch since we can depend on the elements being in sorted order.
-The returned index is a physical one, for accessing contentsArray."
+|index "{ Class: SmallInteger }"
+initialIndex "{ Class: SmallInteger }"
-|low    "{ Class: SmallInteger}"
-high   "{ Class: SmallInteger}"
-middle "{ Class: SmallInteger}"
 element|
-"
+"/ if I am small, the inherited linear search is faster ...
-we can of course use a binary search - since the elements are sorted
+(lastIndex - firstIndex) < 20 ifTrue:[
-"
+firstIndex > lastIndex ifTrue:[
-low := firstIndex.
+"/ empty
-high := lastIndex.
+^ 0
-[low > high] whileFalse:[
+].
-middle := (low + high) // 2.
+^ super indexOf:anObject.
-element := contentsArray at:middle.
+].
-(sortBlock value:element value:anObject) ifTrue:[
-"middleelement is smaller than object"
+initialIndex := self indexForInserting:anObject.
-low := middle + 1
+initialIndex > lastIndex ifTrue:[
-] ifFalse:[
+initialIndex := lastIndex
-high := middle - 1
+] ifFalse:[
+initialIndex < firstIndex ifTrue:[
+initialIndex := firstIndex
 ]
 ].
-^ low
+"the complex case: the collection may include elements, which are odered only by
-"
+a single component (e.g. Associations by key). So we have to test all
-#(1 2 3 4 7 99 1313 981989 898989898) asSortedCollection indexForInserting:50
+previous and next elements having the same component"
-#(1.0 2.0 3 4 7 49.0 51.0 99 1313 981989 898989898) asSortedCollection indexForInserting:50
+"for previous elements: while element is not smaller and not larger than anObject ... compare"
+index := initialIndex.
-"
+[index >= firstIndex
+and:[
-"Modified: 12.4.1996 / 13:22:03 / cg"
+element := contentsArray basicAt:index.
-!
+((sortBlock value:element value:anObject) or:[sortBlock value:anObject value:element]) not]
+] whileTrue:[
-indexOf:anElement
+element = anObject ifTrue:[
-"Return the index of anElement within the receiver.
+^ index - firstIndex + 1.
-If the receiver does not contain anElement, return 0."
+].
+index := index - 1.
-^ self indexOf:anElement ifAbsent:0
+].
+"for next elements: while element is not smaller and not larger than anObject ... compare"
+index := initialIndex.
+[index <= lastIndex
+and:[
+element := contentsArray basicAt:index.
+((sortBlock value:element value:anObject) or:[sortBlock value:anObject value:element]) not]
+] whileTrue:[
+element = anObject ifTrue:[
+^ index - firstIndex + 1.
+].
+index := index + 1.
+].
+^ 0.
+"
+#(7 3 9 10 99) asSortedCollection indexOf:50
+#(7 3 9 10 99) asSortedCollection indexOf:10
+#('aa' 'bb' 'cc' 'dd') asSortedCollection indexOf:'bb'
+#('aa' 'bb' 'cc' 'dd' 'aa' 'bb' 'cc' 'dd') asSortedCollection indexOf:'bb'
+|allSyms indices|
+allSyms := Symbol allInstances asSortedCollection.
+Time millisecondsToRun:[
+indices := allSyms collect:[:el | allSyms indexOf:el].
+].
+indices = (1 to:allSyms size)
+"
 !
 indexOf:anElement ifAbsent:exceptionBlock
 "Return the index of anElement within the receiver.
 If the receiver does not contain anElement,
 return the result of evaluating the argument, exceptionBlock."
-|insertionIndex index "{ Class: SmallInteger }"
+|idx|
-obj|
+idx := self indexOf:anElement.
-firstIndex > lastIndex ifTrue:[
+idx == 0 ifTrue:[^ exceptionBlock value].
-	"/ empty
+^ idx.
-	^ exceptionBlock value
-].
-"/ if I am small, the inherited linear search is faster ...
-(lastIndex - firstIndex) < 20 ifTrue:[
-	^ super indexOf:anElement ifAbsent:exceptionBlock
-].
-insertionIndex := self indexForInserting:anElement.
-insertionIndex > lastIndex ifTrue:[
-	insertionIndex := lastIndex
-] ifFalse:[
-	insertionIndex < firstIndex ifTrue:[
-	    insertionIndex := firstIndex
-	]
-].
-index := insertionIndex.
-[index >= firstIndex
-and:[obj := contentsArray basicAt:index.
-	    anElement = obj ifTrue: [^ index - firstIndex + 1].
-	    [sortBlock value:anElement value:obj]]]
-		    whileTrue: [index := index - 1].
-index := insertionIndex.
-[index <= lastIndex
-and: [obj := contentsArray basicAt: index.
-	    anElement = obj ifTrue: [^ index - firstIndex + 1].
-	    [sortBlock value:obj value:anElement]]]
-		    whileTrue: [index := index + 1].
-^exceptionBlock value
-"
-#('aa' 'bb' 'cc' 'dd') asSortedCollection indexOf:'bb'
-#('aa' 'bb' 'cc' 'dd' 'aa' 'bb' 'cc' 'dd') asSortedCollection indexOf:'bb'
-|allSyms indices|
-allSyms := Symbol allInstances asSortedCollection.
-Time millisecondsToRun:[
-	 indices := allSyms collect:[:el | allSyms indexOf:el].
-].
-indices = (1 to:allSyms size)
-"
 !
 largest:n
 "return a collection containing the n largest elements, largest last.
 Raises an exception, if the receiver does not contain at least n elements"
 !SortedCollection methodsFor:'statistical functions'!
 median
 "Return the middle element, or as close as we can get."
-^ self at:(self size + 1 // 2)
+^ self basicAt:(self size + 1 // 2)
 "
 #(10 35 20 45 30 5) asSortedCollection median
 #(10 35 20 45 30 5) median
 "
 includes:anObject
 "return true, if the argument, anObject is in the collection.
 Redefined, since due to being sorted, the inclusion check can
 be done with log-n compares i.e. much faster."
-|index "{ Class: SmallInteger }"|
+|index "{ Class: SmallInteger }"
+initialIndex "{ Class: SmallInteger }"
-index := self indexForInserting:anObject.
+element|
-((index < firstIndex) or:[index > lastIndex]) ifTrue:[^ false].
-^ (contentsArray at:index) = anObject
+"/ if I am small, the inherited linear search is faster ...
+(lastIndex - firstIndex) < 20 ifTrue:[
+firstIndex > lastIndex ifTrue:[
+"/ empty
+^ false
+].
+^ super includes:anObject.
+].
+initialIndex := self indexForInserting:anObject.
+((initialIndex < firstIndex) or:[initialIndex > lastIndex]) ifTrue:[^ false].
+(contentsArray basicAt:initialIndex) = anObject ifTrue:[
+"the simple case - plain objects"
+^ true.
+].
+"the complex case: the collection may include elements, which are odered only by
+a single component (e.g. Associations by key). So we have to test all
+previous and next elements having the same component"
+"for previous elements: while element is not smaller and not larger than anObject ... compare"
+index := initialIndex - 1.
+[index >= firstIndex
+and:[
+element := contentsArray basicAt:index.
+((sortBlock value:element value:anObject) or:[sortBlock value:anObject value:element]) not]
+] whileTrue:[
+element = anObject ifTrue:[
+^ true.
+].
+index := index - 1.
+].
+"for next elements: while element is not smaller and not larger than anObject ... compare"
+index := initialIndex + 1.
+[index <= lastIndex
+and:[
+element := contentsArray basicAt:index.
+((sortBlock value:element value:anObject) or:[sortBlock value:anObject value:element]) not]
+] whileTrue:[
+element = anObject ifTrue:[
+^ true.
+].
+index := index + 1.
+].
+^ false.
 "
 #(7 3 9 10 99) asSortedCollection includes:50
 #(7 3 9 10 99) asSortedCollection includes:10
 "
 |index      "{ Class: SmallInteger }"
 tally      "{ Class: SmallInteger }"
 last       "{ Class: SmallInteger }" |
-index := self indexForInserting:anObject.
+index := self indexOf:anObject.
+index == 0 ifTrue:[
+^ 0
+].
+index := index + firstIndex - 1.
 last := lastIndex.
-((index < firstIndex) or:[index > last]) ifTrue:[^ 0].
 "/ there may be multiple of them; count 'em
 tally := 0.
-[(index <= last) and:[(contentsArray at:index) = anObject]] whileTrue:[
+[(index <= last) and:[(contentsArray basicAt:index) = anObject]] whileTrue:[
-	tally := tally + 1.
+tally := tally + 1.
-	index := index + 1
+index := index + 1
 ].
 ^ tally
 "
 #(7 3 9 10 99) asSortedCollection occurrencesOf:50
 #(7 3 9 10 99) asSortedCollection occurrencesOf:10
-#(7 10 3 10 9 10 10 99) asSortedCollection occurrencesOf:10
+#(7 10 3 10 9 10 10 10 10 10 10 10 10 99) asSortedCollection occurrencesOf:10
 "
 "Modified: 12.4.1996 / 18:48:40 / cg"
 ! !
 !SortedCollection class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.78 2014-02-12 14:36:52 cg Exp $'
+^ '$Header$'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/SortedCollection.st,v 1.78 2014-02-12 14:36:52 cg Exp $'
+^ '$Header$'
 ! !
 SortedCollection initialize!

changeset 18508	cd84f2138c53
parent 16002	5fd1486ee60a
child 18509	85976deb6616
child 19074	e6e82ab60270