"======================================================================
|
|   SortedCollection Method Definitions
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| 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.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


OrderedCollection variableSubclass: #SortedCollection
		  instanceVariableNames: 'sortBlock'
		  classVariableNames: 'DefaultSortBlock'
		  poolDictionaries: ''
		  category: 'Collections-Sequenceable'
!

SortedCollection comment:
'I am a collection of objects, stored and accessed according to some
sorting criteria.  I store things using a bubble sort.  My instances have a
comparison block associated with them; this block takes two arguments and
is a predicate which returns true if the first argument should be sorted
earlier than the second.  The default block is [ :a :b | a <= b ], but I
will accept any block that conforms to the above criteria.' !


!SortedCollection class methodsFor: 'hacking'!

defaultSortBlock
    "Answer a default sort block for the receiver."
    "This is a clean block, so a single BlockClosure is used all the time."
    ^[ :a :b | a <= b ]
! !


!SortedCollection class methodsFor: 'instance creation'!

new
    "Answer a new collection with a default size and sort block"
    ^self sortBlock: self defaultSortBlock
!

new: aSize
    "Answer a new collection with a default sort block and the given size"
    ^(super new: aSize) setSortBlock: self defaultSortBlock
!

sortBlock: aSortBlock
    "Answer a new collection with a default size and the given sort block"
    ^super new setSortBlock: aSortBlock

! !



!SortedCollection methodsFor: 'basic'!

addFirst: anObject
    self shouldNotImplement
!

addLast: anObject
    self shouldNotImplement
!

at: index put: anObject
    self shouldNotImplement
!

add: anObject afterIndex: i
    self shouldNotImplement
!

addAll: aCollection afterIndex: i
    self shouldNotImplement
!

addAllFirst: aCollection
    self shouldNotImplement
!

addAllLast: aCollection
    self shouldNotImplement
!

add: anObject
    "Add anObject into the collection at the proper place"

    | newIndex |

    "Allocate a slot in the ordered collection."
    self basicAddLast: nil.

    "First do a binary search to find where to add the element.
     This economizes on expensive sort block evaluations; that
     -1 skips the last element we added"
    newIndex := self insertionIndexFor: anObject upTo: lastIndex - 1.

    lastIndex - 1 to: newIndex by: -1 do: [ :index |
	 self basicAt: index + 1 put: (self basicAt: index).
    ].
    ^self basicAt: newIndex put: anObject
!

addAll: aCollection
    "Add all the elements in aCollection to the receiver in their proper
     places"

    | i add |

    "First make space into the collection"
    self basicAddAllLast: aCollection.

    "Merge elements into the collection. We do binary searches on the
     not yet sorted part of the collection to find where to add the
     element. This economizes on expensive sort block evaluations."

    add := aCollection size.
    i := lastIndex - add.
    (aCollection asSortedCollection: self sortBlock) reverseDo: [:element |
	| newIndex |
	newIndex := self insertionIndexFor: element upTo: i.

	[ i >= newIndex ] whileTrue: [
	    self basicAt: i + add put: (self basicAt: i).
	    i := i - 1.
	].
	self basicAt: i + add put: element.
	add := add - 1
    ].
    ^aCollection
!

reverse
    "Answer an OrderedCollection containing the data in the
    receiver in reverse ordering"

    | newOrderedCollection |
    newOrderedCollection := OrderedCollection new: self size.
    self reverseDo: [ :element | newOrderedCollection add: element ].
    ^newOrderedCollection
! !


!SortedCollection methodsFor: 'saving and loading'!

postLoad
    "Restore the default sortBlock if it is nil"
    sortBlock isNil ifTrue: [ sortBlock := self class defaultSortBlock ]
!

preStore
    "Store the default sortBlock as nil"
    sortBlock == self class defaultSortBlock ifTrue: [ sortBlock := nil ]
! !


!SortedCollection methodsFor: 'instance protocol'!

sortBlock
    "Answer the receiver's sort criteria"
    ^sortBlock
!

sortBlock: aSortBlock
    "Change the sort criteria for a sorted collection, resort the elements of 
    the collection, and return it."

    sortBlock := aSortBlock fixTemps.
    self size >= 2 ifTrue: [
	self sortFrom: firstIndex to: lastIndex.
    ].
    ^self
! !


!SortedCollection methodsFor: 'searching'!

indexOf: anObject startingAt: index ifAbsent: aBlock
    "Answer the first index > anIndex which contains anElement.
     Invoke exceptionBlock and answer its result if no item is found"

    | i j |

    (index < 1) | (index > self size) ifTrue: [ ^self error: 'Index out of range' ].
    i := self
	binarySearch: anObject
	low: index + firstIndex - 1
	high: lastIndex
	ifAbsent: [ ^aBlock value].

    j := i - firstIndex + 1.
    [ j ~= index and: [ (self basicAt: i - 1) = anObject ] ]
	whileTrue: [ i := i - 1. j := j - 1 ].

    ^j
!

includes: anObject
    "Private - Answer whether the receiver includes an item which is
     equal to anObject"
    self indexOf: anObject ifAbsent: [ ^false ].
    ^true
!

occurrencesOf: anObject
    "Answer how many occurrences of anObject can be found in the receiver"

    "Find first the index of 'anObject' and then look at the both sides to
     count repetitions of 'anObject', if there are."

    | upper lower max count |

    upper := self indexOf: anObject ifAbsent: [ ^0 ].
    lower := upper - 1.
    max := self size.

    [ lower > 1 and: [ (self at: lower) = anObject ] ]
	whileTrue: [ lower := lower - 1 ].

    [ upper < max and: [ (self at: upper) = anObject ] ]
	whileTrue: [ upper := upper + 1 ].

    ^upper - lower
