Anyone have good code for making a Priority Queue?

leopardpm · Post by **leopardpm** » Dec 11, 2018 0:31

grindstone wrote:Another question: Are there negative values?

nope... the values I am dealing with are TIMER values... so Doubles and positive

if doing Doubles is too slow, then I guess could convert TIMER to an integer (Timer * 10000) to get 1/10 of a millisecond steps

grindstone · Post by **grindstone** » Dec 11, 2018 1:32

Alright, here's my 2nd attempt, a 5 level binary tree. Not completed yet, but already enough to play around with:

Code: Select all

Type tEndNode
	As Integer frontX = 0
	As Integer frontY = 0
	As Boolean valid = FALSE
End Type

Type tPathNode
	As tPathNode Ptr child(0 To 255)
End Type

Type tPreEndNode
	As tEndNode Ptr child(0 To 255)
End Type

Dim As tPathNode Ptr frontier = New tPathNode 'create root node


Sub FrontierAdd(fp As tPathNode Ptr, _
	              ByVal frontX As Integer, _
	              ByVal frontY As Integer, _
	              ByVal frontCost As Integer)

	Dim As tEndNode Ptr fpe
	Dim As String*5 f = Mki(frontCost), g
	Dim As Integer fc
	
	'MSB
	If fp->child(f[3]) = 0 Then
		fp->child(f[3]) = New tPathNode
	EndIf
	
	If fp->child(f[3])->child(f[2]) = 0 Then
		fp->child(f[3])->child(f[2]) = New tPathNode
	EndIf
	
	If fp->child(f[3])->child(f[2])->child(f[1]) = 0 Then
		Cast(tPreEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])) = New tPreEndNode
	EndIf
	
	'LSB
	If fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0 Then
		Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0])) = New tEndNode
	EndIf
	
	fpe = Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]))
	fpe->frontX = frontX
	fpe->frontY = frontY
	fpe->valid  = TRUE
	
	
End Sub

Sub FrontierList(fp As tPathNode Ptr, frontCost As Integer = 0, level As Integer = 0)
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
	Dim As Integer fc
	
	For b3 As Integer = 0 To 255
		If fp->child(b3) = 0 Then
			Continue For
		EndIf
		For b2 As Integer = 0 To 255
			If fp->child(b3)->child(b2) = 0 Then
				Continue For
			EndIf
			For b1 As Integer = 0 To 255
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 0 To 255
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					fc = Cvi(fs)
					Print Cvi(fs), fpe->frontX, fpe->frontY
				Next
			Next
		Next
	Next
		
End Sub

Function FrontierLowest(fp As tPathNode Ptr) As Integer
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
	
	For b3 As Integer = 0 To 255
		If fp->child(b3) = 0 Then
			Continue For
		EndIf
		For b2 As Integer = 0 To 255
			If fp->child(b3)->child(b2) = 0 Then
				Continue For
			EndIf
			For b1 As Integer = 0 To 255
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 0 To 255
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					Return Cvi(fs)
				Next
			Next
		Next
	Next
End Function

Function FrontierHighest(fp As tPathNode Ptr) As Integer
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
	
	For b3 As Integer = 255 To 0 Step -1
		If fp->child(b3) = 0 Then
			Continue For
		EndIf
		For b2 As Integer = 255 To 0 Step -1
			If fp->child(b3)->child(b2) = 0 Then
				Continue For
			EndIf
			For b1 As Integer = 255 To 0 Step -1
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 255 To 0 Step -1
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					Return Cvi(fs)
				Next
			Next
		Next
	Next
End Function

Function FrontierValue(fp As tPathNode Ptr, v As Integer) As tEndNode
	Dim As tEndNode result
	Dim As String*5 f = Mki(v)
	
	'MSB
	If fp->child(f[3]) = 0 Then
		Return result
	EndIf
	
	If fp->child(f[3])->child(f[2]) = 0 Then
		Return result
	EndIf
	
	If fp->child(f[3])->child(f[2])->child(f[1]) = 0 Then
		Return result
	EndIf
	
	'LSB
	If fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0 Then
		Return result
	EndIf
	
	result = *(Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0])))
	result.valid = TRUE
	Return result
	
End Function

