"{ Package: 'stx:libbasic2' }"

Collection subclass:#BTree

	instanceVariableNames:'root'

	classVariableNames:''

	poolDictionaries:''

	category:'Collections-Ordered'

!

Object subclass:#BTreeKeys

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree

!

BTree::BTreeKeys variableSubclass:#BTreeKeysArray

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree

!

Object variableSubclass:#BTreeNode

	instanceVariableNames:'parent keys'

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree

!

BTree::BTreeNode variableSubclass:#BTreeInteriorNode

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree::BTreeNode

!

BTree::BTreeNode variableSubclass:#BTreeLeafNode

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree

!

BTree::BTreeKeys subclass:#BTreeStringKeys

	instanceVariableNames:'keys prefix abbreviations'

	classVariableNames:''

	poolDictionaries:''

	privateIn:BTree

!

!BTree class methodsFor:'documentation'!

documentation

"

    A bunch of collection classes that are useful for building large indices of things. 

    It's especially geared towards people using OODBs like GOODS, but can be used it in the image too: 

    the BTree class is great for when you need to select numeric keys by range, 

    and TSTree makes a solid basis for full-text search. 

    TreeSet has an interesting optimized #intersection: that lets you compare two collections without 

    looking at every item of either. 

    I'm also going to be rolling some code in here from Benjamin Pollack specifically aimed at indexing 

    by date ranges, which lets you do quick queries of all the events that overlap with a specific week, 

    for instance. 

    This is an implementation of the BTree data structure as a Smalltalk collection. 

    It provides log(n) inserts, deletes, and retrieves of values by key. 

    The keys have to be sortable (ie, Magnitudes).

    This is useful in situations where you want to minimize the number and size of individual objects 

    that need to be accessed when using a large collection - for example, when objects are being swapped 

    out to an object database such as GOODS. 

    It is probably not a good choice for a collection that will be kept entirely in memory.

    What you get: efficient sorted iteration through the keys, possibly limited to 

    a given range.  For example, if you store a list of people keyed by their 

    birthdate, and then want to find everyone born in a certain year, in order of 

    birth, you can do that very fast.

    Also in the BTree package is a TSTree, which has similar properties for String 

    keys.  So as well as keeping them sorted, you can do efficient lookups of all 

    the keys with a given prefix.  One other neat trick TSTree can do is a certain 

    amount of fuzzy matching (eg find all keys with an edit distance of 3 from 

    'foo') which makes it especially useful for spell checking and similar 

    applications.

    [author:]

        Avi Bryant

    [license:]

        Dual licensed under both SqueakL and MIT. 

        This enables both base Squeak inclusion and 100% reuse.

"

!

examples

"

    |coll|

    coll := BTree new.

    (1 to:10) do:[:i | coll at:(i printString) put:(i squared) ].

    coll inspect.

    coll at:'10'       

"

! !

!BTree class methodsFor:'as yet unclassified'!

keys: aBTreeKeys

	^ self basicNew initializeWithKeys: aBTreeKeys

!

new

	^ self order: 5

!

order: aNumber

	^ self keys: (BTreeKeysArray new: aNumber)

! !

!BTree methodsFor:'accessing'!

at: aMagnitude

	^ self at: aMagnitude ifAbsent: [self error: aMagnitude printString, ' not found']

!

at: aMagnitude ifAbsent: errorBlock

       | leaf |

       leaf _ root existingLeafForKey: aMagnitude.

       leaf ifNil: [^ errorBlock value].

       ^ leaf valueForKey: aMagnitude ifAbsent: errorBlock

!

depth

	^ root depth

!

keys

	^ Array streamContents:

		[:s |

		self keysDo: [:k | s nextPut: k]]

!

order

	^ root size

!

values

	^ Array streamContents:

		[:s |

		self keysAndValuesDo: [:k :v | s nextPut: v]]

! !

!BTree methodsFor:'adding'!

at: aMagnitude put: anObject

	| leaf |

	leaf _ root leafForKey: aMagnitude.

	leaf insertKey: aMagnitude value: anObject.

	root _ leaf root.

	^ anObject

!

removeKey: aMagnitude

	| leaf |

	leaf _ root leafForKey: aMagnitude.

	leaf removeKey: aMagnitude.

	root _ leaf root

! !

!BTree methodsFor:'enumerating'!

