stack of unidirectional linked list

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

stack of unidirectional linked list

Postby VANYA » Feb 08, 2012 19:00

A simple implementation of the stack of unidirectional linked list:

Code: Select all

'' Class --------- species linked list ------------
 '' ------------------ (stack-list) --------------------------

Type PushList
   d As Integer
   p As PushList Ptr
   Declare Function FirstPush(d As Integer) As PushList Ptr
   Declare Sub Nextpush(ByRef top As PushList Ptr , d As Integer)
   Declare Function PopValue(ByRef top As PushList Ptr) As Integer
End Type

Function PushList.FirstPush(d As Integer) As PushList Ptr
   Dim pv As PushList Ptr = New PushList
   pv->d=d
   pv->p=0
   Return pv
End Function

Sub PushList.NextPush(ByRef top As PushList Ptr , d As Integer)
   Dim pv As PushList Ptr = New PushList
   pv->d=d
   pv->p=top
   top=pv
End Sub

Function PushList.PopValue(ByRef top As PushList Ptr) As Integer
   PushList.PopValue=top->d
   Dim pv As PushList Ptr = top
   top =top->p
   Delete pv
End Function

Dim top As PushList Ptr = top->FirstPush(1)
For a As Integer = 2 To 10
   top->NextPush(top,a)
Next
While top
   ? top->PopValue(top)
Wend
sleep
fxm
Posts: 9947
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: stack of unidirectional linked list

Postby fxm » Feb 08, 2012 21:13

Yes, well.

I enjoyed myself a little compact your code!

Code: Select all

'' Class --------- species linked list ------------
'' ------------------ (stack-list) --------------------------

Type PushList
   d As Integer
   p As PushList Ptr
   Declare Sub PushValue(ByRef top As PushList Ptr , ByVal d As Integer)
   Declare Function PopValue(ByRef top As PushList Ptr) As Integer
End Type

Sub PushList.PushValue(ByRef top As PushList Ptr , ByVal d As Integer)
   top = New PushList(d, top)
End Sub

Function PushList.PopValue(ByRef top As PushList Ptr) As Integer
   Dim pv As PushList Ptr = top
   Function = pv->d
   top = top->p
   Delete pv
End Function

Dim top As PushList Ptr
For a As Integer = 1 To 10
   top->PushValue(top, a)
Next
While top
   ? top->PopValue(top)
Wend
sleep
Lost Zergling
Posts: 334
Joined: Dec 02, 2011 22:51
Location: France

SOURCE BETA 0 Here ck of unidirectional linked list

Postby Lost Zergling » Feb 08, 2012 22:37

Hi Vanya, Hi fxm
Here we are : For Next faster than while wend, so for next fine to load, but what about the fast parse ? Fast testing ?
What about Easy syntax ? Can I manage it with Tags if I don't like pointers ? ;-)
So, here are the sources. Poor programming, not finished. Technic is for newbies, allright. But let's have a look to the concept design.
This is coming with commented examples & tuto, just past in same file (next post) (too big in one post), and some are not finished...
So, when a BlindStep feature in FB ?,.. ;-)))
ps : Lotus mentionned as a salute to past programming life,.. :-)

Code: Select all

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'                   My_Lotus(c)_script_like_Lists - OpenSource use GPL for nc use lgpl otherwise - 02/2012 By LZ - 3 parts : a small explaination(this one), the library, and then commented examples.
'                                                                            @This is the first FB-Beta version, the original one  -  Lotus is a Trademark of IBM
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' THE HI :
' Come, unit "Hi !" 
' First of all a GREAT THX to Parker for his Linked Lists Features in community tuto manual ! As you can see, I largely use copy paste in this code (& changed allocate to allow-cake)(Hallo-Kate too risky)
' But this code "as is" was very inconvenient for me, let me explain why. I'm a LotusScript programmer, also I know what a pointer is, I love B in Basic, RAD compatible
' Before you ran away, let's have a look about the very powerfull features I used to code in LotusScript,
' * Automatic unique keys (Tag) management which is very usefull for left join in List datas, & for many others things
' * VERY FAST "FORALL" lists parsing, which means no testing required when jumping from one node to another
' * VERY simple & condensed coding langage wich means easy & concentrated coding (when you use  to use it)
' * VERY  FAST "IsElement" testing capabilities on automatic keys wich means high performances when coding data filters, and so on
' --> So a very few features, but powerful & convenient especially when programming on databases, or on midrange system(s) management
'And, basic-ally (lol), why I need something convenient to :
'       - Easily migrate my script working on file system (not the DOM relative part)(Domino Object Model) without having to manage pointers, memory management or re-conceptualize my algorythms
'       - Take care of my programming style, trying fast going with Lists, but readable & clear (for me)
'       - Having an automatic optimization features in my lists BUT simple & readable source code (I love B..) no asm, no compilation tricks, just Free Basic baseline coding instructions.
'       - Having close perf than pointer direct coding, but easier to use, so i want to see : "ALLOW CAKE !", and eat it
' So what ? I wanted a more CONVENIENT & RAD-POWERFULL list object management than the .c-like one
'
' THE RESULT :
'In LotusScript/VB                                                                              In my code :
'To Declare :
'Dim Maliste LIST As String/Integer/Variant or Any data                   Dim MaListe As List    /Type data managed in a TYPE structure, but i almost use string type, so i developped that way.
'To Set : (Automatic StringKey) (existing key=mod, new key=new element)
'MaListe(Str_KeyValue) = Data                                                          MaListe.Tag(Str_KeyValue) : MaListe.Val("STRINGDATA")  ->2 instructions because methods are not supported yet & syntax is pretty specific
'                                                                                                         Create or point Tag Str_KeyValue, Write STRING DATA in Current Tag
'To Get :
'return an error if Str_KeyValue not in list :                                          Str_KeyValue = MaListe.Tag & Value = MaListe.Val  This is for current Tag
'Value = MaListe(Str_KeyValue)                                                         Value = MaListe.ValTag(Str_KeyValue)                        Very similar
'To Parse:
'                                                                                                          Dim i As uLong
'ForAll Ref In MaListe                                                                         For i=1 to MaListe.AllOf : MaListe.BlindStep    ' -> readable
'   Value = Ref                                                                                       Value = MaListe.Val
'   KeyValue =  ListTag(ref)                                                                    KeyValue = MaListe.Tag
'End ForAll                                                                                          Next i
'To Test :
'If IsElement(MaListe(Str_KeyValue)) then...                                      If MaListe.HasTag(Str_KeyValue) then...
'                                           
' SPECIFIC :
' Take / Retake / BRetake a convenient way to store a token on a list for code optimisation (without having to deal with pointers)
' BlindTag is for loading a (huge) list very fast without checking existing key in previous Tags, multiples 'keys' support (VB go home)
' ClearTag & ClearTag(Str_KeyValue) : logical remove, use MaListe.Compress to remove all white tags (or to create another List)
' Often coding like this : "If IsElement(MaListe("toto")) Then ... MaListe("toto") = "new value" -> HasTag stores node ptr on success so MaListe.Tag("toto") is fast
' Why so big ? Why not just the basic features ?
'--> First, I coded only a very few features, just for easy migrate my code from VB/LotusScript : that's the kernel : AllOf, BlindStep, Tag & HasTag, Val & ValTag, but,...
' having few experience in programming, i wanted to Typedef some functions to go further, just to see how far we can go with lists in basic,
' thus i wanted a multi-keys support with same syntax(!) the difficulty was to choose the less functions for the more functionnality & the less performances loss.
' The spirit is : advanced features, but lesser compromise with the Lscript-VB lists original syntax, so far, for migrating code & know how easily. Anyway, can't be same.
'
' ADDITIONNAL :
' Code IS NOT BUG-FREE - Code is not crash free, because of optimisation some instructions do not check pointer is valid (ex BlindStep) : you may assume a clean code
' Code optimized, hope so, should be fast (enought), features of this.toolbox are a COMPROMISE between complexity, readability, functionnality & performances
' About complexity : ADVANCED properties are OPTIONNAL, so you can use it SIMPLY very similar way as in VB (the most simple way), although it remains different wich
' means diff syntax & perfs but similar structure, so you can re-use code with few changes (just syntax, not algorythm, hope so).
' I build design of advanced functions according to my professionnal experience in Lscript-> csv handling, LookUp/explode/implode Lotus Like (instead Select/split/concat).
' Type ListContainer has been designed to allow evolution
' So how does it works ? Please assume you already know lists in VB/LotusScript.         
' The spirit is very simple : tags & values are strings. value can be treated & accessed field by field using properties, the fields set (enreg) is identified by Tag 0 or 1 (or n) like a table in a database.
' Ex : Tag(0)="01" Tag(1)="The Kid" Value="The Kid;Billy;16;Cow-Boy;Atlanta"
'        Tag(0)="02" Tag(1)="The Kid" Value="The Kid;Lucky;52;Policeman;Boston" This List has 2 elements : unique tags(keys) on tag(0) column, not unique on tag(1) column

