Parse string to tree structure (solved)

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

Parse string to tree structure (solved)

Postby badidea » Mar 20, 2020 10:11

Hi, does anyone have some code that can do the conversion below?

From:

Code: Select all

/path1/path2/itemA
/path1/path2/itemB
/path3/itemC
/itemD

To:

Code: Select all

root
+ itemD (items before paths)
+ path1
  + path2
    + itemA
    + itemB
+ path3
  + itemC

Note: speed is not important for me.
Last edited by badidea on Mar 23, 2020 22:34, edited 1 time in total.
dodicat
Posts: 6378
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Parse string to tree structure

Postby dodicat » Mar 20, 2020 12:31

Try the easy way first, Linux shells tree also, but not sure of the output string or the flags for tree in Linux
so this is Windows.

Code: Select all



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

var path="C:\fb17_32"

var s=pipeout("tree /A /F "+path)
'to suit windows
s=remove(s,"|")
s=FindAndReplace(s,"---","  ")
print s
print
sleep

#macro FLAGS_For_Windows
TREE [drive:][path] [/F] [/A]

   /F   Display the names of the files in each folder.
   /A   Use ASCII instead of extended characters.
#endmacro
 
grindstone
Posts: 699
Joined: May 05, 2015 5:35
Location: Germany

Re: Parse string to tree structure

Postby grindstone » Mar 20, 2020 13:25

Something like this ?
badidea
Posts: 2002
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 20, 2020 14:05

grindstone wrote:Something like this ?

To clarify, the list that I want to parse (and the output) is not an actual filesystem on my system, but a virtual filesystem in a database. But I will look at the tTreeNode class and see how I can use this.

Edit: A 'fork' of this topic: What's wrong here?
Last edited by badidea on Mar 20, 2020 21:00, edited 2 times in total.
grindstone
Posts: 699
Joined: May 05, 2015 5:35
Location: Germany

Re: Parse string to tree structure

Postby grindstone » Mar 20, 2020 16:01

In the meantime I put the tTreeNode class into a library I call "dirTree.bi":

Code: Select all

#Include Once "dir.bi"

Type tDirTreeNode
   As String fName                'name of the current subfolder
   As UInteger attr               'attributes
   As Integer depth               'tree depth of the current folder
   As boolean deflate = TRUE      'deflation flag (for folder)
   As tDirTreeNode Ptr parent     'pointer to parent node
   As tDirTreeNode Ptr child(Any) 'dynamic array of child nodes (sorted by fname)
   
   Declare Property total() As Integer 'get the total number of tree nodes
   Declare Function doTotal(p As tDirTreeNode Ptr) As Integer
   Declare Property path() As String 'complete directory path corresponding to the current tree node
   Declare Property noChild As boolean
   Declare Property noSubfolder As boolean
   Declare Function newChild(fn As String, att As Integer, sort As Integer = 0) As tDirTreeNode Ptr
   Declare Function childExists(fn As String)  As tDirTreeNode Ptr
   
   Declare Constructor()
   Declare Destructor()
End Type

Constructor tDirTreeNode
   
   ReDim child(0) 'initialize child array
      
End Constructor

Destructor tDirTreeNode
   'deletes the node and the whole following branch
   For x As Integer = 0 To UBound(child) 'delete all child nodes
      If child(x) <> 0 Then
         Delete child(x)
      EndIf
   Next
End Destructor

Property tDirTreeNode.total() As Integer
   Dim As Integer ret
   Dim As tDirTreeNode Ptr p = @This   
      
   Do While p->parent <> 0 'get root node
      p = p->parent
   Loop
   For x As Integer = 0 To UBound(p->child) 'all drives
      ret += this.doTotal(p->child(x))
   Next
   Return ret
End Property

Function tDirTreeNode.doTotal(p As tDirTreeNode Ptr) As Integer
   Dim As Integer ret = 1
   
   If p->noChild Then 'no subnodes --> don't traverse
      Return ret
   EndIf
   For x As Integer = 0 To UBound(p->child) 'all subnodes
      If p->child(x) <> 0 Then
         ret += this.doTotal(p->child(x)) 'traverse subnode (recursive)
      EndIf
   Next
   Return ret
End Function

