! ========================================================================
! Copyright (C) VMware, Inc. 1991-2011.  All Rights Reserved
!
! $Id: btreegeneral.gs,v 1.7 2008-01-09 22:50:08 stever Exp $
!
! ========================================================================
!
! This file contains GemStone Smalltalk code for a general B-tree class.
! This code is provided as a "goodie", but is not part of the
! supported class library.
!
! You must be logged in as SystemUser to file in this code.
!
! The public protocol for this class is as follows:
!  
! class method
!     forKeyKind: aClass
! 
! instance methods
!     at: aKey put: aValue
!     removeKey: aKey value: aValue ifAbsent: aBlock
!     removeKey: aKey value: aValue otherwise: otherValue
!
!     prettyPrint
!     totalElements
!
!     asStream
!
!     allAt: aKey
!     allValuesGreaterThanKey: aKey
!     allValuesGreaterThanOrEqualToKey: aKey
!     allValuesLessThanKey: aKey
!     allValuesLessThanOrEqualToKey: aKey
!     allValuesGreaterThan: val1 andEquals: bool1
!          andLessThan: val2 andEquals: bool2
!
!     keysDo: aBlock
!     valuesDo: aBlock
!     keysAndValuesDo: aBlock
!     
!     valuesAscending
!     valuesDescending