' FEATURES :       (*)=not supported in VB/Ls     (**)=not supported in my code    (+)=common support
'  Common                   : Physical remove(+)(1), Assignment(+)(2), Copy(+), Unique key (tag) auto access(+), Fast parse(+), Fast testing(+),
'  Additionnal               : Logical remove(*), LookUp(*), GroupBy(*), multiple Tags (*), multiple Tags Columns(*), Take/Retake feature (*), Direct parsing(*)
'                                    Fields handling in .csv format (*), Fields handling in List object (*), Keys (tag) direct management (*),
'                                    Direct access to pointers via properties for "manual" index (*), reading & writing files directly from/to a List object (*), /// List Object Operators(3) - not cooked yet
'  Unsupported            : Identic syntax (**) (but similar one), non-string datatypes (**) (any data may be string or wstring), implemented in compiler (**)(but libraries), build-in exceptions handling (**).
'
'(1) : Some code using physical removing inside a ForAll / Loop instruction (usage not recommended under VB) might not work 'as is', this might be the only exception, if never (different implicit node ptr).
'(2) : 2 instructions
'(3) *= & /= : 'Tag(0)="01" Tag(1) = "" Value="Guns"
'                       -> Tag(0)="*01" Tag(1)="The Kid" Value="The Kid;Billy;16;Cow-Boy;Atlanta"  Tag(0)="*01" Tag(1)="The Kid" Value="The Kid;Lucky;52;Policeman;Boston"
'                               -> Tag(0)="**01" Tag(1)="" Values="Adress 1" Tag(0)="**01" Tag(1)="" Values="Adress 2"
'
' CREDITS : In remember of the spirit - Despite the 'Lotus Like' nostalgy, I precise that this code has been developped from a 'white board'.
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------ LIBRARY START HERE --------------------------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'COMPILATOR LEVEL
'Credits : GPL for non-professionnal use. Please, use any standard lgpl otherwise (including all commercial use and all professionnal non commercial use)-This for FB compliance.
CONST True = 1 : CONST False = 0 ' Not really used by program
CONST MAX_TAKE = 4 ' Le nombre maximum de pointeurs de nodes mémorisables en simultané sur la liste start=0
CONST MAX_COLS = 2 ' Le nombre maximal de clefs pouvant être utilisées sur la MEME liste start=0
CONST LIST_ERR = "Not in list or not found" 'Not found en cas de clefs multiples
CONST LIST_RES = "Reserved"
CONST PRES_SEP = Chr(249) : CONST PRES_LINE_SEP =  Chr(250) ' Reserved for Redim & Preserve properties
CONST Sep1 = Chr(176) : CONST Sep2 = Chr(177) : CONST Sep3 = Chr(178)  ' User define - available to programmer, to use with Implode & Explode
'USER DATA LEVEL
Type ListContainer
    Dim str_item as String
    Declare Constructor()
    Declare Property sData(ByVal Str_Data As String)   
    Declare Property sData() As String
End Type
Property ListContainer.sData(ByVal Str_Data as String) : this.str_item = Str_Data : End Property
Property ListContainer.sData() as String : Return this.str_item : End Property
Constructor ListContainer() : str_item = "" : End Constructor
'ELEMENT (listnode) LEVEL
Type listnode
    Dim Tag(0 to MAX_COLS-1) As String ' La clef
    Dim ListData As ListContainer 'Ptr --> Finally, I didn't want to care with mem allocation management on data level
    Dim pNext As listnode Ptr
    Dim pPrev As listnode Ptr
    Dim pIndex As listnode Ptr
End Type
'LIST LEVEL     
Type List
Private:
    Dim pNode As listnode Ptr
    Dim pFirstNode As listnode Ptr
    Dim pLastNode As listnode Ptr
    Dim pSearchNode As listnode Ptr
    Dim pWrkngNode(0 to MAX_TAKE-1) As listnode Ptr
    Dim sSearchTag As String 'Dernier Tag cherché
    Dim sWrkngTag(0 to MAX_TAKE-1) As String
    Dim bSearchRes As Byte '1 si dernière recherche ok
    Dim bSeekMethod As Byte
    Dim uTag as Ubyte ' CurrentTag
    Dim bStepCheck As Byte = 1
    Dim bCol As uByte 'column data for (ColPick) & ColWrite
    Dim uCount As Ulong
    Dim sIdent As String
    Dim sFilter As String
    Dim wPreserve As string
    Declare Property AllowCake() As listnode Ptr                       'Cooking here   
Public:   
    'TAGs management (VB like)   
    Declare Property Tag(str_Tag As String) As listnode Ptr     'Défini str_Tag comme Tag courant, créé automatiquement  un nouveau si il n'est pas dans  la liste. Se positionne dessus.   
    Declare Property Tag() As String                                        'Renvoi la valeurdu tag du node courant     
    Declare Property HasTag(str_Tag As String) As Byte        ' 1 si Tag est dans la liste, sinon 0. (mémorise la dernière recherche)
    'TAGs management (extra values)
    Declare Property BlindTag(str_Tag As String) As listnode Ptr 'Ajoute un tag en fin de liste sans vérifier si il n'existe pas déjà, se positionne en fin de liste   
    Declare Property Tag(iTag As Integer) As String                'Renvoi la valeur du tag(i) du node courant
    Declare Property RwTag(s_Tag As String) As listnode Ptr  'Réécrit le Tag courant (un peu limite au niveau fonctionnel, sauf clefs multiples/n°ième col de tag, etc)
    Declare Property ColTags() As Byte                                   ' Renvoie le numéro de la colonne de tag active
    Declare Property ColTags(i as Byte) As Byte                      ' Définie la colonne de tag active de 0 à MAX_COLS, par défaut 0
    Declare Property BuildTags(inumcol as Integer) As Byte    ' Copie la colonne inumcol dans la colonne d'index (coltags) par défaut
    Declare Property ClearTag(str_Tag As String) As Byte       ' Met le tag spécifié à blanc si il existe (peut permettre de purger des doublons)
    Declare Property ClearTag() As Byte                                  ' Met à blanc le Tag courant (suppression logique)
    Declare Property UniqueTags() As Byte                             ' Renvoie 1 si clef uniques, sinon 0
    Declare Property UniqueTags(i as Byte) As Byte                'Définie la méthode de recherche (depuis le suivant ou début de liste) pour Tag, HasTag, ClearTag, ValTag. 1=Unique tags, 0=clefs multiples
    'DATAs management (VB like)
    Declare Property Val(str_value As String) As listnode Ptr    'Réécrit la valeur contenue dans le node du Tag courant
    Declare Property Val() As String                                          'Renvoie la valeur contenue dans le node du Tag courant
    Declare Property ValTag(str_value As String) As String      'Renvoi la valeur contenue dans le premier tag de valeur str_value, ne modifie pas la position du pointeur dans la liste   
    'DATAs management (extra values)
    Declare Property ColSep() As String                                    'Renvoi le separateur de colonne actif sur la liste
    Declare Property ColSep(s As String) As Byte                     'Défini le(s) caractère(s) de séparation de colonnes  (par défaut csv = ";")
    Declare Property ColData(b As uByte) As Byte                   ' Default working col in data values using sep for ColPick & ColWrite
    Declare Property ColPick As String                                    'ColPick with inumcol = ColData default value
    Declare Property ColPick(inumcol As uByte) As String      'Retourne la valeur chaine en inumcol position dans sdata
    Declare Property ColWrite(s_val As String) As Byte          'Write current tag to col n° ColData         
    Declare Property Implode(LList As List) As String               'Transforme une liste en chaîne concaténation des valeurs séparées par ColSep, les Tags ne sont pas repris
    Declare Property Explode(sExp As String) As List              'Transforme une chaîne en liste en utilisant ColSep, Tag(0)=indice (adressage comme pour un tableau avec Tag(indice)), Tag(1)=valeur, val=valeur
    Declare Property Filter(s As String) As Byte                        'For Compress & LookUp : a string that replace logical suppression filter ("")
    Declare Property LookUp(str_Tag As String) As List 'LookUp("Tag"), LookUp("~Tag") from last search, LookUp(".Tag") from current, LookUp(".*Tag*")containing 'Tag' from current, LookUp("%") compress,LookUp("") all deletions or filter
    Declare Property Regroup() As List                                    'Actif sur ColTags, Renvoie une copie de la liste avec les Tags identiques qui se suivent les uns les autres (regroupés mais non triés)
    Declare Property Regroup(i As Byte) As List                       ' i=n° de col de tags de regroupement
    Declare Property Compress() As Byte
    Declare Property Compress(i As integer) As Byte               'equivalent to LookUp("%") but on current List, no new copy. i=n°col de tag. Use Filter for simple LookUp on current List
    'FLOW control (VB like)
    Declare Property AllOf() As Ulong                                      ' Return nb node & positionne le Tag courant sur le premier élément de la liste (GoTop & return Count) AllOf+BlindStep equiv to ForAll
    Declare Property BlindStep() As listnode Ptr                      ' BLIND increment Positionne le Tag suivant comme Tag courant, sans vérifier si la fin de liste (method=0)     
    Declare Property Drop() As listnode Ptr     
    Declare Property DropAll As Byte                                        'Remove all elements in list
    'FLOW control (extra values)
    Declare Property Count() As Ulong                                    ' Return nb node
    Declare Property Drop(p As listnode Ptr) As listnode Ptr
    Declare Property BlindStep(i As Long) As listnode Ptr        ' Positionne le Tag à +/- n positions 0=dernier de liste (default Bsm=1)
    Declare Property Bsm(i As Byte) As Byte                            'BlindStep method 0=fastest 1=no crash default=1
    Declare Property Take() As listnode Ptr                             ' Memorise listnode ptr dans le pointeur n°0
    Declare Property Take(i As ulong) As listnode Ptr              ' Memorise listnode ptr dans le pointeur n°i
    Declare Property Retake() As listnode Ptr                          ' Repositionne l'élément courant de la liste sur celui mémorisé par Take, si cet élément existe toujours, sinon renvoie False
    Declare Property Retake(i As ulong) As listnode Ptr           ' Repositionne l'élément courant de la liste sur celui mémorisé par Take(i)
    Declare Property BRetake() As listnode Ptr
    Declare Property BRetake(i As ulong) As listnode Ptr        ' Idem Retake sans vérification de validité du Tag (+ rapide)
    'SPECIAL utilities (extra values)
    Declare Property Preserve() As Byte                                  ' All nodes are stored in list object
    Declare Property Preserve(tList As List) As Byte                 'In a variable scope about to be lost, stores all node of tList in current list object     
    Declare Property Redim() As Byte                                       'Reallocate list object in current variable scope, restore "preserved" nodes
    Declare Property Exdim() As List                                         'Idem redim to a new list
    Declare Property Save(sFilename As String) As Byte
    Declare Property Load(sFilename As String) As Byte   
    Declare Property ClearMem() As Byte
    'POINTERs handling (extra values)
    Declare Property Current() As Listnode Ptr                           'Current & Index are Special propertys for working with pointers
    Declare Property Current(pcurse As Listnode Ptr) As byte   'Sometimes, you may prefer a manuel handle to pointers, instead automatic Tags used as keys, for better performances or others
    Declare Property Index() As Listnode Ptr                             'Thus, Index property is the only way  to access pIndex Ptr in listnode
    Declare Property Index(pcurse As Listnode Ptr) As byte      'Code exemples how to build & to use an Index are shown above
    'CONSTRUCTOR & DESTRUCTOR
    Declare Constructor()         
    Declare Destructor() 
    'OPERATORs - FLOW control                       ' ------------------- not implemented yet   
    Declare Operator += (ByRef tList as List)       ' Concatène à la liste courante, sauf si clef unique et déjà dans List
    Declare Operator -= (ByRef tList as List)        ' Remplace dans List par leur valeur dans tList tous les tags présents dans List et tList
    Declare Operator *= (ByRef tList as List)        ' Concatène à la liste courante, créé de tag "*Tag"   
    Declare Operator /= (ByRef tList as List)       ' Retire les "*Tag" de la liste courante les valeurs identiques ayant le même tag dans tList       
    Declare Operator & (ByRef tList as List)         ' Replicate
