Stack (LIFO) v2 implementation using double linked lists

[UEZ]

Here my version of a stack using double linked lists.

Example.bas

Code: Select all

'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.

[fxm]

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)

[dodicat]

For fun
This doesn't use pointers or OOP, or even procedures or lists, it is totally inline.

Code: Select all

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]

For fun

but off topic (compared to the title of this topic).

[UEZ]

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.

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.

[dodicat]

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.

Code: Select all

'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  

Nevertheless, I prefer procedural to OOP.

[fxm]

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.

[Lost Zergling]

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.

[UEZ]

Hello. Is it LIFO ? (Or what does LIFA mean ?)

Ops, you are right. Last In First Out. ^^

[Lost Zergling]

Np. :-)

[fxm]

A last remark concerning the destructor code:

Code: Select all

Destructor _Stack()
   Dim As Vector Ptr n, p = This.start
   For i As Uinteger = 1 To This.counter
      n = p->pn
      Delete p
      'n = p->pn
      p = n
   Next
End Destructor

'n = p->pn' must be executed before 'Delete p', because in theory, the memory can be reused for other assignments immediately after 'Delete p'.

[Lost Zergling]

Code: Select all

'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

Code: Select all

  '  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