1 #Region "Microsoft.VisualBasic::2fcd8aa7a6821d08b54824d32bc241e4, Microsoft.VisualBasic.Core\ComponentModel\DataStructures\Tree\BinaryTree\BinaryTree.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 BinaryTree
35     
36     '         Properties: Length, Root
37     
38     '         Constructor: (+3 OverloadsSub New
39     
40     '         Function: drawNode, findParent, findSuccessor, FindSymbol, GetAllNodes
41     '                   (+2 Overloads) insert, ToString
42     
43     '         Sub: add, (+2 Overloads) Add, clear, delete, KillTree
44     
45     
46     ' /********************************************************************************/
47
48 #End Region
49
50 Imports System.Runtime.CompilerServices
51
52 ' Software License Agreement (BSD License)
53 '* 
54 '* Copyright (c) 2003, Herbert M Sauro
55 '* All rights reserved.
56 '*
57 '* Redistribution and use in source and binary forms, with or without
58 '* modification, are permitted provided that the following conditions are met:
59 '*     * Redistributions of source code must retain the above copyright
60 '*       notice, this list of conditions and the following disclaimer.
61 '*     * Redistributions in binary form must reproduce the above copyright
62 '*       notice, this list of conditions and the following disclaimer in the
63 '*       documentation and/or other materials provided with the distribution.
64 '*     * Neither the name of Herbert M Sauro nor the
65 '*       names of its contributors may be used to endorse or promote products
66 '*       derived from this software without specific prior written permission.
67 '*
68 '* THIS SOFTWARE IS PROVIDED BY <copyright holder> ``AS IS'' AND ANY
69 '* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
70 '* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
71 '* DISCLAIMED. IN NO EVENT SHALL <copyright holder> BE LIABLE FOR ANY
72 '* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
73 '* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
74 '* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
75 '* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
76 '* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
77 '* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
78 '
79
80 Namespace ComponentModel.DataStructures.BinaryTree
81
82     ''' <summary>
83     ''' The Binary tree itself.
84     ''' 
85     ''' A very basic Binary Search Tree. Not generalized, stores
86     ''' name/value pairs in the tree nodes. name is the node key.
87     ''' The advantage of a binary tree is its fast insert and lookup
88     ''' characteristics. This version does not deal with tree balancing.
89     ''' (二叉搜索树,用于建立对repository的索引文件)
90     ''' </summary>
91     ''' <remarks></remarks>
92     Public Class BinaryTree(Of T)
93
94         ''' <summary>
95         ''' The root of the tree.
96         ''' </summary>
97         ''' <returns></returns>
98         Public ReadOnly Property Root As TreeNode(Of T)
99
100         ''' <summary>
101         ''' Points to the root of the tree
102         ''' </summary>
103         ''' <remarks></remarks>
104         Dim _counts As Integer = 0
105
106         Public Sub New()
107         End Sub
108
109         Sub New(root As TreeNode(Of T))
110             Me.Root = root
111             Me._counts = root.Count
112         End Sub
113
114         ''' <summary>
115         ''' 初始化有一个根节点
116         ''' </summary>
117         ''' <param name="ROOT"></param>
118         ''' <param name="obj"></param>
119         Sub New(ROOT As String, obj As T)
120             Call Me.New
121             Call Me.insert(ROOT, obj)
122         End Sub
123
124         ' Recursive destruction of binary search tree, called by method clear
125         ' and destroy. Can be used to kill a sub-tree of a larger tree.
126         ' This is a hanger on from its Delphi origins, it might be dispensable
127         ' given the garbage collection abilities of .NET
128         Private Sub KillTree(ByRef p As TreeNode(Of T))
129             If p IsNot Nothing Then
130                 KillTree(p.Left)
131                 KillTree(p.Right)
132                 p = Nothing
133             End If
134         End Sub
135
136         Public Function GetAllNodes() As TreeNode(Of T)()
137             Dim list = Root.AllChilds
138             Call list.Insert(Scan0, Root)
139             Return list.ToArray
140         End Function
141
142         ''' <summary>
143         ''' Clear the binary tree.
144         ''' </summary>
145         Public Sub clear()
146             Call KillTree(Root)
147             _counts = 0
148         End Sub
149
150         ''' <summary>
151         ''' Manual add tree node
152         ''' </summary>
153         ''' <param name="parent"></param>
154         ''' <param name="node"></param>
155         ''' <param name="left"></param>
156         Public Sub Add(parent$, node As TreeNode(Of T), left As Boolean)
157             Dim parentNode = FindSymbol(parent)
158             If left Then
159                 parentNode.Left = node
160             Else
161                 parentNode.Right = node
162             End If
163         End Sub
164
165         ''' <summary>
166         ''' Manual add tree node
167         ''' </summary>
168         ''' <param name="parent"></param>
169         ''' <param name="node"></param>
170         Public Sub Add(parent As String, node As TreeNode(Of T))
171             Dim parentNode = FindSymbol(parent)
172             parentNode += node
173         End Sub
174
175         ''' <summary>
176         ''' Returns the number of nodes in the tree
177         ''' </summary>
178         ''' <returns>Number of nodes in the tree</returns>
179         Public ReadOnly Property Length As Integer
180             <MethodImpl(MethodImplOptions.AggressiveInlining)>
181             Get
182                 Return _counts
183             End Get
184         End Property
185
186         ''' <summary>
187         ''' Find name in tree. Return a reference to the node
188         ''' if symbol found else return null to indicate failure.
189         ''' </summary>
190         ''' <param name="name">Name of node to locate</param>
191         ''' <returns>Returns null if it fails to find the node, else returns reference to node</returns>
192         Public Function FindSymbol(Name As StringAs TreeNode(Of T)
193             Dim np As TreeNode(Of T) = Root
194             Dim cmp As Integer
195
196             While np IsNot Nothing
197                 cmp = NameCompare(Name, np.Name)
198
199                 If cmp = 0 Then
200                     ' found !
201                     Return np
202                 End If
203
204                 If cmp < 0 Then
205                     np = np.Left
206                 Else
207                     np = np.Right
208                 End If
209             End While
210
211             Return null to indicate failure to find name
212             Return Nothing
213         End Function
214
215         ''' <summary>
216         ''' Recursively locates an empty slot in the binary tree and inserts the node
217         ''' </summary>
218         ''' <param name="node"></param>
219         ''' <param name="tree"></param>
220         ''' <param name="[overrides]">
221         ''' 0不复写,函数自动处理
222         ''' &lt;0  LEFT
223         ''' >0 RIGHT
224         ''' </param>
225         Private Sub add(node As TreeNode(Of T), ByRef tree As TreeNode(Of T), [overrides] As Integer)
226             If tree Is Nothing Then
227                 tree = node
228             Else
229                 If we find a node with the same name then it's 
230                 ' a duplicate and we can't continue
231                 Dim comparison As Integer
232
233                 If [overrides] = 0 Then
234                     comparison = NameCompare(node.Name, tree.Name)
235
236                     If comparison = 0 Then
237                         Throw New Exception("Duplicated node was found!")
238                     End If
239                 Else
240                     comparison = [overrides]
241                 End If
242
243                 ' 2018-1-11
244                 ' overrides 应该一直被传递下去,而不是使用comparison结果,否则会一直被错误的overrides下去的
245                 ' 导致构建出来的树不平衡
246                 If comparison < 0 Then
247                     add(node, tree.Left, [overrides]:=[overrides])
248                     tree.Left.Parent = tree
249                 Else
250                     add(node, tree.Right, [overrides]:=[overrides])
251                     tree.Right.Parent = tree
252                 End If
253             End If
254         End Sub
255
256         ''' <summary>
257         ''' Add a symbol to the tree if it's a new one. Returns reference to the new
258         ''' node if a new node inserted, else returns null to indicate node already present.
259         ''' </summary>
260         ''' <param name="name">Name of node to add to tree</param>
261         ''' <param name="d">Value of node</param>
262         ''' <returns> Returns reference to the new node is the node was inserted.
263         ''' If a duplicate node (same name was located then returns null</returns>
264         Public Function insert(name As String, d As T, left As BooleanAs TreeNode(Of T)
265             Dim node As New TreeNode(Of T)(name, d)
266
267             Try
268                 If Root Is Nothing Then
269                     _Root = node
270                 Else
271                     add(node, Root, If(left, -1, 1))
272                 End If
273                 _counts += 1
274                 Return node
275             Catch generatedExceptionName As Exception
276                 Dim ex = New Exception(node.ToString, generatedExceptionName)
277                 Return App.LogException(ex)
278             End Try
279         End Function
280
281         ''' <summary>
282         ''' Add a symbol to the tree if it's a new one. Returns reference to the new
283         ''' node if a new node inserted, else returns null to indicate node already present.
284         ''' </summary>
285         ''' <param name="name">Name of node to add to tree</param>
286         ''' <param name="d">Value of node</param>
287         ''' <returns> Returns reference to the new node is the node was inserted.
288         ''' If a duplicate node (same name was located then returns null</returns>
289         Public Function insert(name As String, d As T) As TreeNode(Of T)
290             Dim node As New TreeNode(Of T)(name, d)
291             Try
292                 If Root Is Nothing Then
293                     _Root = node
294                 Else
295                     add(node, Root, 0)
296                 End If
297                 _counts += 1
298                 Return node
299             Catch generatedExceptionName As Exception
300                 Dim ex = New Exception(node.ToString, generatedExceptionName)
301                 Return App.LogException(ex)
302             End Try
303         End Function
304
305         ''' <summary>
306         ''' Searches for a node with name key, name. If found it returns a reference
307         ''' to the node and to the nodes parent. Else returns null.
308         ''' </summary>
309         ''' <param name="name"></param>
310         ''' <param name="parent"></param>
311         ''' <returns></returns>
312         Private Function findParent(name As StringByRef parent As TreeNode(Of T)) As TreeNode(Of T)
313             Dim np As TreeNode(Of T) = Root
314             parent = Nothing
315             Dim cmp As Integer
316             While np IsNot Nothing
317                 cmp = NameCompare(name, np.Name)
318                 If cmp = 0 Then
319                     ' found !
320                     Return np
321                 End If
322
323                 If cmp < 0 Then
324                     parent = np
325                     np = np.Left
326                 Else
327                     parent = np
328                     np = np.Right
329                 End If
330             End While
331             Return Nothing
332             Return null to indicate failure to find name
333         End Function
334
335         ''' <summary>
336         ''' Find the next ordinal node starting at node startNode.
337         ''' Due to the structure of a binary search tree, the
338         ''' successor node is simply the left most node on the right branch.
339         ''' </summary>
340         ''' <param name="startNode">Name key to use for searching</param>
341         ''' <param name="parent">Returns the parent node if search successful</param>
342         ''' <returns>Returns a reference to the node if successful, else null</returns>
343         Public Function findSuccessor(startNode As TreeNode(Of T), ByRef parent As TreeNode(Of T)) As TreeNode(Of T)
344             parent = startNode
345             ' Look for the left-most node on the right side
346             startNode = startNode.Right
347             While startNode.Left IsNot Nothing
348                 parent = startNode
349                 startNode = startNode.Left
350             End While
351             Return startNode
352         End Function
353
354         ''' <summary>
355         ''' Delete a given node. This is the more complex method in the binary search
356         ''' class. The method considers three senarios, 1) the deleted node has no
357         ''' children; 2) the deleted node as one child; 3) the deleted node has two
358         ''' children. Case one and two are relatively simple to handle, the only
359         ''' unusual considerations are when the node is the root node. Case 3) is
360         ''' much more complicated. It requires the location of the successor node.
361         ''' The node to be deleted is then replaced by the sucessor node and the
362         ''' successor node itself deleted. Throws an exception if the method fails
363         ''' to locate the node for deletion.
364         ''' </summary>
365         ''' <param name="key">Name key of node to delete</param>
366         Public Sub delete(key As String)
367             Dim parent As TreeNode(Of T) = Nothing
368             ' First find the node to delete and its parent
369             Dim nodeToDelete As TreeNode(Of T) = findParent(key, parent)
370             If nodeToDelete Is Nothing Then
371                 Throw New Exception("Unable to delete node: " & key.ToString())
372             End If
373             ' can't find node, then say so 
374             ' Three cases to consider, leaf, one child, two children
375
376             If it is a simple leaf then just null what the parent is pointing to
377             If (nodeToDelete.Left Is NothingAndAlso (nodeToDelete.Right Is NothingThen
378                 If parent Is Nothing Then
379                     _Root = Nothing
380                     Return
381                 End If
382
383                 ' find out whether left or right is associated 
384                 ' with the parent and null as appropriate
385                 If parent.Left Is nodeToDelete Then
386                     parent.Left = Nothing
387                 Else
388                     parent.Right = Nothing
389                 End If
390                 _counts -= 1
391                 Return
392             End If
393
394             One of the children is null, in this case
395             ' delete the node and move child up
396             If nodeToDelete.Left Is Nothing Then
397                 ' Special case if we're at the root
398                 If parent Is Nothing Then
399                     _Root = nodeToDelete.Right
400                     Return
401                 End If
402
403                 ' Identify the child and point the parent at the child
404                 If parent.Left Is nodeToDelete Then
405                     parent.Right = nodeToDelete.Right
406                 Else
407                     parent.Left = nodeToDelete.Right
408                 End If
409                 nodeToDelete = Nothing
410                 ' Clean up the deleted node
411                 _counts -= 1
412                 Return
413             End If
414
415             One of the children is null, in this case
416             ' delete the node and move child up
417             If nodeToDelete.Right Is Nothing Then
418                 ' Special case if we're at the root
419                 If parent Is Nothing Then
420                     _Root = nodeToDelete.Left
421                     Return
422                 End If
423
424                 ' Identify the child and point the parent at the child
425                 If parent.Left Is nodeToDelete Then
426                     parent.Left = nodeToDelete.Left
427                 Else
428                     parent.Right = nodeToDelete.Left
429                 End If
430                 nodeToDelete = Nothing
431                 ' Clean up the deleted node
432                 _counts -= 1
433                 Return
434             End If
435
436             ' Both children have nodes, therefore find the successor, 
437             ' replace deleted node with successor and remove successor
438             ' The parent argument becomes the parent of the successor
439             Dim successor As TreeNode(Of T) = findSuccessor(nodeToDelete, parent)
440             ' Make a copy of the successor node
441             Dim tmp As New TreeNode(Of T)(successor.Name, successor.Value)
442             ' Find out which side the successor parent is pointing to the
443             ' successor and remove the successor
444             If parent.Left Is successor Then
445                 parent.Left = Nothing
446             Else
447                 parent.Right = Nothing
448             End If
449
450             ' Copy over the successor values to the deleted node position
451             nodeToDelete.Name = tmp.Name
452             nodeToDelete.Value = tmp.Value
453             _counts -= 1
454         End Sub
455
456         ' Simple 'drawing' routines
457         Private Function drawNode(node As TreeNode(Of T)) As String
458             If node Is Nothing Then
459                 Return "empty"
460             End If
461
462             If (node.Left Is NothingAndAlso (node.Right Is NothingThen
463                 Return node.Name
464             End If
465             If (node.Left IsNot NothingAndAlso (node.Right Is NothingThen
466                 Return node.Name & "(" & drawNode(node.Left) & ", _)"
467             End If
468
469             If (node.Right IsNot NothingAndAlso (node.Left Is NothingThen
470                 Return node.Name & "(_, " & drawNode(node.Right) & ")"
471             End If
472
473             Return node.Name & "(" & drawNode(node.Left) & ", " & drawNode(node.Right) & ")"
474         End Function
475
476         ''' <summary>
477         ''' Return the tree depicted as a simple string, useful for debugging, eg
478         ''' 50(40(30(20, 35), 45(44, 46)), 60)
479         ''' </summary>
480         ''' <returns>Returns the tree</returns>
481         Public Overrides Function ToString() As String
482             Return drawNode(Root)
483         End Function
484     End Class
485 End Namespace