End Type
'PRIVATE
Property List.AllowCake() As listnode Ptr :Dim pTemp As listnode Ptr : pTemp = CAllocate(Len(listnode)) : Return pTemp : End Property
'FILE LEVEL
Type FileLink 'Not cooked yet
Private:
    Dim FileLinkList As List
    Dim FileString As String
    Dim FileKeyCol As Integer
    Dim FileUsedCols As String
    Dim FileCursor As uLong
    Dim FileSetNum As uLong
Public:
    'Working tools
    'Declare Property GetList As List
    Declare Property SetList(byref ResList As List) As Byte
    Declare Property ReadFile As byte
    Declare Property UpdateFile As byte
    Declare Property UpdateList As byte
    Declare Property WriteFile As byte
    'Object Status
    Declare Property KeyCol As Integer
    Declare Property KeyCol(i As Integer) As Integer
    Declare Property PtColumns As String
    Declare Property PtColumns(scol As String) As String
    Declare Property Cursor As uLong
    Declare Property Cursor(u As uLong) As uLong
    Declare Property LineSet As uLong
    Declare Property LineSet(u As uLong) As uLong
    Declare Constructor()
End Type
'FUNCTION LEVEL
    'FILEs utilities
    Declare Function ListLoad_csv(tList as List, FileString As String, sColumns As String, ustart as Ulong, unum as Ulong) As List      ' Load "FileString" in List, filtering "sColumns" list from "ustart" line writing "unum" lines
    Declare Function ListWrite_csv(tList as List, FileString As String, sColumns As String, tagstart as String, unum as Ulong) As List ' Overwrite "FileString" from tList with columns sColums from tagstart to tagend
'CODE
'-------------------TAGs management-------------------
Property List.Tag(str_Tag As String) As listnode Ptr
    Dim pTemp As listnode Ptr : Dim item As ListContainer
    If this.sSearchTag = str_Tag then         'Tag est déjà cherché
        If this.bSearchRes=1 Then               'Tag est en statut "trouvé" 
            pTemp = this.pSearchNode
        Else                                                    'sSearchTag doit être à jour
            pTemp = this.pLastNode
            this.uCount += 1
            pTemp->pNext = this.AllowCake() 'And eat it - CAllocate(Len(listnode))
            pTemp->pNext->pPrev = pTemp
            pTemp->pNext->ListData = item
            pTemp->pNext->Tag(uTag) = str_Tag
            pTemp = pTemp->pNext
            this.pLastNode = pTemp   
        End if       
    Elseif this.sWrkngTag(0) = str_Tag then   'Tag est pointé par travail       
        pTemp = this.pWrkngNode(0)
    Else  'Recherche dans la liste
        If this.bSeekMethod=1 Then
            pTemp = this.pFirstNode
        Else
            pTemp = this.pNode
            If pTemp->pNext <> 0 Then : pTemp = pTemp->pNext : End If
        End If       
        While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag)
            pTemp = pTemp->pNext
        Wend
        if pTemp->Tag(uTag) = str_Tag then
            'Tag trouvé, pointeur pTemp ok
        Else 'Nouveau       
            this.uCount += 1
            pTemp->pNext = this.AllowCake() 'And eat it - CAllocate(Len(listnode))
            pTemp->pNext->pPrev = pTemp
            pTemp->pNext->ListData = item
            pTemp->pNext->Tag(uTag) = str_Tag
            pTemp = pTemp->pNext 'Le Tag courant devient aussi le pointeur courant de l'objet
            this.pLastNode = pTemp   
        End If   
    End If
    this.pNode = pTemp
    Return pTemp
End Property

Property List.Tag() As String   
    Return this.pNode ->tag(uTag)
End Property

Property List.HasTag(str_Tag As String) As Byte
    Dim pTemp As listnode Ptr     
    Dim item As ListContainer
    this.sSearchTag = str_Tag   
    If this.bSeekMethod=1 Then
        pTemp = this.pFirstNode 'on commence au premier
    Else 'Clefs multiples : on commence au Tag qui suit immédiatement le Tag courant
        pTemp = this.pNode
        If pTemp->pNext <> 0 Then
            pTemp = pTemp->pNext '
        Else 'Si on est en fin de liste
            this.bSearchRes = 0
            Return 0           
        End If
    End If   
    While (pTemp->pNext <> 0 And pTemp->Tag(uTag) <> str_Tag)
        pTemp = pTemp->pNext
    Wend
    if pTemp->Tag(uTag) = str_Tag then
        this.pSearchNode = pTemp       
        this.bSearchRes = 1
        Return 1
    Else : this.bSearchRes = 0 : Return 0 : End If   
End Property
'TAGs management (extra values)
Property List.BlindTag(str_Tag As String) As listnode Ptr
    Dim pTemp As listnode Ptr
    Dim item As ListContainer
    pTemp = this.pLastNode
    this.uCount += 1
    pTemp->pNext = this.AllowCake() 'And eat it - CAllocate(Len(listnode))
    pTemp->pNext->pPrev = pTemp
    pTemp->pNext->ListData = item
    pTemp->pNext->Tag(uTag) = str_Tag
    pTemp = pTemp->pNext
    this.pLastNode = pTemp
    this.pNode = pTemp
    Return pTemp
End Property

Property List.Tag(i As Integer) As String   
    Return this.pNode ->tag(i)
End Property

Property List.RwTag(s_Tag As String) As listnode Ptr
    this.pNode ->tag(uTag) = s_Tag
    Return this.pNode
End Property

Property List.ColTags() As Byte
    Return(this.uTag)
End Property

Property List.ColTags(i as Byte) As Byte
    this.sSearchTag = "" : this.bSearchRes=0
    If i > ubound(this.pNode->Tag) then
        this.uTag=Ubound(this.pNode->Tag) : Return 0
    Else : this.uTag=i : Return 1 :End If       
End Property

Property List.BuildTags(inumcol as Integer) As Byte
    Dim pTemp As Listnode Ptr : Dim i As uLong : pTemp = this.pNode   
    For i=1 To this.AllOf : this.BlindStep : this.RwTag( this.ColPick(inumcol) ) : Next i
    this.pNode = pTemp : Return 1
End Property

Property List.ClearTag(str_Tag As String) As Byte
     If this.sSearchTag = str_Tag And this.bSearchRes then 'print "No loop"
        this.pSearchNode->Tag(uTag) = "" : this.sSearchTag = "" : Return 1
    ElseIf this.HasTag(str_Tag) then
        this.pSearchNode->Tag(uTag) = "" : this.sSearchTag = "" : Return 1
    Else : Return 0 : End if
End Property

Property List.ClearTag() As Byte
    If this.pNode->Tag(uTag) = this.sSearchTag then : this.sSearchTag = "" : End If
    this.pNode->Tag(uTag) = "" : Return 1
End Property

Property List.UniqueTags() As Byte :Return this.bSeekMethod : End Property
Property List.UniqueTags(i as Byte) As Byte
    If i=1 Then : this.bSeekMethod = 1 : Else : this.bSeekMethod = 0 : End If
    Return this.bSeekMethod
End Property

'-------------------DATAs management-------------------
Property List.Val(str_value As String) As listnode Ptr
    this.pNode->ListData.sData = str_value
    Return this.pNode 'pTemp
End Property

Property List.Val() As String
    Return this.pNode->ListData.sData
End Property

Property List.ValTag(str_value As String) As String
    Dim pTemp As listnode Ptr
    If this.sSearchTag = str_value Then         'Tag est déjà cherché
        pTemp = this.pSearchNode
        Return pTemp->ListData.sData
    Elseif this.sWrkngTag(0) = str_value Then   'Tag est pointé par travail       
        pTemp = this.pWrkngNode(0)
        Return pTemp->ListData.sData
    Elseif this.HasTag(str_value) Then
        pTemp = this.pSearchNode 
        Return pTemp->ListData.sData
    End If
    Return(LIST_ERR) 
End Property

'DATAs management (extra values)
Property List.ColSep() As String : Return this.sIdent : End Property
Property List.ColSep(sep As String) As Byte : this.sIdent=sep : Return 1 : End Property
Property List.ColData(inumcol As uByte) As Byte : this.bCol=inumcol  : Return 1 : End Property

Property List.ColPick() As String : Return this.ColPick(this.bCol ) : End Property
Property List.ColPick(inumcol As UByte) As String   
    Dim ResStr As String : Dim s_wrk As String
    Dim iLen As Integer : Dim iStart As Integer : Dim icol As Integer   
    If Right(trim(this.Val),1)<>this.sIdent Then : s_wrk = this.Val+this.sIdent : Else : s_wrk = this.Val : End If
    iLen = len(this.sIdent) :iStart = 1 : icol = 0 : inumcol -=1
    While icol < inumcol
        iStart = Instr(iStart, s_wrk, this.sIdent) : icol += 1 : iStart += 1
    Wend
    iStart -= 1
    ResStr = Right(s_wrk, len(s_wrk)-iStart-iLen+1)  ' iStart -= 1
    ResStr = Left(ResStr, Instr(ResStr, this.sIdent)-1)   
    Return ResStr
End Property

Property List.ColWrite(s_val As String) As Byte   
    Dim sResLeft As String : Dim sResRight As String
    Dim iLen As Integer : Dim iStart As Integer : Dim icol As Integer : Dim inumcol As uByte
    iLen = len(this.sIdent) :iStart = 1 : icol = 0 : inumcol =  this.bCol-1
    While icol < inumcol 
        iStart = Instr(iStart, this.Val, this.sIdent) : icol += 1 : iStart += 1
    Wend   
    iStart -= 1
    sResLeft = Left(this.Val,iStart+iLen-1)
    iStart = Instr(iStart+1, this.Val, this.sIdent)
    sResRight = Right(this.Val, len(this.Val)-iStart+1)
    this.Val(sResLeft & s_val & sResRight )
    Return 1
