 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 149
Wohnort: Opel Stadt
|
 Verfasst am: 05.01.2019, 03:07 Titel: Stack Implementierung mit doppelt verketteten Listen |
 |
|
Ich hatte mich gefragt, wie man in FB doppelt verketteten Listen erstellen kann (hatte wohl ein Flashback zu meiner Studienzeit, die verdammt lange zurück liegt  ).
Hier das Resultat als ein Stack.
| Code: |
'Stack (LIFO) v2.1 implementation using double linked lists
'Coded by UEZ build 2026-08-09 beta
'payload only - no link fields, so nothing internal leaks to the caller
Type Vector
As Single x, y, z
End Type
'list node
Type VectorNode
As Vector v
As VectorNode Ptr pp, pn
End Type
Type _Stack
Declare Constructor()
Declare Constructor(ByRef rhs As _Stack)
Declare Destructor()
Declare Operator Let(ByRef rhs As _Stack)
Declare Sub Push(x As Single, y As Single, z As Single)
Declare Function Pop() As Vector
Declare Function PeekTop() As Vector
Declare Function Get(iPos As UInteger) As Vector
Declare Sub DeleteItem(iPos As UInteger)
Declare Sub Clear()
Declare Sub Print()
Declare Function Count() As UInteger
Declare Function IsEmpty() As Integer
Private:
Declare Function NodeAt(iPos As UInteger) As VectorNode Ptr
Declare Sub CopyFrom(ByRef rhs As _Stack)
As UInteger counter
As VectorNode Ptr start, last
End Type
Constructor _Stack()
This.counter = 0
This.start = 0
This.last = 0
End Constructor
Constructor _Stack(ByRef rhs As _Stack)
This.counter = 0
This.start = 0
This.last = 0
This.CopyFrom(rhs)
End Constructor
Operator _Stack.Let(ByRef rhs As _Stack)
If @rhs = @This Then Exit Operator 'guard against self assignment
This.Clear()
This.CopyFrom(rhs)
End Operator
Destructor _Stack()
This.Clear()
End Destructor
Sub _Stack.CopyFrom(ByRef rhs As _Stack) 'deep copy
Dim As VectorNode Ptr p = rhs.start
While p
This.Push(p->v.x, p->v.y, p->v.z)
p = p->pn
Wend
End Sub
Sub _Stack.Clear()
Dim As VectorNode Ptr n, p = This.start
While p
n = p->pn
Delete p
p = n
Wend
This.start = 0
This.last = 0
This.counter = 0
End Sub
Sub _Stack.Push(x As Single, y As Single, z As Single)
Dim As VectorNode Ptr pv = New VectorNode
If pv = 0 Then Exit Sub 'out of memory - counter stays valid
pv->v.x = x
pv->v.y = y
pv->v.z = z
pv->pp = 0 'never rely on New returning zeroed memory
pv->pn = 0
If This.last Then
This.last->pn = pv 'link previous entry to current one
pv->pp = This.last
Else
This.start = pv 'first element
End If
This.last = pv
This.counter += 1
End Sub
Function _Stack.Pop() As Vector
Dim As Vector r = Type<Vector>(0, 0, 0)
If This.last = 0 Then Return r 'empty stack
Dim As VectorNode Ptr c = This.last
r = c->v
This.last = c->pp
If This.last Then
This.last->pn = 0
Else
This.start = 0 'stack is empty now
End If
Delete c
This.counter -= 1
Return r
End Function
Function _Stack.PeekTop() As Vector 'top element without removing it
If This.last = 0 Then Return Type<Vector>(0, 0, 0)
Return This.last->v
End Function
Function _Stack.NodeAt(iPos As UInteger) As VectorNode Ptr
If iPos < 1 Or iPos > This.counter Then Return 0 'iPos = 0 used to loop forever
Dim As VectorNode Ptr p
If iPos <= This.counter \ 2 Then 'walk from the nearer end
p = This.start
For i As UInteger = 2 To iPos
p = p->pn
Next
Else
p = This.last
For i As UInteger = This.counter To iPos + 1 Step -1
p = p->pp
Next
End If
Return p
End Function
Function _Stack.Get(iPos As UInteger) As Vector
Dim As VectorNode Ptr p = This.NodeAt(iPos)
If p = 0 Then Return Type<Vector>(0, 0, 0)
Return p->v
End Function
Sub _Stack.DeleteItem(iPos As UInteger)
Dim As VectorNode Ptr p = This.NodeAt(iPos)
If p = 0 Then Exit Sub
If p->pp Then 'unlink on both sides
p->pp->pn = p->pn
Else
This.start = p->pn
End If
If p->pn Then
p->pn->pp = p->pp
Else
This.last = p->pp
End If
Delete p
This.counter -= 1
End Sub
Function _Stack.Count() As UInteger
Return This.counter
End Function
Function _Stack.IsEmpty() As Integer
Return (This.counter = 0)
End Function
Sub _Stack.Print() 'print stack elements to console
If This.start = 0 Then
? "Stack is empty"
Exit Sub
End If
Dim As VectorNode Ptr p = This.start
While p 'null terminated - no reliance on counter
? p->v.x, p->v.y, p->v.z
p = p->pn
Wend
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)
? "Remaining stack elements after 5th element was deleted:"
Stack.Print()
?
'delete first element - links must stay intact
Stack.DeleteItem(1)
? "Remaining stack elements after first element was deleted:"
Stack.Print()
?
? "Elements count: " & Stack.Count()
?
'edge cases which crashed in v2.0
Test = Stack.Get(0)
? "Get(0) returns: " & Test.x & ", " & Test.y & ", " & Test.z
Stack.DeleteItem(0)
Test = Stack.Get(Stack.Count() + 1)
? "Get(count + 1) returns: " & Test.x & ", " & Test.y & ", " & Test.z
?
'copying a stack is safe now
Dim As _Stack Stack2 = Stack
Stack2.Push(99, 99, 99)
? "Copy has " & Stack2.Count() & " elements, original has " & Stack.Count()
?
'empty the stack completely
While Not Stack.IsEmpty()
Stack.Pop()
Wend
? "After popping everything:"
Stack.Print()
? "Pop() on empty stack returns: " & Stack.Pop().x
Sleep
|
Sollte funktionieren.
_________________
Gruß
UEZ
Zuletzt bearbeitet von UEZ am 19.08.2026, 22:34, insgesamt 4-mal bearbeitet |
|
| Nach oben |
|
 |
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1297
Wohnort: Ruhrpott
|
| Verfasst am: 05.01.2019, 16:21 Titel: |
|
|
Eine Anwendung mit einer doppelt verketteten Liste hatten wir hier vor ein paar Jahren schon mal, als Baumstruktur (Type tNode) mit einem Eltern- und einer variablen Anzahl von Kindknoten. Hier der dazugehörige Thread.
Vielleicht sind ja einige (zusätzliche) Anregungen für dich dabei.
Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
| Nach oben |
|
|
UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 149
Wohnort: Opel Stadt
|
| Verfasst am: 05.01.2019, 19:33 Titel: |
|
|
Danke @grindstone für dein Feedback.  Ich werde mir den Thread durchschauen.
Ich hatte nach verkettete Listen gesucht, aber nichts gefunden, was in diese Richtung geht. ¯\_(ツ)_/¯
Wie auch immer, dann habe ich das Rad neu erfunden...
_________________
Gruß
UEZ |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1841
Wohnort: [JN58JR]
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
