Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Stack Implementierung mit doppelt verketteten Listen

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 05.01.2019, 02:07    Titel: Stack Implementierung mit doppelt verketteten Listen Antworten mit Zitat

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 lächeln).

Hier das Resultat als ein Stack.
Code:

'Stack (LIFO) v2 implementation using doubly linked lists
'Coded by UEZ build 2020-06-14 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
      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
   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)
? "Remained stack elements after 5th element was deleted:"
Stack.Print()
?

? "Elements count: " & Stack.Count


Sleep


Sollte funktionieren.
_________________
Gruß,
UEZ


Zuletzt bearbeitet von UEZ am 14.06.2020, 22:25, insgesamt 3-mal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 05.01.2019, 15:21    Titel: Antworten mit Zitat

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. lächeln

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
UEZ



Anmeldungsdatum: 24.06.2016
Beiträge: 129
Wohnort: Opel Stadt

BeitragVerfasst am: 05.01.2019, 18:33    Titel: Antworten mit Zitat

Danke @grindstone für dein Feedback. happy 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... lächeln
_________________
Gruß,
UEZ
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ThePuppetMaster



Anmeldungsdatum: 18.02.2007
Beiträge: 1837
Wohnort: [JN58JR]

BeitragVerfasst am: 15.01.2019, 11:36    Titel: Antworten mit Zitat

@UEZ ... https://www.freebasic-portal.de/porticula/linkedlistbi-847.html


MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ]
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
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.

 Impressum :: Datenschutz