AATreeNode.st
author Claus Gittinger <cg@exept.de>
Sun, 05 Aug 2012 11:30:17 +0200
changeset 2764 61ab354f8c97
parent 2280 fef9e704c733
permissions -rw-r--r--
category changes
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2280
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     1
"
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     2
 COPYRIGHT (c) 2009 by eXept Software AG
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     3
              All Rights Reserved
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     4
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     5
 This software is furnished under a license and may be used
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     6
 only in accordance with the terms of that license and with the
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     8
 be provided or otherwise made available to, or used by, any
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
     9
 other person.  No title to or ownership of the software is
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    10
 hereby transferred.
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    11
"
2267
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libbasic2' }"
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
BinaryTreeNode subclass:#AATreeNode
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	instanceVariableNames:'level'
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	classVariableNames:''
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	poolDictionaries:''
2764
61ab354f8c97 category changes
Claus Gittinger <cg@exept.de>
parents: 2280
diff changeset
    18
	category:'Collections-Ordered-Trees'
2267
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
2280
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    21
!AATreeNode class methodsFor:'documentation'!
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    22
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    23
copyright
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    24
"
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    25
 COPYRIGHT (c) 2009 by eXept Software AG
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    26
              All Rights Reserved
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    27
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    28
 This software is furnished under a license and may be used
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    29
 only in accordance with the terms of that license and with the
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    31
 be provided or otherwise made available to, or used by, any
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    32
 other person.  No title to or ownership of the software is
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    33
 hereby transferred.
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    34
"
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
    35
