"{ Package: 'stx:libbasic2' }"

Collection subclass:#BinaryTree
	instanceVariableNames:'treeRoot sortBlock'
	classVariableNames:''
	poolDictionaries:''
	category:'Collections-Ordered'
!

Object subclass:#BinaryTreeNode
	instanceVariableNames:'data leftSubtree rightSubtree'
	classVariableNames:''
	poolDictionaries:''
	privateIn:BinaryTree
!

!BinaryTree class methodsFor:'documentation'!

documentation
"
    Loosely based on the Public Domain BinaryTreeNode class from Steve Chepurny.

    Changes:
        Changed to be Collection-protocol compatible.
        Slight speedup in insert-code.

    [author:]
        Steve Chepurny (original BinaryTreeNode implementation)
        Claus Gittinger (cg@alan)

    [instance variables:]

    [class variables:]

    [see also:]

"
!

examples
"
                                                                [exBegin]
    |coll|

    coll := BinaryTree new.
    (1 to:10) do:[:i | coll add:i]..
    coll addAll:(20 to:30).
    coll    
                                                                [exEnd]

  timing:  
                                                                [exBegin]
    |N randomNumbers coll1 coll2 t1 t2|

    N := 1000000.
    randomNumbers := (1 to:N) collect:[:i | Random nextInteger].

    ObjectMemory garbageCollect.
    t1 := Time millisecondsToRun:[
        coll1 := BinaryTree new.
        coll1 addAll:randomNumbers
    ].

    coll1 := nil.
    ObjectMemory garbageCollect.
    t2 := Time millisecondsToRun:[
        coll2 := SortedCollection new.
        coll2 addAll:randomNumbers
    ].
    Transcript show:'Time to insert '; show:N; show:' into BinaryTree: '; show:t1; showCR:'ms'.
    Transcript show:'Time to insert '; show:N; show:' into SortedCollection: '; show:t2; showCR:'ms'.
                                                                [exEnd]

  timing 2:  
                                                                [exBegin]
    |allSelectors coll1 coll2 t0 t1 t2|

    allSelectors := OrderedCollection new.
    Smalltalk allClassesDo:[:cls |
        cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
            allSelectors add:sel.
        ].
    ].

    t1 := Time millisecondsToRun:[
        coll1 := SortedCollection new.
        allSelectors do:[:sel |
            coll1 add:sel
        ].
    ].
    Transcript show:'Time to insert '; show:coll1 size; show:' selectors into SortedCollection: '; show:t1; showCR:'ms'.

    t2 := Time millisecondsToRun:[
        coll2 := BinaryTree new.
        allSelectors do:[:sel |
            coll2 add:sel
        ].
    ].
    Transcript show:'Time to insert '; show:coll2 size; show:' selectors into BinaryTree: '; show:t2; showCR:'ms'.

    t1 := Time millisecondsToRun:[
        allSelectors do:[:sel |
            coll1 remove:sel
        ].
    ].
    self assert:(coll1 isEmpty).
    Transcript show:'Time to remove selectors from SortedCollection: '; show:t1; showCR:'ms'.

    t2 := Time millisecondsToRun:[
        allSelectors do:[:sel |
            coll2 remove:sel
        ].
    ].
    self assert:(coll2 isEmpty).
    Transcript show:'Time to remove selectors from BinaryTree: '; show:t2; showCR:'ms'.
                                                                [exEnd]

"
! !

!BinaryTree class methodsFor:'instance creation'!

new
    ^ self basicNew initialize
!

new:n
    ^ self new
! !

!BinaryTree methodsFor:'adding & removing'!

add:anObject
    |newNode|

    newNode := BinaryTreeNode data:anObject.
    treeRoot isNil ifTrue:[
        treeRoot := newNode.
    ] ifFalse:[
        treeRoot insert:newNode sortBlock:sortBlock
    ].
    ^ anObject "sigh - collection protocol"

    "
     BinaryTree new add:1; add:2; yourself
     BinaryTree with:1 with:2 with:3
    "
!

do:aBlock
    treeRoot notNil ifTrue:[
        treeRoot inOrderDo:[:eachNode | aBlock value:(eachNode data)].
    ].

    "
     BinaryTree new add:1; add:2; yourself
    "
!

includesIdentical:anElement
    treeRoot isNil ifTrue:[
        ^ false.
    ].
    ^ treeRoot includesIdenticalValue:anElement sortBlock:sortBlock.

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        includesIdentical:4
    "

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        includesIdentical:8
    "
!

