Yet another non-binary tree

[Lunasole]

Hi. Posting here some stuff I've coded hour ago for myself.

Generally it is regular "tree data structure". It uses PB Map object to store data.

What it can do now:
- add element
- delete (also delete with all nested elements)
- process items recursively through callback function
- return full path of element, element deepth, child count
- rename item
- items movement in all possible and some impossible ways
- search elem by name and "clear tree" (performed by Map itself)

Main code is simple enough and only ~ 132 lines (pff, it was old and not a truth, the tree grow up and now takes ~300 lines ^^)

Code: Select all

EnableExplicit

;{ Tree 1.4 }
	
	;	2017			(c) Luna Sole
	
	Structure TreeNode
		*Data			; pointer for user data
		Parent$			; internal, don't touch it
		Name$			; internal, don't edit too
		List Childs$()	; internal also :)
	EndStructure
	
	
	; Add new element to a tree data structure. Element is added to the end of current list
	; *Data				pointer to a some user data
	; RETURN:			true on success, false else
	Procedure TreeAdd (Map Tree.TreeNode(), Name$, *Data, Parent$ = "")
		If Name$ = "" Or FindMapElement(Tree(), Name$)
			; name$ is empty or already exists
			ProcedureReturn #False
		EndIf
		If Parent$ And FindMapElement(Tree(), Parent$) = 0
			; non-existing parent specified
			ProcedureReturn #False
		EndIf
		
		; success
		Tree(Name$)\Data = *Data
		Tree(Name$)\Name$ = Name$
		; update childs list of parent$
		If Parent$
			Tree(Name$)\Parent$ = Parent$
			AddElement(Tree(Parent$)\Childs$())
			Tree(Parent$)\Childs$() = Name$
			MoveElement(Tree(Parent$)\Childs$(), #PB_List_Last)
		EndIf
		
		ProcedureReturn #True
	EndProcedure
	
	; Deletes given element and (optionally) all nested elements
	; Name$				identifier
	; DeleteAllChilds	true to delete all nested elements with their subelements
	; RETURN:			true on success, false else
	Procedure TreeDelete (Map Tree.TreeNode(), Name$, DeleteAllChilds = #False)
		If Name$ = "" Or FindMapElement(Tree(), Name$) = 0
			; element not exists
			ProcedureReturn #False
		EndIf
		
		; get parent of Name$ element
		Protected Parent$ = Tree(Name$)\Parent$
		
		; transfer all Name$ childs to it's parent
		; ... or kill'em all if specified :)
		Protected tKey$
		ForEach Tree(Name$)\Childs$()
			; get name of this child
			tKey$ = Tree(Name$)\Childs$()
			
			If DeleteAllChilds
				; delete all childs of this child
				If TreeDelete(Tree(), tKey$, DeleteAllChilds)
					ResetList(Tree(Name$)\Childs$())
				EndIf
			Else
				; replace child parent
				Tree(tKey$)\Parent$ = Parent$
				
				; add child to a parent of Name$
				If Parent$
					AddElement(Tree(Parent$)\Childs$())
					Tree(Parent$)\Childs$() = tKey$
					MoveElement(Tree(Parent$)\Childs$(), #PB_List_Last)
				EndIf	
			EndIf
		Next
		; remove Name$ from parent child list
		If Parent$
			ForEach Tree(Parent$)\Childs$()
				If Tree(Parent$)\Childs$() = Name$
					DeleteElement(Tree(Parent$)\Childs$())
					Break
				EndIf
			Next
		EndIf
		
		; remove Name$ element
		DeleteMapElement(Tree(), Name$)
		
		ProcedureReturn #True
	EndProcedure
	
	; Moves given element to a new position
	; Name$				item name to move, cannot be empty
	; Target$			where to move? cannot be empty, except if TargetAsParent = #true (then "" can be used to move item to the root level)
	; TargetAsParent	set it to True if element should be added as a child of Target element, instead of add it at the same tree level
	; Location			one of four #PB_List_ constants. By default element will be moved to a position after Target
	;					NOTE: if TargetAsParent = true, then location can be only #PB_List_First or #PB_List_Last
	; RETURN:			true on success
	Procedure TreeMove (Map Tree.TreeNode(), Name$, Target$, TargetAsParent = #False, Location = #PB_List_After)
		If Name$ = ""  Or (Target$ = "" And Not TargetAsParent)
			; Name$ can't be empty, Target$ can't be empty unless TargetAsParent mode enabled
			ProcedureReturn #False
		ElseIf FindMapElement(Tree(), Name$) = 0 Or (Target$ <> "" And FindMapElement(Tree(), Target$) = 0)
			; One or both items not found
			ProcedureReturn #False
		ElseIf Name$ = Target$
			; That futile search for meaning
			ProcedureReturn #True
		EndIf

		; some fool protection
		; detect if name is parent of target, if it is so, that will cause infinite loop in tree or just will break it (cancel movement)
		Protected CName$ = Target$
		Repeat
			If CName$
				If CName$ = Name$
					; yes, it is
					ProcedureReturn #False
				EndIf
				CName$ = Tree(CName$)\Parent$
			Else
				Break
			EndIf
		ForEver
		
		; now prepare to movement itself
		Protected Target
		Protected *CParent.TreeNode
		Protected NameParent$ = Tree(Name$)\Parent$
		Protected TargetParent$
		If TargetAsParent
			TargetParent$ = Target$
			If Not Location = #PB_List_First And Not Location = #PB_List_Last
				Location = #PB_List_Last
			EndIf
		Else
			TargetParent$ = Tree(Target$)\Parent$
			If Not Location = #PB_List_First And Not Location = #PB_List_Last And Not Location = #PB_List_Before And Not Location = #PB_List_After
				Location = #PB_List_After
			EndIf
		EndIf
		
		; find name$ element in it's parent child list and delete it
		If NameParent$
			*CParent = @Tree(NameParent$)
			ForEach *CParent\Childs$()
				If *CParent\Childs$() = Name$
					DeleteElement(*CParent\Childs$())
					Break
				EndIf
			Next
		EndIf		
		; find target element in it's parent child list and add name$ to a target$ parent child list
		If TargetParent$
			*CParent = @Tree(TargetParent$)
			If Not TargetAsParent
				ForEach *CParent\Childs$()
					If *CParent\Childs$() = Target$
						Target = @*CParent\Childs$()
						AddElement(*CParent\Childs$())
						*CParent\Childs$() = Name$
						MoveElement(*CParent\Childs$(), Location, Target)
						Break
					EndIf
				Next
			Else
				AddElement(*CParent\Childs$())
				*CParent\Childs$() = Name$
				MoveElement(*CParent\Childs$(), Location)
			EndIf
		EndIf
		
		; overwrite name$ parent
		Tree(Name$)\Parent$ = TargetParent$
		
		ProcedureReturn #True
	EndProcedure
	
	; Performs tree node "renaming". Pointers to a Name$ element are no more valid after this operation, because map item is deleted and replaced by new one
	; Name$				tree item identifier to rename
	; NewName$			new item name
	; RETURN:			true on success, false else
	Procedure TreeRename (Map Tree.TreeNode(), Name$, NewName$)
		If Name$ = "" Or NewName$ = "" Or FindMapElement(Tree(), Name$) = 0 Or FindMapElement(Tree(), NewName$)
			; element not exists, or element with newname$ already exists
			ProcedureReturn #False
		EndIf
		
		; change parent of Name$ childs to a NewName$
		Protected tKey$
		ForEach Tree(Name$)\Childs$()
			Tree(Tree(Name$)\Childs$())\Parent$ = NewName$
		Next
		
		; modify childs list of Name$ parent
		Protected Parent$ = Tree(Name$)\Parent$	
		If Parent$
			ForEach tree(Parent$)\Childs$()
				If Tree(Parent$)\Childs$() = Name$
					Tree(Parent$)\Childs$() = NewName$
					Break
				EndIf
			Next
		EndIf
		
		; transfer Name$ item data to NewName$
		CopyStructure(@Tree(Name$), @Tree(NewName$), TreeNode)
		Tree(NewName$)\Name$ = NewName$
		
		; remove Name$ element
		DeleteMapElement(Tree(), Name$)
		
		ProcedureReturn #True
	EndProcedure
	
	
	; A function to examine tree data
	; StartName$		tree item identifier to start from it
	; *Callback			pointer to a function which will be called from here. Function must accept 1 argument: pointer to a Tree() element
	; GoUp				by default TreeRecurse() moves from current item to it childs, if GoUp = #True, it will move from current to it's parents
	; MaxLevels			how deep it should go? -1 means infinite, 1 will stop after current element, 2 will examine current element + all elements on next level, and so on
	; RETURN:			none
	Procedure TreeRecurse (Map Tree.TreeNode(), StartName$, *Callback, GoUp = #False, MaxLevels = -1)
		If StartName$ = "" Or FindMapElement(Tree(), StartName$) = 0
			; element not exists
			ProcedureReturn
		EndIf
		
		; send current element to a callback
		If *Callback And CallFunctionFast(*Callback, @Tree(StartName$))
			; stop recursion by user choise
			ProcedureReturn 
		EndIf
		
		; have next fun with recursion
		MaxLevels -1
		If MaxLevels <> 0 And FindMapElement(Tree(), StartName$)
			If GoUp
				; continue with parent of current element
				TreeRecurse(Tree(), Tree(StartName$)\Parent$, *Callback, GoUp, MaxLevels)	
			Else
				; continue with childs
				ForEach Tree(StartName$)\Childs$()
					TreeRecurse(Tree(), Tree(StartName$)\Childs$(), *Callback, GoUp, MaxLevels)
				Next
			EndIf
		EndIf
	EndProcedure
	
	
	; Returns full path of specified element
	; RETURN:			path string, or empty string if no such element found
	Procedure$ TreeGetPath (Map Tree.TreeNode(), Name$)
		Protected Path$, CName$ = Name$
		Repeat
			If CName$ And FindMapElement(Tree(), CName$)
				Path$ = CName$ + Path$
				CName$ = Tree()\Parent$
				If CName$
					Path$ = "\" + Path$
				EndIf
			Else
				Break
			EndIf
		ForEver
		ProcedureReturn Path$
	EndProcedure
	
	; Returns number representing level of specified element
	; RETURN:			item deepth level (number of parents item has), starting from 0. -1 returned if item doesn't exists
	Procedure TreeGetLevel (Map Tree.TreeNode(), Name$)
		Protected Level = -1
		Repeat
			If Name$ And FindMapElement(Tree(), Name$)
				Name$ = Tree()\Parent$
				Level + 1
			Else
				Break
			EndIf
		ForEver
		ProcedureReturn Level
	EndProcedure
	
	; Returns number of nested items that specified element has
	; RETURN:			0 if element doesn't exists or doesn't have childs, 1+ else
	Procedure TreeGetChildCount (Map Tree.TreeNode(), Name$)
		If Name$ = "" Or FindMapElement(Tree(), Name$) = 0
			; element not exists
			ProcedureReturn 0
		EndIf
		ProcedureReturn ListSize(Tree(Name$)\Childs$())
	EndProcedure
	
;}



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



; Create tree storage. This way you can make as many trees as you need
Global NewMap Tree.TreeNode()

; Fill tree with some items. 
; From here "test" is parent for test2, and so on
TreeAdd(Tree(), "root1", 1)
TreeAdd(Tree(), "nodeA", 2, "root1")			; childs of "test"
TreeAdd(Tree(), "nodeB", 3, "root1")			; childs of "test"
TreeAdd(Tree(), "nodeX", 7, "root1")			; childs of "test"
TreeAdd(Tree(), "nodeC", 4, "nodeA")			; childs of "test"
TreeAdd(Tree(), "nodeD", 5, "nodeA")			; childs of "test"
TreeAdd(Tree(), "nodeE", 6, "nodeB")			; childs of "test"
TreeAdd(Tree(), "nodeF", 7, "nodeB")			; childs of "test"


; Here is callback function example for use with TreeRecurse() 
; - it can be used to process data in tree (for example, process some item and it's subitems) and other such things
; - it is safe (but not recommended) to add or delete tree items from this callback
; RETURN:      generally none, but if you return non-zero, recursion will not go deeper in current dirrection
;            (but will continue in others until non-zero returned also for them ^_^)
Procedure testCb (*item.TreeNode)
	Debug TreeGetPath (Tree(), *item\Name$) + 
	      ".......... [data = " + Str(*item\Data) + 
	      ", level = " + Str(TreeGetLevel (Tree(), *item\Name$)) + "], childs = " + TreeGetChildCount(Tree(), *item\Name$)
EndProcedure

; 1) Just print all items using TreeRecurse() + callback
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end callback example --"
Debug ""

; 2) Now "nodeB" is deleted, it has child elements and all of them
; will join "root1" instead (to be exact, they are joining to the end of "root1" childs list)
TreeDelete(Tree(), "nodeB")
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end deletion example --"
Debug ""

; 3) And here "nodeA" is deleted with recursion
; after that all nested items from lower levels are removed also
; (thanks @Torp for pointing a bug with recursive deletion)
TreeDelete(Tree(), "nodeA", #True)
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end recursive deletion example --"
Debug ""

; 4) Here TreeMove() function is used to change order of nodes
; "nodeF" stands after "nodeE", but will be before after this
TreeMove(Tree(), "nodeF", "nodeE", #False, #PB_List_Before)
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end movement example --"
Debug ""

; 5) Again TreeMove(), this time it moves elements between tree levels
; thus "nodeE" becomes child of "nodeF", then "nodeX" does the same and stands before "nodeE"
TreeMove(Tree(), "nodeE", "nodeF", #True, #PB_List_First)
TreeMove(Tree(), "nodeX", "nodeF", #True, #PB_List_First)
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end movement example-2 --"
Debug ""

; 6) Finally some rename example
TreeRename(Tree(), "nodeF", "nodeForever")
TreeRecurse(Tree(), "root1", @testCb())
Debug "MapSize: " + Str(MapSize(Tree()))
Debug "-- end rename example-2 --"
Debug ""

[aaaaaaaargh]

Very useful, thanks for sharing!

[Kwai chang caine]

Yes, thanks for sharing

[Torp]

Clear, Simple and Useful ! Thanks

[Torp]

hello,

There is a bug with TreeDelete().
if you put a breakpoint on the last lineand and you look at the contents of the Map Tree (), "TestA" is still there.

EDIT : I added a test in TreeDelete and the code works.

Code: Select all

; remove Name$ from parent child list
If DeleteAllChilds = #False
   DeleteMapElement(Tree(Parent$)\Childs(), Name$)
EndIf

Corrected Code :

Code: Select all

EnableExplicit

;{ Tree 1.1 }

;   2017         (c) Luna Sole

Structure TreeNode
	*Data         ; pointer for user data
	Parent$				; internal, don't touch it
	Name$					; internal, don't edit too
	Map Childs.a(); internal also :)
EndStructure

; Add new element to a tree data structure
; *Data         pointer to any user data
; RETURN:      true on success, false else
Procedure TreeAdd(Map Tree.TreeNode(), Name$, *Data, Parent$ = "")
	If FindMapElement(Tree(), Name$)
		; element already exists, use different name
		ProcedureReturn #False
	EndIf
	If Parent$ And FindMapElement(Tree(), Parent$) = 0
		; non-existing parent specified
		ProcedureReturn #False
	EndIf
	
	; success
	Tree(Name$)\Data = *Data
	Tree(Name$)\Name$ = Name$
	If Parent$
		Tree(Name$)\Parent$ = Parent$
		Tree(Parent$)\Childs(Name$) = #True
	EndIf
	
	ProcedureReturn #True
EndProcedure


; Deletes given element and (optionally) all nested elements
; Name$            identifier
; DeleteAllChilds   true to delete all nested elements with their subelements
; RETURN:         true on success, false else
Procedure TreeDelete (Map Tree.TreeNode(), Name$, DeleteAllChilds = #False)
	If Name$ = "" Or FindMapElement(Tree(), Name$) = 0
		; element not exists
		ProcedureReturn #False
	EndIf
	
	; get parent of Name$ element
	Protected Parent$ = Tree(Name$)\Parent$
	
	; transfer all Name$ childs to it's parent
	; ... or kill'em all if specified :)
	Protected tKey$
	ForEach Tree(Name$)\Childs()
		; get name of this child
		tKey$ = MapKey(Tree(Name$)\Childs())
		
		If DeleteAllChilds
			; delete all childs of this child
			TreeDelete(Tree(), tKey$, DeleteAllChilds)
		Else
			; replace child parent
			Tree(tKey$)\Parent$ = Parent$
			
			; add child to a parent of Name$
			If Parent$
				Tree(Parent$)\Childs(tKey$) = #True   
			EndIf   
		EndIf
	Next
	
	; remove Name$ from parent child list
	If DeleteAllChilds = #False
		DeleteMapElement(Tree(Parent$)\Childs(), Name$)
	EndIf
		
	; remove Name$ element
	DeleteMapElement(Tree(), Name$)
	
	ProcedureReturn #True
EndProcedure

; A function to examine tree data
; StartName$      tree item identifier to start from it
; *Callback         pointer to a function which will be called from here. function must accept 1 argument: pointer to a Tree() element
; GoUp            by default TreeRecurse() moves from current item to it childs, if GoUp = #True, it will move from current to it's parents
; MaxLevels         how deep it should go? -1 means infinite, 1 will stop after current element, 2 will examine current element + all elements on next level, and so on
; RETURN:         none
Procedure TreeRecurse (Map Tree.TreeNode(), StartName$, *Callback, GoUp = #False, MaxLevels = -1)
	If StartName$ = "" Or FindMapElement(Tree(), StartName$) = 0
		; element not exists
		ProcedureReturn
	EndIf
	
	; send current element to a callback
	If *Callback And CallFunctionFast(*Callback, @Tree(StartName$))
		; stop recursion by user choise
		ProcedureReturn
	EndIf
	
	; have next fun with recursion
	MaxLevels -1
	If MaxLevels <> 0 And FindMapElement(Tree(), StartName$)
		If GoUp
			; continue with parent of current element
			TreeRecurse(Tree(), Tree(StartName$)\Parent$, *Callback, GoUp, MaxLevels)   
		Else
			; continue with childs
			ForEach Tree(StartName$)\Childs()
				TreeRecurse(Tree(), MapKey(Tree(StartName$)\Childs()), *Callback, GoUp, MaxLevels)
			Next
		EndIf
	EndIf
EndProcedure

; Returns full path of specified element
; RETURN:         path string, or empty string if no such element found
Procedure$ TreeGetPath (Map Tree.TreeNode(), Name$)
	Protected Path$
	Repeat
		If Name$ And FindMapElement(Tree(), Name$)
			Path$ = Name$ + Path$
			Name$ = Tree()\Parent$
			If Name$
				Path$ = "\" + Path$
			EndIf
		Else
			Break
		EndIf
	ForEver
	ProcedureReturn Path$
EndProcedure
;}




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE CODE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Create tree storage
Global NewMap Tree.TreeNode()

; Fill tree with some items.
; From here "test" is parent for test2, and so on
TreeAdd(Tree(), "test", 1)
TreeAdd(Tree(), "test2", 2, "test")
TreeAdd(Tree(), "test3", 3, "test2")
TreeAdd(Tree(), "test4", 4, "test3")
TreeAdd(Tree(), "testX", 44, "test2")
TreeAdd(Tree(), "testY", 444, "test2")
TreeAdd(Tree(), "testZ", 4444, "testY")
TreeAdd(Tree(), "test5", 5, "test4")
TreeAdd(Tree(), "test6", 6, "test5")
TreeAdd(Tree(), "testA", 66, "test5")
TreeAdd(Tree(), "test7", 7, "test6")
TreeAdd(Tree(), "test8", 8, "test7")

; Here is callback function example for use with TreeRecurse()
; - it can be used to process data in tree (for example, process some item and it's subitems) and other such things
; - it is safe (but not recommended) to add or delete tree items from this callback
; RETURN:      generally none, but if you return non-zero, recursion will not go deeper in current dirrection
;            (but will continue in others until non-zero returned also for them ^_^)
Procedure testCb (*item.TreeNode)
	Debug TreeGetPath (Tree(), *item\Name$) + " : data = " + Str(*item\Data)
EndProcedure


; First just print all items using TreeRecurse() + callback
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end callback example --"
Debug ""

; now "test5" is deleted, it has child elements and all of them
; will join "test4" instead
TreeDelete(Tree(), "test5")
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example1 --"
Debug ""

; and here "test3" is deleted with recursion
; after that all nested items from lower levels are removed also
TreeDelete(Tree(), "test3", #True)
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example2 --"
Debug ""

[Lunasole]

hello,

There is a bug with TreeDelete().
if you put a breakpoint on the last lineand and you look at the contents of the Map Tree (), "TestA" is still there. :wink:

EDIT : I added a test in TreeDelete and the code works.

Code: Select all

; remove Name$ from parent child list
If DeleteAllChilds = #False
   DeleteMapElement(Tree(Parent$)\Childs(), Name$)
EndIf

Thanks, but looks it is not enough to fix it ^_^
If you add following to a code with your fix, there will be wrong results:

Code: Select all

TreeDelete(Tree(), "test2", #False)
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example3 --"
Debug ""

Thanks anyway, today I've drink too much coffee to play further with recursion, will try to fix that later


UPDATED: Well no matter how much coffee, I won't go to sleep until it is fixed :)
Following should be a solution:

Code: Select all

; delete all childs of this child
TreeDelete(Tree(), tKey$, DeleteAllChilds)
+ ResetMap(Tree(Name$)\Childs())

[Torp]

You're right, recursion makes your brain smoke too much

Envoyé de mon SM-G901F en utilisant Tapatalk

[Torp]

This is a bit "brute force", but this version seems to work correctly (I had trouble for your neurons ):

Code: Select all

EnableExplicit

;{ Tree 1.1 }

;   2017         (c) Luna Sole

Structure TreeNode
	*Data         ; pointer for user data
	Parent$				; internal, don't touch it
	Name$					; internal, don't edit too
	Map Childs.a(); internal also :)
EndStructure

; Add new element to a tree data structure
; *Data         pointer to any user data
; RETURN:      true on success, false else
Procedure TreeAdd(Map Tree.TreeNode(), Name$, *Data, Parent$ = "")
	If FindMapElement(Tree(), Name$)
		; element already exists, use different name
		ProcedureReturn #False
	EndIf
	If Parent$ And FindMapElement(Tree(), Parent$) = 0
		; non-existing parent specified
		ProcedureReturn #False
	EndIf
	
	; success
	Tree(Name$)\Data = *Data
	Tree(Name$)\Name$ = Name$
	If Parent$
		Tree(Name$)\Parent$ = Parent$
		Tree(Parent$)\Childs(Name$) = #True
	EndIf
	
	ProcedureReturn #True
EndProcedure


; Deletes given element and (optionally) all nested elements
; Name$            identifier
; DeleteAllChilds   true to delete all nested elements with their subelements
; RETURN:         true on success, false else
Procedure TreeDelete (Map Tree.TreeNode(), Name$, DeleteAllChilds = #False, RecurseCall = #False)
	
	If Name$ = "" Or FindMapElement(Tree(), Name$) = 0
		; element not exists
		ProcedureReturn #False
	EndIf
	
	Static NewMap Copy_Tree.TreeNode()
	If RecurseCall = #False
		CopyMap(Tree(), Copy_Tree())
	EndIf
	
	; get parent of Name$ element
	Protected Parent$ = Copy_Tree(Name$)\Parent$
	
	; transfer all Name$ childs to it's parent
	; ... or kill'em all if specified :)
	Protected tKey$
	ForEach Copy_Tree(Name$)\Childs()
		; get name of this child
		tKey$ = MapKey(Copy_Tree(Name$)\Childs())
		
		If DeleteAllChilds
			; delete all childs of this child
			TreeDelete(Tree(), tKey$, DeleteAllChilds, #True)
		Else
			; replace child parent
			Tree(tKey$)\Parent$ = Parent$
			
			; add child to a parent of Name$
			If Parent$
				Tree(Parent$)\Childs(tKey$) = #True   
			EndIf   
		EndIf
	Next
	
	; remove Name$ from parent child list
		DeleteMapElement(Tree(Parent$)\Childs(), Name$)
		
	; remove Name$ element
	DeleteMapElement(Tree(), Name$)
	
	If RecurseCall = #False
		ClearMap(Copy_Tree())
	EndIf
	
	ProcedureReturn #True
EndProcedure

; A function to examine tree data
; StartName$      tree item identifier to start from it
; *Callback         pointer to a function which will be called from here. function must accept 1 argument: pointer to a Tree() element
; GoUp            by default TreeRecurse() moves from current item to it childs, if GoUp = #True, it will move from current to it's parents
; MaxLevels         how deep it should go? -1 means infinite, 1 will stop after current element, 2 will examine current element + all elements on next level, and so on
; RETURN:         none
Procedure TreeRecurse (Map Tree.TreeNode(), StartName$, *Callback, GoUp = #False, MaxLevels = -1)
	If StartName$ = "" Or FindMapElement(Tree(), StartName$) = 0
		; element not exists
		ProcedureReturn
	EndIf
	
	; send current element to a callback
	If *Callback And CallFunctionFast(*Callback, @Tree(StartName$))
		; stop recursion by user choise
		ProcedureReturn
	EndIf
	
	; have next fun with recursion
	MaxLevels -1
	If MaxLevels <> 0 And FindMapElement(Tree(), StartName$)
		If GoUp
			; continue with parent of current element
			TreeRecurse(Tree(), Tree(StartName$)\Parent$, *Callback, GoUp, MaxLevels)   
		Else
			; continue with childs
			ForEach Tree(StartName$)\Childs()
				TreeRecurse(Tree(), MapKey(Tree(StartName$)\Childs()), *Callback, GoUp, MaxLevels)
			Next
		EndIf
	EndIf
EndProcedure

; Returns full path of specified element
; RETURN:         path string, or empty string if no such element found
Procedure$ TreeGetPath (Map Tree.TreeNode(), Name$)
	Protected Path$
	Repeat
		If Name$ And FindMapElement(Tree(), Name$)
			Path$ = Name$ + Path$
			Name$ = Tree()\Parent$
			If Name$
				Path$ = "\" + Path$
			EndIf
		Else
			Break
		EndIf
	ForEver
	ProcedureReturn Path$
EndProcedure
;}




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE CODE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Create tree storage
Global NewMap Tree.TreeNode()

; Fill tree with some items.
; From here "test" is parent for test2, and so on
TreeAdd(Tree(), "test", 1)
TreeAdd(Tree(), "test2", 2, "test")
TreeAdd(Tree(), "test3", 3, "test2")
TreeAdd(Tree(), "test4", 4, "test3")
TreeAdd(Tree(), "testX", 44, "test2")
TreeAdd(Tree(), "testY", 444, "test2")
TreeAdd(Tree(), "testZ", 4444, "testY")
TreeAdd(Tree(), "test5", 5, "test4")
TreeAdd(Tree(), "test6", 6, "test5")
TreeAdd(Tree(), "testA", 66, "test5")
TreeAdd(Tree(), "test7", 7, "test6")
TreeAdd(Tree(), "test8", 8, "test7")

; Here is callback function example for use with TreeRecurse()
; - it can be used to process data in tree (for example, process some item and it's subitems) and other such things
; - it is safe (but not recommended) to add or delete tree items from this callback
; RETURN:      generally none, but if you return non-zero, recursion will not go deeper in current dirrection
;            (but will continue in others until non-zero returned also for them ^_^)
Procedure testCb (*item.TreeNode)
	Debug TreeGetPath (Tree(), *item\Name$) + " : data = " + Str(*item\Data)
EndProcedure


; First just print all items using TreeRecurse() + callback
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end callback example --"
Debug ""

; now "test5" is deleted, it has child elements and all of them
; will join "test4" instead
TreeDelete(Tree(), "test5")
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example1 --"
Debug ""

; and here "test3" is deleted with recursion
; after that all nested items from lower levels are removed also
TreeDelete(Tree(), "test3", #True)
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example2 --"
Debug ""

TreeDelete(Tree(), "test2", #False)
TreeRecurse(Tree(), "test", @testCb())
Debug "-- end delete example2 --"
Debug ""

[Lunasole]

This is a bit "brute force", but this version seems to work correctly (I had trouble for your neurons ):

Well no much trouble (I've added some fix yesterday to that post, propably you didn't seen edit). Recursion generally is funny thing... if fall into "philosophy", all the life goes recursively ^_^

Your current variant with map copy seems working too, but needs more memory and might be slower.

[Torp]

Yes I had not seen your modifications. Much simpler than my solution !

[Lunasole]

Slightly updated code (adding function to return element deepth/level).

Those two [ TreeGetLevel() and TreeGetPath() ] are relatively slow, but as for me it's better than store path/level with elements and update them everytime on item added/delete or move [currently moving is not added yet ^_^]

[Lunasole]

Today I wasted some time to grow that tree... and I can say it grew up damn dramatically from 130 lines to almost 300 ^_^

Key changes:
* childs map replaced with list, which causes that list to be brute-forced on search performed internally, but allowed to do much more things easily.
Should not be a performance problem... in most cases, as the regular item search is still based on map.
* added complex functions, such as renaming and moving of tree item
* added some more

// I guess many ppl would think it would be simpler to use someone's else code, but not for me :) [or at least not this time]. Really it becomes faster to make such "classical things" yourself, among other pluses of that

Anyway, code in main post updated. Take it if you like it :)

Code: Select all

What it can do now:
- add element
- delete (also delete with all nested elements)
- process items recursively through callback function
- return full path of element, element deepth, child count
- rename item
- items movement in all possible and some impossible ways
- search elem by name and "clear tree" (performed by Map itself)