! !
2267
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
!AATreeNode class methodsFor:'instance creation'!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
data:dataArg level:levelArg
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    ^ self basicNew data:dataArg level:levelArg
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
! !
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
!AATreeNode methodsFor:'accessing'!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
data:dataArg level:levelArg
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    data := dataArg.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    level := levelArg.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
level
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    ^ level
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
level:something
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    level := something.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
! !
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!AATreeNode methodsFor:'helpers'!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
decrease_level
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
"/    function decrease_level is
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
"/        input: T, a tree for which we want to remove links that skip levels.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
"/        output: T with its level decreased.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
"/        should_be = min(level(left(T)), level(right(T))) + 1
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
"/        if should_be < level(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
"/            level(T) := should_be
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
"/            if should_be < level(right(T)) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
"/                level(right(T)) := should_be
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
"/            end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
"/        end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
"/        return T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
"/    end function
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    |shouldBe leftLevel rightLevel|
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    leftLevel := leftSubtree isNil ifTrue:[0] ifFalse:[leftSubtree level].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    rightLevel := rightSubtree isNil ifTrue:[0] ifFalse:[rightSubtree level].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    shouldBe := (leftLevel min:rightLevel) + 1.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
    shouldBe < level ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
        level := shouldBe.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
        shouldBe < rightLevel ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
            rightSubtree level:shouldBe
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
insert:anObject usingSortBlock:sortBlock
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
"/    function insert is
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
"/        input: X, the value to be inserted, and T, the root of the tree to insert it into.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
"/        output: A balanced version T including X.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
"/        Do the normal binary tree insertion procedure.  Set the result of the
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
"/        recursive call to the correct child in case a new node was created or the
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
"/        root of the subtree changes.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
"/        if nil(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
"/            Create a new leaf node with X.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
"/            return node(X, 1, Nil, Nil)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
"/        else if X < value(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
"/            left(T) := insert(X, left(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
"/        else if X > value(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
"/            right(T) := insert(X, right(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
"/        end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
"/        Note that the case of X == value(T) is unspecified.  As given, an insert
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
"/        will have no effect.  The implementor may desire different behavior.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
"/        Perform skew and then split.  The conditionals that determine whether or
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
"/        not a rotation will occur or not are inside of the procedures, as given
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
"/        above.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
"/        T := skew(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
"/        T := split(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
"/        return T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
"/    end function
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    (sortBlock value:anObject value:data) ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
        leftSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
            leftSubtree := AATreeNode data:anObject level:1
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
        ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
            leftSubtree := (leftSubtree insert:anObject usingSortBlock:sortBlock)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
        rightSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
            rightSubtree := AATreeNode data:anObject level:1
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
        ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
            rightSubtree := (rightSubtree insert:anObject usingSortBlock:sortBlock)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
        ]
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    ^ self skew split.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
removeValue:oldValue using:equalSelector sortBlock:sortBlock
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    "remove a value - returns a new treeNode, or nil if the value is not in the tree"
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
    |nextValue prevValue newTop rr thisIsMyNode newLeftSubtree newRightSubtree|
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
"/    function delete is
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
"/        input: X, the value to delete, and T, the root of the tree from which it should be deleted.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
"/        output: T, balanced, without the value X.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
"/        if X > value(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
"/            right(T) := delete(X, right(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
"/        else if X < value(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
"/            left(T) := delete(X, left(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
"/        else
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
"/            If we're a leaf, easy, otherwise reduce to leaf case. 
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
"/            if leaf(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
"/                return Nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
"/            else if nil(left(T)) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
"/                L := successor(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
"/                right(T) := delete(L, right(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
"/                value(T) := L
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
"/            else
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
"/                L := predecessor(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
"/                left(T) := delete(L, left(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
"/                value(T) := L
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
"/            end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
"/        end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
"/        Rebalance the tree.  Decrease the level of all nodes in this level if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
"/        necessary, and then skew and split all nodes in the new level.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
"/        T := decrease_level(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
"/        T := skew(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
"/        right(T) := skew(right(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
"/        right(right(T)) := skew(right(right(T)))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
"/        T := split(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
"/        right(T) := split(right(T))
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
"/        return T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
"/    end function
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
    "/ speed hack - avoids message sends (and also better inline caching)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
    equalSelector == #== ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
        thisIsMyNode := (data == oldValue).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
    ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
        equalSelector == #= ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
            thisIsMyNode := (data = oldValue).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
        ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
            thisIsMyNode := data perform:equalSelector with:oldValue.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
    thisIsMyNode ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
        leftSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
            rightSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
                ^ nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
            ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
            nextValue := rightSubtree leftMostNode data.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
            rightSubtree := (rightSubtree removeValue:nextValue using:equalSelector sortBlock:sortBlock).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
            data := nextValue.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
        ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
            prevValue := leftSubtree rightMostNode data.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
            leftSubtree := (leftSubtree removeValue:prevValue using:equalSelector sortBlock:sortBlock).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
            data := prevValue.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
    ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
        (sortBlock value:oldValue value:data) ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
            "/ the value should be in the left part.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
            leftSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
                ^ nil.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
            ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
            newLeftSubtree := leftSubtree removeValue:oldValue using:equalSelector sortBlock:sortBlock.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
            newLeftSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
                (leftSubtree data perform:equalSelector with:oldValue) ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
                    ^ nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
                ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
            ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
            leftSubtree := newLeftSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
        ] ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
            "/ the value should be in the right part.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
            rightSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
                ^ nil.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
            ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
            newRightSubtree := rightSubtree removeValue:oldValue using:equalSelector sortBlock:sortBlock.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
            newRightSubtree isNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
                (rightSubtree data perform:equalSelector with:oldValue) ifFalse:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
                    ^ nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
                ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
            ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
            rightSubtree := newRightSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
    self decrease_level.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
    newTop := self skew.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
    (rr := newTop rightSubtree) notNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
        newTop rightSubtree:(rr skew).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
        (rr := newTop rightSubtree rightSubtree) notNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
            newTop rightSubtree rightSubtree:(rr skew).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
        ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
    newTop := newTop split.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
    (rr := newTop rightSubtree) notNil ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
        newTop rightSubtree:(rr split).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    ^ newTop
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
skew
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
    |oldLeft|
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
"/    function skew is
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
"/        input: T, a node representing an AA tree that needs to be rebalanced.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
"/        output: Another node representing the rebalanced AA tree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
"/        if nil(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
"/            return Nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
"/        else if level(left(T)) == level(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
"/            Swap the pointers of horizontal left links.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
"/            L = left(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
"/            left(T) := right(L)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
"/            right(L) := T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
"/            return L
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
"/        else
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
"/            return T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
"/        end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
"/    end function
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
    leftSubtree isNil ifTrue:[^ self].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
    leftSubtree level == level ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
        oldLeft := leftSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
        leftSubtree := (oldLeft rightSubtree).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
        oldLeft rightSubtree:self.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
        ^ oldLeft
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    ^ self
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
split
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
    |oldRight oldRightRight|
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
"/    function split is
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
"/        input: T, a node representing an AA tree that needs to be rebalanced.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
"/        output: Another node representing the rebalanced AA tree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
"/
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
"/        if nil(T) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
"/            return Nil
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
"/        else if level(T) == level(right(right(T))) then
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
"/            We have two horizontal right links.  Take the middle node, elevate it, and return it.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
"/            R = right(T)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
"/            right(T) := left(R)
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
"/            left(R) := T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
"/            level(R) := level(R) + 1
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
"/            return R
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
"/        else
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
"/            return T
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
"/        end if
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
"/    end function
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
    rightSubtree isNil ifTrue:[^ self].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
    oldRightRight := rightSubtree rightSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
    oldRightRight isNil ifTrue:[^ self].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
    level == oldRightRight level ifTrue:[
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
        oldRight := rightSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
        rightSubtree := oldRight leftSubtree.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
        oldRight leftSubtree:self.
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
        oldRight level:(oldRight level + 1).
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
        ^ oldRight
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
    ].
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
    ^ self
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
! !
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
!AATreeNode class methodsFor:'documentation'!
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
version
2764
61ab354f8c97 category changes
Claus Gittinger <cg@exept.de>
parents: 2280
diff changeset
   306
    ^ '$Header: /cvs/stx/stx/libbasic2/AATreeNode.st,v 1.3 2012-08-05 09:30:17 cg Exp $'
2280
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
   307
!
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
   308
fef9e704c733 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 2267
diff changeset
   309
version_CVS
2764
61ab354f8c97 category changes
Claus Gittinger <cg@exept.de>
parents: 2280
diff changeset
   310
    ^ '$Header: /cvs/stx/stx/libbasic2/AATreeNode.st,v 1.3 2012-08-05 09:30:17 cg Exp $'
2267
7230320c1a2f initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
! !