End Property

Property List.Implode(tList As List) As String
    Dim ResultString As String : Dim i As uLong
    For i=1 to tList.AllOf : tList.BlindStep
        ResultString = ResultString + tList.Val + this.sIdent 
    Next i   
    Return ResultString
End Property

Property List.Explode(sExp As String) As List
    Dim ResultList As List : Dim sTmp As String
    Dim sval As String : Dim iLen As Integer : Dim posi As uLong : Dim iCount As uLong
    sTmp = sExp
    iLen = len(this.sIdent) : iCount = 1
    If Left(sTmp, iLen) = this.sIdent Then : sTmp= Right(sTmp, len(sTmp)-iLen) : End If
    If Right(sTmp, iLen) <> this.sIdent Then sTmp = sTmp & this.sIdent : End If
    posi = Instr(sTmp, this.sIdent)
    While posi <> 0   
        sval = Left(sTmp, posi-1)   
        ResultList.Tag(str(iCount)) : ResultList.Val(sval)
        sTmp = Right(sTmp, len(sTmp)-posi-iLen+1)
        iCount += 1
        posi = Instr(sTmp, this.sIdent)       
    Wend
    Return ResultList
End Property

Property List.Filter(s As String) As Byte : this.SFilter=s : Return 1 : End Property
Property List.LookUp(str_Tag As String) As List
    Dim TempList As List : Dim pTemp As listnode Ptr : Dim i as uLong : Dim IsCompress As Byte=0 : Dim IsAll As Byte=0
    Dim iLeft As Byte = 0 : Dim iRight As Byte = 0 : Dim iposi As Integer : Dim sTag As string : Dim uNum As uLong
    TempList.ColTags(this.ColTags) : TempList.UniqueTags(this.UniqueTags) : TempList.ColSep(this.ColSep)
    uNum=this.uCount
    i = len(str_Tag)
    If Left(str_Tag,1)="~" And This.bSearchRes Then
        pTemp = This.pSearchNode : str_Tag = Right(str_Tag,i-1) : i -= 1
    ElseIf Left(str_Tag,1)="." Then
        pTemp = This.pNode : str_Tag = Right(str_Tag,i-1) : i -= 1
    Else : pTemp = This.pFirstNode : IsAll=1 : End If       
    If Left(str_Tag,1)="*" Then : str_Tag = Right(str_Tag,i-1) : i -= 1 : iLeft = 1 : End If
    If Right(str_Tag,1)="*" Then : str_Tag = Left(str_Tag,i-1) : i -= 1 : iRight = 1 : End If 
    If str_Tag = "%" Then : IsCompress =1 : End If
   
    'Pas très élégant mais il est préférable de tester en dehors de la boucle quand cela est possible   
    If IsCompress=1 Then
        If IsAll=1 Then
            For i=1 To uNum           
            pTemp = pTemp->pNext
            If pTemp->Tag(This.uTag) <> this.sFilter Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For iposi=0 To MAX_COLS-1 : TempList.pNode->tag(iposi) = pTemp->Tag(iposi) : Next iposi
            End If
            Next i
        Else
            Do
            pTemp = pTemp->pNext
            If pTemp->Tag(This.uTag) <> this.sFilter Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
            End If
            Loop Until pTemp->pNext = 0
        End If
    ElseIf str_Tag = this.sFilter And (iLeft=1 Or iRight=1) Then 'str_tag = "*", "**","***"
        Do
            pTemp = pTemp->pNext
            TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
            For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
        Loop Until pTemp->pNext = 0
    ElseIf iLeft And iRight Then
        Do
            pTemp = pTemp->pNext
            If Instr(pTemp->Tag(This.uTag), str_Tag) <>0 Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
            End If
        Loop Until pTemp->pNext = 0
    Elseif iLeft Then
        Do
            pTemp = pTemp->pNext
            sTag = pTemp->Tag(This.uTag) : iposi = Instr(sTag, str_Tag)
            If iposi <>0 And Right(sTag, i) = str_Tag Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
            End If       
        Loop Until pTemp->pNext = 0
    Elseif iRight Then           
        Do
            pTemp = pTemp->pNext
            sTag = pTemp->Tag(This.uTag) : iposi = Instr(sTag, str_Tag)
            If iposi <>0 And Left(sTag, i) = str_Tag Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
            End If       
        Loop Until pTemp->pNext = 0
    Else
        If IsAll=1 Then
            For i=1 To uNum
            pTemp = pTemp->pNext
            If pTemp->Tag(This.uTag) = str_Tag Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For iposi=0 To MAX_COLS-1 : TempList.pNode->tag(iposi) = pTemp->Tag(iposi) : Next iposi               
            End If                   
            Next i
        Else
            Do       
            pTemp = pTemp->pNext
            If pTemp->Tag(This.uTag) = str_Tag Then
                TempList.BlindTag(str_Tag) : TempList.Val(pTemp->ListData.sData)
                For i=0 To MAX_COLS-1 : TempList.pNode->tag(i) = pTemp->Tag(i) : Next i
            End If                   
            Loop Until pTemp->pNext = 0 
        End If
    End If
    Return TempList   
End Property

Property List.Regroup() As List
    Return this.Regroup(this.uTag)
End Property
Property List.Regroup(i As Byte) As List
    Dim ResultList As List      'Résultat
    Dim TestList As List         'Liste des Tags déjà groupés
    Dim tmpList As List          'Pour les LookUp
    Dim pTemp As listnode Ptr
    Dim sTag As String
    Dim u As ulong   
    Dim t As Integer
    Dim iTag As Byte
    iTag = i
    pTemp = This.pFirstNode 
    Do
        sTag = pTemp->Tag(iTag)
        If TestList.HasTag(sTag)=0 Then
            TestList.BlindTag(sTag)
            tmpList = this.LookUp(sTag)
            For u=1 To tmpList.AllOf : tmpList.BlindStep
                ResultList.BlindTag(sTag)
                ResultList.Val(tmpList.Val)
                For i=0 to MAX_COLS-1 : ResultList.pNode->tag(i) = tmpList.pNode->Tag(i) : Next i           
            Next u           
        End If       
        pTemp = pTemp->pNext
    Loop Until pTemp->pNext = 0   
    ResultList.bSeekMethod = this.bSeekMethod : ResultList.uTag = this.uTag : ResultList.sIdent = this.sIdent
    Return ResultList
End Property

Property List.Compress As Byte : this.Compress(0) : Return 1 : End Property
Property List.Compress(inum As Integer) As Byte   
    Dim i As uLong : this.pNode = this.pLastNode
    For i=1 to this.uCount
        If this.Tag(inum) = this.sFilter then : this.Drop : End If
        this.pNode = this.pNode->pPrev
    Next i
    Return 1
End Property

'-------------------FLOW control-------------------
Property List.AllOf() As Ulong : this.pNode = this.pFirstNode : Return this.Count : End Property

Property List.BlindStep() As listnode Ptr
    this.pNode = this.pNode->pNext
    Return this.pNode
End Property

Property List.Drop As listnode Ptr : Return this.Drop(this.pNode) : End Property

Property List.DropAll As Byte   
    Dim i As Integer
    Dim pTemp As listnode Ptr       
    pTemp = this.pFirstNode
    While (pTemp <> 0)
        this.pnode = pTemp
        pTemp =  pTemp->pNext           
        Deallocate this.pnode
    Wend
    pNode = this.AllowCake()
    pFirstNode = pNode
    pLastNode = pNode
    bSeekMethod = 1
    uCount = 0 : uTag = 0
    pNode->Tag(uTag) = "Reserved"
    pNode->ListData.sData = "Reserved"
    sSearchTag = ""
    For i=0 to Ubound(sWrkngTag)
        sWrkngTag(i)=""
    Next i
    Return 1
End Property

'FLOW control (extra values)
Property List.Count() As Ulong : Return this.uCount : End Property

Property List.Drop(pTemp As listnode Ptr)  As listnode Ptr   
    If this.uCount = 0 Then Return pTemp End If
    Dim pRes As listnode Ptr : Dim pPrev As listnode Ptr : Dim pNext As listnode Ptr : Dim i As Integer
    pRes  = pTemp
    If pTemp-> pPrev <> 0 Then
        pPrev = pTemp->pPrev
        pPrev->pNext = pTemp->pNext
        pRes = pPrev
    Else : this.pFirstNode = pRes: End If   
    If pTemp-> pNext <> 0 Then
        pNext = pTemp->pNext
        pNext->pPrev = pTemp->pPrev
        pRes = pNext
    Else : this.pLastNode = pRes : End If
    this.uCount -=1
    For i = 1 To MAX_TAKE-1
        If this.pWrkngNode(i) = pTemp Then
            this.pWrkngNode(i) = 0 : this.sWrkngTag(i) = ""
        End If
    Next i
    If this.pSearchNode = pTemp Then : this.bSearchRes=0 : End If
    Deallocate pTemp : this.pNode = pRes : Return pRes
End Property

Property List.BlindStep(top As Long) As listnode Ptr   
    Dim As Long i, istep   
    If top>0 Then : istep = 1 :
        If this.bStepCheck=1 Then
            For i=1 To top step istep : If this.pNode->pNext <> 0 Then : this.pNode = this.pNode->pNext : End If : Next i
        Else
            For i=1 To top step istep : this.pNode = this.pNode->pNext : Next i
        End If       
    ElseIf top = 0 Then
        this.pNode = this.pLastNode
    Else : istep = -1 :
        If this.bStepCheck=1 Then
            For i=-1 To top step istep : If this.pNode->pPrev <> 0 Then : this.pNode = this.pNode->pPrev : End If : Next i
        Else
            For i=-1 To top step istep :this.pNode = this.pNode->pPrev : Next i
        End If
    End If
    Return this.pNode
End Property

Property List.Bsm(i As Byte) As Byte : this.bStepCheck=i : Return this.bStepCheck : End Property

