1 #Region "Microsoft.VisualBasic::9edde09923b165c5f275c597d284087a, Microsoft.VisualBasic.Core\ComponentModel\Algorithm\BinaryTree\AVLTree.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Class AVLTree
35     
36     '         Properties: root
37     
38     '         Constructor: (+1 OverloadsSub New
39     
40     '         Function: Add, Remove
41     
42     '         Sub: Add, appendLeft, appendRight, Remove, removeCurrent
43     '              removeLeft, removeRight
44     
45     
46     ' /********************************************************************************/
47
48 #End Region
49
50 Imports System.Runtime.CompilerServices
51
52 Namespace ComponentModel.Algorithm.BinaryTree
53
54     ''' <summary>
55     ''' The AVL binary tree operator.
56     ''' </summary>
57     ''' <typeparam name="K"></typeparam>
58     ''' <typeparam name="V"></typeparam>
59     ''' <remarks>
60     ''' http://www.cnblogs.com/huangxincheng/archive/2012/07/22/2603956.html
61     ''' </remarks>
62     Public Class AVLTree(Of K, V)
63
64         ''' <summary>
65         ''' The root node of this binary tree
66         ''' </summary>
67         ''' <returns></returns>
68         Public ReadOnly Property root As BinaryTree(Of K, V)
69
70         ReadOnly compares As Comparison(Of K)
71         ReadOnly views As Func(Of K, String)
72
73         ''' <summary>
74         ''' Create an instance of the AVL binary tree.
75         ''' </summary>
76         ''' <param name="compares">Compare between two keys.</param>
77         ''' <param name="views">Display the key as string</param>
78         Sub New(compares As Comparison(Of K), Optional views As Func(Of K, String) = Nothing)
79             Me.compares = compares
80             Me.views = views
81         End Sub
82
83         <MethodImpl(MethodImplOptions.AggressiveInlining)>
84         Public Sub Add(key As K, value As V, Optional valueReplace As Boolean = True)
85             _root = Add(key, value, _root, valueReplace)
86         End Sub
87
88         Public Function Add(key As K, value As V, tree As BinaryTree(Of K, V), valueReplace As BooleanAs BinaryTree(Of K, V)
89             If tree Is Nothing Then
90                 tree = New BinaryTree(Of K, V)(key, value, Nothing, views)
91             End If
92
93             Select Case compares(key, tree.Key)
94                 Case < 0 : Call appendLeft(tree, key, value, valueReplace)
95                 Case > 0 : Call appendRight(tree, key, value, valueReplace)
96                 Case = 0
97
98                     ' 将value追加到附加值中(也可对应重复元素)
99                     If valueReplace Then
100                         tree.Value = value
101                     End If
102
103                     ' 2018.3.6
104                     ' 如果是需要使用二叉树进行聚类操作,那么等于零的值可能都是同一个簇之中的
105                     ' 在这里将这个member添加进来
106                     Call DirectCast(tree!values, List(Of V)).Add(value)
107
108                 Case Else
109                     ' This will never happend!
110                     Throw New Exception("????")
111             End Select
112
113             tree.PutHeight
114
115             Return tree
116         End Function
117
118         Private Sub appendRight(ByRef tree As BinaryTree(Of K, V), key As K, value As V, replace As Boolean)
119             tree.Right = Add(key, value, tree.Right, replace)
120
121             If tree.Right.height - tree.Left.height = 2 Then
122                 If compares(key, tree.Right.Key) > 0 Then
123                     tree = tree.RotateRR
124                 Else
125                     tree = tree.RotateRL
126                 End If
127             End If
128         End Sub
129
130         Private Sub appendLeft(ByRef tree As BinaryTree(Of K, V), key As K, value As V, replace As Boolean)
131             tree.Left = Add(key, value, tree.Left, replace)
132
133             If tree.Left.height - tree.Right.height = 2 Then
134                 If compares(key, tree.Left.Key) < 0 Then
135                     tree = tree.RotateLL
136                 Else
137                     tree = tree.RotateLR
138                 End If
139             End If
140         End Sub
141
142         <MethodImpl(MethodImplOptions.AggressiveInlining)>
143         Public Sub Remove(key As K)
144             _root = Remove(key, _root)
145         End Sub
146
147         Public Function Remove(key As K, tree As BinaryTree(Of K, V)) As BinaryTree(Of K, V)
148             If tree Is Nothing Then
149                 Return Nothing
150             End If
151
152             Select Case compares(key, tree.Key)
153                 Case < 0 : Call removeLeft(tree, key)
154                 Case > 0 : Call removeRight(tree, key)
155                 Case = 0 : Call removeCurrent(tree)
156                 Case Else
157                     Throw New Exception
158             End Select
159
160             If Not tree Is Nothing Then
161                 Call tree.PutHeight
162             End If
163
164             Return tree
165         End Function
166
167         Private Sub removeLeft(ByRef tree As BinaryTree(Of K, V), key As K)
168             tree.Left = Remove(key, tree.Left)
169
170             If tree.Left.height - tree.Right.height = 2 Then
171                 If compares(key, tree.Left.Key) < 0 Then
172                     tree = tree.RotateLL
173                 Else
174                     tree = tree.RotateLR
175                 End If
176             End If
177         End Sub
178
179         Private Sub removeRight(ByRef tree As BinaryTree(Of K, V), key As K)
180             tree.Right = Remove(key, tree.Right)
181
182             If tree.Right.height - tree.Left.height = 2 Then
183                 If compares(key, tree.Right.Key) > 0 Then
184                     tree = tree.RotateRR
185                 Else
186                     tree = tree.RotateRL
187                 End If
188             End If
189         End Sub
190
191         Private Sub removeCurrent(ByRef tree As BinaryTree(Of K, V))
192             If Not tree.Left Is Nothing AndAlso Not tree.Right Is Nothing Then
193
194                 tree = New BinaryTree(Of K, V)(tree.Right.MinKey, tree.Value) With {
195                     .Left = tree.Left,
196                     .Right = tree.Right
197                 }
198                 tree.Right = Remove(tree.Key, tree.Right)
199
200             Else
201                 tree = If(tree.Left Is Nothing, tree.Right, tree.Left)
202
203                 If tree Is Nothing Then
204                     tree = Nothing
205                 End If
206             End If
207         End Sub
208     End Class
209 End Namespace