Double Linked List

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
MusicianKool
Posts: 57
Joined: May 13, 2010 22:30

Double Linked List

Postby MusicianKool » Jul 05, 2011 20:35

Figured I would share this, the only thing it's missing is insert, but everything else is good. Might need some optimization but I think it's good. I haven't found anything like this in the forum so...

Code: Select all

'Define a void
#Define NIL 0

#Define Object(Type_,Identifier) (CPtr(Type_ Ptr,Identifier))

'Describe Node_
Type Node_
   Dim Next_ As Node_ Ptr
   Dim Prev_ As Node_ Ptr
   Dim Attribute As Any Ptr
End Type

'Describe List_
Type List_
   Dim First_ As Node_ Ptr
   Dim Last_ As Node_ Ptr
   Dim Current As Node_ Ptr
   Dim Size As Integer
End Type

'Describe EachIn_
Type EachIn_
   Dim Current As Node_ Ptr
   Dim ID As Any Ptr
End Type

'Return a new List_
Function CreateList() As List_ ptr Export
   Return New List_
End Function

Declare Function Last_( List As List_ Ptr) As Any Ptr
Declare Function EachIn(List As List_ Ptr,ByRef ID As Integer) As Integer

'Add a node to said list with said attribute.
Sub AddToList(List As List_ ptr , ByRef Attribute As Any Ptr) Export
   Dim N As Node_ Ptr = New Node_
   If List->Size = 0 Then
      N->Attribute = Attribute
      List->First_ = N
      List->Current = N
      List->Last_ = N
      List->Size=List->Size+1
      Return
   EndIf
   Last_(List)
   N->Attribute = Attribute
   N->Prev_ = List->Last_
   List->Last_->Next_ = N
   List->Last_ = N
   List->Current = N
   List->Size=List->Size+1
End Sub

'Return First node attribute of said list or NIL if no node exist's.
Function First_(List As List_ Ptr) As Any Ptr Export
   If list->Current <> NIL Then
      List->Current = List->First_
      Return List->Current->Attribute
   EndIf
   Return NIL
End Function

'Return Last node attribute of said list or NIL if no node exist's.
Function Last_(List As List_ ptr) As Any Ptr Export
   If list->Current <> NIL Then
      List->Current = List->Last_
      Return List->Current->Attribute
   EndIf
   Return NIL
End Function

'Returns node attribute of said list after the current node in said list or NIL if no node exist's after.
Function After_(List As List_ ptr) As Any Ptr Export
   If List->Current->Next_ <> NIL And list->Current <> NIL Then
      List->Current = List->Current->Next_
      Return List->Current->Attribute
   EndIf
   Return NIL
End Function

'Returns node attribute of said list before the current node in said list or NIL if no node exist's before.
Function Before_(List As List_ ptr) As Any Ptr Export
   If List->Current->Prev_ <> NIL And list->Current <> NIL Then
      List->Current = List->Current->Prev_
      Return List->Current->Attribute
   EndIf
   Return NIL
End Function

'Returns Current node attribute of said list or NIL if no node exist's.
Function Current_(List As List_ Ptr) As Any Ptr Export
   If list->Current <> NIL Then
      Return List->Current->Attribute
   EndIf
   Return NIL
End Function