Sub FrontierDelete(fp As tPathNode Ptr, v As Integer)
	Dim As String*5 f = Mki(v)
	Dim As tEndNode Ptr ep
	
	If FrontierValue(fp, v).valid Then
		ep = Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]))
		Delete ep
		fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0
		For x As Integer = 0 To 255
			If fp->child(f[3])->child(f[2])->child(f[1])->child(x) Then
				Return
			EndIf
		Next
		'fp->child(f[3])->child(f[2])->child(f[1]) has no subnodes --> erase
		Delete fp->child(f[3])->child(f[2])->child(f[1])
		fp->child(f[3])->child(f[2])->child(f[1]) = 0
		For x As Integer = 0 To 255
			If fp->child(f[3])->child(f[2])->child(x) Then
				Return
			EndIf
		Next
		'fp->child(f[3])->child(f[2]) has no subnodes --> erase
		Delete fp->child(f[3])->child(f[2])
		fp->child(f[3])->child(f[2]) = 0
		For x As Integer = 0 To 255
			If fp->child(f[3])->child(x) Then
				Return
			EndIf
		Next
		'fp->child(f[3]) has no subnodes --> erase
		Delete fp->child(f[3])
		fp->child(f[3]) = 0
	EndIf
	
End Sub


FrontierAdd(frontier, 100, 100, 1)
FrontierAdd(frontier, 200, 200, 10)
FrontierAdd(frontier, 300, 300, 5)
FrontierAdd(frontier, 400, 400, 100)
FrontierAdd(frontier, 402, 400, 7)
FrontierAdd(frontier, 401, 400, 10000)
FrontierAdd(frontier, 500, 100, 5362)
'FrontierAdd(frontier, 700, 400, -5)
?"ADD"
'Sleep
'End



FrontierList(frontier)
? "TRAV"

? FrontierLowest(frontier)
? "LOW"

? FrontierHighest(frontier)
?"HIGH"

? FrontierValue(frontier, 7).valid
? "VAL"

FrontierDelete(frontier, 5362)
FrontierList(frontier)
?
FrontierDelete(frontier, 1)
FrontierList(frontier)
?
FrontierDelete(frontier, 100)
FrontierList(frontier)
?
FrontierDelete(frontier, 10000)
FrontierList(frontier)
?
FrontierAdd(frontier, 30, 98, 27)
FrontierList(frontier)
?
FrontierDelete(frontier, 7)
FrontierList(frontier)
?
FrontierDelete(frontier, 10)
FrontierList(frontier)
?
FrontierDelete(frontier, 5)
FrontierList(frontier)
?
FrontierAdd(frontier, 30, 98, 27)
FrontierList(frontier)

Sleep

'FrontierErase(frontier)

leopardpm · Post by **leopardpm** » Dec 11, 2018 2:09

OMG! that is EXTENSIVE! not sure I understand the output yet.... will mull it over and see.... that is ALOT of work you put into this, grindstone! I am unsure the effort expended will be worth the miniscule time savings in the program though... BUT, it could also be applied to alot of other different programs as well..... having a good, fast Binary Tree Search is always helpful

grindstone · Post by **grindstone** » Dec 11, 2018 9:28

Yes, it was a lot of work, and it took a lot of brainpower - when I coded the template of this a few years ago: A search tree list to maintain my music collection <smile>.

This time it was not so hard. If you have a closer look at the code you will see that most of the procedures are quite similar, so I only had to copy them and with a few modifications adapt them to their different purposes.

The basic idea was to convert the "frontCost" (32 bit-) Integer value to a 4-byte-string and use the values of the "characters" as indices of the subnode arrays. So the storing place incidentally contains the information of the frontCost value, and the list is quasi self-sorting.

Here a completed and commented version of the code. I only made some functional tests and leave the performance tests to you (and I am curious about the results <grin>).

Code: Select all

Type tEndNode
	As Integer frontX = 0
	As Integer frontY = 0
	As Boolean valid = FALSE
End Type

Type tPathNode
	As tPathNode Ptr child(0 To 255) 'array of child nodes
End Type

Dim As tPathNode Ptr frontier = New tPathNode 'create root node

Sub FrontierAdd(fp As tPathNode Ptr, _
	              ByVal frontX As Integer, _
	              ByVal frontY As Integer, _
	              ByVal frontCost As Long)

	Dim As tEndNode Ptr fpe
	Dim As String*5 f = Mkl(frontCost), g
		
	If fp = 0 Then Return 
	
	'MSB
	If fp->child(f[3]) = 0 Then 'no such node
		fp->child(f[3]) = New tPathNode 'create node for MSB index
	EndIf
	
	'byte 2
	If fp->child(f[3])->child(f[2]) = 0 Then 'no such node
		fp->child(f[3])->child(f[2]) = New tPathNode 'create node for byte 2 index
	EndIf
	
	'byte 1
	If fp->child(f[3])->child(f[2])->child(f[1]) = 0 Then 'no such node
		Cast(tPathNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])) = New tPathNode 'create node for byte 1 index
	EndIf
	
	'LSB
	If fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0 Then 'no such node
		'create end node (containing "frontX" and "frontY") for LSB index
		Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0])) = New tEndNode
	EndIf
	
	'get pointer to end node to ease access
	fpe = Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]))
	
	'write values to end node
	fpe->frontX = frontX
	fpe->frontY = frontY
	fpe->valid  = TRUE
		