commonKeysWith: aTree keysAndValuesDo: aBlock

	^ aTree depth < self depth

		ifTrue: [aTree root commonKeysWith: root keysAndValuesDo: aBlock flip: true]

		ifFalse: [root commonKeysWith: aTree root keysAndValuesDo: aBlock flip: false]

!

do: aBlock

	root allLeavesDo: [:ea | ea valuesDo: aBlock]

!

from: start to: end do: aBlock

	self from: start to: end keysAndValuesDo: [:k :v | aBlock value: v]

!

from: start to: end keysAndValuesDo: aBlock

	root leavesFrom: start to: end do:

		[:ea |

		ea keysAndValuesDo:

			[:k :v |

			(k between: start and: end) ifTrue:

				[aBlock value: k value: v]]]

!

keysAndValuesDo: aBlock

	root allLeavesDo: [:ea | ea keysAndValuesDo: aBlock]

!

keysDo: aBlock

! !

!BTree methodsFor:'initialize-release'!

initializeWithKeys: aBTreeKeys

	aBTreeKeys size > 3 ifFalse: [self error: 'The BTree order must be at least 4'].

	root _ BTreeLeafNode keys: aBTreeKeys

! !

!BTree methodsFor:'private'!

root

	^ root

! !

!BTree::BTreeKeys class methodsFor:'documentation'!

documentation

"

    [author:]

        Avi Bryant

    [license:]

        Dual licensed under both SqueakL and MIT. 

        This enables both base Squeak inclusion and 100% reuse.

"

! !

!BTree::BTreeKeys methodsFor:'as yet unclassified'!

canGrow

	^ (self at: self size) isNil

!