'Delete:
'   -1 = current node of said list
'    0 = all nodes of said list
'    0 < node containing said attribute within said list
'Returns 1: Succesful   0:Failed or Node with said attribute does not exist within said list.
Function Delete_(ByRef List As List_  Ptr , ByVal Attribute As Any Ptr = NIL) As Integer Export
   Dim TMP As Node_ Ptr
   If Attribute = -1 Then
      
      If List->Current->Next_ = NIL And List->Current->Prev_ <> NIL Then
         List->Current->Prev_->Next_ = NIL
         TMP = List->Current
         List->Current = List->Current->Prev_
         Delete TMP
         Return 1
      EndIf
      If List->Current->Prev_ = NIL And List->Current->Next_ <> NIL Then
         List->Current->Next_->Prev_ = NIL
         TMP = List->Current
         List->Current = List->Current->Next_
         Delete TMP
         Return 1
      EndIf
      If List->Current->Prev_ = NIL And List->Current->Next_ = NIL Then
         Delete List->Current
         list->Current = NIL
         Return 1
      EndIf
      
      List->Current->Prev_->Next_ = List->Current->Next_
      List->Current->Next_->Prev_ = List->Current->Prev_
      TMP = List->Current->Prev_
      Delete List->Current
      List->Current = TMP
      Return 1
      
   EndIf
   
   If Attribute =NIL Then

      First_(List)
      While  (List->Current <> NIL)
         Delete_(list,-1)
      Wend
      Delete List
      list = NIL
      Return 1

   EndIf
   
   First_(List)
   While List->Current  <> NIL
      If List->Current->Attribute = Attribute Then
         
         If List->Current->Next_ = NIL And List->Current->Prev_ <> NIL Then
            List->Current->Prev_->Next_ = NIL
            TMP = List->Current
            List->Current = List->Current->Prev_
            List->Last_ = List->Current
            list->size -= 1
            Delete TMP
            Return 1
         EndIf
         If List->Current->Prev_ = NIL And List->Current->Next_ <> NIL Then
            List->Current->Next_->Prev_ = NIL
            TMP = List->Current
            List->Current = List->Current->Next_
            List->First_ = List->Current
            list->size -=1
            Delete TMP
            Return 1
         EndIf
         If List->Current->Prev_ = NIL And List->current->Next_ = NIL  Then
            Delete list->Current
            list->First_ = NIL
            List->Last_=NIL
            List->Current=NIL
            List->size = 0
            Return 1
         EndIf
         List->Current->Prev_->Next_ = List->Current->Next_
         List->Current->Next_->Prev_ = List->Current->Prev_
         list->size -= 1
         TMP = List->Current->Prev_
         Delete List->Current
         List->Current = TMP
         Return 1
   
      EndIf
      If list->current->Next_ <> NIL Then
         List->Current = List->Current->Next_
      Else
         Exit while
      EndIf
   Wend
   Return 0
End Function

'Insert node/attribute after said list's current node.
Sub Insert_After(List As list_ Ptr,attribute As Any ptr) Export
   Dim N As Node_ Ptr = New Node_
   If list->Current = list->Last_  Then
      N->Attribute = Attribute
      N->Prev_ = List->Current
      List->Current->Next_ = N
      list->size+=1
      List->Last_ = N
      Exit Sub
   EndIf
   N->Attribute = Attribute
   List->Current->Next_->Prev_ = N
   N->Next_ = List->Current->Next_
   N->Prev_ = List->Current
   List->Current->Next_ = N
   List->Size=List->Size+1
End Sub

'Insert node/attribute before said list's current node.
Sub Insert_Before(List As list_ Ptr, attribute As Any Ptr) Export
   Dim N As Node_ Ptr = New Node_
   If List->Current = List->First_ Then
      N->Attribute = Attribute
      N->Next_ = List->Current
      List->Current->Prev_ = N
      List->Size += 1
      List->First_ = N
      Exit Sub
   EndIf
   N->Attribute = Attribute
   List->Current->Prev_->Next_ = N
   N->Next_ = List->Current
   N->Prev_ = List->Current->Prev_
   List->Current->Prev_ = N
   List->Size=List->Size+1
End Sub

'Describe global eachin as a list
Dim Shared Global_EachIn As list_ Ptr
Global_EachIn = CreateList()

'Returns (ID: each node within said list through ID with each pass of a while loop.)
'True:  Itteration has not reached the end of said list.
'False: Itterated through every node within said list.
'Starts from first node to last node
Function EachIn(List As List_ Ptr ,ByRef ID As Integer) As Integer Export
   If list->Current = NIL Then Return  0
   Dim E As EachIn_ Ptr
   If ID = NIL Then
      E = New EachIn_
      AddToList(Global_EachIn,e)
      E->Current = List->First_
      List->Current = E->Current
      E->ID = @ID
      ID = Cast(Integer,E->Current->Attribute)
      Return 1
   EndIf
   First_(Global_Eachin)
   While Global_EachIn->Current <> NIL
      E = Global_EachIn->Current->Attribute
      If E->ID = @ID Then
         If E->Current = List->Last_ Then
            Delete_(Global_EachIn,E)
            Delete e
            ID = 0
            Return 0
         EndIf
         If e->Current = NIL Or e->Current->Next_ = NIL Then
            e->Current = List->First_
         Else
            E->Current=E->Current->Next_
         EndIf
         ID = Cast(Integer,E->Current->Attribute)
         List->Current = E->Current
         Return 1
      EndIf
      If Global_Eachin->Current->Next_ <> NIL Then
         Global_EachIn->Current = global_eachin->current->Next_
      Else
         Exit While
      EndIf
   Wend
   Return 0