Property List.Take() As listnode Ptr : Return this.Take(0) : End Property
Property List.Take(i as ulong) As listnode Ptr
    If ubound(this.pWrkngNode) < i then
        i = ubound(this.pWrkngNode)
    End If
    this.pWrkngNode(i) = this.pNode
    this.sWrkngTag(i) = this.pNode->Tag(uTag)   
    Return this.pNode
End Property

Property List.Retake() As listnode Ptr : Return this.Retake(0) : End Property
Property List.Retake(i as ulong) As listnode Ptr
    If ubound(this.pWrkngNode) < i then : i = ubound(this.pWrkngNode) : End If
    If this.HasTag(this.sWrkngTag(i)) then
        this.pNode = this.pSearchNode
        Return this.pNode
    Else : Return 0 : End if
End Property

Property List.BRetake() As listnode Ptr : Return this.BRetake(0) : End Property
Property List.BRetake(i as ulong) As listnode Ptr
    this.pNode = this.pWrkngNode(i)
    Return this.pNode
End Property

'-------------------SPECIAL UTILITIES------------------
Property List.Preserve As Byte : this.Preserve(this) : Return 1 : End Property
Property List.Preserve(tList As List) As Byte
    Dim i As ulong : Dim u As integer
    Dim pTemp As listnode Ptr
    'this.wPreserve = ""
    pTemp = tList.pFirstNode   
    For i=1 to tList.Count
        tList.pnode = pTemp
        pTemp =  pTemp->pNext   
        For u = 0 to MAX_COLS-1
            this.wPreserve = this.wPreserve+PRES_SEP+pTemp->Tag(u)
        Next u
        this.wPreserve = this.wPreserve+PRES_SEP+pTemp->ListData.sData+PRES_LINE_SEP
    Next i
    Return 1   
End Property 

Property List.Redim As Byte : this= this.Exdim : this.wPreserve = "" : Return 1 : End Property 
Property List.Exdim As List
Dim i As ulong : Dim u As uLong : Dim s_colsep As String : Dim tList As List 
Dim tempList1 As list : Dim tempList2 As list ': Dim pTemp As listnode Ptr 'this.uCount=0
If this.wPreserve <> "" Then
    s_colsep = this.ColSep
    this.ColSep(PRES_LINE_SEP)
    tempList1 = Explode(this.wPreserve)
    this.ColSep(PRES_SEP)
    For i=1 to tempList1.AllOf : tempList1.BlindStep       
        tempList2 = Explode(tempList1.Val) : tempList2.AllOf : tempList2.BlindStep
        tList.BlindTag(tempList2.Val)
        For u=2 to (tempList2.Count)-1 : tempList2.BlindStep
            tList.ColTags(u-1) : tList.RwTag(tempList2.Val)
        Next u
        tempList2.BlindStep
        tList.Val(tempList2.Val)       
        tList.ColTags(0)
    Next i   
End If
tList.ColTags(this.ColTags) : tList.UniqueTags(this.UniqueTags) : tList.ColSep(s_colsep) : tList.Filter(this.sFilter)
Return tList
End Property 

Property List.Save(sFilename As String) As Byte
    Dim filenum As Integer : filenum = FreeFile
    open sFilename for binary Access Write as #filenum
    Put #filenum, , this.wPreserve
    close #filenum
    Return 1
End Property 

Property List.Load(sFilename As String) As Byte   
    Dim filenum As Integer : filenum = FreeFile : Dim str_read As String : Dim pmem As String Ptr   
    Open sFilename for binary Access Read as #filenum
    str_read = space(LOF(filenum))
    Get #filenum, , str_read     
    this.wPreserve = str_read
    close #filenum   
    Return 1
Return 1
End Property 

Property List.ClearMem() As Byte : this.wPreserve = "" : Return 1 : End Property 

'-------------------POINTERs handling-------------------
Property List.Current() As Listnode Ptr : Return this.pNode : End Property
Property List.Current(pcurse As Listnode Ptr) As byte : this.pNode = pcurse : Return 1 : End Property
Property List.Index() As Listnode Ptr : Return this.Pnode->pIndex : End Property
Property List.Index(pcurse As Listnode Ptr) As byte : this.Pnode->pIndex = pcurse : Return 1 : End Property

'-------------------Constructor & Destructor-------------------
Constructor List()
    pNode = AllowCake() ' Moment angulaire(petite masse)
    pFirstNode = pNode : pLastNode = pNode : bSeekMethod = 1 : uCount = 0 : uTag = 0
    pNode->Tag(uTag) = LIST_RES : pNode->ListData.sData = LIST_RES : sIdent = ";" : sFilter = ""
End Constructor
Destructor List()       
End Destructor

'-------------------OPERATORs-------------------
'Not implemented yet
Operator List.+= (ByRef tList1 as List)
    print str(this.uTag)+"-"+this.sIdent
End Operator

Operator List.-= (ByRef tList1 as List)
    print str(this.uTag)+"-"+this.sIdent
End Operator

Operator List.*= (ByRef tList1 as List)
    print str(this.uTag)+"-"+this.sIdent
End Operator

Operator List./= (ByRef tList1 as List)
    print str(this.uTag)+"-"+this.sIdent
End Operator

'---------------FILE LINK object ---------------
'Not implemented yet

' FUNCTION LEVEL
'-------------------FILEs utilities-------------------
Function ListLoad_csv(tList as List, FileString As String, sColumns As String="", ustart as Ulong = 1, unum as Ulong = 0)  As List 
    Dim Tmp_LineList_1 As List
    Dim Tmp_LineList_2 As List
    Dim STR_LigneFichier As String
    Dim INT_File As Integer
    Dim i As uLong : Dim t As uLong
   INT_File = Freefile()
   Open FileString For Input As INT_File
    If Err>0 Then : Return tList : End If   
    If ustart<1 Then : ustart=1 : End If
    i=ustart     
    Line Input #INT_File, STR_LigneFichier
    While Not Eof(INT_File) And ustart > 1
        ustart = ustart-1 : Line Input #INT_File, STR_LigneFichier   
    Wend       
    If sColumns <> "" Then
        Tmp_LineList_1 = tList.Explode(sColumns)
        Tmp_LineList_2.Tag("1") : Tmp_LineList_2.Val(STR_LigneFichier) : STR_LigneFichier = ""
        For t=1 To Tmp_LineList_1.AllOf : Tmp_LineList_1.BlindStep
            STR_LigneFichier = STR_LigneFichier+Tmp_LineList_2.ColPick( CInt(Tmp_LineList_1.Val) )+tList.ColSep
        Next t
    End If
    tList.BlindTag(str(i)) : tList.val(STR_LigneFichier)       
    If unum=0 Then
        If sColumns <> "" Then           
            While Not Eof(INT_File)
                i=i+1
                Line Input #INT_File, STR_LigneFichier   
                Tmp_LineList_2.Tag("1") : Tmp_LineList_2.Val(STR_LigneFichier) : STR_LigneFichier = ""
                For t=1 To Tmp_LineList_1.AllOf : Tmp_LineList_1.BlindStep
                    STR_LigneFichier = STR_LigneFichier+Tmp_LineList_2.ColPick(CInt(Tmp_LineList_1.Val))+tList.ColSep
                Next t
                tList.BlindTag(str(i)) : tList.val(STR_LigneFichier)       
            Wend
        Else
            While Not Eof(INT_File)
                i=i+1
                Line Input #INT_File, STR_LigneFichier              
                tList.BlindTag(str(i)) : tList.val(STR_LigneFichier)       
            Wend
        End If       
    Else
        unum=unum-1
        If sColumns <> "" Then                   
            While Not Eof(INT_File) And unum > 0
                i=i+1
                Line Input #INT_File, STR_LigneFichier   
                Tmp_LineList_2.Tag("1") : Tmp_LineList_2.Val(STR_LigneFichier) : STR_LigneFichier = ""
                For t=1 To Tmp_LineList_1.AllOf : Tmp_LineList_1.BlindStep
                    STR_LigneFichier = STR_LigneFichier+Tmp_LineList_2.ColPick(CInt(Tmp_LineList_1.Val))+tList.ColSep
                Next t
                tList.BlindTag(str(i)) : tList.val(STR_LigneFichier)
                unum=unum-1
            Wend
        Else           
            While Not Eof(INT_File) And unum > 0
                i=i+1
                Line Input #INT_File, STR_LigneFichier              
                tList.BlindTag(str(i)) : tList.val(STR_LigneFichier)
                unum=unum-1
            Wend
        End If
    End If
    Close #INT_File
    Return tList
End Function

Function ListWrite_csv(tList as List, FileString As String, sColumns As String="", tagstart As String="", tagend As String="")  As List
    Dim Tmp_LineList_1 As List : Dim Tmp_LineList_2 As List : Dim pTemp1 As Listnode Ptr : Dim pTemp2 As Listnode Ptr
    Dim STR_LigneFichier As String : Dim INT_File As Integer : Dim i As Ulong : INT_File = Freefile()
    Open FileString For Output As INT_File
    If Err>0 Then : Return tList : End If   
    'pTemp1 = tList.Current
    If tagstart = "" Then
        tList.AllOf
        pTemp2 = tList.BlindStep
    Else
        pTemp2 = tList.Tag(tagstart)
    End if
    pTemp2 = pTemp2->pPrev
    If sColumns <> "" Then
        Tmp_LineList_1 = tList.Explode(sColumns)       
        Do 
            pTemp2 = pTemp2->pNext
            For t=1 To Tmp_LineList_1.AllOf : Tmp_LineList_1.BlindStep
                STR_LigneFichier = STR_LigneFichier+tList.ColPick(Cint(Tmp_LineList_1.Val))+tList.ColSep
            Next t
            Write #INT_File, STR_LigneFichier
        Loop Until pTemp->pNext = 0 And tagend <> pTemp2->Tag(this.uTag)
    Else       
        Do
            pTemp2 = pTemp2->pNext
            STR_LigneFichier = tList.Val
            Write #INT_File, STR_LigneFichier
        Loop Until pTemp->pNext = 0 And tagend <> pTemp2->Tag(this.uTag)
    End If
    Close #INT_File : Return tList
End Function



'END CODE
Lost Zergling
Posts: 334
Joined: Dec 02, 2011 22:51
Location: France