! !


!SortedCollection methodsFor: 'copying'!

copyEmpty: newSize
    "Answer an empty copy of the receiver, with the same sort block as the
     receiver"
    ^(super copyEmpty: newSize) setSortBlock: sortBlock
! !



!SortedCollection methodsFor: 'private methods'!

copyEmptyForCollect
    "Answer an empty copy of the receiver, with the class answered by the
     collect: method."
    ^OrderedCollection new: self basicSize
!

median: ia median: ib median: ic
    "Private - Calculate the middle of a, b and c. Needed for selecting
     the quicksort's pivot item"
    | a b c |
    a := self basicAt: ia.
    b := self basicAt: ib.
    c := self basicAt: ic.
    (sortBlock value: a value: b)
	ifTrue: [
	    (sortBlock value: b value: c) ifTrue: [ ^ib ].
	    (sortBlock value: a value: c) ifTrue: [ ^ic ] ifFalse: [ ^ia ]
	]
	ifFalse: [
	    (sortBlock value: a value: c) ifTrue: [ ^ia ].
	    (sortBlock value: b value: c) ifTrue: [ ^ic ] ifFalse: [ ^ib ]
	]
!

sortFrom: first to: last
    "Private - Perform a quicksort on the indexed variables
     from the first-th to the last-th (using basicAt: indices!). Recursive."
    | pivot mid smaller larger |

    last - first < 2 ifTrue: [
	last > first ifTrue: [
	    (self sortBlock value: (self basicAt: last) value: (self basicAt: first))
		ifTrue: [ self swap: first with: last ].
	].
	^self
    ].

    "First we pick a partititioning element.  We must find one
     that is approximately the median of the values, but we must do
     that fast; we use the median of the first, last and middle one,
     which would require a very weirdly arranged array for worst case
     performance.
     We also have to to put it in the middle."

    mid := (first + last) // 2.
    (sortBlock value: (self basicAt: first) value: (self basicAt: mid))
	ifFalse: [ self swap: first with: mid ].

    (sortBlock value: (self basicAt: mid) value: (self basicAt: last))
	ifFalse: [ self swap: mid with: last ].

    (sortBlock value: (self basicAt: first) value: (self basicAt: last))
	ifFalse: [ self swap: first with: last ].

    pivot := self basicAt: mid.
    smaller := first.
    larger := last.
    [ 
	[ (smaller <= last) and: "self[smaller] <= pivot"
	    [ sortBlock value: (self basicAt: smaller) value: pivot ] ]
	    whileTrue: [ smaller := smaller + 1 ].

	[ (larger >= first) and: "self[larger] >= pivot"
	    [ sortBlock value: pivot value: (self basicAt: larger) ] ]
	    whileTrue: [ larger := larger - 1 ].

	smaller < larger
    ]   whileTrue: [
	self swap: smaller with: larger.
	smaller := smaller + 1.
	larger := larger - 1.
    ].

    smaller > larger ifFalse: [
	smaller := smaller + 1.
	larger := larger - 1.
    ].

    first < larger ifTrue: [ self sortFrom: first to: larger ].
    smaller < last ifTrue: [ self sortFrom: smaller to: last ]
!

binarySearch: anObject low: low high: high ifAbsent: aBlock
    "Private - Perform a binary search on the receiver, searching between
     indexes i and j (indexes are referenced with #basicAt:). If anObject
     is not found, answer the result of evaluating aBlock, else answer one
     of the indices containing anObject"

    | i j mid element |
    i := low.
    j := high.

    [ i > j ] whileFalse: [
	mid := (i + j + 1) // 2.
	element := self basicAt: mid.
	element = anObject ifTrue: [ ^mid ].
	(sortBlock value: anObject value: element)
	    ifTrue: [ j := mid - 1]
	    ifFalse: [ i := mid + 1 ].
    ].
    ^aBlock value
!

insertionIndexFor: anObject upTo: highestIndex
    "Private - Perform a binary search on the receiver, searching between
     indexes firstIndex and highestIndex for an element which comes just
     after anObject (according to the sort block of course."

    | low high mid |

    low := firstIndex.
    high := highestIndex.
    [mid := (high + low) // 2. low > high] whileFalse: [
	(sortBlock value: (self basicAt: mid) value: anObject)
	    ifTrue: [low _ mid + 1]
	    ifFalse: [high _ mid - 1]
    ].
    ^low
!

moveElementsFrom: i by: add toMerge: element
    "Private - Move by add spaces all the elements before the i-th until
     we have created a place to insert element. Answer the new i (element will
     be inserted at position i + add)."

    | newIndex |

    "First do a binary search to find where to add the element.
     This economizes on expensive sort block evaluations; that
     -1 skips the last element we added"
    newIndex := self insertionIndexFor: element upTo: i.

    i to: newIndex by: -1 do: [ :index |
	 self basicAt: index + add put: (self basicAt: index).
    ].
    ^newIndex - 1

"   | anObject |
    i to: firstIndex by: -1 do: [ :index |
	 anObject := self basicAt: index.
	 (sortBlock value: anObject value: element)
	       ifTrue: [ ^index ]
	       ifFalse: [ self basicAt: index + add put: anObject ]
    ].
    ^firstIndex - 1 "
!

swap: anIndex with: anotherIndex
    "Private - Swap the item at index anIndex with the item at index
     another index"

    | saved |
    saved := self basicAt: anIndex.
    self basicAt: anIndex put: (self basicAt: anotherIndex).
    self basicAt: anotherIndex put: saved
!

setSortBlock: aSortBlock
    sortBlock := aSortBlock fixTemps
! !