End Function

' Test Program for Library
Dim i As Integer

Dim list As list_ Ptr = CreateList()

For i = 1 To 5
   AddToList(list,i)   
Next

Dim look1 As Integer = 0

While EachIn(list,look1)
   Print look1
   Dim Look2 As Integer = 0
   While EachIn(list,look2)
      If look2 = 1 Then
         i = 11111111
         Insert_Before(List,i)
      EndIf
      If look2 = 5 Then
         i = 99999999
         Insert_After(list,i)
      EndIf
      Print look2
   Wend
   print
Wend
If Delete_(list) Then Print " List Deleted. "
Print
Print " Press <Any Key> to see type list."
Print
Sleep

'to do type lists
list = CreateList()

Type  numbers
   Dim num As Integer
   Dim ID As String
End Type

For i = 1 To 5
   Dim tn As Numbers Ptr = New numbers
   tn->num = i
   tn->ID = "This type is number: "
   AddToList(list,tn)
Next

look1 = 0
While EachIn(list,look1)
   Dim typepointer As Numbers Ptr = CPtr(Numbers Ptr,look1)
   Print typepointer->ID , typepointer->num
Wend


Print
If Delete_(List) Then Print " List Deleted "

Print
Print" Press <Any Key> to exit."
Sleep



eh, had some bugs that are all taken care of i think. compiling the example will lead to warnings but that is because of passing integer values when the double linked list here is based on pointers.
fixed a bug - where deleting an attribute inside an EachIn would cause an error.
Last edited by MusicianKool on Jul 18, 2011 22:08, edited 7 times in total.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Jul 08, 2011 22:53

Moved this to tips and tricks. =)
pestery
Posts: 493
Joined: Jun 16, 2007 2:00
Location: Australia

Postby pestery » Jul 12, 2011 5:40

I use something similar, but a macro version instead. I think I've posted this before somewhere but this is more up-to-date.

Code: Select all

' Double linked list macros
#Macro double_linked_list_add_to_back(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If list_last Then
         list_last->next_ptr = @This
         This.next_ptr = 0
         This.prev_ptr = list_last
         list_last = @This
      Else
         list_first = @This
         list_last = @This
         This.next_ptr = 0
         This.prev_ptr = 0
      EndIf
   #Else
      If list_last Then
         list_last->next_ptr = this_ptr
         this_ptr->next_ptr = 0
         this_ptr->prev_ptr = list_last
         list_last = this_ptr
      Else
         list_first = this_ptr
         list_last = this_ptr
         this_ptr->next_ptr = 0
         this_ptr->prev_ptr = 0
      EndIf
   #EndIf
#EndMacro
#Macro double_linked_list_add_to_front(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If list_first Then
         list_first->prev_ptr = @This
         This.next_ptr = list_first
         This.prev_ptr = 0
         list_first = @This
      Else
         list_first = @This
         list_last = @This
         This.next_ptr = 0
         This.prev_ptr = 0
      EndIf
   #Else
      If list_first Then
         list_first->prev_ptr = this_ptr
         this_ptr->next_ptr = list_first
         this_ptr->prev_ptr = 0
         list_first = this_ptr
      Else
         list_first = this_ptr
         list_last = this_ptr
         this_ptr->next_ptr = 0
         this_ptr->prev_ptr = 0
      EndIf
   #EndIf
#EndMacro
#Macro double_linked_list_add_after_target(target_ptr, list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If target_ptr->next_ptr Then
         This.next_ptr = target_ptr->next_ptr
         This.next_ptr->prev_ptr = @This
      Else
         This.next_ptr = 0
         list_last = @This
      EndIf
      This.prev_ptr = target_ptr
      target_ptr->next_ptr = @This
   #Else
      If target_ptr->next_ptr Then
         this_ptr->next_ptr = target_ptr->next_ptr
         this_ptr->next_ptr->prev_ptr = this_ptr
      Else
         this_ptr->next_ptr = 0
         list_last = this_ptr
      EndIf
      this_ptr->prev_ptr = target_ptr
      target_ptr->next_ptr = this_ptr
   #EndIf