End Sub

Sub FrontierList(fp As tPathNode Ptr)
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
		
	If fp = 0 Then Return
	
	For b3 As Integer = 0 To 255 'all MSB indices
		If fp->child(b3) = 0 Then 'no child node ( = no such value )
			Continue For 'next MSB index ( = skip all lower significant bytes )
		EndIf
		For b2 As Integer = 0 To 255 'all byte 2 indices
			If fp->child(b3)->child(b2) = 0 Then 'no child node
				Continue For 'next byte 2 index
			EndIf
			For b1 As Integer = 0 To 255 'all byte 1 indices
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 0 To 255 'all LSB indices
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					'found existing end node
					'get pointer to end node to ease access
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					'write indices to "frontCost" value string
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					Print Cvl(fs), fpe->frontX, fpe->frontY 'convert "frontCost" value to long and print result
				Next
			Next
		Next
	Next
		
End Sub

Function FrontierLowest(fp As tPathNode Ptr) As Long
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
	
	If fp = 0 Then Return 0
	
	For b3 As Integer = 0 To 255 'all MSB indices
		If fp->child(b3) = 0 Then 'no child node ( = no such value )
			Continue For 'next MSB index ( = skip all lower significant bytes )
		EndIf
		For b2 As Integer = 0 To 255 'all byte 2 indices
			If fp->child(b3)->child(b2) = 0 Then 'no child node
				Continue For 'next byte 2 index
			EndIf
			For b1 As Integer = 0 To 255 'all byte 1 indices
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 0 To 255 'all LSB indices
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					'1st ( = lowest ) value of the list found
					'get pointer to end node to ease access
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					'write indices to "frontCost" value string
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					Return Cvl(fs) 'return lowest value
				Next
			Next
		Next
	Next
End Function

Function FrontierHighest(fp As tPathNode Ptr) As Long
	Dim As tEndNode Ptr fpe
	Dim As String*5 fs
	
	If fp = 0 Then Return 0
	
	For b3 As Integer = 255 To 0 Step -1 'all MSB indices in reverse order
		If fp->child(b3) = 0 Then 'no child node ( = no such value )
			Continue For 'next MSB index ( = skip all lower significant bytes )
		EndIf
		For b2 As Integer = 255 To 0 Step -1 'all byte 2 indices in reverse order
			If fp->child(b3)->child(b2) = 0 Then 'no child node
				Continue For 'next byte 2 index
			EndIf
			For b1 As Integer = 255 To 0 Step -1 'all byte 1 indices in reverse order
				If fp->child(b3)->child(b2)->child(b1) = 0 Then
					Continue For
				EndIf
				For b0 As Integer = 255 To 0 Step -1 'all LSB indices in reverse order
					If fp->child(b3)->child(b2)->child(b1)->child(b0) = 0 Then
						Continue For
					EndIf
					'last ( = highest ) value of the list found
					'get pointer to end node to ease access
					fpe = Cast(tEndNode Ptr, fp->child(b3)->child(b2)->child(b1)->child(b0))
					'write indices to "frontCost" value string
					fs[0] = b0
					fs[1] = b1
					fs[2] = b2
					fs[3] = b3
					Return Cvl(fs) 'return highest value
				Next
			Next
		Next
	Next
End Function

Function FrontierValue(fp As tPathNode Ptr, v As Long) As tEndNode
	Dim As tEndNode result
	Dim As String*5 f = Mki(v)
	
	If fp = 0 Then Return result
	
	'MSB
	If fp->child(f[3]) = 0 Then
		Return result 'no such value ( = return "result" with ".valid" set to FALSE )
	EndIf
	
	'byte 2
	If fp->child(f[3])->child(f[2]) = 0 Then
		Return result
	EndIf
	
	'byte 1
	If fp->child(f[3])->child(f[2])->child(f[1]) = 0 Then
		Return result
	EndIf
	
	'LSB
	If fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0 Then
		Return result
	EndIf
	
	'get end node corresponding to the requested value
	result = *(Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0])))
	result.valid = TRUE
	Return result
	
