Parse string to tree structure (solved)

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

Parse string to tree structure (solved)

Post by badidea »

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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Parse string to tree structure

Post by dodicat »

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: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Parse string to tree structure

Post by grindstone »

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

Re: Parse string to tree structure

Post by badidea »

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: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Parse string to tree structure

Post by grindstone »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure

Post by UEZ »

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: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Post by badidea »

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: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Parse string to tree structure

Post by UEZ »

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: 534
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure

Post by Lost Zergling »

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: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Post by badidea »

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: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Parse string to tree structure

Post by D.J.Peters »

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: 534
Joined: Dec 02, 2011 22:51
Location: France

Re: Parse string to tree structure

Post by Lost Zergling »

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: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Post by badidea »

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: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Parse string to tree structure

Post by D.J.Peters »

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: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Parse string to tree structure

Post by badidea »

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
Post Reply