remove:oldObject ifAbsent:exceptionValue
    |newRoot|

    treeRoot isNil ifTrue:[
        ^ exceptionValue value.
    ].
    newRoot := treeRoot removeValue:oldObject sortBlock:sortBlock.
    newRoot isNil ifTrue:[
        treeRoot data = oldObject ifFalse:[
            ^ exceptionValue value.
        ].
    ].
    treeRoot := newRoot    

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        removeIdentical:4;
        yourself   
    "

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        removeIdentical:7;
        yourself      
    "
!

removeIdentical:oldObject ifAbsent:exceptionValue
    |newRoot|

    treeRoot isNil ifTrue:[
        ^ exceptionValue value.
    ].
    newRoot := treeRoot removeIdenticalValue:oldObject sortBlock:sortBlock.
    newRoot isNil ifTrue:[
        ^ exceptionValue value.
    ].
    treeRoot := newRoot    

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        removeIdentical:4;
        yourself   
    "

    "
     BinaryTree new 
        addAll:#(4 2 1 3 6 5 7); 
        removeIdentical:7;
        yourself      
    "
! !

!BinaryTree methodsFor:'initialization'!

initialize
    sortBlock := [:a :b | a < b]
! !

!BinaryTree methodsFor:'queries'!

size
    ^ treeRoot size
! !

!BinaryTree::BinaryTreeNode class methodsFor:'documentation'!

copyright
"
    Public domain (I guess, as it was published in c.l.s)
    no limitation on use.

    This class is provided as-is, without any warranty. 
    It is not part of or covered by the ST/X copyright.
"
!

documentation
"
    goody from comp.lang.smalltalk;
    original header:

	Here's a complete implementation of a binary tree class:


    claus:
	I would have called this a BinaryTreeNode ....


    [organization:]
	The National Capital FreeNet, Ottawa, Ontario, Canada

    [author:]
	al938@FreeNet.Carleton.CA (Steve Chepurny)

    [see also:]
	LinkedList Chain
	Link ValueLink ChainLink
"
!

examples
"
  manual building of a tree:
                                                                        [exBegin]
    |tree|

    tree := BinaryTreeNode data:2.
    tree leftSubtree:(BinaryTreeNode new data:1).
    tree rightSubtree:(BinaryTreeNode new data:3).
    tree printOn:Transcript.
                                                                        [exEnd]

  insertion:
                                                                        [exBegin]
    |tree|

    tree := BinaryTreeNode data:'hello'.
    #('the' 'quick' 'brown' 'fox' 'jumps' 'over' 'the' 'lazy' 'dogs')
    do:[:word |
        tree insert:(BinaryTreeNode data:word).
    ].
    tree inOrderDo:[:node |
        Transcript showCR:node data
    ]
                                                                        [exEnd]
"
! !

!BinaryTree::BinaryTreeNode class methodsFor:'instance creation'!

data:data
    "Returns a new binary tree node, holding data"

    ^ self basicNew initialize data:data

    "Modified: 10.5.1996 / 15:00:13 / cg"
    "Created: 10.5.1996 / 15:00:35 / cg"
!

empty
    "Returns a new binary tree with subtrees as binary tree nodes"

    ^ self new
	    leftSubtree: self new;
	    rightSubtree: self new

    "Modified: 10.5.1996 / 15:00:02 / cg"
!

new
    "Returns a new empty binary tree node"

    ^ self basicNew initialize

    "Modified: 10.5.1996 / 15:00:13 / cg"
! !

!BinaryTree::BinaryTreeNode methodsFor:'accessing'!

data
    ^data
!

data:   anObject
    data := anObject
!

leftSubtree
    ^leftSubtree
!

leftSubtree: aBinaryTree
    leftSubtree := aBinaryTree
!

rightSubtree
    ^rightSubtree
!

rightSubtree: aBinaryTree
    rightSubtree := aBinaryTree
! !

!BinaryTree::BinaryTreeNode methodsFor:'enumeration'!

do: aBlock
    "applies aBlock to each elements data in the binary tree in inorder"

    self inOrderDo:[:eachNode | aBlock value:eachNode data]
!

inOrderDo:aBlock
    "Traverses the elements of the binary tree in
        LEFT - ROOT - RIGHT order, 
     applying a block to each node"

    leftSubtree notNil ifTrue:[
        leftSubtree inOrderDo: aBlock
    ].

    aBlock value:self.

    rightSubtree notNil ifTrue:[
        rightSubtree inOrderDo: aBlock
    ].

    "Modified: 10.5.1996 / 15:10:34 / cg"