End Function

Sub FrontierDelete(fp As tPathNode Ptr, v As Long)
	Dim As String*5 f = Mki(v)
	Dim As tEndNode Ptr ep
	
	If fp = 0 Then Return
	
	If FrontierValue(fp, v).valid Then 'end node exists
		ep = Cast(tEndNode Ptr, fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]))
		Delete ep 'delete end node
		fp->child(f[3])->child(f[2])->child(f[1])->child(f[0]) = 0 'set pointer to NULL
		
		'delete unused subnodes
		'LSB level
		For x As Integer = 0 To 255 'scan child node array for subnodes
			If fp->child(f[3])->child(f[2])->child(f[1])->child(x) Then 'subnode found ( = terminate scan )
				Return
			EndIf
		Next
		'fp->child(f[3])->child(f[2])->child(f[1]) has no subnodes ( = node can be erased )
		Delete fp->child(f[3])->child(f[2])->child(f[1]) 'erase node
		fp->child(f[3])->child(f[2])->child(f[1]) = 0 'set pointer to NULL
		
		'byte 1 level
		For x As Integer = 0 To 255
			If fp->child(f[3])->child(f[2])->child(x) Then
				Return
			EndIf
		Next
		'fp->child(f[3])->child(f[2]) has no subnodes ( = node can be erased )
		Delete fp->child(f[3])->child(f[2])
		fp->child(f[3])->child(f[2]) = 0
		
		'byte 2 level 
		For x As Integer = 0 To 255
			If fp->child(f[3])->child(x) Then
				Return
			EndIf
		Next
		'fp->child(f[3]) has no subnodes ( = node can be erased )
		Delete fp->child(f[3])
		fp->child(f[3]) = 0
	EndIf
	
End Sub

Sub FrontierKill(ByRef frontier As tPathNode Ptr)
	Dim As Long x
	
	Do 'delete all nodes
		x = FrontierHighest(frontier)
		FrontierDelete(frontier, x)
	Loop While x
	
	Delete frontier 'delete the root node
	frontier = 0 'set root pointer to NULL
	
End Sub


FrontierAdd(frontier, 100, 100, 1)
FrontierAdd(frontier, 200, 200, 10)
FrontierAdd(frontier, 300, 300, 5)
FrontierAdd(frontier, 400, 400, 100)
FrontierAdd(frontier, 402, 400, 7)
FrontierAdd(frontier, 401, 400, 10000)
FrontierAdd(frontier, 500, 100, 5362)
'FrontierAdd(frontier, 700, 400, -5)
?"ADD"
'Sleep
'End

FrontierList(frontier)
? "TRAV"

? FrontierLowest(frontier)
? "LOW"

? FrontierHighest(frontier)
?"HIGH"

? FrontierValue(frontier, 7).valid
? "VAL"

'FrontierDelete(frontier, 5362)
'FrontierList(frontier)
'?
'FrontierDelete(frontier, 1)
'FrontierList(frontier)
'?
'FrontierDelete(frontier, 100)
'FrontierList(frontier)
'?
'FrontierDelete(frontier, 10000)
'FrontierList(frontier)
?
FrontierAdd(frontier, 30, 98, 27)
FrontierList(frontier)
'?
'FrontierDelete(frontier, 7)
'FrontierList(frontier)
'?
'FrontierDelete(frontier, 10)
'FrontierList(frontier)
'?
'FrontierDelete(frontier, 5)
'FrontierList(frontier)
?
FrontierAdd(frontier, 30, 98, 27)
FrontierList(frontier)

? "KILL"
? frontier
?
FrontierKill(frontier)
FrontierList(frontier)
?
? frontier

Sleep

leopardpm · Post by **leopardpm** » Dec 15, 2018 1:20

@grindstone
that works well!

I have something else that is similar and might need some help, gonna try and tackle it myself first before asking for any help. my issue is making recursive code, which always throws me for a loop. Basically, I am generating a tree structure... has been blowing my mind for the past 2 days but thought again about it and have a few more ideas... will let you know.

Anyone have good code for making a Priority Queue?

Re: Anyone have good code for making a Priority Queue?

Re: Anyone have good code for making a Priority Queue?

Re: Anyone have good code for making a Priority Queue?

Re: Anyone have good code for making a Priority Queue?

Re: Anyone have good code for making a Priority Queue?