Parse string to tree structure (solved)

General FreeBASIC programming questions.
badidea
Posts: 2045
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 23, 2020 22:33

fxm wrote:But on the other hand, you cannot only allocate (and deallocate at end) memory for creating an instance of tree_type, because this instance must also be built (and destroyed at the end), because it contains three descriptors of dynamic arrays:
...

Thanks, switching to new/delete fix the issues. I never knew the real purpose of new/delete until now :-)
Topic marked as solved. For completeness:

Code: Select all

function countInStr(text as string, char as string) as integer
   dim as integer count = 0
   for i as integer = 0 to len(text) - 1
      if text[i] = asc(char) then count += 1
   next
   return count
end function

'-------------------------------------------------------------------------------

type tree_fwd as tree_type 'forward declaration

type sub_tree
   dim as string path
   dim as tree_fwd ptr pChild
end type

type tree_type
   dim as string item(any)
   dim as sub_tree subTree(any)
   declare sub addItem(objectStr as string, sepChar as string)
   declare sub show(depth as integer = 0)
   declare sub cleanup()
end type

'object = item or tree
sub tree_type.addItem(objectStr as string, sepChar as string)
   dim as integer i, j
   if objectStr[0] <> asc(sepChar) then
      print "Fail: Bad input"
      exit sub
   end if
   if countInStr(objectStr, sepChar) = 1 then
      dim as string itemStr = mid(objectStr, 2) 'all after "/"
      dim as integer ub = ubound(item)
      redim preserve item(ub + 1)
      'find insert location
      for i = 0 to ub
         if itemStr < item(i) then exit for
      next
      'move other items below
      for j = ub to i step -1
         item(j + 1) = item(j)
      next
      'insert new item
      item(i) = itemStr
   else
      dim as integer nextSepPos = instr(2, objectStr, sepChar)
      dim as string pathStr = mid(objectStr, 2, nextSepPos - 2)
      dim as string remObjStr = mid(objectStr, nextSepPos)
      for i = 0 to ubound(subTree)
         if subTree(i).path = pathStr then exit for
      next
      if i <= ubound(subTree) then 'match found
         subTree(i).pChild->addItem(remObjStr, sepChar)
      else
         'add sub tree
         dim as integer ub = ubound(subTree)
         redim preserve subTree(ub + 1)
         'find insert location
         for i = 0 to ub
            if pathStr < subTree(i).path then exit for
         next
         'move other items below
         for j = ub to i step -1
            subTree(j + 1) = subTree(j)
         next
         'insert new item
         subTree(i).path = pathStr
         subTree(i).pChild = new tree_type
         subTree(i).pChild->addItem(remObjStr, sepChar)
      end if
   end if
end sub

sub tree_type.show(depth as integer = 0)
   dim as string indentStr = string(depth * 2, " ") + "+ "
   for i as integer = 0 to ubound(item)
      color 14, 0 'item in yellow
      print indentStr & item(i)
      color 15, 0
   next
   for i as integer = 0 to ubound(subTree)
      color 10, 0 'path in green
      print indentStr & subTree(i).path
      color 15, 0
      subTree(i).pChild->show(depth + 1)
   next
end sub

sub tree_type.cleanup()
   for i as integer = 0 to ubound(subTree)
      subTree(i).pChild->cleanup()
      delete(subTree(i).pChild)
   next
   erase item, subTree
end sub

'-------------------------------------------------------------------------------

dim as string inputStr(...) = { _
   "/itemE",_
   "/path1/path2/itemA", _
   "/path1/path2/itemC", _
   "/path1/path2/itemB", _
   "/path2/path2/itemX", _
   "/path4/path5/path6/path7/itemQ", _
   "/path4/path5/path8/path7/itemR", _
   "/path4/path5/path6/path7/itemP", _
   "/path3/itemC", _
   "/path3/path9/itemY", _
   "/path3/itemC", _
   "/itemD"}

dim as tree_type tree