Re: stack of unidirectional linked list

Postby Lost Zergling » Feb 08, 2012 22:39

Code: Select all

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------- CODE EXAMPLES START HERE ---------------------------------------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function ShowCurrent(tmpList As List) As Byte
    Print "Tag 0=" & tmpList.Tag(0) & " - Tag 1=" & tmpList.Tag(1)  & " - data=" & tmpList.Val : return 1
End Function
' Demos & tutorials here, just read, choose an example & fast execute
Dim MaListe as List
Dim i As uLong
Declare Function Example_01(MaListe As List) As Byte
Declare Function Example_02(MaListe As List) As Byte
Declare Function Example_03(MaListe As List) As Byte
Declare Function Example_04(MaListe As List) As Byte
Declare Function Example_05(MaListe As List) As Byte
Declare Function Example_06(MaListe As List) As Byte
Declare Function Example_07(MaListe As List) As Byte
Declare Function Example_08(MaListe As List) As Byte


'Example_01(MaListe)  ' ALL COMMON BASIC OPERATIONS VB/LS Like : setting, accessing, parse, seek, test, remove
'Print "Redim Maliste & accessing :"
'MaListe.Redim 'Nodes where lost due to variable scope
'For i = 1 To MaListe.AllOf : MaListe.BlindStep : ShowCurrent(MaListe) : Next : sleep :  Input "Bugging.."; i
'Example_02(MaListe) ' LOOKUP, REGROUP, BUILDTAGS AND SEEK
'Example_03(MaListe) ' IMPLODE and EXPLODE a powerfull feature adapted from Lotus world
Example_04(MaListe) ' Handling csv Files
'Example_05(MaListe) ' Working with files (ColPick & ColWrite)
'Example_06(MaListe) ' Building an Index  with Pointers features

Print "Thank you."
Sleep
stop


Function Example_01(MaListe As List) As Byte  ' ALL COMMON BASIC OPERATIONS VB/LS Like : setting, accessing, parse, seek, test, remove
    Dim i As uLong : Dim s_Input As string
    Print "List Fast loading using BlindTag feature - Fast parse & load important on large lists"
    For i=1 to 10
        MaListe.BlindTag(str(i))
        MaListe.Val("VALUE OF " & str(i))
        ShowCurrent(MaListe)
    Next i
    'BlindTag is always a new tag even thouhg tag already exists, but here is not case because "01" is not "1"
    MaListe.BlindTag("01")
    MaListe.Val("VALUE OF 01")
    ShowCurrent(MaListe)
    Print MaListe.Count & " elements in list."
    Print "" : Sleep   
    Print "Accessing Tag 5 wich becomes current tag and changing its value"
    MaListe.Tag("5") : MaListe.Val("NEW Value For 5")
    ShowCurrent(MaListe)
    Print "" : Sleep
   
    Print "Now shows the Take/Retake feature - Taking handle on Tag 5.."
    MaListe.Take
    Print "Performing Fast Parse"
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        Print str(i) & " ALLOF fast performing Tag " & MaListe.Tag & " = " & MaListe.Val
    Next i
    Print "Now cursor is on last element in list"   
    ShowCurrent(MaListe)
    Print "Re-taking,.."
    MaListe.ReTake
    Print "Now cursor is on re-taked element in list" 
    ShowCurrent(MaListe) : Sleep
    Print "Performing direct parse : go back 2 elements previous in list"   
    MaListe.BlindStep(-2)
    ShowCurrent(MaListe)
    Print "" : Sleep
    Print "Now we  want to modify Tag 2, but only if it exists"
    If MaListe.HasTag("2") Then 'note that tag is string
        MaListe.Tag("2")
        Print "Tag '2' exist an cursor is on it"
        ShowCurrent(MaListe)
        Print "Modifying tag 2 : "
        MaListe.Val("NEW Value For 2")
        ShowCurrent(MaListe)
    End If
    Sleep
    Print "Accessing Tag 8"
    MaListe.Tag("8")
    ShowCurrent(MaListe)
    Print "Direct read acces to tag data is either possible, for full vb compliance"
    Print "Tag 4 value = " & MaListe.ValTag("4")
    Print "Please note that current cursor position hasn't been impacted : " & MaListe.Tag   
    Sleep   
    Print "Tag 99 does not exist if we try to access it, it'll be created azap"
    MaListe.Tag("99")   
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        Print "Line " & str(i) & "  Tag value = " & MaListe.Tag & " data = " & MaListe.Val
    Next i   
    Sleep   
    Print "Now the Tag 99 sets its data value to it's tag value"
    MaListe.Val(MaListe.Tag)
    ShowCurrent(MaListe)
    Print "This to illustrate that properties .tag and .val can be used "
    Print " to set or get wether a STRING parameter is passed or not"
    Print "But .tag is key management, so it can't be modified this way,"
    Print " just created or accessed, same behaviour as in vb"
    Print ""
    Sleep
    Print "Logical remove is VB comp because null tags are illegal in vb"
    Print "But number of elements is not updated untill Compress is call"
    Print "And node are still visible with BlindStep...Use DROP property"
    Print "for better VB comp. The choice between clear and drop will"
    Print "depends of your code structure regarding best performances"
    MaListe.ClearTag
    ShowCurrent(MaListe)
    If Not MaListe.HasTag("99") Then
        Print "Tag '99' not found"
    End If
    Print "RwTag is only way modify existing tag - writing '98' in current (ex-99)"
    MaListe.RwTag("98")
    ShowCurrent(MaListe)
    If MaListe.HasTag("98")=1 Then
        Print "Tag '98' found"
    End If
    Sleep
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        ShowCurrent(MaListe)
    Next i 
    Print MaListe.Count & " elements in list"
    Print "Please note that there were more than one possible tags to work with"
    Print "Tag 1, Same behaviour, just set to 1 ColTags property, instead of " & str(MaListe.ColTags)
    Print ""
    Print "Accessing first element in list = GoTop"
    MaListe.AllOf
    ShowCurrent(MaListe)
    Print "First 'hidden' element is reserved, nevertheless it can be accessed"
    MaListe.BlindStep(-1)
    ShowCurrent(MaListe)
    Sleep
    Print "MaListe.AllOf can be used to get first element in list"
    Print "MaListe.BlindStep(0) get last element"
    MaListe.BlindStep(0)
    ShowCurrent(MaListe)
    Sleep
    Print "Now, let's clear tags 4, 5 and 6 "
    MaListe.Tag("4")
    For i=1 To 3
        MaListe.ClearTag : MaListe.BlindStep
    Next i
    Print str(MaListe.Count) & " elements in list : no change"
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        ShowCurrent(MaListe)
    Next i
    sleep
    Print "Compression = physical remove of white tags"
    'MaListe = MaListe.LookUp("%")
    MaListe.Compress
    Print str(MaListe.AllOf) & " elements in list : count changed"
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        ShowCurrent(MaListe)
    Next i
    Sleep
    Print "Dropping All"
    MaListe.DropAll
    Print str(MaListe.AllOf) & " elements in list"
    For i=1 to MaListe.AllOf : MaListe.BlindStep       
        ShowCurrent(MaListe)
    Next i
    Print "Hiden element still here, preventing null pointer"
    MaListe.BlindStep(-1)
    ShowCurrent(MaListe)
   
    Sleep
    Print "Reloading list - Clearing elements : using Drop property"
    For i=1 to 10
    MaListe.BlindTag(str(i))
    MaListe.Val("VALUE OF " & str(i))
    ShowCurrent(MaListe)
    Next i
    Print "accessing 4"
    MaListe.Tag("4")
    ShowCurrent(MaListe)
    Sleep
    For i=1 To 15 : Input "Bugging.."; s_input :  Next i :
    Input "Please enter removing method (1 to 3): "; i   
    If i=1 then
        Print "Removing using while :"
        While MaListe.Count > 0
            ShowCurrent(MaListe)
            MaListe.Drop     
        Wend
    Elseif i=2 then
        Print "Removing using For(All) from end :"
        MaListe.BlindStep(0) 'Last element
        For i = 1 To MaListe.Count
            ShowCurrent(MaListe)
            MaListe.Drop           
        Next
    Elseif i=3 then
        Print "Removing using For(All) from first :"
        MaListe.AllOf : MaListe.BlindStep 'FirstElement
        For i = 1 To MaListe.Count
            ShowCurrent(MaListe)
            MaListe.Drop   
        Next
    Else
        Print "No remove"
    End If
    Print "Don't use blindstep in a For-Next if Drop or Compress in loop"
    Print "BlindStep leads to a crash if node has become first or last element"
    Print "Remaining  : "
    Print "Showing from 1 element to " & str(MaListe.AllOf) & " element"
    For i = 1 To MaListe.AllOf : MaListe.BlindStep
        Print MaListe.Tag & MaListe.Val
    Next
    Print "BlindStep not performed if not enought elements in list"
    Print "For i = 1 To MaListe.AllOf : MaListe.BlindStep should always work"
    Print MaListe.Tag & MaListe.Val   
    For i=15 to 20
        MaListe.BlindTag(str(i))
        MaListe.Val("VALUE OF " & str(i))
    Next i   
    MaListe.Preserve
    print "List preserved"
    sleep :  Input "Bugging.."; s_input
    Dim Maliste2 As List
    MaListe2.Tag("TEST_1") : MaListe2.Val("TEST_ONE")
    MaListe2.Tag("TEST_2") : MaListe2.Val("TEST_TWO")
    MaListe.Preserve(MaListe2)
    print "List MaListe2 preserved in MaListe"   
    Sleep :  Input "Bugging.."; s_input
    Return 1
End Function