Property tDirTreeNode.path() As String
   Dim As String ret
   Dim As tDirTreeNode Ptr p = @This
   
   If p->attr And fbDirectory Then
      ret = p->fName
   EndIf
   Do While p->parent <> 0
      p = p->parent
      ret = p->fName + "\" + ret
   Loop
   Return Trim(ret, "\")
End Property

Property tDirTreeNode.noChild As boolean
   If (UBound(this.child) = 0) And (this.child(0)->fName = "") Then
      Return TRUE
   Else
      Return FALSE
   EndIf

End Property

Property tDirTreeNode.noSubfolder As boolean
   If this.noChild Then
      Return TRUE
   Else
      For x As Integer = 0 To UBound(This.child)
         If (this.child(x)->attr And fbDirectory) Then
            Return FALSE
         EndIf
      Next
      Return TRUE
   EndIf

End Property

Function tDirTreeNode.newChild(fn As String, att As Integer, mode As Integer = 0) As tDirTreeNode Ptr
   Dim As Integer x, y
   Dim As String fnl = LCase(fn)
   Dim As tDirTreeNode Ptr ret
            
   'mode:
   ' bit 0 set (1) --> sort alphabetical
   ' bit 1 set (2) --> check if already child exists
   
   With This
      If .noChild Then
         x = 0
      Else
         If mode And 2 Then 'check if subnode already exists
            For y = 0 To UBound(.child)
               If LCase(.child(y)->fName) = fnl Then 'subnode already exists
                  Return .child(y)
               EndIf
            Next
         EndIf
         x = UBound(.child) + 1
      EndIf
      
      ReDim Preserve .child(x)
      .child(x) = New tDirTreeNode 'create new node
      ret = .child(x)
      .child(x)->parent  = @This
      .child(x)->depth   = .depth + 1
      .child(x)->fName   = fn 'subfolder name
      .child(x)->attr    = att
      .child(x)->deflate = TRUE
      
      If mode And 1 Then 'sort entries alphabetical
         For y = x To 1 Step -1
            If LCase(.child(y)->fName) < LCase(.child(y - 1)->fName) Then
               Swap .child(y), .child(y - 1)
            Else
               Exit For
            EndIf
         Next
      EndIf
            
      Return ret
   End With
      
End Function

Function tDirTreeNode.childExists(fn As String) As tDirTreeNode Ptr
   If this.noChild Then
      Return 0
   EndIf
   
   For x As Integer = 0 To UBound(this.child)
      If LCase(fn) = LCase(this.child(x)->fName) Then
         Return child(x)
      EndIf
   Next
   Return 0
   
End Function

Function getFolderEntryList(p As tDirTreeNode Ptr) As Integer
   Dim As Integer i, x, y, out_attr, fileindex, ret
   Dim As String g
      
   ReDim p->child(0) 'initialize child array
      
   g = Dir(p->path + "\*", -1, @out_attr) '1st dir entry
   
   Do While Len(g) 'dir entry found
      Select Case g
         Case ".",".."
            'ignore
         Case Else
            p->newChild(g, out_attr)
            ret += 1
      End Select
      g = Dir("", -1, @out_attr) 'next dir entry
   Loop
   Return ret
   
End Function
Maybe this makes it a little bit easier to understand the code. Here a (very basic) example how to use it:

Code: Select all

#Include "dirTree.bi"

Dim As tDirTreeNode root 'create the tree's root node
Dim As tDirTreeNode Ptr rp = @root
Dim As Integer numberOfEntries, x

root.fName = "C:" 'name of the folder whose contents you want to add to the tree
root.attr Or= fbDirectory 'set attribute

numberOfEntries = getFolderEntryList(rp) 'put the contents of the folder into the tree
Print numberOfEntries
For x = 0 To numberOfEntries - 1 'print the entries
   Print x;" ";rp->child(x)->fname
Next

Sleep
UEZ
Posts: 520
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure

Postby UEZ » Mar 20, 2020 23:22

I don't know if this is usable:

Code: Select all

#Define LF   Chr(10)
#Define CRLF Chr(13) & Chr(10)


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(sPathes As String)
   ReDim As String aPathes(1000)
   Dim As String char
   Dim As Uinteger i = 1, ii = 1, c = 0, d = 0, x, y, dimx = 0
   
   While i <= Len(sPathes)
      char = Mid(sPathes, i, 1)
      If char = "/" Then d+= 1
      If Asc(char) = 10 Then
         aPathes(c) = Mid(sPathes, ii, i - ii)
         c += 1
         i += 1
         ii = i
         If dimx < d Then dimx = d
         d = 0
      Else
         i += 1
      End If   
   Wend
   If ii < i Then
      aPathes(c) = Mid(sPathes, ii, i - ii)
   Else
      c -= 1
   End If
   Redim Preserve aPathes(c)
   Quicksortup(@aPathes(0), @aPathes(c))
   ? "Input pathes sorted:" : ?
   For i = 0 To Ubound(aPathes)
      ? aPathes(i)
   Next
   ? : ?
   
   ? "Formatted (parsed):" : ?
   ? "root"
   Dim As String aTree(dimx * c, dimx - 1), aLine()
   Dim As Integer px, py, found
   
   For i = 0 To Ubound(aPathes)
      Redim aLine(0)
      StringSplit(aPathes(i), aLine())
      px = 0
      For x = 0 To Ubound(aLine)
         y = 0
         found = 0
         While y < py
            If aLine(x) = aTree(y, x) Then
               found = 1
               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
   
   For y = 0 To py
      For x = 0 To Ubound(aTree, 2)
         sOutput &= Iif(aTree(y, x) <> "", "+" + aTree(y, x), "") + Chr(9)
      Next
      sOutput &= CRLF
   Next
   ? sOutput
End Sub

Dim As String sPathes =  "/path1/path2/itemB" & LF & _
                   "/path2/itemC" & LF & _
                   "/path1/path2/itemA" & LF & _
                   "/zitemA" & LF & _
                   "/path1/path2/path3/itemA" & LF & _
                   "/path2/itemA" & LF & _
                   "/itemD"

PrintDirStructure(sPathes)

Sleep


Compile it with console option.

EDIT: this solution doesn't work properly
Last edited by UEZ on Mar 23, 2020 10:16, edited 2 times in total.
badidea
Posts: 2002
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 20, 2020 23:42

UEZ wrote:I don't know if this is usable

Thanks, totally different than the code I was making, but it seems to do the job.
I'll do some further testing and a bit of adjusting ...

While commenting your code, I found a bug, see "xxxx":

Code: Select all

#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 PrintDirStructur(sPathes As String, sepChar As String)
   ReDim As String aPathes(1000)
   Dim As String char
   Dim As Uinteger i = 1, ii = 1, c = 0, d = 0, x, y, dimx = 0

   While i <= Len(sPathes) 'loop all characters
      char = Mid(sPathes, i, 1)
      If char = sepChar Then d+= 1 'current depth
      If Asc(char) = 10 Then 'LF
         aPathes(c) = Mid(sPathes, 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
      aPathes(c) = Mid(sPathes, ii, i - ii)
   Else
      c -= 1 'correct line count
   End If
   Redim Preserve aPathes(c) 'shrink array size
   quicksortup(@aPathes(0), @aPathes(c))
   ? "Input pathes sorted:"
   For i = 0 To Ubound(aPathes)
      ? aPathes(i)
   Next
   '?
   ?
   ? "Formatted:"
   '? "root"
   Dim As String aTree(dimx * c, dimx - 1) 'allocate for worst case
   Dim As String aLine()
   Dim As Integer px, py, found

   For i = 0 To Ubound(aPathes) 'loop all full paths
      Redim aLine(0)
      StringSplit(aPathes(i), aLine(), sepChar) 'split path into segments
      px = 0
      For x = 0 To Ubound(aLine) 'loop path segments
         y = 0
         found = 0
         While y < py
            If aLine(x) = aTree(y, x) Then
               found = 1
               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
   
   For y = 0 To py
      For x = 0 To Ubound(aTree, 2)
         sOutput &= Iif(aTree(y, x) <> "", PREFIX + aTree(y, x), "") + INDENT
      Next
      sOutput &= CRLF
   Next
   ? sOutput
End Sub

Dim As String sPathes = _
   "/path1/xxxx/itemB" & LF & _
   "/path2/itemC" & LF & _
   "/path2/xxxx/itemA" & LF & _
   "/itemA" & LF & _
   "/path1/path2/path3/itemA" & LF & _
   "/path2/itemA" & LF & _
   "/itemD"

PrintDirStructur(sPathes, "/")

Sleep

It finds "xxxx" but in the wrong tree.
This kind of stuff is probably easier with a recursive function. I was trying to make a class, but got stuck a freebasic limitation it seems (error 88: Recursive TYPE or UNION not allowed). Continue tomorrow...
UEZ
Posts: 520
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure

Postby UEZ » Mar 21, 2020 13:29

Hmmm, you are right. I forgot to cover equal sub dir names when searching it in the 2d array.

This will get into a logical nightmare to cover all possibilities using iterative way. You might be right that a recursive solution might be easier to implement.

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

Re: Parse string to tree structure

Postby Lost Zergling » Mar 21, 2020 15:39

Suggest this one

Code: Select all

#Include once "F:\Basic\LZLE.bi"
Dim MyList As List
' MyList.HashTag("path1") : MyList.HashTag("path1/path2") : MyList.HashTag("path3")'?
MyList.HashTag("path1/path2/itemA")
MyList.HashTag("path1/path2/itemB")
MyList.HashTag("path3/itemC")
MyList.HashTag("itemD")
MyList.HashTag("->Root")
MyList.Root
While MyList.KeyStep
    Print MyList.HashTag   
Wend
Sleep

or that one

Code: Select all

#Include once "F:\Basic\LZLE.bi"
Dim MyList As List
MyList.HashLen(6)
MyList.HashTag("path1/path2/itemA")
MyList.HashTag("path1/path2/itemB")
MyList.HashTag("path3/itemC")
MyList.HashTag("itemD")
MyList.HashTag("->Root")
MyList.Root
While MyList.HashStep
    Print MyList.Tag   
Wend
Sleep

HashLen Property is probably going to be (partially ?) deprecated next release for memory optimization reasons.
These are quite simple exemples using list engine capabilities.
As you want to parse an unknown tree structure, recursive shall be best.
Nevertheless you may sometimes wish to store the structure in memory before parsing/seeking it.
badidea
Posts: 2002
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 21, 2020 20:27

Lost Zergling wrote:Suggest this one ...
or that one ...

I don't know how your list engine works.
One prints:

Code: Select all

->Root
itemD
path1/path2/itemA
path1/path2/itemB
path3/itemC

The other:

Code: Select all

->Root
itemD
path1/
path2/
itemA
itemB
path3/
itemC

But I have no idea how to use LZLE to print it as a tree.
Meanwhile I continue with my own code...
D.J.Peters
Posts: 8023
Joined: May 28, 2005 3:28
Contact:

Re: Parse string to tree structure

Postby D.J.Peters » Mar 21, 2020 22:13

You can use strtok() to split the path in folders and items !

Joshy

Code: Select all

#include "crt.bi"

const MAX_FILES = 10 ' <--- change it if you like

function getDepth(path as string) as integer
  var c=0,n = instr(path,"/")
  while n
    c+=1
    n = instr(n+1,path,"/")
  wend
  return c
end function

sub SortFS(FS() as string)
  dim as boolean flag=true
  while flag
    flag=false
    for i as integer = 0 to ubound(FS)-1
      if getDepth(FS(i)) > getDepth(FS(i+1)) then
        swap FS(i),FS(i+1)
        flag=true
      end if
    next
  wend
end sub

dim as string VirtualFS(MAX_FILES-1)

' create input data (your virtual file system)
for i as integer = 0 to ubound(VirtualFS)
  dim as integer depth = rnd*4
  dim as string path
  while depth>1
    path &= "/path" & chr(asc("0")+rnd*9)
    depth-=1
  wend 
  VirtualFS(i) = path & "/item" & chr(asc("A")+i)
next
print "virtual file system"
for i as integer = 0 to ubound(VirtualFS)
  print VirtualFS(i)
next
print
' sort the FS.
SortFS(VirtualFS())
print "sorted:"
for i as integer = 0 to ubound(VirtualFS)
  print VirtualFS(i)
next
print

print "root"
for i as integer = 0 to ubound(VirtualFS)
  var c=0,depth = getDepth(VirtualFS(i))
  dim as string splitted(depth-1)
  var path = VirtualFS(i) & "/"
  var p = strtok(strptr(path),strptr("/"))
  while (p<>NULL) : splitted(c) = *p : c+=1 : p = strtok(NULL,strptr("/")) : wend
  for j as integer = 0 to c-1
    print space(j*2) & "+ " & splitted(j)
  next 
next 
sleep
Lost Zergling
Posts: 306
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure

Postby Lost Zergling » Mar 21, 2020 22:20

On first code, remove comment on 'MyList.hashtag("path1")…
hashtag is loading a unique key into a tree, building that tree key by key. You should get something closer to what you are looking for. To de-linearize you just need to encapsulate hashtag into a loop so as to do a setting wich build the required tree structure.
while instr(str, "/",i)<>0
MyList.hashtag(…)
wend
to get an equivalent of
MyList.hashtag("path1")
MyList.hashtag("path1/path2")
MyList.hashtag("path1/path2/item1")
and so on for each 'linear' description
the same path will be merged in tree till list is not multi-valued.
Then it should be sufficient to parse the list.
item will be ordered, but it would be necessary to format and reindent to get the required output.
badidea
Posts: 2002
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 21, 2020 22:35

D.J.Peters wrote:You can use strtok() to split the path in folders and items !
...

Thanks, but not perfect, a different random run gave me this (see remark "<--------- path3"):
For my purpose, these to paths need to be merged.

Code: Select all

virtual file system
/path8/path7/path3/itemA
/path7/path3/itemB
/path4/path9/path7/itemC
/path6/itemD
/itemE
/path3/path5/path7/itemF
/path6/path3/itemG
/path3/itemH
/itemI
/path3/path3/itemJ

sorted:
/itemE
/itemI
/path6/itemD
/path3/itemH
/path7/path3/itemB
/path6/path3/itemG
/path3/path3/itemJ
/path8/path7/path3/itemA
/path4/path9/path7/itemC
/path3/path5/path7/itemF

root
+ itemE
+ itemI
+ path6
  + itemD
+ path3
  + itemH
+ path7
  + path3
    + itemB
+ path6
  + path3
    + itemG
+ path3          <--------- path3
  + path3
    + itemJ
+ path8
  + path7
    + path3
      + itemA
+ path4
  + path9
    + path7
      + itemC
+ path3          <--------- path3
  + path5
    + path7
      + itemF
D.J.Peters
Posts: 8023
Joined: May 28, 2005 3:28
Contact:

Re: Parse string to tree structure

Postby D.J.Peters » Mar 21, 2020 22:41

badidea wrote:For my purpose, these to paths need to be merged.
I never sayed I made your homework !

You need only change the "sorting" code to your needs thats all.

Joshy
badidea
Posts: 2002
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Postby badidea » Mar 22, 2020 0:27

My own version:

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

function findInList(list() as string, find as string) as integer
   for i as integer = 0 to ubound(list)
      if list(i) = find then return i
   next
   return -1
end function

sub bubbleSort(list() as string)
   for i as integer = 0 to ubound(list)
      for j as integer = 0 to i - 1
         if list(i) < list(j) then
            swap list(i), list(j)
         end if
      next
   next
end sub

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

type tree_type
   dim as string item(any)
   dim as string path(any)
   dim as tree_type ptr pSubTree(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)
   if objectStr[0] <> asc(sepChar) then
      print "Fail: Bad input"
      exit sub
   end if
   if countInStr(objectStr, sepChar) = 1 then
      dim as integer ub = ubound(item)
      redim preserve item(ub + 1)
      item(ub + 1) = mid(objectStr, 2) 'note mid starts at 1
      bubbleSort(item())
   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)
      dim as integer index = findInList(path(), pathStr)
      if index >= 0 then
         pSubTree(index)->addItem(remObjStr, sepChar)
      else
         'add sub tree
         dim as integer ub = ubound(pSubTree)
         redim preserve path(ub + 1)
         path(ub + 1) = pathStr
         redim preserve pSubTree(ub + 1)
         pSubTree(ub + 1) = allocate(sizeof(tree_type))
         pSubTree(ub + 1)->addItem(remObjStr, sepChar)
         'bubble sort with 2nd array
         for i as integer = 0 to ubound(path)
            for j as integer = 0 to i - 1
               if path(i) < path(j) then
                  swap path(i), path(j)
                  swap pSubTree(i), pSubTree(j)
               end if
            next
         next
      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(path)
      color 10, 0 'path in green
      print indentStr & path(i)
      color 15, 0
      pSubTree(i)->show(depth + 1)
   next
end sub

sub tree_type.cleanup()
   for i as integer = 0 to ubound(pSubTree)
      pSubTree(i)->cleanup()
      deallocate(pSubTree(i))
   next
   erase item, path, pSubTree
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/itemC", _
   "/itemD"}

dim as tree_type tree

for i as integer = 0 to ubound(inputStr)
   tree.addItem(inputStr(i), "/")
next
tree.show()
tree.cleanup()
print "end"
sleep

Return to “General”

Who is online

Users browsing this forum: Bing [Bot] and 4 guests