!--------------------------------------------------
! Btree
!--------------------------------------------------
run
Object subclass: #Btree
  instVarNames: #(#root #keyKind)
  classVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[ #[ #root, BtreeNode] ]
  instancesInvariant: false
  isModifiable: false.
true
%

!--------------------------------------------------
! BtreeStream
!--------------------------------------------------
run
  BtreeReadStream subclass: 'BtreeStream'
  instVarNames: #()
  classVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[]
  instancesInvariant: false
  isModifiable: false.
true
%

! ------------------- Class methods for Btree
category: 'Instance Creation'
classmethod: Btree
new

self shouldNotImplement: #new
%
category: 'Instance Creation'
classmethod: Btree
forKeyKind: aClass

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a new instance that holds keys of the given class. "

| newOne |
(aClass == Symbol _or:[ aClass == DoubleByteSymbol ]) ifTrue:[
  "Symbol canonicalization not supported in B-trees outside of the
   indexing subsystem."
  self _halt:'Btree does not support keys that are Symbols'.
  ].
newOne := super new.
newOne keyKind: aClass.
newOne root: aClass btreeLeafNodeClass new.
^ newOne
%
! ------------------- Instance methods for Btree
category: 'Updating'
method: Btree
at: aKey put: aValue

" This method is provided as a goodie, but is not part of the
  supported class library "

" Add the key/value pair to the receiver.  Answer the value. "

| returnNode node |

"Symbol canonicalization not supported in B-trees outside of the
 indexing subsystem."
aKey _isSymbol ifTrue:[
  self _halt:'Btree does not support keys that are Symbols'.
  ].
aValue _isSymbol ifTrue:[
  self _halt:'Btree does not support values that are Symbols'.
  ].
  
" if root does not exist, create it "
root == nil
    ifTrue: [ root := self leafNodeClass new ].

returnNode := root at: aKey put: aValue.

" see if a split occurred "
returnNode == root
    ifFalse: [ " returnNode is the second half of the split "
        " create the new parent node "
        node := root parentNodeClass new.
        node lastValue: returnNode lastValue.

        " insert the first half (the original root) "
        node 
            _insertKey: (root _at: root _lastKeyIndex) 
            value: root 
            atIndex: 1.
        " insert the second half "
        node 
            _insertKey: (returnNode _at: returnNode _lastKeyIndex) 
            value: returnNode 
            atIndex: (node entrySize + 1).

        root := node.
    ].
^ aValue
%
category: 'Printing'
method: Btree
prettyPrint

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a (somewhat) formatted string representation of the receiver. "

| str |
str := root prettyPrint.
^ str
%
category: 'Removing'
method: Btree
removeKey: aKey value: aValue ifAbsent: aBlock

" This method is provided as a goodie, but is not part of the
  supported class library "

" Remove the key/value pair from the receiver.  Answer the value. "

" if root does not exist, create it "
root == nil
    ifTrue: [
        ^ aBlock value
    ].

(root removeKey: aKey value: aValue)
    ifTrue: [
        ((root numElements == 1) _and: [ root isLeaf not ] )
            ifTrue: [ root := root at: (root _lastKeyIndex - 1) ]
    ]
    ifFalse: [
        ^ aBlock value
    ].
^ aValue
%
category: 'Removing'
method: Btree
removeKey: aKey value: aValue otherwise: otherValue

"This method is provided as a goodie, but is not part of the
 supported class library."

"Remove the key/value pair from the receiver.  Return the value."

" if root does not exist, create it "
root == nil
    ifTrue: [
        ^ otherValue
    ].

(root removeKey: aKey value: aValue)
    ifTrue: [
        ((root numElements == 1) _and: [ root isLeaf not ] )
            ifTrue: [ root := root at: (root _lastKeyIndex - 1) ]
    ]
    ifFalse: [
        ^ otherValue
    ].
^ aValue
%
category: 'Accessing'
method: Btree
root

" This method is provided as a goodie, but is not part of the
  supported class library "

   "Return the value of the instance variable 'root'."
   ^root
%
category: 'Updating'
method: Btree
root: newValue

" This method is provided as a goodie, but is not part of the
  supported class library "

   "Modify the value of the instance variable 'root'."
   root := newValue
%
category: 'Accessing'
method: Btree
keyKind

" This method is provided as a goodie, but is not part of the
  supported class library "

   "Return the value of the instance variable 'keyKind'."
   ^keyKind
%
category: 'Updating'
method: Btree
keyKind: newValue

" This method is provided as a goodie, but is not part of the
  supported class library "

   "Modify the value of the instance variable 'keyKind'."
   keyKind := newValue
%
category: 'Converting'
method: Btree
asStream

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream over the contents of the receiver. "

| stream |
stream := BtreeStream on: root.
^ stream
%
category: 'Accessing'
method: Btree
allAt: aKey

" This method is provided as a goodie, but is not part of the
  supported class library "

"Returns an Array of all values for the given key."

| array |
array := #[].
root _findAllValuesForKey: aKey into: array.
^ array
%
category: 'Accessing'
method: Btree
allValuesGreaterThanKey: aKey

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream of all values that are greater than the given key. "

| array1 array2 stream |
stream := BtreeStream new.
array1 := #[].
(root _findAllValuesGreaterThanKey: aKey into: array1)
    ifFalse: [ " none were greater than "
        stream currentStack: (Array with: 0).
        ^ stream
    ].

array2 := #[].
root _putLastIndexOfLastChildInto: array2.

stream currentStack: array1.
stream endIndex: (array2 at: 1).
stream endNode: (array2 at: 2).

^ stream
%
category: 'Accessing'
method: Btree
allValuesGreaterThanOrEqualToKey: aKey

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream of all values that are greater or equal to the given key. "

| array1 array2 stream doNext |
stream := BtreeStream new.
array1 := #[].
doNext := false.
" >=, perform < and do an 'next' operation later "
(root _findAllValuesLessThanKey: aKey andEquals: false into: array1)
    ifTrue: [ doNext := true ]
    ifFalse: [ " all were greater than or equal to "
        root _putFirstIndexOfFirstChildInto: array1 ifGreaterThanOrEqualTo: aKey
    ].

array2 := #[].
root _putLastIndexOfLastChildInto: array2.

stream currentStack: array1.
stream endIndex: (array2 at: 1).
stream endNode: (array2 at: 2).

doNext ifTrue: [ stream next ].

^ stream
%
category: 'Accessing'
method: Btree
_allValuesLessThanKey: aKey andEquals: boolean

" This method is provided as a goodie, but is not part of the
  supported class library "

| array1 array2 stream |
stream := BtreeStream new.
array2 := #[].
(root _findAllValuesLessThanKey: aKey andEquals: boolean into: array2)
    ifTrue: [
        array1 := #[].
        root _putFirstIndexOfFirstChildInto: array1.
        stream currentStack: array1.
        stream endIndex: (array2 at: 1).
        stream endNode: (array2 at: 2)
    ]
    ifFalse: [ stream currentStack: (Array with: 0) ].
^ stream
%
category: 'Accessing'
method: Btree
allValuesLessThanKey: aKey

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream of all values that are less than the given key. "

^ self _allValuesLessThanKey: aKey andEquals: false
%
category: 'Accessing'
method: Btree
allValuesLessThanOrEqualToKey: aKey

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream of all values that are less than or equal to the given key. "

^ self _allValuesLessThanKey: aKey andEquals: true
%
category: 'Enumerating'
method: Btree
keysDo: aBlock

" This method is provided as a goodie, but is not part of the
  supported class library "

" Execute the block with each key of the receiver as the argument. "

| keys eSize |
keys := #[].
eSize := root entrySize.
root _preOrderDo: [ :node |
    node isLeaf
        ifTrue: [
            2 to: (node numElements * eSize) by: eSize do: [ :i |
                keys add: (node _at: i).
            ]
        ]
].
1 to: keys size do: [ :i | aBlock value: (keys at: i) ]
%
category: 'Enumerating'
method: Btree
valuesDo: aBlock

" This method is provided as a goodie, but is not part of the
  supported class library "

" Execute the block with each value of the receiver as the argument. "

| vals eSize |
vals := #[].
eSize := root entrySize.
root _preOrderDo: [ :node |
    node isLeaf
        ifTrue: [
            1 to: (node numElements * eSize) by: eSize do: [ :i |
                vals add: (node _at: i).
            ]
        ]
].
1 to: vals size do: [ :i | aBlock value: (vals at: i) ]
%
category: 'Enumerating'
method: Btree
keysAndValuesDo: aBlock

" This method is provided as a goodie, but is not part of the
  supported class library "

" Execute the block with each key and value of the receiver as the arguments. "

| objs eSize |
objs := #[].
eSize := root entrySize.
root _preOrderDo: [ :node |
    node isLeaf
        ifTrue: [
            1 to: (node numElements * eSize) by: eSize do: [ :i |
                objs add: (node _at: i+1).
                objs add: (node _at: i).
            ]
        ]
].
1 to: objs size by: 2 do: [ :i |
    aBlock value: (objs at: i) value: (objs at: i+1)
]
%
category: 'Accessing'
method: Btree
totalElements

" This method is provided as a goodie, but is not part of the
  supported class library "

^ root totalElements
%
category: 'Accessing'
method: Btree
valuesAscending

" This method is provided as a goodie, but is not part of the
  supported class library "

| result |
result := Array new: root totalElements.
root _putAscendingValuesInto: result startingAt: 1.
^ result

%
category: 'Accessing'
method: Btree
valuesDescending

" This method is provided as a goodie, but is not part of the
  supported class library "

| result |
result := Array new: root totalElements.
root _putDescendingValuesInto: result startingAt: root totalElements.
^ result

%

! ------------------- Instance methods for BtreeStream

category: 'Testing'
method: BtreeStream
atEnd

" This method is provided as a goodie, but is not part of the
  supported class library "

| result |
result := super atEnd.
^ result
%
category: 'Accessing'
method: BtreeStream
next

" This method is provided as a goodie, but is not part of the
  supported class library "

| result |
result := super next.
^ result
%

method: BtreeStream
numElements

" This method is provided as a goodie, but is not part of the
  supported class library "

"Return the number of elements contained in the receiver
(i.e. how many successful 'next' operations can be performed)."

| array |
self atEnd ifTrue: [ 
 ^ 0 
 ].
array := #[ 0, false ].
(currentStack at: currentStack size)
  _totalElementsIn: currentStack
  endNode: endNode
  endIndex: endIndex
  into: array.
^ array at: 1
%

method: Btree
allValuesGreaterThan: val1
andEquals: bool1
andLessThan: val2
andEquals: bool2

" This method is provided as a goodie, but is not part of the
  supported class library "

" Answer a stream of all values that are greater than (or greater
than and equals if bool1 is true) val1, and less than (or less than
and equals if bool2 is true) val2."