Function Example_02(MaListe As List) As Byte ' LOOKUP, REGROUP, BUILDTAGS AND SEEK
    Dim MaListe2 As List
    Dim s_input As String
    Dim i As uLong
    Dim FreeBug As Integer=0
   
    For i=1 to 9
        MaListe.BlindTag(str(i))
        MaListe.Val("Loop;1;" & str(i))   
    Next i
    For i=3 to 6
        MaListe.BlindTag(str(i))
        MaListe.Val("Loop;2;" & str(i))       
    Next i
    For i=4 to 5
        MaListe.BlindTag(str(i))
        MaListe.Val("Loop;3;" & str(i))       
    Next i   
    Print "List contains : " & str(MaListe.Count) & " elements"
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep : FreeBug +=1
    Print "BuildTags is writing all current Tags from a data column"
    Print "We set cursor to tag 1 and use buildtag to read col2 to tag1 :"
    MaListe.ColTags(1)
    MaListe.BuildTags(2)
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep : FreeBug +=1
   
    Print "Tag 1 now contains the number the loop used to fill it"   
    For i=1 To FreeBug
        Input "Please enter a bug number : "; s_input
    Next i : FreeBug -=i
    Print "We load a new list from the one above using LookUp"
    Print "LookUp on Tag 1 : loop number we use to load list"
    Input "Please enter loop number (1 to 3) : "; s_input
   
    MaListe2 = MaListe.LookUp(s_input)
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Print "is a Lookup on Tag 1 (first is 0) from list shown below..."
    Sleep : FreeBug +=1
   
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep : FreeBug +=1
   
    Print "List after groupby on tag 0 :"
    MaListe.ColTags(0)       
    MaListe = MaListe.Regroup()
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep : FreeBug +=1   
   
    Print "List after groupby on tag 1 :"
    MaListe.ColTags(1) 
    MaListe = MaListe.Regroup()   
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
   
    MaListe.AllOf
    MaListe.BlindStep(3)
    Print "Current element is now :"
    ShowCurrent(MaListe)
    Sleep : FreeBug +=1   
    Print "Performing LookUp on Tag " & MaListe.ColTags & " = '1' from current"
    MaListe2 = MaListe.LookUp(".1")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
   
    Print "Performing Tag (search & set cursor) on tag 1 using multiple keys (inc search)"
    MaListe.UniqueTags(0) 'Incremental search
    MaListe.AllOf ' Go top
    MaListe.Tag("1")   
    Print "Current element 1 is now :"
    ShowCurrent(MaListe)
    MaListe.Tag("1")
    Print "Next current element is now :"
    ShowCurrent(MaListe)   
    Print "Tag property performed a stepnext search due to not unique keys"
    Print "HasTag does not impact current element in list, it can be used with"
    Print "Tag to prevent auto creation of a new tag while parsing all tags"
    Print "Performing LookUp on Tag " & MaListe.ColTags & " = '1' from current"   
    MaListe2 = MaListe.LookUp(".1")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Print "Please note that LookUp did not impact cursor position :"
    ShowCurrent(MaListe)
    Sleep : FreeBug +=1   
    Print "We add a new element in List"
    MaListe.BlindTag("1")
    MaListe.Val("Added;1;99")
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep
    Print "Then we are using HasTag instead of Tag : "   
    Print "Performing search on tag '2' using multiple keys (inc search)"
    MaListe.UniqueTags(0) 'Incremental search
    MaListe.AllOf ' Go top
    MaListe.HasTag("2")
    Print "HasTag does not impact search cursor position, it just memorise Last Search"
    Print "Note : to memorise/restore a search starting point we can use Take/BRetake"
    Print "Current element is now :"
    ShowCurrent(MaListe)   
    Print "Performing LookUp on Tag " & MaListe.ColTags & " = '1' from Last Search"   
    MaListe2 = MaListe.LookUp("~1")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Sleep
    Print "Going top & Same search from current"
    MaListe2.AllOf
    MaListe2 = MaListe.LookUp(".1")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Print ""
    Sleep : FreeBug +=1       
    Print "Be care of wich search method you are using"
    Print "If UniqueTags=1 Tag and HasTag are working from top"
    Print "If UniqueTags<>1 Tag and HasTag are working from current (not from last search)"
    Print "Use Tag just after HasTag to perform multikey searches without perf loss"
    Print "LookUp property works from first node, current node or last search depending on"
    Print "the parameter and no matter UniqueTags or not (you can re-use LastSearch)"
    Print "LookUp and Regroup are always working on the currrent column of tags"
    Print "Take(i) & BRetake(i) can be use to memorise and get elements positions in list"
    Print "Retake is safe & equivalent to HasTag+Tag, same tag but no warranty same node"
    Print "Caution : Retakes retake Tag, BRetake (faster) retakes node,.."
    Print "Different behaviour on multi keys or logical removing"
    Print "To take handle on last search, just use Tag after HasTag"
    Sleep
    Print ""
    Print "LookUp support * caracter :"
    MaListe.BuildTags(1)
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Sleep : FreeBug +=1       
    Print "LookUp on *op : "
    MaListe2 = MaListe.LookUp("*op")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Print "LookUp on Add* :"
    MaListe2 = MaListe.LookUp("Add*")
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep
        ShowCurrent(MaListe2)
    Next
    Print ".*String* *String* and ~*string* are valid"
    Sleep
   
    Return 1
End Function

