'Stack (LIFA) v2 implementation using double linked lists
'Coded by UEZ build 2020-06-15 beta
Type Vector
As Single x, y, z
As Vector Ptr pp, pn
End Type
Type _Stack
Declare Constructor()
Declare Destructor()
Declare Sub Push(x As Single, y As Single, z As Single)
Declare Function Pop() As Vector
Declare Function Get(iPos As UInteger) As Vector
Declare Sub DeleteItem(iPos As UInteger)
Declare Sub Print()
Declare Function Count() As UInteger
Private:
As Uinteger counter
As Vector Ptr last, start
End Type
Constructor _Stack()
This.counter = 0
last = 0
End Constructor
Destructor _Stack()
Dim As Vector Ptr n, p = This.start
For i As Uinteger = 1 To This.counter
n = p->pn
Delete p
p = n
Next
End Destructor
Sub _Stack.Push(x As Single, y As Single, z As Single)
This.counter += 1
Dim As Vector Ptr pv = New Vector
pv->x = x
pv->y = y
pv->z = z
If This.counter = 1 Then This.start = pv 'save first element
If This.counter > 1 Then
This.last->pn = pv 'set next pointer from previous entry to current list
pv->pp = last
End If
This.last = pv
End Sub
Function _Stack.Pop() As Vector
If This.counter > 0 Then
Dim r As Vector
r.x = This.last->x
r.y = This.last->y
r.z = This.last->z
r.pp = This.last->pp
Dim As Vector Ptr prev, c = This.last
If This.counter > 1 Then 'if not last list element
prev = r.pp
This.last = prev
prev->pn = 0
End If
This.counter -= 1
Delete c
Return r
End if
End Function
Function _Stack.Get(iPos As UInteger) As Vector
If iPos <= This.counter Then
Dim As UInteger c = 1
Dim As Vector r
Dim As Vector Ptr p = This.start
While c <> iPos 'search for list element
p = p->pn
c += 1
Wend
r.x = p->x
r.y = p->y
r.z = p->z
Return r
End If
End Function
Sub _Stack.DeleteItem(iPos As UInteger)
If iPos <= This.counter Then
Dim As Vector Ptr n, p, prev
If iPos = This.counter Then 'last element
Pop()
ElseIf iPos = 1 Then 'first element
n = this.start->pn
Delete This.start
This.start = n
This.counter -= 1
Else
Dim As UInteger c = 1
p = This.start
While c <> iPos 'else seach for list element first
p = p->pn
c += 1
Wend
prev = p->pp
n = p->pn
prev->pn = n
n->pp = prev
Delete p
This.counter -= 1
End if
End if
End Sub
Function _Stack.Count() As UInteger
Return This.Counter
End Function
Sub _Stack.Print() 'Print stack elements to console
If This.counter > 0 Then
Dim As Vector Ptr n, p = This.start
For i As Uinteger = 1 To This.counter
? p->x, p->y, p->z
n = p->pn
p = n
Next
Else
? "Stack is empty"
End If
End Sub
'Example
Dim Stack As _Stack
Dim As Vector Test
For i As UByte = 1 to 10
Stack.Push(i, i, i)
Next
? "Print all stack elements:"
Stack.Print()
?
'remove last added element from stack
Stack.Pop()
? "Removed last pushed element. Remaining elements:"
Stack.Print()
?
'get 5th element from stack
Test = Stack.get(5)
? "Print 5th element from stack: "
? Test.x, Test.y, Test.z
?
Stack.DeleteItem(5)
? "Remain stack elements after 5th element was deleted:"
Stack.Print()
?
? "Elements count: " & Stack.Count
Sleep
I hope it's bug free..^^
Edit1: removed the '[]' from delete as suggested by fxm.
Edit2: modified Destructor _Stack() as suggested by fxm.
Last edited by UEZ on Jun 24, 2020 13:46, edited 5 times in total.
It's a bad habit to use Delete[] when New (without []) is used, even if it works when the Type (Vector) has no destructor as in your precise case.
If one adds a destructor in the Vector Type (or a member field like a string), the program crashes.
I advise you to replace delete[] by delete in the 4 occurrences.
(otherwise, all the rest of the code is safe)
Last edited by fxm on Jun 14, 2020 14:27, edited 2 times in total.
Type Vector
As Single x, y, z
End Type
#define pushtop(a) ubound(a)+1
#define poptop(a) ubound(a)
#define bottom(a) lbound(a)
#macro push(a,index,insert)
If (index)>=Lbound(a) And (index)<=Ubound(a)+1 Then
Var index2=(index)-Lbound(a)
Redim Preserve a(Lbound(a) To Ubound(a)+1)
For x As Integer= Ubound(a) To Lbound(a)+index2+1 Step -1
Swap a(x),a(x-1)
Next x
a(Lbound(a)+index2)=(insert)
End If
#endmacro
#macro pop(a,index)
If index>=Lbound(a) And (index)<=Ubound(a) Then
For x As Integer=(index) To Ubound(a)-1
a(x)=a(x+1)
Next x
Redim Preserve a(Lbound(a) To Ubound(a)-1)
End If
#endmacro
#macro showall(a,msg)
print msg
for n as long=lbound(a) to ubound(a)
print a(n).x,a(n).y,a(n).z
next
print
#endmacro
#macro showsome(a,range,msg)
print msg
for n as long= range
print a(n).x,a(n).y,a(n).z
next
print
#endmacro
'Example
reDim As Vector Test()
For i As UByte = 1 to 10
Push(test,pushtop(test),type(i, i, i))
Next
redim preserve test(1 to 10) 'make 1 based
showall(test,"original")
pop(test,poptop(test))
showall(test,"last one removed")
showsome(test,5 to 5,"fifth")
pop(test,5)
showall(test,"take out fifth")
print "count ";ubound(test)-lbound(test)+1
sleep
fxm wrote:It's a bad habit to use Delete[] when New (without []) is used, even if it works when the Type (Vector) has no destructor as in your precise case.
If one adds a destructor in the Vector Type (or a member field like a string), the program crashes.
I advise you to replace delete[] by delete in the 4 occurrences.
(otherwise, all the rest of the code is safe)
Thank you for your feedback. I'm new to class section and I'm still diggin' in this stuff to get a better understanding. ^^
I will read in the help file this chapter and try to understand the difference using [] and leaving it off.
dodicat wrote:This doesn't use pointers or OOP, or even procedures or lists, it is totally inline.
Thanks dodicat for your contribution. :-)
My idea was to get in touch to oop and implement as stack using doubly linked lists.
Hi UEZ.
I do this sometimes.
Instead of new and delete, create a memory stack (static array), and pick off slots of memory.
Make sure you have enough slots for the job before you start. (a little like c)
I have lim 100.
'Stack (LIFA) v2 implementation using doubly linked lists
'Coded by UEZ build 2019-01-05 beta
#define lim 100
Type Vector
As Single x, y, z
As Vector Ptr pp, pn
static as Vector mem(1 to lim) '<<< slots
static as long counter
End Type
dim as Vector vector.mem(1 to lim)=any
dim as long vector.counter
Type _Stack
Declare Constructor()
Declare Destructor()
Declare Sub Push(x As Single, y As Single, z As Single)
Declare Function Pop() As Vector
Declare Function Get(iPos As UInteger) As Vector
Declare Sub DeleteItem(iPos As UInteger)
Declare Sub Print()
Declare Function Count() As UInteger
Private:
As Uinteger counter
As Vector Ptr last, start
End Type
Constructor _Stack()
This.counter = 0
last = 0
End Constructor
Destructor _Stack()
' Dim As Vector Ptr n, p = This.start
'For i As Uinteger = 1 To This.counter
' Delete[] p
' n = p->pn
'p = n
' Next
End Destructor
Sub _Stack.Push(x As Single, y As Single, z As Single)
This.counter += 1
vector.counter+=1
if vector.counter=lim then vector.counter=1 'just in case!
Dim As Vector Ptr pv = @Vector.mem(Vector.counter)'New Vector
pv->x = x
pv->y = y
pv->z = z
If This.counter = 1 Then This.start = pv 'save first element
If This.counter > 1 Then
This.last->pn = pv 'set next pointer from previous entry to current list
pv->pp = last
End If
This.last = pv
End Sub
Function _Stack.Pop() As Vector
If This.counter > 0 Then
Dim r As Vector
r.x = This.last->x
r.y = This.last->y
r.z = This.last->z
r.pp = This.last->pp
Dim As Vector Ptr prev, c = This.last
If This.counter > 1 Then 'if not last list element
prev = r.pp
This.last = prev
prev->pn = 0
End If
This.counter -= 1
'delete[] c
Return r
End if
End Function
Function _Stack.Get(iPos As UInteger) As Vector
If iPos <= This.counter Then
Dim As UInteger c = 1
Dim As Vector r
Dim As Vector Ptr p = This.start
While c <> iPos 'search for list element
p = p->pn
c += 1
Wend
r.x = p->x
r.y = p->y
r.z = p->z
Return r
End If
End Function
Sub _Stack.DeleteItem(iPos As UInteger)
If iPos <= This.counter Then
Dim As Vector Ptr n, p, prev
If iPos = This.counter Then 'last element
Pop()
ElseIf iPos = 1 Then 'first element
n = this.start->pn
'Delete[] This.start
This.start = n
This.counter -= 1
Else
Dim As UInteger c = 1
p = This.start
While c <> iPos 'else seach for list element first
p = p->pn
c += 1
Wend
prev = p->pp
n = p->pn
prev->pn = n
n->pp = prev
'Delete[] p
This.counter -= 1
End if
End if
End Sub
Function _Stack.Count() As UInteger
Return This.Counter
End Function
Sub _Stack.Print() 'Print stack elements to console
If This.counter > 0 Then
Dim As Vector Ptr n, p = This.start
For i As Uinteger = 1 To This.counter
? p->x, p->y, p->z
n = p->pn
p = n
Next
Else
? "Stack is empty"
End If
End Sub
'Example
Dim Stack As _Stack
Dim As Vector Test
For i As UByte = 1 to 10
Stack.Push(i, i, i)
Next
? "Print all stack elements:"
Stack.Print()
?
'remove last added element from stack
Stack.Pop()
? "Removed last pushed element. Remaining elements:"
Stack.Print()
?
'get 5th element from stack
Test = Stack.get(5)
? "Print 5th element from stack: "
? Test.x, Test.y, Test.z
?
Stack.DeleteItem(5)
? "Remained stack elements after 5th element was deleted:"
Stack.Print()
?
? "Elements count: " & Stack.Count
Sleep
fxm wrote:It's a bad habit to use Delete[] when New (without []) is used, even if it works when the Type (Vector) has no destructor as in your precise case.
If one adds a destructor in the Vector Type (or a member field like a string), the program crashes.
I advise you to replace delete[] by delete in the 4 occurrences.
(otherwise, all the rest of the code is safe)
Thank you for your feedback. I'm new to class section and I'm still diggin' in this stuff to get a better understanding. ^^
I will read in the help file this chapter and try to understand the difference using [] and leaving it off.
I think that the topic New and Delete in the Programmer's Guide is a good introduction before studying the 5 relevant pages to New/Delete in the manual.
Hello. Is it LIFO ? (Or what does LIFA mean ?)
(using lzle I can handle FIFO and does not manage LIFO, but it could be implemented modifying/creating "HoldBack" to "HoldBackRev" to link backward instead forward.
Last edited by Lost Zergling on Jun 14, 2020 21:27, edited 1 time in total.
'FIFO.BAS LZLE 0.996c Required !
#Include once "F:\Basic\LZLE_.bi"
Dim MyList As List
Dim As Integer i
For i=110 to 90 step -1
MyList.HashTag(Str(i))
MyList.HoldBack
Next i
' When you HashTag a new value, it will be marked as "key", so recursive NodeFlat on tracking will preserve keys
' MyList.HashTag("10")
' MyList.HashTag("11")
MyList.Root
While MyList.KeyStep
? MyList.HashTag
Wend
? "------------------------"
sleep
'MyList.TrackStep : MyList.TrackStep
MyList.Track 'Tracking starting point is set by default to first "HoldBack"
While MyList.TrackStep
? MyList.HashTag
Wend
? "------------------------@"
sleep
MyList.Track 'Access to Iteration previously build by HoldBack
i=10
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag
Wend
? "------------------------*"
sleep
'MyList.NFRecursive(0) => Implicit on tracking
'MyList.TrackMethod(1) => Deprecated
' Check behaviour
' MyList.NFMethod(1) ' NFMethod(1) is sending parent to non indexed, leaving a hashtag if childrens still referenced
MyList.NFMethod(0) ' NFMethod(1) is sending parent only when last children is dereferenced from index (TRIE)
MyList.Track
i=11
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag ' Not define after NodeFlat
MyList.NodeFlat 'After a NodeFlat, list is ready to iterate depending on context
Wend
? "------------------------?"
sleep
? "New track starting point = " & MyList.HashTag
MyList.TrackSet(3) 'Tracking starting point is now set to current
? MyList.HashTag & " ??"
sleep
MyList.Root
While MyList.HashStep
? MyList.HashTag
Wend
? "------------------------"
sleep
? "Garbage= " & MyList.GarbageCount
MyList.FlatStack 'Access to protected 'Flat' (on indexed) list
? "Flat count=" & MyList.FlatCount
While MyList.fStep
? MyList.Tag '& " IsKey=" & MyList.IsKey
Wend
? "------------------------*$"
sleep
MyList.Track(3) 'Access to Iteration previously build by HoldBack from breaking point specified by TrackSet
i=19
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag & " *"
Wend
? "------------------------/"
? "TrackCompCounter=" & TrackCompCounter
sleep
New version for test code working with 0.997 release
' FIFO_LIFO.BAS
#Include once "F:\Basic\LZLE_.bi"
Dim MyList As List
Dim As Integer i
For i=110 to 90 step -1
MyList.HashTag(Str(i))
If i<>107 and i<>108 Then
MyList.HoldBack'Rev
End if
Next i
' When you HashTag a new value, it will be marked as "key", so recursive NodeFlat on tracking will preserve keys
MyList.HashTag("10")
' MyList.HashTag("11")
MyList.Root
While MyList.KeyStep
? MyList.HashTag
Wend
? "------------------------"
sleep ' Tracking starting point is set by default to first "HoldBack"
MyList.Track 'accessing track n°0 (default set by HoldBack) for parsing
While MyList.TrackStep
? MyList.HashTag
Wend
? "------------------------@"
sleep
MyList.Track
i=12
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag
Wend
? "------------------------*"
sleep
'MyList.NFRecursive(1) '=> Implicit on tracking
' Check behaviour
MyList.NFMethod(2) ' NFMethod(1) is sending parent to non indexed, leaving a hashtag if childrens still referenced, NFMethod(2) is the recursive transposition of pseudo recursive NFMethod(1)
'MyList.NFMethod(0) ' NFMethod(0) is sending parent only when last children is dereferenced from index (TRIE)
MyList.Track
i=12
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag ' Not define after NodeFlat
MyList.NodeFlat 'After a NodeFlat, list is ready to iterate depending on context
Wend
? "------------------------?"
? "New track starting point = " & MyList.HashTag
MyList.TrackSet(3) 'Tracking starting point is now set to current on 'track' n°3
? MyList.HashTag & " ??"
sleep
MyList.HashTag("97")
MyList.NodeFlat
MyList.HashTag("95")
MyList.NodeFlat
MyList.HashTag("94")
MyList.NodeFlat
MyList.HashTag("93")
MyList.NodeFlat
MyList.Root
While MyList.HashStep
? MyList.HashTag ': sleep
Wend
? "------------------------"
sleep
? "Garbage= " & MyList.GarbageCount
MyList.FlatStack
? "Flat count=" & MyList.FlatCount
While MyList.fStep
? MyList.Tag '& " IsKey=" & MyList.IsKey
Wend
? "------------------------*$"
sleep
MyList.Track'(3)
i=19
While MyList.TrackStep 'And i>0
i-=1
? MyList.HashTag & " *"
Wend
? "------------------------/"
MyList.Track(3) 'accessing track n°3 for parsing
i=19
While MyList.TrackStep And i>0
i-=1
? MyList.HashTag & " *"
Wend
? "------------------------/"
? "TrackCompCounter=" & TrackCompCounter
sleep