for i as integer = 0 to ubound(inputStr)
   tree.addItem(inputStr(i), "/")
next
tree.show()
tree.cleanup()
tree.show()
print "end"
sleep
UEZ
Posts: 556
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure (solved)

Postby UEZ » Mar 24, 2020 13:28

@badidea: your list of paths has duplicates.

Anyhow, can you please test this 4th try against your real data? Ist it working or still faulty? :-)
I know that you have a working solution but this problem won't let me go now. ^^

Code: Select all

'Code by UEZ - proof of concept version
'Probaly still not working properly...^^

#Define LF   Chr(10)
#Define CRLF Chr(13) & Chr(10)
#Define INDENT "  "
#Define PREFIX "+ "

Dim Shared As String * 255 u
For n As Long = 0 To 255
    u[n] = Iif(n < 91 Andalso n > 64, n + 32, n)  'lookup string
Next

Sub QuicksortUp(low As String Ptr,high As String Ptr) 'by dodicat
    If (high - low <= 1) Then Return
    Var J = low + 1, I = J, lenb = Cast(Integer Ptr, low)[1], lena=0
    While J <= high
        lena = Cast(Integer Ptr, J)[1] '=Len(*a)
        If lena > lenb Then lena = lenb
        For n As Long = 0 To lena - 1
            If u[(J)[0][n]] < u[(low)[0][n]] Then Swap *J, *I : I += 1 : Exit For
            If u[(J)[0][n]] > u[(low)[0][n]] Then Exit For
        Next
        J + =1
    Wend
    J = I - 1 : Swap *low, *J
    QuicksortUp(low, J)
    QuicksortUp(I, high)
End Sub

Sub StringSplit(sString As String, aResult() As String, sDelimiter As String = "/")
   Dim As Uinteger j = 0, i, ii = 1
   If Left(sString, 1) = sDelimiter Then sString = Ltrim(sString, "/")
   For i = 1 To Len(sString)
      If Mid(sString, i, 1) = sDelimiter Then
         Redim Preserve aResult(Ubound(aResult) + 1)
         aResult(j) = Mid(sString, ii, i - ii)
         j += 1
         i += 1
         ii = i
      End If
   Next
   If ii < i Then
      aResult(j) = Mid(sString, ii, i - ii)
   Else
      Redim Preserve aResult(j - 1)
   End If
End Sub

