[PB4] LinkedList2 and Trees

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

[PB4] LinkedList2 and Trees

Post by Flype »

Code updated For 5.20+

Without linkedlist feature i feel i'm naked.
I love using them but sometimes, they are not enough powerful.

For building tree-structured informations for example.
As Directory Listing, Reading XML, Parsing Databases, and much more situation.

Here is just another easy/small linkedlist implementation.

LinkedList2.pbi

Code: Select all

;---------------------------------------
; Object:  LinkedList2
; Version: Version 0.2
; Author:  Flype (flype44@hotmail.fr)
; Date:    Mar 2006
; Requir : Purebasic 4.0
;---------------------------------------


; MiniSet.pbi

Global NewList set.l()

Procedure.l Push(value.l)
  If AddElement(set())
    set() = value
  EndIf
EndProcedure
Procedure.l Pop(value.l)
  ForEach set()
    If set() = value
      DeleteElement(set())
    EndIf
  Next
EndProcedure
Procedure.l NotIn(value.l)
  ForEach set()
    If set() = value
      ProcedureReturn #False
    EndIf
  Next
EndProcedure

; LinkedList2.pbi

Structure LL
  *nextLL
  *prevLL
  nByte.l
  nElement.l
  userdata.l
EndStructure

Macro NewTree(STRUCTNAME)
  LL_Alloc(SizeOf(STRUCTNAME))
EndMacro

Macro NewList2(STRUCTNAME)
  LL_Alloc(SizeOf(STRUCTNAME))
EndMacro

Macro Assert2(element,func)
  If element = -1
    Debug "[" + func + "] List is empty"
  ElseIf element = -2
    Debug "[" + func + "] Out of bounds"
  ElseIf element = #Null
    Debug "[" + func + "] Pointer is null"
    End
  ElseIf NotIn(element)
    Debug "[" + func + "] Not a valid list"
    End
  EndIf
EndMacro

Procedure.l LL_Alloc(nByte.l=SizeOf(LL))
  *list.LL = AllocateMemory(nByte)
  Push(*list)
  Assert2(*list,"NewList2")
  *list\nByte = nByte
  ProcedureReturn *list
EndProcedure
Procedure.l LL_Free(*element.LL)
  Assert2(*element,"LL_Free")
  ZeroMemory_(*element,*element\nByte)
  FreeMemory(*element)
  Pop(*element)
EndProcedure
Procedure.l LL_Link(*element1.LL,*element2.LL)
  Assert2(*element1,"LL_Attach")
  *element1\nextLL = *element2
  If *element2
    *element2\prevLL = *element1
  EndIf
EndProcedure

Procedure.l CountList2(*list.LL)
  Assert2(*list,"CountList2")
  ProcedureReturn *list\nElement
EndProcedure
Procedure.l FirstElement2(*list.LL)
  Assert2(*list,"FirstElement2")
  If *list\nextLL
    ProcedureReturn *list\nextLL
  EndIf
  Assert2(-1,"FirstElement2")
EndProcedure
Procedure.l LastElement2(*list.LL)
  Assert2(*list,"LastElement2")
  While *list
    If *list\nextLL = #Null
      ProcedureReturn *list
    EndIf
    *list = *list\nextLL
  Wend
  Assert2(-1,"LastElement2")
EndProcedure
Procedure.l AddElement2(*list.LL,position.l=-1)
  Assert2(*list,"AddElement2")
  *this.LL = LL_Alloc(*list\nByte)
  Assert2(*this,"AddElement2")
  *last.LL = LastElement2(*list)
  *list\nElement + 1
  If *last
    *this\prevLL = *last
    *last\nextLL = *this
  Else
    *this\prevLL = *list
  EndIf
  ProcedureReturn *this
EndProcedure
Procedure.l ClearList2(*list.LL)
  Assert2(*list,"ClearList2")
  *list\nElement = 0
  *list = FirstElement2(*list)
  While *list
    *this = *list
    *list = *list\nextLL
    LL_Free(*this)
  Wend
EndProcedure
Procedure.l DeleteList2(*list.LL)
  Assert2(*list,"DeleteList2")
  ClearList2(*list)
  LL_Free(*list)