canShrink

	^  (self at: self size // 2 + 1) notNil

!

emptyCopy

	^ self class new: self size

!

findIndexForKey: aMagnitude

	self withIndexDo:

		[:key :i |

		(key isNil or: [key > aMagnitude]) ifTrue:

			[^ i - 1]].

	^ self size

!

first

	^ self at: 1

!

shiftLeftTo: index

	index to: self size - 1 by: 1 do:

		[:i |

		self at: i put: (self at: i+1)].

	self at: self size put: nil.

!

shiftRightFrom: index

	self size to: index+1 by: -1 do:

		[:i |

		self at: i put: (self at: i - 1)]

!

withIndexDo: aBlock

	1 to: self size do: [:i | aBlock value: (self at: i) value: i]

! !

!BTree::BTreeKeysArray class methodsFor:'documentation'!

documentation

"

    [author:]

        Avi Bryant

    [license:]

        Dual licensed under both SqueakL and MIT. 

        This enables both base Squeak inclusion and 100% reuse.

"

! !

!BTree::BTreeNode class methodsFor:'as yet unclassified'!

keys: anArray

	^ (self new: (anArray size)) keys: anArray

! !

!BTree::BTreeNode class methodsFor:'documentation'!

documentation

"

    [author:]

        Avi Bryant

    [license:]

        Dual licensed under both SqueakL and MIT. 

        This enables both base Squeak inclusion and 100% reuse.

"

! !

!BTree::BTreeNode methodsFor:'accessing'!

children

	^ Array streamContents: [:s | self childrenDo: [:ea | s nextPut: ea]]

!

depth

	^ parent ifNil: [1] ifNotNil: [1 + parent depth]

!

firstKey

	^ keys first

!

parent

	^ parent

!

parent: aBTreeNode

	parent _ aBTreeNode

!

root

	^ parent

		ifNil: [self]

		ifNotNil: [parent root]

!

values

	^ Array streamContents: [:s | self valuesDo: [:ea | s nextPut: ea]]

! !

!BTree::BTreeNode methodsFor:'enumerating'!

allChildrenDo: aBlock

	self childrenDo:

		[:ea |

		aBlock value: ea.

		ea allChildrenDo: aBlock]

!

allLeavesDo: aBlock

	self withAllChildrenDo: [:ea | ea isLeaf ifTrue: [aBlock value: ea]]

!

childrenDo: aBlock

	self subclassResponsibility

!

keysAndValuesDo: aBlock

        keys withIndexDo:

                [:key :i |

                key notNil ifTrue: [aBlock value: key value: (self at: i)]]

    "Modified: / 08-08-2010 / 14:39:17 / cg"

!

keysDo: aBlock

	keys withIndexDo:

		[:key :i |

		key ifNotNil: [aBlock value: key] ifNil: [^ self]]

!

leavesFrom: start to: end do: aBlock

	self subclassResponsibility

!

valuesDo: aBlock

	self keysAndValuesDo: [:k :v | aBlock value: v]

!

withAllChildrenDo: aBlock

	aBlock value: self.

	self allChildrenDo: aBlock.

! !

!BTree::BTreeNode methodsFor:'inserting'!

insertKey: aMagnitude value: anObject

	| index key |

	index _ keys findIndexForKey: aMagnitude.

	index = 0 ifTrue:

		[self canGrow

			ifTrue:

				[self shiftRightFrom: 1.

				^ self insertKey: aMagnitude value: anObject at: 1]

			ifFalse:

				[self split.

				^ (parent childForKey: aMagnitude) insertKey: aMagnitude value: anObject]].

	key _ keys at: index.

	key = aMagnitude ifTrue:

		[^ self insertKey: aMagnitude value: anObject at: index].

	index < self size ifTrue:

		[key _ keys at: index + 1.

		key

			ifNil: [^ self insertKey: aMagnitude value: anObject at: index+1]

			ifNotNil:

				[self canGrow ifTrue:

					[self shiftRightFrom: index+1.

					^ self insertKey: aMagnitude value: anObject at: index+1]]].

	"otherwise"

	self split.

	^ (parent childForKey: aMagnitude) insertKey: aMagnitude value: anObject

! !

!BTree::BTreeNode methodsFor:'private'!

ensureParent

	parent ifNil:

		 [parent _ BTreeInteriorNode keys: keys emptyCopy.

		parent insertKey: self firstKey value: self].

	^ parent

!

grow

        | sibling |

        parent notNil ifTrue:

                [sibling := parent nextSiblingForChild: self.

                sibling ifNil: ["we're the new root" parent := nil. ^ self].

                sibling canShrink

                        ifTrue: [self stealFrom: sibling]

                        ifFalse: [self mergeWith: sibling]]

    "Modified: / 08-08-2010 / 14:39:07 / cg"

!

insertKey: aMagnitude value: anObject at: index

	keys at: index put: aMagnitude.

	self at: index put: anObject

!

keys: anArray

	keys _ anArray

!

mergeWith: aNode		

	| oldKey |

	oldKey _ self firstKey.

	aNode keysAndValuesDo:

		[:k :v |

		self insertKey: k value: v].

	parent removeKey: aNode firstKey.

	parent updateKey: oldKey to: self firstKey.

!

shiftLeftTo: index

	keys shiftLeftTo: index.

	index to: self size - 1 by: 1 do:

		[:i |

		self at: i put: (self at: i+1)].

	self at: self size put: nil.

!

shiftRightFrom: index

	keys shiftRightFrom: index.

	self size to: index+1 by: -1 do:

		[:i |

		self at: i put: (self at: i-1)]

!

split

	| other midpoint |

	other _ self class keys: keys emptyCopy.

	midpoint _ self size // 2 + 1.

	midpoint to: self size do:

		[:i |

		other insertKey: (keys at: i) value: (self at: i) at: (i - midpoint + 1).

		keys at: i put: nil.

		self at: i put: nil].

	self ensureParent insertKey: other firstKey value: other

!

stealFrom: aNode

        | key value |

        aNode firstKey > self firstKey

                ifTrue: [value := aNode at: 1. key := aNode firstKey]

                ifFalse:

                        [aNode keysAndValuesDo: [:k :v | key := k. value := v].

                        parent notNil ifTrue: [parent updateKey: self firstKey to: key]].

        self insertKey: key value: value.

        aNode removeKey: key

    "Modified: / 08-08-2010 / 14:39:50 / cg"

! !

!BTree::BTreeNode methodsFor:'removing'!

removeKey: aMagnitude

        | index key |

        self canShrink ifFalse: [self grow].

        index := keys findIndexForKey: aMagnitude.

        key := keys at: index.

        key = aMagnitude ifFalse: [^ self error: 'No such key'].

        self shiftLeftTo: index.

        index = 1 ifTrue: [parent notNil ifTrue: [parent updateKey: key to: self firstKey]]

    "Modified: / 08-08-2010 / 14:39:29 / cg"

! !

!BTree::BTreeNode methodsFor:'testing'!

canGrow

	^ keys canGrow

!

canShrink

	^ keys canShrink

!