Sub PrintDirStructure(sPaths As String, sepChar As String)
   ReDim As String aPaths(1000)
   Dim As String char
   Dim As Integer i = 1, ii = 1, c = 0, d = 0, x, y, dimx = 0

   While i <= Len(sPaths) 'loop all characters
      char = Mid(sPaths, i, 1)
      If char = sepChar Then d += 1 'current depth
      If Asc(char) = 10 Then 'LF
         aPaths(c) = Mid(sPaths, ii, i - ii) 'one complete line
         c += 1 'line count
         i += 1 'input iterator
         ii = i 'previous
         If dimx < d Then dimx = d 'increase max depth
         d = 0 'reset current depth
      Else
         i += 1 'No LF
      End If   
   Wend
   If ii < i Then 'add the last line
      aPaths(c) = Mid(sPaths, ii, i - ii)
   Else
      c -= 1 'correct line count
   End If
   Redim Preserve aPaths(c) 'shrink array size
   QuicksortUp(@aPaths(0), @aPaths(c))
   
   'make input of Paths unique
    Dim As String aPathsUnique(c)
   Dim As Ubyte bIsEqual
   c = 0
   y = 0
   While y < Ubound(aPaths)
      If Len(aPaths(y)) = Len(aPaths(y + 1)) Then
         bIsEqual = 1
         For x = 1 To Len(aPaths(y))
            If Mid(aPaths(y), x, 1) <> Mid(aPaths(y + 1), x, 1) Then
               bIsEqual = 0
               Exit For
            End If
         Next
         If bIsEqual = 0 Then
            aPathsUnique(c) = aPaths(y)
            c += 1
         End If
      Else
         aPathsUnique(c) = aPaths(y)
         c += 1
      End If
      y += 1
   Wend
   If bIsEqual = 0 Then
      aPathsUnique(c) = aPaths(y)
      Redim Preserve aPathsUnique(c)
   Else
      Redim Preserve aPathsUnique(c - 1)
   End If
   
   ? "Input Paths sorted:"
   For i = 0 To Ubound(aPathsUnique)
      ? aPathsUnique(i)
   Next
   ?
   ?
   ? "Formatted:" : ?
   ?
   Dim As String aTree(dimx * c, dimx - 1) 'allocate for worst case
   Dim As String aLine()
   Dim As Integer px, py = 0, found, yy

   For i = 0 To Ubound(aPathsUnique) 'loop all full paths
      Redim aLine(0) 'reset aLine array
      StringSplit(aPathsUnique(i), aLine(), sepChar) 'split path into segments
      px = 0
      For x = 0 To Ubound(aLine) 'loop path segments
         y = py - 1
         found = 0
       While y > -1
          If aLine(x) = aTree(y, px) Then
            If x > 0 Then
               yy = py
               While yy >= y - 1
                  If aTree(yy, px - 1) = aLine(x - 1) Then Exit While
                  yy -= 1
               Wend
               If yy > y - 1 Then
                  found = 0
               Else
                  found = 1
               End If
            Else
               found = 1
            End If
            Exit While
          End If
         y -= 1
       Wend
         If found = 1 Then
            px += 1
         Else
            aTree(py, px) = aLine(x)
            px += 1
            py += 1
         End if
      Next
   Next
   Dim As String sOutput, tc, tn 
   Dim As Uinteger iUBy = py, iUBx = Ubound(aTree, 2)
   'Redim Preserve aTree(iUBy, iUBx) ' doesn't work
   
   For y = 0 To iUBy
      For x = 0 To iUBx
         sOutput &= Iif(aTree(y, x) <> "", PREFIX + aTree(y, x), "") + INDENT
      Next
      sOutput &= CRLF
   Next
   ? sOutput
End Sub

Dim As String sPaths = _
"/UPP/HpCooling/Manifold/Temperatures/Target" & LF & _
"/UPP/HpCooling/Manifold/Temperatures/Target" & LF & _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit" & LF & _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit" & LF & _
"/UPP/HpCooling/Manifold/Temperatures/Target" & LF & _
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil1" & LF & _
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil2"


'Dim As String sPaths
'Dim As Long filenum = FreeFile()
'Open "Paths.txt" For Binary Access Read As #filenum 'only Chr(10) for line feed is accepted
'If Lof(filenum) > 0Then
'   sPaths = String(LOF(filenum), 0)
'   Get #filenum, , sPaths
'End If
'Close #filenum

PrintDirStructure(sPaths, "/")

Sleep


I've added also the file load code at the end of the file. So, if you have the paths saved to a text file and the line break is only LF aka Chr(10) then it will work, too.
grindstone
Posts: 716
Joined: May 05, 2015 5:35
Location: Germany

Re: Parse string to tree structure

Postby grindstone » Mar 24, 2020 13:42

badidea wrote:One small issue: It does not display all items in a path before all sub-paths ("files before folders").
This can easily be fixed by a slight modification of the printTree sub:

Code: Select all

Sub printTree(tp As tDirTreeNode Ptr)
   Print String(tp->depth, " "); "+ "; tp->fname 'print the name of the current node
   If tp->noChild Then
      Return
   Else 'call sub recursively
      For x As Integer = 0 To UBound(tp->child) 'print all items
         If (tp->child(x)->attr And fbDirectory) = 0 Then
            printTree(tp->child(x))
         EndIf
      Next
      For x As Integer = 0 To UBound(tp->child) 'print all paths
         If (tp->child(x)->attr And fbDirectory) <> 0 Then
            printTree(tp->child(x))
         EndIf
      Next
   EndIf