!

postOrderDo: aBlock
    "Traverses the elements of the binary tree in
        LEFT - RIGHT - ROOT order, 
     applying a block to each node"

    leftSubtree notNil ifTrue:[
        leftSubtree postOrderDo: aBlock
    ].
    rightSubtree notNil ifTrue:[
        rightSubtree postOrderDo: aBlock
    ].

    aBlock value: self.
!

preOrderDo: aBlock
    "Traverses the elements of the binary tree in
        ROOT - LEFT - RIGHT order, 
     applying a block to each node"

    aBlock value: self.

    leftSubtree notNil ifTrue:[
        leftSubtree preOrderDo: aBlock
    ].
    rightSubtree notNil ifTrue:[
        rightSubtree preOrderDo: aBlock
    ].
! !

!BinaryTree::BinaryTreeNode methodsFor:'insert & delete'!

insert:aBinaryTreeNode
    "insert a node, comparing nodes using a default sort rule"

    ^ self
        insert:aBinaryTreeNode
        sortBlock:[:a :b | a < b]

    "Modified: 10.5.1996 / 15:08:30 / cg"
    "Created: 10.5.1996 / 15:09:44 / cg"
!

insert:newBinaryTreeNode sortBlock:sortBlock
    "insert a node, comparing nodes using sortBlock"

"/    "/ the following might be ugly - however, it it slightly faster
"/    "/ than the stuff below.
"/    "/ (we MUST have LCO in smalltalk for this to be automatically fast)
"/
"/    |node newValue left right|
"/
"/    node := self.
"/    newValue := newBinaryTreeNode data.
"/    [true] whileTrue:[
"/        (sortBlock value:newValue value:node data) ifTrue:[
"/            left := node leftSubtree.
"/            left isNil ifTrue:[
"/                node leftSubtree:newBinaryTreeNode.
"/                ^ self
"/            ].
"/            node := left
"/        ] ifFalse:[
"/            right := node rightSubtree.
"/            right isNil ifTrue:[
"/                node rightSubtree:newBinaryTreeNode.
"/                ^ self
"/            ].
"/            node := right
"/        ]
"/    ].
"/    "not reached"

    (sortBlock value:newBinaryTreeNode data value:data) ifTrue:[
        leftSubtree isNil ifTrue:[
            leftSubtree := newBinaryTreeNode.
        ] ifFalse:[
            leftSubtree insert:newBinaryTreeNode sortBlock:sortBlock
        ]
    ] ifFalse:[
        rightSubtree isNil ifTrue:[
            rightSubtree := newBinaryTreeNode.
        ] ifFalse:[
            rightSubtree insert:newBinaryTreeNode sortBlock:sortBlock
        ]
    ]
!

removeIdenticalValue:oldValue sortBlock:sortBlock
    "remove a value - returns a new treeNode, or nil if the value is not in the tree"

    |newTop|

    data == oldValue ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ rightSubtree
        ].
        rightSubtree isNil ifTrue:[
            ^ leftSubtree
        ].
        newTop := self removeLeftRightMostNode.
        newTop leftSubtree:leftSubtree.
        newTop rightSubtree:rightSubtree.
        ^ newTop.
    ].

    (sortBlock value:oldValue value:data) ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ nil
        ].
        leftSubtree := leftSubtree removeIdenticalValue:oldValue sortBlock:sortBlock.
        ^ self. 
    ].
    rightSubtree isNil ifTrue:[
        ^ nil
    ].
    rightSubtree := rightSubtree removeIdenticalValue:oldValue sortBlock:sortBlock.
    ^ self. 
!

removeValue:oldValue sortBlock:sortBlock
    "remove a value - returns a new treeNode, or nil if the value is not in the tree"

    |newTop|

    data = oldValue ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ rightSubtree
        ].
        rightSubtree isNil ifTrue:[
            ^ leftSubtree
        ].
        newTop := self removeLeftRightMostNode.
        newTop leftSubtree:leftSubtree.
        newTop rightSubtree:rightSubtree.
        ^ newTop.
    ].

    (sortBlock value:oldValue value:data) ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ nil
        ].
        leftSubtree := leftSubtree removeValue:oldValue sortBlock:sortBlock.
        ^ self. 
    ].
    rightSubtree isNil ifTrue:[
        ^ nil
    ].
    rightSubtree := rightSubtree removeValue:oldValue sortBlock:sortBlock.
    ^ self. 
! !

!BinaryTree::BinaryTreeNode methodsFor:'printing'!