| array1 array2 stream doNext |
stream := BtreeStream new.
" check to see if the query is even satisfiable "
( (val1 _idxCompareGreaterThan: val2) _or:
[ val1 = val2 _and: [ (bool1 & bool2) not ] ] )
  ifTrue: [
    stream currentStack: (Array with: 0).
    ^ stream
  ].

doNext := false.
array1 := Array new.
" see if querying > or >= "
bool1
  ifTrue: [ " if >=, perform < and do an 'next' operation later "
    (root _findAllValuesLessThanKey: val1 andEquals: false into: array1)
      ifTrue: [ doNext := true ]
      ifFalse: [ " all were greater than or equal to "
        root _putFirstIndexOfFirstChildInto: array1 ifGreaterThanOrEqualTo: val1
      ]
  ]
  ifFalse: [ " if >, ask the B-tree specifically for > "
    (root _findAllValuesGreaterThanKey: val1 into: array1)
      ifFalse: [ " none were greater than "
        stream currentStack: (Array with: 0).
        ^ stream
      ]
  ].

array2 := Array new.
" ask the B-tree for the second boundary of the query result "
(root _findAllValuesLessThanKey: val2 andEquals: bool2 into: array2)
  ifFalse: [ " none were found less than "
    stream currentStack: (Array with: 0).
    ^ stream
  ].

stream currentStack: array1.
stream endIndex: (array2 at: 1).
stream endNode: (array2 at: 2).

(stream endNode == (array1 at: 2) _and:
[ stream endIndex < (array1 at: 1) ] )
  ifTrue: [
    array1 at: 1 put: 0.
    ^ stream
  ].

doNext
  ifTrue: [ " advance the B-tree positioning "
    stream next.
  ].

^ stream
%