#EndMacro
#Macro double_linked_list_add_before_target(target_ptr, list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If target_ptr->prev_ptr Then
         This.prev_ptr = target_ptr->prev_ptr
         This.prev_ptr->next_ptr = @This
      Else
         This.prev_ptr = 0
         list_first = @This
      EndIf
      This.next_ptr = target_ptr
      target_ptr->prev_ptr = @This
   #Else
      If target_ptr->prev_ptr Then
         this_ptr->prev_ptr = target_ptr->prev_ptr
         this_ptr->prev_ptr->next_ptr = this_ptr
      Else
         this_ptr->prev_ptr = 0
         list_first = this_ptr
      EndIf
      this_ptr->next_ptr = target_ptr
      target_ptr->prev_ptr = this_ptr
   #EndIf
#EndMacro
#Macro double_linked_list_remove(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If This.prev_ptr Then This.prev_ptr->next_ptr = This.next_ptr Else list_first = This.next_ptr
      If This.next_ptr Then This.next_ptr->prev_ptr = This.prev_ptr Else list_last = This.prev_ptr
      This.next_ptr = 0
      This.prev_ptr = 0
   #Else
      If this_ptr->prev_ptr Then this_ptr->prev_ptr->next_ptr = this_ptr->next_ptr Else list_first = this_ptr->next_ptr
      If this_ptr->next_ptr Then this_ptr->next_ptr->prev_ptr = this_ptr->prev_ptr Else list_last = this_ptr->prev_ptr
      this_ptr->next_ptr = 0
      this_ptr->prev_ptr = 0
   #EndIf
#EndMacro
#Macro double_linked_list_move_to_back(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   double_linked_list_remove(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   double_linked_list_add_to_back(list_first, list_last, this_ptr, prev_ptr, next_ptr)
#EndMacro
#Macro double_linked_list_move_to_front(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   double_linked_list_remove(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   double_linked_list_add_to_front(list_first, list_last, this_ptr, prev_ptr, next_ptr)
#EndMacro
#Macro double_linked_list_move_backward(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If This.next_ptr Then
         If This.prev_ptr Then This.prev_ptr->next_ptr = This.next_ptr Else list_first = This.next_ptr
         This.next_ptr->prev_ptr = This.prev_ptr
         This.prev_ptr = This.next_ptr
         This.next_ptr = This.prev_ptr->next_ptr
         This.prev_ptr->next_ptr = @This
         If This.next_ptr Then This.next_ptr->prev_ptr = @This Else list_last = @This
      EndIf
   #Else
      If this_ptr->next_ptr Then
         If this_ptr->prev_ptr Then this_ptr->prev_ptr->next_ptr = this_ptr->next_ptr Else list_first = this_ptr->next_ptr
         this_ptr->next_ptr->prev_ptr = this_ptr->prev_ptr
         this_ptr->prev_ptr = this_ptr->next_ptr
         this_ptr->next_ptr = this_ptr->prev_ptr->next_ptr
         this_ptr->prev_ptr->next_ptr = this_ptr
         If this_ptr->next_ptr Then this_ptr->next_ptr->prev_ptr = this_ptr Else list_last = this_ptr
      EndIf
   #EndIf
#EndMacro
#Macro double_linked_list_move_forward(list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If This.prev_ptr Then
         If This.next_ptr Then This.next_ptr->prev_ptr = This.prev_ptr Else list_last = This.prev_ptr
         This.prev_ptr->next_ptr = This.next_ptr
         This.next_ptr = This.prev_ptr
         This.prev_ptr = This.next_ptr->prev_ptr
         This.next_ptr->prev_ptr = @This
         If This.prev_ptr Then This.prev_ptr->next_ptr = @This Else list_first = @This
      EndIf
   #Else
      If this_ptr->prev_ptr Then
         If this_ptr->next_ptr Then this_ptr->next_ptr->prev_ptr = this_ptr->prev_ptr Else list_last = this_ptr->prev_ptr
         this_ptr->prev_ptr->next_ptr = this_ptr->next_ptr
         this_ptr->next_ptr = this_ptr->prev_ptr
         this_ptr->prev_ptr = this_ptr->next_ptr->prev_ptr
         this_ptr->next_ptr->prev_ptr = this_ptr
         If this_ptr->prev_ptr Then this_ptr->prev_ptr->next_ptr = this_ptr Else list_first = this_ptr
      EndIf
   #EndIf