printOn: aStream
    "Append the ascii representation to aStream"

    data isNil
        ifTrue: [aStream nextPutAll: '--']
        ifFalse: [
            aStream nextPut: $(.
            data printOn: aStream. aStream nextPut: $ .
            leftSubtree printOn: aStream. aStream nextPut: $ .
            rightSubtree printOn: aStream.
            aStream nextPut: $)]
! !

!BinaryTree::BinaryTreeNode methodsFor:'private helpers'!

removeLeftRightMostNode
    |rightMost|

    leftSubtree rightSubtree isNil ifTrue:[
        rightMost := leftSubtree.
        leftSubtree := leftSubtree leftSubtree.
        ^ rightMost.
    ].

    ^ leftSubtree removeRightMostNode

    "
     |tree|

     tree := BinaryTreeNode data:4.
     #(2 6 1 3 5 7)
     do:[:word |
         tree insert:(BinaryTreeNode data:word).
     ].
     Transcript showCR:tree.
     tree removeLeftRightMostNode.
    "
!

removeRightMostNode
    |removedNode|

    rightSubtree isNil ifTrue:[
        self error:'should not happen'
    ].
    rightSubtree rightSubtree notNil ifTrue:[
        ^ rightSubtree removeRightMostNode.
    ].
    removedNode := rightSubtree.
    rightSubtree := nil.
    ^ removedNode

    "
     |tree|

     tree := BinaryTreeNode data:4.
     #(2 6 1 3 5 7)
     do:[:word |
         tree insert:(BinaryTreeNode data:word).
     ].
     Transcript showCR:tree.
     Transcript showCR:(tree removeLeftRightMostNode). 
     Transcript showCR:tree.
    "
! !

!BinaryTree::BinaryTreeNode methodsFor:'queries'!

depth
    "Returns the depth of the binary list"

    ^ self level - 1.
!

getTreeWithAnInteger: anInteger
    "Private - Returns the BinaryTree with data anInteger.  
     If anInteger not in the tree it returns nil."

    self inOrderDo: [:each| each data = anInteger ifTrue:[^each]].
    ^nil.
!

inOrderSuccessor
    "Returns the in-order successor the of receiver.
     (that is the leftMost node on the right side)
     If receiver is empty then returns the receiver."

    rightSubtree isNil ifTrue:[^ self].
    ^ rightSubtree leftMostNode
!

includesIdenticalValue:aValue sortBlock:sortBlock
    "return true, if aValue is contained as some node's data"

    data == aValue ifTrue:[ ^ true ].
    (sortBlock value:aValue value:data) ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ false
        ].
        ^ leftSubtree includesIdenticalValue:aValue sortBlock:sortBlock.
    ].
    rightSubtree isNil ifTrue:[
        ^ false
    ].
    ^ rightSubtree includesIdenticalValue:aValue sortBlock:sortBlock.
!

includesValue:aValue sortBlock:sortBlock
    "return true, if some node's data is equal to aValue"

    data = aValue ifTrue:[ ^ true ].

    (sortBlock value:aValue value:data) ifTrue:[
        leftSubtree isNil ifTrue:[
            ^ false
        ].
        ^ leftSubtree includesIdenticalValue:aValue.
    ].
    rightSubtree isNil ifTrue:[
        ^ false
    ].
    ^ rightSubtree includesIdenticalValue:aValue.
!

isEmpty
    "returns true if the binary tree is empty and false otherwise"

    ^ data isNil
!

isLeaf
    "Returns true if self is a leaf"

    ^ ((leftSubtree isNil) and: [rightSubtree isNil])
!

leftMostNode
    "Returns the leftMost (smallest-valued) node"

    leftSubtree isNil ifTrue:[^ self].
    ^ leftSubtree leftMostNode
!

level
    "Returns the depth of the binary tree"

    |l|

    l := 0.
    leftSubtree notNil ifTrue:[
        l := leftSubtree level
    ].
    rightSubtree notNil ifTrue:[
        l := l max:(rightSubtree level)
    ].
    ^ l + 1
!

rightMostNode
    "Returns the rightMost (largest-valued) node"

    rightSubtree isNil ifTrue:[^ self].
    ^ rightSubtree rightMostNode
!

size
    "Returns the size of the binary tree by traversing each element inorder"

    |count|

    count := 0.
    self inOrderDo: [:each | count := count + 1].
    ^ count
! !

!BinaryTree class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/BinaryTree.st,v 1.2 2003-12-10 09:54:24 cg Exp $'
! !