End Sub
dodicat
Posts: 6485
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Parse string to tree structure (solved)

Postby dodicat » Mar 24, 2020 16:04

Hello UEZ.
I think yours is good.
Here is my check (windows)
Save and run in a dedicated folder
It the literal thing.

Code: Select all


#include "file.bi"
Sub string_split(byval s As String,chars As String,result() As String)
    redim result(0)
    Dim As String var1,var2
Dim As long pst,LC=len(chars)
      #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+LC)
    Else
    var1=stri
End if
    if len(var1) then
    redim preserve result(1 to ubound(result)+1)
    result(ubound(result))=var1
    end if
    #endmacro
   Do
   split(s):s=var2
Loop Until var2=""
End Sub

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Function Remove(Byval Text As String,Char As String) As String
    Dim As Long i
    For n As Long = 0 To Len(Text)-1
        If Text[n]<> Asc(char) Then Text[i]= Text[n]:i+=1
    Next
    Return Left(Text,i)
End Function

Function FindAndReplace(InString As String,Find As String,Replace As String) As String
    Dim s As String=InString
    var position=Instr(s,Find)
    While position>0
        s=Mid(s,1,position-1) & Replace & Mid(s,position+Len(Find))
        position=Instr(position+Len(Replace),s,Find)
    Wend
    return s
End Function

Function pipeout(Byval s As String="") Byref As String
    Var f=Freefile
    Dim As String tmp
    Open Pipe s For Input As #f
    s=""
    Do Until Eof(f)
        Line Input #f,tmp
        s+=tmp+Chr(10)
    Loop
    Close #f
    Return s
End Function