#EndMacro
#Macro double_linked_list_in_list(result, list_first, list_last, this_ptr, prev_ptr, next_ptr)
   #If this_ptr = This
      If list_first = @This Then
         result = Not 0
      ElseIf list_last = @This Then
         result = Not 0
      ElseIf This.prev_ptr Then
         result = Not 0
      ElseIf This.next_ptr Then
         result = Not 0
      Else
         result = 0
      EndIf
   #Else
      If list_first = this_ptr Then
         result = Not 0
      ElseIf list_last = this_ptr Then
         result = Not 0
      ElseIf this_ptr->prev_ptr Then
         result = Not 0
      ElseIf this_ptr->next_ptr Then
         result = Not 0
      Else
         result = 0
      EndIf
   #EndIf
#EndMacro

' Example data type
Type datatype
   As String text
   As Integer a, b, c
   
   As datatype Ptr prev_ptr ' Previous entry in double linked list, if any
   As datatype Ptr next_ptr ' Next entry in double linked list, if any
   
   Declare Constructor
   Declare Destructor
End Type

' Double linked list header
Dim Shared As datatype Ptr list_first ' First entry in the list, if any
Dim Shared As datatype Ptr list_last ' Last entry in the list, if any

' Create some list entries
Dim As datatype Ptr dt
For i As Integer = 1 To 9
   dt = New datatype ' This will call the Constructor
   If dt = 0 Then Continue For
   dt->text = "Datatype " & i
   dt->a = Rnd * 3
   dt->b = Rnd * 3
   dt->c = Rnd * 3
Next

' View the list
Print : Print "Unsorted list"
dt = list_first
While dt
   Print dt->text & ", values are " & dt->a & ", " & dt->b & ", " & dt->c
   dt = dt->next_ptr
Wend

' Sort the list
dt = list_first
While dt
   If dt->next_ptr = 0 Then Exit While
   If dt->a > dt->next_ptr->a Then
      double_linked_list_move_backward(list_first, list_last, dt, prev_ptr, next_ptr)
      dt = list_first
      Continue While
   ElseIf dt->a = dt->next_ptr->a Then
      If dt->b > dt->next_ptr->b Then
         double_linked_list_move_backward(list_first, list_last, dt, prev_ptr, next_ptr)
         dt = list_first
         Continue While
      ElseIf dt->b = dt->next_ptr->b Then
         If dt->c > dt->next_ptr->c Then
            double_linked_list_move_backward(list_first, list_last, dt, prev_ptr, next_ptr)
            dt = list_first
            Continue While
         EndIf
      EndIf
   EndIf
   dt = dt->next_ptr
Wend

' View the list
Print : Print "Sorted list"
dt = list_first
While dt
   Print dt->text & ", values are " & dt->a & ", " & dt->b & ", " & dt->c
   dt = dt->next_ptr
Wend

' Delete the list and finish
While list_first
   dt = list_first
   Delete dt ' This will call the Destructor
Wend
Sleep
End

' Datatype functions
Constructor datatype
   
   ' Add this datatype to the back of the list
   double_linked_list_add_to_back(list_first, list_last, This, prev_ptr, next_ptr)
   
End Constructor
Destructor datatype
   
   ' Check if this datatype is in the list
   Dim As Integer result
   double_linked_list_in_list(result, list_first, list_last, This, prev_ptr, next_ptr)
   
   ' If datatype is in the list then remove it
   If result Then
      double_linked_list_remove(list_first, list_last, This, prev_ptr, next_ptr)
   EndIf
   
End Destructor

I noticed the Export command at the end of your functions, are you building them into a library? Just curious.
MusicianKool
Posts: 57
Joined: May 13, 2010 22:30

Postby MusicianKool » Jul 14, 2011 9:51

Well yes and no. I started it to be a library but then it wasn't compatible because of the lack of pointers for the language I originally designed it for.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 4 guests