EndProcedure
Procedure.l DeleteElement2(*list.LL,position.l)
  Assert2(*list,"DeleteElement2")
  *this.LL = FirstElement2(*list)
  While *this
    If i = position
      LL_Link(*this\prevLL,*this\nextLL)
      LL_Free(*this)
      *list\nElement - 1
      ProcedureReturn
    EndIf
    *this = *this\nextLL
    i + 1
  Wend
  Assert2(-2,"DeleteElement2")
EndProcedure
Procedure.l NextElement2(*list.LL)
  Assert2(*list,"NextElement2")
  ProcedureReturn *list\nextLL
EndProcedure
Procedure.l PreviousElement2(*list.LL)
  Assert2(*list,"PreviousElement2")
  *prev.LL = *list\prevLL
  If *prev
    If *prev\prevLL = #Null
      ProcedureReturn #Null
    EndIf
  EndIf
  ProcedureReturn *prev
EndProcedure
Procedure.l SwapElement2(*element1.LL,*element2.LL)
  Assert2(*element1,"SwapElement2")
  Assert2(*element2,"SwapElement2")
  *prev1 = *element1\prevLL
  *next1 = *element1\nextLL
  *element1\nextLL = *element2\prevLL
  *element1\nextLL = *element2\nextLL
  *element2\prevLL = *prev1
  *element2\nextLL = *next1
EndProcedure
Procedure.l SelectElement2(*list.LL,position.l)
  Assert2(*list,"SelectElement2")
  *list = FirstElement2(*list)
  While *list
    If i = position
      ProcedureReturn *list
    EndIf
    *list = *list\nextLL
    i + 1
  Wend
  Assert2(-2,"SelectElement2")
EndProcedure