Dim As String sPaths(...) = {_
"/UPP/HpCooling/Manifold/Temperatures/Target", _
"/UPP/HpCooling/Manifold/Temperatures/Target", _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit", _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit", _
"/UPP/HpCooling/Manifold/Temperatures/Target",_
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil1", _
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil2"}

dim as string inputStr(1 to 11) = { _
   "/itemE",_
   "/path1/path2/itemA", _
   "/path1/path2/itemC", _
   "/path1/path2/itemB", _
   "/path2/path2/itemX", _
   "/path4/path5/path6/path7/itemQ", _
   "/path4/path5/path8/path7/itemR", _
   "/path4/path5/path6/path7/itemP", _
   "/path3/itemC", _
   "/path3/itemC", _
   "/itemD"}

sub gettree(p() as string)
shell "mkdir "+curdir+"\tmp"
for n as long=1 to ubound(p)
    redim as string a()
    string_split(p(n),"/",a())
    if ubound(a)=1 then
        savefile("tmp/"+a(1),"Hello")
    else
        dim as string g
        for m as long=1 to ubound(a)-1
          g+="\"+a(m)
        next m
         shell "mkdir "+curdir+"\tmp"+g
        savefile(curdir+"\tmp"+g+"\"+a(ubound(a)),"HELLO THERE")
        end if
    next n
    cls
    var path=curdir +"\tmp"
var s=pipeout("tree /A /F "+path)
'to suit windows
s=remove(s,"|")
s=FindAndReplace(s,"---","  ")
s=FindAndReplace(s,"\"," + ")
print s
print
print "Press a key . . ."
sleep
shell "rmdir /S /Q "+curdir +"\tmp"
 print iif(fileexists(curdir+"\tmp"),"Manually delete folder tmp","OK")
end sub

gettree(spaths())

gettree(inputstr())

sleep


 

For the huge strings comment out cls
badidea
Posts: 2045
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure (solved)

Postby badidea » Mar 24, 2020 17:51

UEZ wrote:@badidea: your list of paths has duplicates.

Yes, 3 x "VesselGas1" and I see that I use "PS1.1" and "Ps1.1"

UEZ wrote:Anyhow, can you please test this 4th try against your real data? Ist it working or still faulty? :-)

Looks good.

UEZ wrote:I've added also the file load code at the end of the file. So, if you have the paths saved to a text file and the line break is only LF aka Chr(10) then it will work, too.

I don't need that part, but thanks anyway.
UEZ
Posts: 556
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure (solved)

Postby UEZ » Mar 24, 2020 18:04

@dodicat: thanks for testing. Very interesting approach to use the file system to create dir tree structure and read it out afterwards.

@badidea: thanks for testing. Now I can close this capture. ;-)
dodicat
Posts: 6485
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Parse string to tree structure (solved)

Postby dodicat » Mar 25, 2020 0:47

UEZ and all.
Let the OS take the strain, saves fluffing around with home made trees.
That's me done here also, here is a checker version for LINUX.

Code: Select all

 
#include "file.bi"
Sub string_split(byval s As String,chars As String,result() As String)
    redim result(0)
    Dim As String var1,var2
Dim As long pst,LC=len(chars)
      #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
    var1=Mid(stri,1,pst-1)
    var2=Mid(stri,pst+LC)
    Else
    var1=stri
End if
    if len(var1) then
    redim preserve result(1 to ubound(result)+1)
    result(ubound(result))=var1
    end if
    #endmacro
   Do
   split(s):s=var2
Loop Until var2=""
End Sub

Sub savefile(filename As String,p As String)
    Dim As Integer n
    n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename
    End If
End Sub

Function Remove(Byval Text As String,Char As String) As String
    Dim As Long i
    For n As Long = 0 To Len(Text)-1
        If Text[n]<> Asc(char) Then Text[i]= Text[n]:i+=1
    Next
    Return Left(Text,i)
End Function

Function FindAndReplace(InString As String,Find As String,Replace As String) As String
    Dim s As String=InString
    var position=Instr(s,Find)
    While position>0
        s=Mid(s,1,position-1) & Replace & Mid(s,position+Len(Find))
        position=Instr(position+Len(Replace),s,Find)
    Wend
    return s
End Function

Function pipeout(Byval s As String="") Byref As String
    Var f=Freefile
    Dim As String tmp
    Open Pipe s For Input As #f
    s=""
    Do Until Eof(f)
        Line Input #f,tmp
        s+=tmp+Chr(10)
    Loop
    Close #f
    Return s
End Function

Dim As String sPaths(...) = {_
"/UPP/HpCooling/Manifold/Temperatures/Target", _
"/UPP/HpCooling/Manifold/Temperatures/Target", _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit", _
"/UPP/LpCooling/Manifold/Calorimeters/DirtyWaterUnit", _
"/UPP/HpCooling/Manifold/Temperatures/Target",_
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil1", _
"/UPP/LpCooling/Manifold/Calorimeters/MagnetCoil2"}

dim as string inputStr(1 to 11) = { _
   "/itemE",_
   "/path1/path2/itemA", _
   "/path1/path2/itemC", _
   "/path1/path2/itemB", _
   "/path2/path2/itemX", _
   "/path4/path5/path6/path7/itemQ", _
   "/path4/path5/path8/path7/itemR", _
   "/path4/path5/path6/path7/itemP", _
   "/path3/itemC", _
   "/path3/itemC", _
   "/itemD"}

sub gettree(p() as string)
shell "mkdir "+curdir+"/tmp"
for n as long=1 to ubound(p)
    redim as string a()
    string_split(p(n),"/",a())
    if ubound(a)=1 then
        savefile("tmp/"+a(1),"Hello")
    else
        dim as string g
        for m as long=1 to ubound(a)-1
          g+="/"+a(m)
        next m
         shell "mkdir -p "+curdir+"/tmp"+g
        savefile(curdir+"/tmp"+g+"/"+a(ubound(a)),"HELLO THERE")
        end if
    next n
    cls
    var path=curdir +"/tmp"
var s=pipeout("tree  "+path)

print s
print
print "Press a key . . ."
sleep

shell "rm -r "+curdir +"/tmp"


end sub

gettree(spaths())

gettree(inputstr())

sleep


 
Lost Zergling
Posts: 322
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure (solved)

Postby Lost Zergling » Mar 25, 2020 10:20

@Dodicat : This seems indeed the most logical choice, for those who are comfortable with a little more "intellectual" code.
For my part, I continue to work on my small code library. 3 loops: one to fill in the values, one to browse it in a pseudo recursive way and one to browse through consecutive roots (viewtopic.php?f=3&t=28409&start=18). One could hardly imagine an easier and readable syntax (even those who are not convenient with keywords or syntax), I did not "cheat" (ie adapted the code on the site), and I pretty used only basic function. It is independent of the system and as it is a set of instructions then it makes it possible to manage a very wide variety of scenarios. From my point of view, it is disruptive enough to justify its use, and in fact I program a lot with it (the example sent to Sarg to test Gas64 is only the beginning of a program and already includes lists per dozens, otherwise it would be too complex to read, too nested in parse and not sufficiently standardized). The readability and the time saving is enormous in this type of use. On the other hand, in certain cases the performances can prove to be insufficient, the memory consumption is really very excessive, the manual is not obvious, and there remain bugs or inconsistencies. I'm working on it (but there are some delicate points..). It is possible to recover more deallocation at end (List.Destroy) by replacing the line "Dim Tag (0 to RUP_COLS) As String" by "Dim Tag (0 to RUP_COLS) As zString*MAX_KEYLEN" (fixed max len)(it would seem that the number of descriptors called and managed by the library can put the deallocate or its toolchain in overflow) (intrinsic logic is to privilegiate node Recycling).
dodicat
Posts: 6485
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Parse string to tree structure (solved)

Postby dodicat » Mar 25, 2020 11:55

Hi Lost Zerling.
I always enjoy reading your colourful written English.
I appreciate that your own project is general and can be adapted for this thread.
I do test out code on SARG's GAS64, but my knowledge of assembler is not good enough to make sensible contributions.
But GAS64 it is a brilliant project to escape gcc.
My literal method of getting a tree is only a checker for other methods.
I assume that the end bit in each line i.e.

"/UPP/HpCooling/Manifold/Temperatures/Target"

"Target" is a file and not a folder, to display the result better.
Lost Zergling
Posts: 322
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure (solved)

Postby Lost Zergling » Mar 25, 2020 12:44

@Dodicat : thank you. (ps: I do know pretty nothin' about asm, just reported a compile issue).
badidea
Posts: 2045
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 28, 2020 16:13

grindstone wrote:@badidea: Great work! That reminds me that I have to clean my nesting boxes (and my letter box, too, I get this little lodger since three years).
...

Build my own nesting box. I hope that it is cat-safe:
Image
Lost Zergling
Posts: 322
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure (solved)

Postby Lost Zergling » Apr 03, 2020 21:25

I would like to come back to the problem which presents, it seems to me, an interesting aspect. Starting from the principle of the desired presentation (presenting duplicate files), it appears that we have two distinct types of data: directories (unique keys) and files (multi-valued keys), or typically, in a tree the sidings and leaves. LZLE does not recognize this distinction and uses a generic format for these two types of data.

Code: Select all

#Include once "F:\Basic\LZLE_.bi" 'Please use 0.994 or 0.995 release
Declare Function SetMyVirtualTree(Str_tmp As String, L_tmp As List) As Byte
Function SetMyVirtualTree(Str_tmp As String, L_tmp As List) As Byte
    Dim As Integer  t : Dim As String  Str_tmp2
    If Left(Str_tmp,1)="/" Then : Str_tmp=Right(Str_tmp, Len(Str_tmp)-1) : End If
    Str_tmp2=Str_tmp :
    If L_tmp.HashTag(Str_tmp2)=1 Then ' If key exists... (1)
        Print "Double on : " & L_tmp.HashTag
        Str_tmp2=Str_tmp : 
        L_tmp.HashKeyUnique(0)    ' Indicates we want multi-keys on hashlist, but this instruction BUT also autosets SeekMethod to 0, (for default consistency) THIS SPECIFY A MULTI KEY/VALUE CONTEXT
        L_tmp.SeekMethod(1)         ' "hacking" (override a security) => we need MultiKeys for the KEYS of the tree (itemC should appear several times) BUT same time we need to merge branches  (2)
        L_tmp.HashTag(Str_tmp2)     ' Then we create a new one (1), .. fast (context of previous hashtag is memorized)
        L_tmp.HashKeyUnique(1)      ' Return to "normal" context       ' (selective key duplication not supported : no "no key duplicate on branches" => a key could have been duplicated before a sub-tree is created) (2)
    End If

    t=Instr(Str_tmp, "/")
    While t<>0       
        Str_tmp=Left(Str_tmp, Len(Str_tmp)-t)
        Str_tmp2=Str_tmp : L_tmp.HashTag(Str_tmp2) 'Unique Key context for branches
        t=Instr(Str_tmp, "/")
    Wend
    Return 1
End Function

Dim MyList As List
Dim Str_Path() As String : Redim Str_Path(14)
Dim i As Integer

Str_Path(1)="/path1/path2/itemA"
Str_Path(2)="/path1/path2/itemB"
Str_Path(3)="/path3/itemC"
Str_Path(4)="/itemD"
Str_Path(5)="/path8/path7/path3/itemA"
Str_Path(6)="/path7/path3/itemB"
Str_Path(7)="/path4/path9/path7/itemC"
Str_Path(8)="/path6/itemD"
Str_Path(9)="/itemE"
Str_Path(10)="/path3/path5/path7/itemF"
Str_Path(11)="/path6/path3/itemG"
Str_Path(12)="/path3/itemC"
Str_Path(13)="/itemI"
Str_Path(14)="/path3/path3/itemJ"

For i=1 To 14
    SetMyVirtualTree(Str_Path(i), MyList)
Next i

MyList.Root
While MyList.KeyStep
    Print MyList.HashTag   
Wend
sleep
?
? "MarkRoot ---------------------------"
MyList.Root ' Parsing the TREE structure using consecutive roots
While MyList.nKeyStep
    Print MyList.HashTag
Wend
sleep

MyList.Destroy
gCollector.Destroy
Print AllocateDeallocateCounter ' The new 0.995a version has got 0 status
Sleep

The question is therefore to generate a tree structure presenting two distinct types of data. To this end, the "HashKeyUnique" and "SeekMethod" instructions allow you to specify the context for filling in the data in the tree. This dataset is ambiguous because it supposes either that each last element is a file and that there cannot be a folder name which is also a file name (at end), because in fact, these data must be the object of a differentiated presentation. We see here better the interest and the stake of a complete instruction set, I took again in part this example in the documentation of my tool.
(ps : The chance to enjoy a garden!)
badidea
Posts: 2045
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure (solved)

Postby badidea » Apr 16, 2020 21:30

Totally not freebasic related, but I have birds:
Image
Image
But also a cat problem:
Image
I'll try to fix that tomorrow.
Lost Zergling
Posts: 322
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure (solved)

Postby Lost Zergling » Apr 24, 2020 8:57

badidea, the sense of artistic detail has led you to opt for an animal with a coat to match your work, and so the hairy predator is indebted to you. I can only bow to the artistic level that you deploy to honor your nickname. I am beaten.
badidea
Posts: 2045
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure (solved)

Postby badidea » Apr 24, 2020 11:49

I the cat issue has been solved. The extra wire mesh blocks the cats from passing next it. And does not support their weight. The cat tried 3 times, looked annoyed and give up. But I haven't seen the birds much the last days.
Image

Return to “General”

Who is online

Users browsing this forum: angros47 and 4 guests