1 #Region "Microsoft.VisualBasic::6cf33da488e1d2ee8003ede9c2d88ec5, Microsoft.VisualBasic.Core\ComponentModel\System.Collections.Generic\PriorityQueue\BinaryPriorityQueue.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 BinaryPriorityQueue
35     ' 
36     '         Properties: Count, IList_IsFixedSize, IList_IsReadOnly, IsSynchronized, SyncRoot
37     ' 
38     '         Constructor: (+5 Overloads) Sub New
39     ' 
40     '         Function: [ReadOnly], Clone, Contains, IEnumerable_GetEnumerator, IList_Add
41     '                   IList_IndexOf, OnCompare, Peek, Pop, Push
42     '                   Syncronized
43     ' 
44     '         Sub: Clear, CopyTo, IList_Insert, IList_Remove, IList_RemoveAt
45     '              SwitchElements, Update
46     ' 
47     ' 
48     ' /********************************************************************************/
49
50 #End Region
51
52 Imports System.Runtime.CompilerServices
53
54 Namespace ComponentModel.Collection
55
56     Public Class BinaryPriorityQueue
57         Implements IPriorityQueue(Of Object)
58         Implements ICollection
59         Implements ICloneable
60         Implements IList
61         Protected InnerList As New ArrayList()
62         Protected Comparer As IComparer
63
64 #Region "contructors"
65         Public Sub New()
66             Me.New(System.Collections.Comparer.[Default])
67         End Sub
68
69         Public Sub New(c As IComparer)
70             Comparer = c
71         End Sub
72
73         Public Sub New(C As Integer)
74             Me.New(System.Collections.Comparer.[Default], C)
75         End Sub
76
77         Public Sub New(c As IComparer, Capacity As Integer)
78             Comparer = c
79             InnerList.Capacity = Capacity
80         End Sub
81
82         Protected Sub New(Core As ArrayList, Comp As IComparer, Copy As Boolean)
83             If Copy Then
84                 InnerList = TryCast(Core.Clone(), ArrayList)
85             Else
86                 InnerList = Core
87             End If
88             Comparer = Comp
89         End Sub
90 #End Region
91
92         <MethodImpl(MethodImplOptions.AggressiveInlining)>
93         Protected Sub SwitchElements(i As Integer, j As Integer)
94             Dim h As Object = InnerList(i)
95             InnerList(i) = InnerList(j)
96             InnerList(j) = h
97         End Sub
98
99         <MethodImpl(MethodImplOptions.AggressiveInlining)>
100         Protected Overridable Function OnCompare(i As Integer, j As Integer) As Integer
101             Return Comparer.Compare(InnerList(i), InnerList(j))
102         End Function
103
104 #Region "Public methods of Queue"
105
106         ''' <summary>
107         ''' Push an object onto the PQ
108         ''' </summary>
109         ''' <param name="O">The new object</param>
110         ''' <returns>The index in the list where the object is _now_. This will change when objects are taken from or put onto the PQ.</returns>
111         Public Function Push(O As Object) As Integer Implements IPriorityQueue(Of Object).Push
112             Dim p As Integer = InnerList.Count, p2 As Integer
113             InnerList.Add(O)
114             ' E[p] = O
115             Do
116                 If p = 0 Then
117                     Exit Do
118                 End If
119                 p2 = (p - 1) \ 2
120                 If OnCompare(p, p2) < 0 Then
121                     SwitchElements(p, p2)
122                     p = p2
123                 Else
124                     Exit Do
125                 End If
126             Loop While True
127
128             Return p
129         End Function
130
131         ''' <summary>
132         ''' Get the smallest object and remove it.
133         ''' </summary>
134         ''' <returns>The smallest object</returns>
135         Public Function Pop() As Object Implements IPriorityQueue(Of Object).Pop
136             Dim result As Object = InnerList(0)
137             Dim p As Integer = 0, p1 As Integer, p2 As Integer, pn As Integer
138             InnerList(0) = InnerList(InnerList.Count - 1)
139             InnerList.RemoveAt(InnerList.Count - 1)
140             Do
141                 pn = p
142                 p1 = 2 * p + 1
143                 p2 = 2 * p + 2
144                 If InnerList.Count > p1 AndAlso OnCompare(p, p1) > 0 Then
145                     ' links kleiner
146                     p = p1
147                 End If
148                 If InnerList.Count > p2 AndAlso OnCompare(p, p2) > 0 Then
149                     ' rechts noch kleiner
150                     p = p2
151                 End If
152
153                 If p = pn Then
154                     Exit Do
155                 End If
156                 SwitchElements(p, pn)
157             Loop While True
158
159             Return result
160         End Function
161
162         ''' <summary>
163         ''' Notify the PQ that the object at position i has changed
164         ''' and the PQ needs to restore order.
165         ''' Since you dont have access to any indexes (except by using the
166         ''' explicit IList.this) you should not call this function without knowing exactly
167         ''' what you do.
168         ''' </summary>
169         ''' <param name="i">The index of the changed object.</param>
170         Public Sub Update(i As Integer)
171             Dim p As Integer = i, pn As Integer
172             Dim p1 As Integer, p2 As Integer
173             Do
174                 ' aufsteigen
175                 If p = 0 Then
176                     Exit Do
177                 End If
178                 p2 = (p - 1) \ 2
179                 If OnCompare(p, p2) < 0 Then
180                     SwitchElements(p, p2)
181                     p = p2
182                 Else
183                     Exit Do
184                 End If
185             Loop While True
186             If p < i Then
187                 Return
188             End If
189             Do
190                 ' absteigen
191                 pn = p
192                 p1 = 2 * p + 1
193                 p2 = 2 * p + 2
194                 If InnerList.Count > p1 AndAlso OnCompare(p, p1) > 0 Then
195                     ' links kleiner
196                     p = p1
197                 End If
198                 If InnerList.Count > p2 AndAlso OnCompare(p, p2) > 0 Then
199                     ' rechts noch kleiner
200                     p = p2
201                 End If
202
203                 If p = pn Then
204                     Exit Do
205                 End If
206                 SwitchElements(p, pn)
207             Loop While True
208         End Sub
209
210         ''' <summary>
211         ''' Get the smallest object without removing it.
212         ''' </summary>
213         ''' <returns>The smallest object</returns>
214         Public Function Peek() As Object Implements IPriorityQueue(Of Object).Peek
215             If InnerList.Count > 0 Then
216                 Return InnerList(0)
217             End If
218             Return Nothing
219         End Function
220 #End Region
221
222 #Region "explicit implementation"
223         Public Function Contains(value As Object) As Boolean Implements IList.Contains
224             Return InnerList.Contains(value)
225         End Function
226
227         Public Sub Clear() Implements IList.Clear
228             InnerList.Clear()
229         End Sub
230
231         Public ReadOnly Property Count() As Integer Implements ICollection.Count
232             Get
233                 Return InnerList.Count
234             End Get
235         End Property
236
237         Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
238             Return InnerList.GetEnumerator()
239         End Function
240
241         Public Sub CopyTo(array As Array, index As Integer) Implements ICollection.CopyTo
242             InnerList.CopyTo(array, index)
243         End Sub
244
245         Public Function Clone() As Object Implements ICloneable.Clone
246             Return New BinaryPriorityQueue(InnerList, Comparer, True)
247         End Function
248
249         Public ReadOnly Property IsSynchronized() As Boolean Implements ICollection.IsSynchronized
250             Get
251                 Return InnerList.IsSynchronized
252             End Get
253         End Property
254
255         Public ReadOnly Property SyncRoot() As Object Implements ICollection.SyncRoot
256             Get
257                 Return Me
258             End Get
259         End Property
260
261         Private ReadOnly Property IList_IsReadOnly() As Boolean Implements IList.IsReadOnly
262             Get
263                 Return False
264             End Get
265         End Property
266
267         Default Public Property IList_Item(index As Integer) As Object Implements IList.Item
268             Get
269                 Return InnerList(index)
270             End Get
271             Set(value As Object)
272                 InnerList(index) = value
273                 Update(index)
274             End Set
275         End Property
276
277         Private Function IList_Add(o As Object) As Integer Implements IList.Add
278             Return Push(o)
279         End Function
280
281         Private Sub IList_RemoveAt(index As Integer) Implements IList.RemoveAt
282             Throw New NotSupportedException()
283         End Sub
284
285         Private Sub IList_Insert(index As Integer, value As Object) Implements IList.Insert
286             Throw New NotSupportedException()
287         End Sub
288
289         Private Sub IList_Remove(value As Object) Implements IList.Remove
290             Throw New NotSupportedException()
291         End Sub
292
293         Private Function IList_IndexOf(value As Object) As Integer Implements IList.IndexOf
294             Throw New NotSupportedException()
295         End Function
296
297         Private ReadOnly Property IList_IsFixedSize() As Boolean Implements IList.IsFixedSize
298             Get
299                 Return False
300             End Get
301         End Property
302
303         Public Shared Function Syncronized(P As BinaryPriorityQueue) As BinaryPriorityQueue
304             Return New BinaryPriorityQueue(ArrayList.Synchronized(P.InnerList), P.Comparer, False)
305         End Function
306         Public Shared Function [ReadOnly](P As BinaryPriorityQueue) As BinaryPriorityQueue
307             Return New BinaryPriorityQueue(ArrayList.[ReadOnly](P.InnerList), P.Comparer, False)
308         End Function
309 #End Region
310     End Class
311 End Namespace