;---------------------------------------
[EDIT]
Corrected: Ligne 7 Assert2(-1,"FirstElement2") instead of Assert2(#False,"FirstElement2")
New Alias: NewTree(), same as NewList2()
Last edited by Flype on Fri Mar 31, 2006 1:47 am, edited 3 times in total.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

and here is a database parsing example.

this code parse an entire odbc connection for databases, tables, and fields
it works without problem with a MySQL ODBC driver, not tested with others (don't forget to set your own connection parameters on line 115).
The result of the parsing process is stored in a tree in memory.

Code: Select all

;------------------------------------------------------------------------

IncludeFile "LinkedList2.pb"

;------------------------------------------------------------------------

Structure DATABASE Extends LL
  name.s
  *tables
EndStructure
Structure TABLE Extends LL
  name.s
  *fields
EndStructure
Structure FIELD Extends LL
  name.s
  type.s
  null.s
  key.s
  def.s
  extra.s
EndStructure

;------------------------------------------------------------------------

Procedure.l ParseDatabase(name.s,user.s,password.s)
  
  ; Parse Databases
  
  dbDB = OpenDatabase(#PB_Any,name,user,password)
  
  If dbDB
    
    If DatabaseQuery(dbDB,"SHOW DATABASES")
      
      *conn.DATABASE = NewList2(DATABASE)
      
      While NextDatabaseRow(dbDB)
        
        *db.DATABASE = AddElement2(*conn)
        *db\name = GetDatabaseString(dbDB,0)
        *db\tables = NewList2(TABLE)
        
        ; Parse Tables
        
        dbTable = OpenDatabase(#PB_Any,name,user,password)
        
        If dbTable
          
          If DatabaseQuery(dbTable,"SHOW TABLES FROM " + *db\name)
            
            While NextDatabaseRow(dbTable)
              
              *table.TABLE = AddElement2(*db\tables)
              *table\name = GetDatabaseString(dbTable,0)
              *table\fields = NewList2(FIELD)
              
              ; Parse Fields
              
              dbField = OpenDatabase(#PB_Any,name,user,password)
              
              If dbField
                
                If DatabaseQuery(dbField,"DESCRIBE " + *db\name + "." + *table\name)
                  
                  While NextDatabaseRow(dbField)
                    
                    *field.FIELD = AddElement2(*table\fields)
                    *field\name  = GetDatabaseString(dbField,0)
                    *field\type  = GetDatabaseString(dbField,1)
                    *field\null  = GetDatabaseString(dbField,2)
                    *field\key   = GetDatabaseString(dbField,3)
                    *field\def   = GetDatabaseString(dbField,4)
                    *field\extra = GetDatabaseString(dbField,5)
                    
                  Wend
                  
                EndIf
                
                CloseDatabase(dbField)
                
              EndIf
              
            Wend
            
          EndIf
          
          CloseDatabase(dbTable)
          
        EndIf
        
      Wend
      
    EndIf
    
    CloseDatabase(dbDB)
    
  EndIf
  
  ProcedureReturn *conn
  
EndProcedure

;------------------------------------------------------------------------

If InitDatabase() = #False
  MessageRequester("Error","InitDatabase() failed",#True):End
EndIf

If OpenWindow(0,50,50,640,480,"ParseDatabase()") And CreateGadgetList(WindowID(0))
  
  TreeGadget(0,10,10,620,460)
  
  *root = ParseDatabase("test","guest","")
  
  If *root
    *db.DATABASE = FirstElement2(*root)
    While *db ; parse databases
      AddGadgetItem(0,-1,*db\name,0,0)
      *table.TABLE = FirstElement2(*db\tables)
      While *table ; parse tables
        AddGadgetItem(0,-1,*table\name,0,1)
        *field.FIELD = FirstElement2(*table\fields)
        While *field ; parse fields
          AddGadgetItem(0,-1,*field\name,0,2)
          AddGadgetItem(0,-1,*field\type,0,3)
          AddGadgetItem(0,-1,*field\def,0,3)
          AddGadgetItem(0,-1,*field\null,0,3)
          AddGadgetItem(0,-1,*field\key,0,3)
          AddGadgetItem(0,-1,*field\extra,0,3)
          *field = NextElement2(*field)
        Wend
        *table = NextElement2(*table)
      Wend
      *db = NextElement2(*db)
    Wend
  EndIf
  
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
  
EndIf

;------------------------------------------------------------------------
Last edited by Flype on Thu Mar 30, 2006 12:18 pm, edited 1 time in total.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
dracflamloc
Addict
Addict
Posts: 1648
Joined: Mon Sep 20, 2004 3:52 pm
Contact:
Contact dracflamloc

Post by dracflamloc »

Cool thanks for sharing Flype
Top
Thalius
Enthusiast
Enthusiast
Posts: 711
Joined: Thu Jul 17, 2003 4:15 pm
Contact:
Contact Thalius

Post by Thalius »

Flype you are m Hero!!!

I just started to think about a solution for my NULL pointer problem in my version using Linkedlists and changecurrentelement. This solved it !

Lovely !!

Thx ! :D

Thalius
"In 3D there is never enough Time to do Things right,
but there's always enough Time to make them *look* right."
"psssst! i steal signatures... don't tell anyone! ;)"
Top
User avatar
kenmo
Addict
Addict
Posts: 2047
Joined: Tue Dec 23, 2003 3:54 am

Post by kenmo »

:D Very nice. I'm aware this sort of thing has been done many times before, but I like your version, and I think I'll work this into the buddy list managing part of my chat program... thanks for sharing!
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

First post edited, you will need the updated LinkedList2.pbi for the example below.

And another example :P

This time, the tree is a directory listing.

PS:
Beware, when passing "C:\" for example i get an invalid access memory.
It's a bug i notified in the bug topic with TreeGadget/AddGadgetItem.
http://www.purebasic.fr/english/viewtop ... highlight=

Code: Select all

;------------------------------------------------------------------------ 

IncludeFile "LinkedList2.pb" 

;------------------------------------------------------------------------ 

Structure FILE Extends LL 
  name.s 
  size.d 
  *sub 
EndStructure 

;------------------------------------------------------------------------ 

Procedure ParseDirectory(id, folder.s) 
  
  If Right(folder, 1) <> "\" 
     folder + "\" 
  EndIf 
  
  If ExamineDirectory(id, folder, "*.*") 
    
    *root.FILE = NewTree(FILE) 
    
    While NextDirectoryEntry(id) 
      
      If DirectoryEntryName(id) <> "." And DirectoryEntryName(id) <> ".." 
        
        *a.FILE = AddElement2(*root) 
        *a\name = DirectoryEntryName(id) 
        
        If DirectoryEntryType(id) = #PB_DirectoryEntry_Directory 
          *a\sub = ParseDirectory(id+1, folder+DirectoryEntryName(id)) 
        EndIf 
        
      EndIf 
      
    Wend 
    
    FinishDirectory(id) 
    
  EndIf 
  
  ProcedureReturn *root 
  
EndProcedure 

Procedure ParseTree(gadget.l, depth.l, *root.FILE) 
  
  If *root 
    
    *file.FILE = FirstElement2(*root) 
    
    While *file 
      
      AddGadgetItem(0, -1, *file\name, #Null, depth) 
      
      If *file 
        ParseTree(gadget, depth+1, *file\sub) 
      EndIf 
      
      *file = NextElement2(*file) 
      
    Wend 
    
  EndIf 
  
EndProcedure 

If OpenWindow(0, 50, 50, 640, 480,"ParseDatabase()") And CreateGadgetList(WindowID(0)) 
  
  TreeGadget(0, 10, 10, 620, 460) 
  
  ParseTree(0, 0, ParseDirectory(0, GetEnvironmentVariable("USERPROFILE")) ) 
  
  Repeat 
  Until WaitWindowEvent() = #PB_Event_CloseWindow 
  
EndIf
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

LinkedListEx Version 0.3 released as UserLibrary for PureBasic 4.0

Download it from here :
http://www.purebasic.fr/english/viewtopic.php?t=21862
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

This looks like it will be VERY useful.

Thanks for sharing with us :)

cheers
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

another sample. this time it use (PBOSL) MSXML3 :

and another forum bug : the XML$ is truncated. so pick it up here :
http://purebasic.forum-gratuit.com/post ... te&p=51203

Code: Select all

; dépendancy: MSXML3 (PBOSL), LINKEDLISTEX (flype)

Structure ENTRY Extends LINKEDLISTEX
  text.s
  *sub
EndStructure

Procedure.l ParseXml(oNode.l)
  
  If oNode
    
    *list = NewListEx( SizeOf(ENTRY) )
    
    If MSXML3_HasChildNodes(oNode) ; recursive only if childnodes
      
      oNodeList = MSXML3_SelectNodes(oNode, "entry")
      
      For i = 0 To MSXML3_NodeListGetLength(oNodeList) - 1
        
        oNode = MSXML3_NodeListGetItem(oNodeList, i)
        
        *item.ENTRY = AddElementEx(*list)
        *item\text  = MSXML3_SpecialGetNamedAttributeValue(oNode, "text")
        *item\sub   = ParseXml(oNode)
        
        MSXML3_ReleaseObject(oNode)
        
      Next
      
      MSXML3_ReleaseObject(oNodeList)
      
    EndIf
    
    ProcedureReturn *list
    
  EndIf
  
EndProcedure

Procedure ParseTree(*list, depth.l)
  
  If *list
    
    *item.ENTRY = FirstElementEx(*list)
    
    While *item
      
      Debug Space(depth * 4) + "ParseTree: " + *item\text
      
      ParseTree(*item\sub, depth + 1)
      
      *item = NextElementEx(*item)
      
    Wend
    
  EndIf
  
EndProcedure

XML$ + "<entry>"
XML$ + "  <entry>"
XML$ + "    <entry>"
XML$ + "      <entry>"
XML$ + "      <entry>"
XML$ + "    </entry>"
XML$ + "    <entry>"
XML$ + "      <entry>"
XML$ + "      <entry>"
XML$ + "    </entry>"
XML$ + "  </entry>"
XML$ + "  <entry>"
XML$ + "    <entry>"
XML$ + "      <entry>"
XML$ + "      <entry>"
XML$ + "    </entry>"
XML$ + "    <entry>"
XML$ + "      <entry>"
XML$ + "      <entry>"
XML$ + "    </entry>"
XML$ + "  </entry>"
XML$ + "</entry>"

oDoc = MSXML3_CreateDomDocument()

If oDoc And MSXML3_LoadXML(oDoc, XML$)
  ParseTree(ParseXml(MSXML3_SelectSingleNode(oDoc, "entry")), 0)
  MSXML3_ReleaseObject(oDoc)
EndIf
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
Post Reply

Return to “Tricks 'n' Tips”