"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

OrderedCollection subclass:#SortedCollection

	instanceVariableNames:'sortBlock'

	classVariableNames:'DefaultSortBlock'

	poolDictionaries:''

	category:'Collections-Sequenceable'

!

!SortedCollection class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    I keep my elements sorted. The sort order is defined by a sortblock,

    a two-argument block which, when given two elements of the collection, 

    should return true if the element given as first arg has to come before the 

    element given as second arg.

    Equal elements may occur multiple times.

    SortedCollection uses quickSort to resort and a binary search when adding/removing

    elements. 

    Because insertion/removal may require that remaining elements have to

    be shifted within the container, adding many individual elements may be done faster

    by creating a completely new collection from the unsorted elements.

    (see examples)

    Thus a sortBlock of [:a :b | a < b] defines ascending sort-order,

    while [:a :b | a > b] defines descening order.

    The default sortBlock for SortedCollections is the first one.

    Compatibility Warning:

        VW seems to use a default sortBlock which compares a<=b,

        while ST/X uses a<b.

        That means, that elements which are compared MUST understand #< in ST/X

        while the minumum protocol is #<= in VW.

        This may be changed in a future release of ST/X 

        (it is not yet, to not confuse existing applications ...

         ... be aware, that the sortBlock has an effect on a few algorithms

         found here; especially #indexForInserting is critical.)

    [author:]

        Claus Gittinger

"

!

examples

"

    when many elements are to be added, it may be better to add them 

    all en-bloeque instead of individually.

    The reason is that for each individual #add:, the contents has to be

    shifted, to create an empty slot for the new element.

    timing example:

        |o rnd|

        o := SortedCollection new.

        rnd := Random new.

        10000 timesRepeat:[

            o add:rnd next.

        ]  

    takes 1365 ms on a P5 (admitted: this is a fast machine ;-)

    In contrast:

        |o rnd|

        o := OrderedCollection new.

        rnd := Random new.

        10000 timesRepeat:[

            o add:rnd next.

        ].

        o := o asSortedCollection

    takes 383 ms on the same machine.

    If you already have a big sortedCollection at hand, adding multiple

    items may be better done with #addAll:, which resorts all elements, if

    the number of added items is more than some threshold number.

    However, the break-even point where bulk-adding is faster depends

    on the machine ... (and ST/X version ;-).

"

! !

!SortedCollection class methodsFor:'initialization'!

initialize

    "setup the default sortBlock."

    "/ only do this once at early startup

    DefaultSortBlock isNil ifTrue:[

        DefaultSortBlock := [:a :b | a < b ]

    ]

    "

     SortedCollection initialize

    "

    "Modified: 12.4.1996 / 12:29:27 / cg"

! !

!SortedCollection class methodsFor:'instance creation'!

forStrings

    "this is supposed to return a sortedCollection, which sorts using

     the current locales collating sequence. For now, simply use a

     normal string compare.

     This will change"

    ^ self new

    "Modified: 13.9.1997 / 10:18:58 / cg"

    "Created: 13.9.1997 / 10:41:54 / cg"

!

forStrings:size

    "this is supposed to return a sortedCollection, which sorts using

     the current locales collating sequence. For now, simply use a

     normal string compare.

     This will change"

    ^ self new:size

    "Modified: 13.9.1997 / 10:18:58 / cg"

!

new

    "return a new sortedCollection, the sorting is done using

     a compare for a < b, in ascending order"

    ^ super new setSortBlock:DefaultSortBlock

    "Modified: 12.4.1996 / 12:28:18 / cg"

!

new:size

    "return a new sortedCollection with preallocated size.

     The sorting is done using a compare for a < b, in ascending order"

    ^ (super new:size) setSortBlock:DefaultSortBlock

    "Modified: 12.4.1996 / 12:28:22 / cg"

!

sortBlock:aBlock

    "return a new sortedCollection, whe the sort order is defined

     by aBlock. 

     This must be a two-argument block which returns true if its arg1 has to come before

     its arg2 in the collection."

    ^ super new setSortBlock:aBlock

    "default:

     |s|

     s := SortedCollection new.

     s add:15; add:99; add:3; add:-29; add:17; add:-6.

     Transcript showCR:s

    "

    "sorting by absolute values:

     |s|

     s := SortedCollection sortBlock:[:a :b | a abs < b abs].

     s add:15; add:99; add:3; add:29; add:17; add:-6.

     Transcript showCR:s

    "

    "default again:

     |s|

     s := SortedCollection new.

     s add:'foo'; add:'Bar'; add:'baz'; add:'hello'; add:'world'; add:'Wow'.

     Transcript showCR:s

    "

    "sorting strings caseless:

     |s|

     s := SortedCollection sortBlock:[:a :b | a asLowercase < b asLowercase].

     s add:'foo'; add:'Bar'; add:'baz'; add:'hello'; add:'world'; add:'Wow'.

     Transcript showCR:s

    "

    "Modified: 12.4.1996 / 12:26:28 / cg"

!

withAll:aCollection sortBlock:aBlock

    "initialize from aCollection and set the sort-block"

    ^ (self sortBlock:aBlock) addAll:aCollection; yourself

    "

     SortedCollection withAll:#(1 2 3 4 5 6 7 8 9 0)

                      sortBlock:[:a :b | a > b] 

    "

    "default:

     |s|

     s := SortedCollection withAll:#(15 99 3 29 17 -6).

     Transcript showCR:s

    "

    "sorting by absolute values:

     |s|

     s := SortedCollection withAll:#(15 99 3 29 17 -6) sortBlock:[:a :b | a abs < b abs].

     Transcript showCR:s

    "

    "default again:

     |s|

     s := SortedCollection withAll:#('foo' 'Bar' 'baz' 'hello' 'world' 'Wow').

     Transcript showCR:s

    "

    "sorting strings caseless:

     |s|

     s := SortedCollection withAll:#('foo' 'Bar' 'baz' 'hello' 'world' 'Wow') sortBlock:[:a :b | a asLowercase < b asLowercase].

     Transcript showCR:s

    "

    "Modified: 12.4.1996 / 12:28:09 / cg"

! !

!SortedCollection methodsFor:'adding & removing'!

add:anObject

    "add the argument, anObject at the proper place in the

     receiver. Returns the argument, anObject."

    |index|

    lastIndex < firstIndex "i.e. self size == 0" ifTrue:[

        "/ empty - add at the end

        index := lastIndex.

        (index == contentsArray size) ifTrue:[

            self makeRoomAtLast.

            index := lastIndex.

        ].

        lastIndex := index := index + 1.

    ] ifFalse:[

        index := self indexForInserting:anObject. 

        index := self makeRoomAtIndex:index.

    ].

    contentsArray basicAt:index put:anObject.

    ^ anObject

    "

     |c| #(7 3 9 10 99) asSortedCollection add:5; yourself    

     #(7 3 9 10 99) asSortedCollection add:1; yourself        

     #(7 3 9 10 99) asSortedCollection add:1000; yourself     

    "

    "Modified: / 13.3.1998 / 16:21:52 / cg"

!

add:newObject after:oldObject

    "catch this - its not allowed for sortedCollections"

    self shouldNotImplement

!

add:newObject before:oldObject

    "catch this - its not allowed for sortedCollections"

    self shouldNotImplement

!

addAll:aCollection

    "add all elements of the argument, aCollection to the

     receiver. Returns the argument, aCollection."

    |newContents|

    "/ special case: I am empty - add them en-bloque.

    "/ (but only if the argument is not a sortedCollection,

    "/  because quicksort degenerates to a veeery slow operation then)

    (self size == 0 and:[aCollection isSorted not]) ifTrue:[

        newContents := Array withAll:(aCollection asArray).

        newContents == aCollection ifTrue:[

            newContents := newContents shallowCopy

        ].

        newContents sort:sortBlock.

        contentsArray := newContents.

        firstIndex := 1.

        lastIndex := newContents size.

        ^ aCollection

    ].

    "/

    "/ do a mergeSort

    "/

    self mergeSorted:(aCollection asSortedCollection).

    ^ aCollection

    "

     #(7 3 9 10 99) asSortedCollection addAll:#(77 0 1 16 5); yourself 

    "

    "Modified: 13.4.1996 / 12:42:15 / cg"

!

addFirst:anObject

    "catch this - its not allowed for sortedCollections"

    self shouldNotImplement

!

addLast:anObject

    "catch this - its not allowed for sortedCollections"

    self shouldNotImplement

!

at:index put:anObject

    "catch this - its not allowed for sortedCollections"

    self shouldNotImplement

!

mergeSorted:aSortedCollection

    "add all elements of the argument, aSortedCollection to the

     receiver. 

     This leads to an error, if the argument is not a sortedCollection.

     This should be used when a number of elements is to be added. 

     Notice, that quicksort degenerates to a veeery slow bubble-like

     sort when a collection of already sorted elements is given to it.

     Therefore, adding chunks is better done by sorting the chunk and merging

     it in, instead of resorting the receiver."

    |newContentsArray 

     contentsArray2

     destIndex "{ Class: SmallInteger }"

     n1        "{ Class: SmallInteger }"

     n2        "{ Class: SmallInteger }"

     srcIndex1 "{ Class: SmallInteger }"

     srcIndex2 "{ Class: SmallInteger }"

     last1     "{ Class: SmallInteger }"

     last2     "{ Class: SmallInteger }"  

     end1Reached end2Reached

     el1 el2 |

    n1 := self size.

    n2 := aSortedCollection size.

    newContentsArray := Array new:(n1 + n2).

    destIndex := 1.

    contentsArray2 := aSortedCollection contentsArray.

    srcIndex2 := aSortedCollection firstIndex.

    last2 := srcIndex2 + n2 -1.

    srcIndex1 := firstIndex.

    last1 := srcIndex1 + n1 -1.

    (srcIndex1 <= last1 and:[srcIndex2 <= last2]) ifTrue:[

        el1 := contentsArray at:srcIndex1.

        el2 := contentsArray2 at: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.

                srcIndex1 := srcIndex1 + 1.

                srcIndex1 <= last1 ifTrue:[

                    el1 := contentsArray at:srcIndex1.

                ] ifFalse:[

                    end1Reached := true

                ]

            ] ifFalse:[

                "/ el2 to come before el1

                newContentsArray at:destIndex put:el2. destIndex := destIndex + 1.

                srcIndex2 := srcIndex2 + 1.

                srcIndex2 <= last2 ifTrue:[

                    el2 := contentsArray2 at:srcIndex2.

                ] ifFalse:[

                    end2Reached := true

                ]

            ]

        ]

    ].

    "/ fill up with remaining elements from source1

    (srcIndex1 <= last1) ifTrue:[

        newContentsArray 

            replaceFrom:destIndex 

            to:(destIndex+(last1-srcIndex1))

            with:contentsArray

            startingAt:srcIndex1

    ].

    "/ fill up with remaining elements from source2

    (srcIndex2 <= last2) ifTrue:[

        newContentsArray 

            replaceFrom:destIndex 

            to:(destIndex+(last2-srcIndex2))

            with:contentsArray2

            startingAt:srcIndex2

    ].

    firstIndex := 1.

    lastIndex := n1 + n2.

    contentsArray := newContentsArray

    "

     #(7 3 9 10 99) asSortedCollection 

        mergeSorted:#(77 0 1 16 5) asSortedCollection 

     #(7 3 9 10 99) asSortedCollection 

        mergeSorted:#(77 0 3 1 98 99 16 5) asSortedCollection 

     #() asSortedCollection 

        mergeSorted:#(77 0 3 1 98 99 16 5) asSortedCollection 

     #(7 3 9 10 99) asSortedCollection 

        mergeSorted:#() asSortedCollection 

    "

    "Modified: / 30.1.1998 / 01:49:42 / cg"

! !

!SortedCollection methodsFor:'converting'!

asSortedCollection

    "return the receiver as a sorted collection"

    "could be an instance of a subclass..."

    self class == SortedCollection ifTrue:[

	^ self

    ].

    ^ super asSortedCollection

! !

!SortedCollection methodsFor:'copying'!

copyEmpty:size

    "return a copy of the receiver with no elements, but

     the same size. This method has been be redefined to

     preserve the sortBlock."

    ^ (self species new:size) sortBlock:sortBlock

!

postCopyFrom:anOriginal

    "sent after a copy or when a new collection species has been created.

     The new collection should have the same sortBlock as the original."

    sortBlock := anOriginal sortBlock

    "

     #(4 7 1 99 -1 17) asSortedCollection inspect

     #(4 7 1 99 -1 17) asSortedCollection copy inspect

     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) inspect

     (#(4 7 1 99 -1 17) asSortedCollection sortBlock:[:a :b | a > b]) copy inspect

     (#(4 7 1 99 -1 17) asSortedCollection select:[:e| e even]) inspect

    "

! !