Function Example_03(MaListe As List) As Byte    ' IMPLODE and EXPLODE a powerfull feature adapted from Lotus world
    ' Explode property is a list utility that returns a LIST OBJECT from a string (in ls returns a variant array), like the "split" in Perl but returning a LIST object, not an array.
    ' It can be used to create a list from a data value in a list. Data values can be managed as sub-list, like multi dimensional arrays (may need to manage different separators).
    ' The return value is a list object, so all properties are available.
    ' Implode is building a string data from a List object. Tags column & current tag column, seek method (key unique or not), separator(";" or other) and all Takes are lost
    Dim i As uLong   
    MaListe.DropAll
    MaListe.Tag("01") : MaListe.Val("Smith;vehicles;Ford Must-hang~Ford Phoque-US~Honda Varadodo~trotinette")
    MaListe.Tag("02") : MaListe.Val("Jones;vehicles\childrens;Kia KirNaval~Chevrolet Crevette~Benz In~Rollers\Calamity~John")
    MaListe.Tag("01")
    Print MaListe.Val
    Print MaListe.ColPick(3) : Sleep : Input "";i
   
    Dim MaListe2 As List
    MaListe2.ColSep("~")
    MaListe2 = MaListe2.Explode(MaListe.ColPick(3))
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep : ShowCurrent(MaListe2) : Next :  sleep : Input "";i
   
    MaListe.BlindStep
    MaListe2.ColSep("\")
    MaListe2 = MaListe2.Explode(MaListe.ColPick(3))
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep : ShowCurrent(MaListe2) : Next
    Print "Please note Explode is giving a number, like an array"
    Print "So you can use 'Tag(str(indice))' or 'ValTag(str(indice))' to access"
    sleep : Input "";i
    MaListe2.AllOf : MaListe2.BlindStep
   
    Dim MaListe3 As List
    MaListe3.ColSep("~")
    MaListe3 = MaListe3.Explode(MaListe2.Val)
    For i=1 to MaListe3.AllOf : MaListe3.BlindStep : ShowCurrent(MaListe3) : Next :  sleep : Input "";i
    Print "Implode on ? " & MaListe3.ColSep & " no."
    MaListe2.ColSep("~")
    MaListe3.ColSep("##")
    Print "Implode on ? " & MaListe3.ColSep & " yes."
    Print MaListe3.Implode(MaListe3)+";"+MaListe3.Implode(MaListe2.Explode(MaListe2.ValTag("2")))
    Print "Preserve property use Implode & Explode to store & restore a list in a string"
    Sleep : Input "";i   
    Return 1
End Function

Function Example_04(MaListe As List) As Byte    ' Handling csv Files
    'MaListe.Save to save tags & datas in a binary format, previously stored by MaListe.Preserve
    'MaListe.Load to load tags & data in Preserve memory, then use Redim or ExDim to restore List
    'ListLoad_csv and ListWrite_csv are functions that enable to load a List Object from a csv file or to overwrite a csv file
    'FileLink object is to declare & maintain a link between a file and a list : UpDateFile & UpDateList are used to synchronise from one to other
    Dim MaListe2 As List : Dim i As Integer
    For i = 20 to 24
        MaListe.BlindTag(str(i)) : MaListe.Val("Value of " & str(i))
    Next i
    For i=1 to MaListe.AllOf : MaListe.BlindStep : ShowCurrent(MaListe) : Next :  sleep : input "";i
    MaListe.Preserve
    MaListe.DropAll : print "All nodes removed"
    For i=1 to MaListe.AllOf : MaListe.BlindStep : ShowCurrent(MaListe) : Next :  sleep : input "";i
    MaListe2 = MaListe.ExDim  : print "ExDim example "
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep : ShowCurrent(MaListe2) : Next :  sleep : input "";i
    MaListe.Redim : print "Now Redim - caution Redim is clearing List memory"
    For i=1 to MaListe.AllOf : MaListe.BlindStep : ShowCurrent(MaListe) : Next :  sleep : input "";i
    MaListe.Preserve : print "Liste 1 preserved"
    MaListe.Save("d:\temp\testlist1.mll") : print "List 1 saved"   
    MaListe2.DropAll : print "All nodes on list 2 removed : "
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep : ShowCurrent(MaListe2) : Next :  sleep : input "";i
    MaListe2.Load("d:\temp\testlist1.mll") : print "Reloading saved list 1 file in List 2 memory"
    MaListe2.Redim : print "Now List2 is restoring its own context"
    For i=1 to MaListe2.AllOf : MaListe2.BlindStep : ShowCurrent(MaListe2) : Next : sleep : input "";i
    Print "Now let's have a look on ListLoad_csv and ListWrite_csv" : sleep : input "";i
   
   
   
   
    Return 1
End Function

Function Example_05(MaListe As List) As Byte    ' Working with files (ColPick & ColWrite)
    ' Managing working tag with  "RwTag" and "ColTags"
    ' Accessing fields with "ColPick" and "ColWrite"
    Dim StringLine As String : Dim s_val As String : Dim i As uLong : Dim t As uLong
    Dim ncol As Integer : Dim nval As Integer   
    Dim sep As String : Dim newval As String
    sep = ";" : nval = 10
    Input "Please enter column separator (default is ';') : "; sep
    If sep="" Then : sep = ";" : End If
    MaListe.ColSep(sep)
    Input "Please enter field default value with no separator (default is 'def') : "; s_val
    If s_val="" Then : s_val = "def" : End If
    Input "Please enter number of values in your list (default is 10) : "; nval
    If nval=0 Then : nval=10 : End If
    Input "Please enter the new string value with no separator to store in tag 1 : "; newval
    For i=1 To nval
        StringLine = StringLine & s_val & str(i) & MaListe.ColSep   
    Next i       
    MaListe.BlindTag("01") 'create 1° node
    'ColTags : using to set the default keys column of the list
    'RwTag : direct rewriting of working tag
    MaListe.ColTags(1) : MaListe.RwTag(newval) : MaListe.ColTags(0) 'Current node - go to tag 1, set value, back to tag 0
    MaListe.Val(StringLine) ' Set node value
    Print "Your List contains " & str(MaListe.Count) & " element : "
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next
    Input "Please enter column number to update (from tag 1)" ; ncol
    MaListe.ColData(ncol)
    'ColPick : get the value of "field" in the string value, using default list separator
    Print "Value of column " & str(ncol) & " is : " & MaListe.ColPick(ncol) & " same as " & MaListe.ColPick
    MaListe.ColTags(1)
    Print "New value for data col " & str(ncol) & " will be : " & MaListe.Tag
    MaListe.ColWrite(MaListe.Tag)
    Print "Column " & str(ncol) & " updated"
    For i=1 to MaListe.AllOf : MaListe.BlindStep
        ShowCurrent(MaListe)
    Next   
    Print "Don't forget Tags are not stored in a csv file"
    Print "ColPick & ColWrite are working on column ColData of data value"
    Print "You may manage separator is never in values"
    Print "Sep1, Sep2 and Sep3 are predefined constants on uncommon separators"
    Return 1
End Function

Function Example_06(MaListe As List) As Byte ' Building an Index  with Pointers features
    ' This example shows possible use/interest of the "POINTERs handling" feature, especially for optimisation.
   
   
    Return 1
End Function

'----------------Operators
Function Example_07(MaListe As List) As Byte ' List to list operators + & -
    ' This example shows how using filters list to list operations
   
   
    Return 1
End Function

Function Example_08(MaListe As List) As Byte ' Hierarchical list operators * & /
    ' This example shows how using Hierarchical list to list operations
   
   
    Return 1
End Function

VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Push-List Example in action

Postby VANYA » Apr 13, 2012 14:00

On the Small Basic language, I found an example of constructing a tree using Push plate and recursion, and tried to play, that's what happened:

Image

Code: Select all

Type PushList
   d As Integer
   p As PushList Ptr
   Declare Sub PushValue(ByRef top As PushList Ptr , ByVal d As Integer)
   Declare Function PopValue(ByRef top As PushList Ptr) As Integer
End Type

Sub PushList.PushValue(ByRef top As PushList Ptr , ByVal d As Integer)
   top = New PushList(d, top)
End Sub

Function PushList.PopValue(ByRef top As PushList Ptr) As Integer
   Dim pv As PushList Ptr = top
   Function = pv->d
   top = top->p
   Delete pv
End Function

Dim Shared top As PushList Ptr
Screen 16
Dim Shared As Integer _
angle = 0 , _
delta = 10 , _
distance = 60
Draw "B M256,300 C2"
Sub DrawTree()   
  If (distance > 0) Then   
    Draw "TA" & -angle & "U" & distance
    angle+=30
    Sleep(300)
    top->PushValue(top, distance)
    distance = distance - delta
    DrawTree()
    angle-=60
    DrawTree()
    angle+=30
    distance=top->PopValue(top)
    Draw  "TA" & 0 - angle & "BD" & distance 
  EndIf
End Sub
DrawTree()
Sleep
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

Re: stack of unidirectional linked list

Postby BasicCoder2 » Apr 13, 2012 15:00

Functions and subs of course use the system stack to push the parameter list as well as the return address onto the stack and the RETURN statement pops them off so you don't need to implement the push and pop for the paramater list.

You can get different affects changing the angle, length and depth.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians


screenres 640,480,32
DECLARE SUB tree (x as integer, y as integer, a as single, l as single, depth as integer)

'************** MAIN ROUTINE ****************
'     x, y, angle, length, depth
tree (0, 0,   0,    100,     5   )
sleep
'********************************************

SUB tree (x as integer, y as integer, a as single, L as single, depth as integer)
   
    IF depth THEN
        pset (x+320, 480-y),rgb(0,0,255)      'this sets the start position x,y
        x = x + L * COS(a + DtoR*90)          'compute new x coordinate
        y = y + L * SIN(a + DtoR*90)          'compute new y coordinate
       
        LINE -(x+320, 480-y),rgb(depth*30,40,255-depth*30) 'join the nodes
       
        tree (x,y, a + 25*DtoR, L * .75, depth - 1)  'shorten the length of branch
        tree (x,y, a - 25*DtoR, L * .75, depth - 1)  'and reduce the depth value

    END IF
   
    if depth = 0 then       
        circle (x+320, 480-y),3 ,rgb(255,0,0)  'TERMINAL NODE
    end if
   
    return
   
END SUB


A simple integer stack with push and pop.

Code: Select all


dim shared as integer stack(10)  'ten items maximum
dim shared as integer sp         'pointer to stack

sub push(item as integer)
    if sp < 10 then
        stack(sp)=item
        sp = sp + 1
    else
        print "STACK OVERFLOW"
        end
    end if
end sub

function pop() as integer
    if sp > 0 then
        sp = sp - 1
        return stack(sp)
    end if
    return -1  'error no items on stack
end function

'main
dim as integer r   'random number

print "PUSH THESE NUMBERS ONTO STACK"
for i as integer = 0 to 7
    r = int(rnd(1)*1000)
    print r
    push(r)
next i
print "NOW POP THEM OFF"
'pop them off the stack
for i as integer = 0 to 7
    print pop()
next i
sleep
end
VANYA
Posts: 1374
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

Re: stack of unidirectional linked list

Postby VANYA » Apr 13, 2012 15:29

I just wanted to find a use Push-LIST :)

But still your examples are very good, I love to watch you easily through the algorithm solves the problem.
fxm
Posts: 9947
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: stack of unidirectional linked list

Postby fxm » Apr 13, 2012 18:58

BasicCoder2 wrote:A simple integer stack with push and pop.
Just a small typo in your code ('<' instead of '<='):
..........
sub push(item as integer)
if sp <= 10 then
..........



I played to improve your short program, with a dynamic stack (using Redim Preserve ...), resizing the array per block of N integers (N=10 in the following example), in order not to too penalize the execution speed:

Code: Select all

dim shared as integer stack()
dim shared as integer sp         'pointer to stack
const N as integer = 10          'array resizing per block of N integers (N>=1)

sub push(byval item as integer)
    if sp mod N = 0 Then
        redim preserve stack(sp + N)
    end if
    stack(sp) = item
    sp = sp + 1
end sub

function pop() as integer
    if sp > 0 then
        sp = sp - 1
        function = stack(sp)
        if sp mod N = 0 then
            redim preserve stack(sp)
        end if
    else
        return -1  'error no items on stack
    end if
end function

'main
dim as integer r   'random number

print "PUSH THESE NUMBERS ONTO STACK"
for i as integer = 0 to 49
    r = int(rnd(1)*1000)
    print r,
    push(r)
next i
print
print "NOW POP THEM OFF"
'pop them off the stack
for i as integer = 0 to 49
    print pop(),
next i
sleep
end


Similar code, but using dynamic memory reallocation instead of dynamic array resizing, allowing so to define an UDT 'stack':

Code: Select all

type stack
    public:
        declare constructor(byval memory_block_step as integer = 1)
        declare sub push(byval item as integer)
        declare function pop() as integer
        declare function size() as integer
    private:
        dim as integer ptr mp 'pointer to memory
        dim as integer si     'index to stack
        dim as integer mb = 1 'memory resizing per block of N integers (N>=1)
end type

constructor stack(byval memory_block_step as integer = 1)
    if memory_block_step > 0 then
        this.mb = memory_block_step
    end if
end constructor

sub stack.push(byval item as integer)
    if this.si mod this.mb = 0 Then
        this.mp = reallocate(this.mp, (this.si + this.mb) * sizeof(integer))
    end if
    this.mp[this.si] = item
    this.si = this.si + 1
end sub

function stack.pop() as integer
    this.si = this.si - 1
    function = this.mp[this.si]
    if this.si mod this.mb = 0 then
        this.mp = reallocate(this.mp, this.si * sizeof(integer))
    end if
end function

function stack.size() as integer
    function = This.si
end function

'==========================================================================================

'main
dim as stack stack1 = 10 'stack1 construction (memory block allocation per 10 integers)
dim as integer r         'random number

print "PUSH THESE NUMBERS ONTO STACK"
for i as integer = 0 to 49
    r = int(rnd(1)*1000)
    print r,
    stack1.push(r)
next i
print
print "NOW POP THEM OFF"
'pop them off the stack
while stack1.size > 0
    print stack1.pop(),
wend
sleep
end
Last edited by fxm on Apr 15, 2012 19:41, edited 11 times in total.
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: stack of unidirectional linked list

Postby dodicat » Apr 13, 2012 21:23

In the CHM help it says:
"If Shared is not used on a module-level variable's declaration, it is stored on the stack of the implicit main function and therefore only visible to the module-level code in that file."

So, if the variable is declared as shared, then it is not stored on the stack?

stack() in these examples is shared, so the sub push(), assigns values to stack(), pop returns values of stack(), and stack() is not actually stored on the given default 1MB. of stack space.

Or am I completely missing something again?
fxm
Posts: 9947
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: stack of unidirectional linked list

Postby fxm » Apr 13, 2012 21:45

Yes, you are right.

Among all the following declarations:
Dim Variable As ...
Redim Variable As ...
Common Variable As ...
Static Variable As ...
Dim Shared Variable As ...
Redim Shared Variable As ...
Common Shared Variable As ...
Static Shared Variable As ...

only the first declaration ('Dim Variable As ...') corresponds to a variable stored on the stack, except if this declaration is inside a 'Namespace' block.

See my previous post about this subject:
viewtopic.php?p=168015#p168015

I modified the documentation (KeyPgShared) accordingly (2012-01-22 and 2012-04-14).
But the wiki page 'ProPgStorageClasses' should be thoroughly revised by an expert of storage in memory.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests