"{ 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:'accessing'!

sortBlock:something

    sortBlock := something.

! !

!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"

    ^ self removeValue:oldValue using:#== sortBlock:sortBlock

!

removeValue:oldValue sortBlock:sortBlock

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

    ^ self removeValue:oldValue using:#= sortBlock:sortBlock

!

removeValue:oldValue using:compareOp sortBlock:sortBlock

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

    |thisIsMyNode newTop|

    "/ speed hack - avoids message sends

    compareOp == #== ifTrue:[

        thisIsMyNode := (data == oldValue).

    ] ifFalse:[

        compareOp == #= ifTrue:[

            thisIsMyNode := (data = oldValue).

        ] ifFalse:[

            thisIsMyNode := data perform:compareOp with:oldValue.

        ].

    ].