aboutsummaryrefslogtreecommitdiff
path: root/tree.tcl
blob: 01fc16704eae9bc2c666346a35354179631f82e8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
# Conceptually compatible with tcllib ::struct::tree
# but uses an object based interface.
# To mimic tcllib, do:
#   rename [tree] mytree

package require oo

# set pt [tree]
#
#   Create a tree
#   This automatically creates a node named "root"
#
# $pt destroy
#
#   Destroy the tree and all it's nodes
#
# $pt set <nodename> <key> <value>
#
#   Set the value for the given key
#
# $pt lappend <nodename> <key> <value> ...
#
#   Append to the (list) value(s) for the given key, or set if not yet set
#
# $pt keyexists <nodename> <key>
#
#   Returns 1 if the given key exists
#
# $pt get <nodename> <key>
#
#   Returns the value associated with the given key
# 
# $pt getall <nodename>
#
#   Returns the entire attribute dictionary associated with the given key
# 
# $pt depth <nodename>
#
#   Returns the depth of the given node. The depth of "root" is 0.
#
# $pt parent <nodename>
#
#   Returns the name of the parent node, or "" for the root node.
# 
# $pt numchildren <nodename>
#
#   Returns the number of child nodes.
# 
# $pt children <nodename>
#
#   Returns a list of the child nodes.
# 
# $pt next <nodename>
#
#   Returns the next sibling node, or "" if none.
# 
# $pt insert <nodename> ?index?
#
#   Add a new child node to the given node.
#   THe default index is "end"
#   Returns the name of the newly added node
#
# $pt walk <nodename> dfs|bfs {actionvar nodevar} <code>
#
#   Walks the tree starting from the given node, either breadth first (bfs)
#   depth first (dfs).
#   The value "enter" or "exit" is stored in variable $actionvar
#   The name of each node is stored in $nodevar.
#   The script $code is evaluated twice for each node, on entry and exit.
#
# $pt dump
#
#   Dumps the tree contents to stdout

#------------------------------------------
# Internal implementation.
# The tree class has 4 instance variables.
# - tree is a dictionary. key=node, value=node value dictionary
# - parent is a dictionary. key=node, value=parent of this node
# - children is a dictionary. key=node, value=list of child nodes for this node
# - nodeid is an integer which increments to give each node a unique id

# Construct a tree with a single root node with no parent and no children
class tree {
	tree {root {}}
	parents {root {}}
	children {root {}}
	nodeid 0
}

# Simply walk up the tree to get the depth
tree method depth {node} {
	set depth 0
	while {$node ne "root"} {
		incr depth
		set node [dict get $parents $node]
	}
	return $depth
}

tree method parent {node} {
	dict get $parents $node
}

tree method children {node} {
	dict get $children $node
}

tree method numchildren {node} {
	llength [dict get $children $node]
}

tree method next {node} {
	# My siblings are my parents children
	set siblings [dict get $children [dict get $parents $node]]
	# Find me
	set i [lsearch $siblings $node]
	incr i
	lindex $siblings $i
}

tree method set {node key value} {
	dict set tree $node $key $value
	return $value
}

tree method get {node key} {
	dict get $tree $node $key
}

tree method keyexists {node key} {
	dict exists $tree $node $key
}

tree method getall {node} {
	dict get $tree $node
}

tree method insert {node {index end}} {

	# Make a new node and add it to the tree
	set childname node[incr nodeid]
	dict set tree $childname {}

	# The new node has no children
	dict set children $childname {}

	# Set the parent
	dict set parents $childname $node

	# And add it as a child
	set nodes [dict get $children $node]
	dict set children $node [linsert $nodes $index $childname]

	return $childname
}

tree method lappend {node key args} {
	if {[dict exists $tree $node $key]} {
		set result [dict get $tree $node $key]
	}
	lappend result {*}$args
	dict set tree $node $key $result
	return $result
}

# $tree walk node bfs|dfs {action loopvar} <code>
#
tree method walk {node type vars code} {
	# set up vars
	lassign $vars actionvar namevar

	set n $node

	if {$type ne "child"} {
		upvar 2 $namevar name $actionvar action

		# Enter this node
		set name $node
		set action enter

		uplevel 2 $code
	}

	if {$type eq "dfs"} {
		# Depth-first so do the children
		foreach child [$self children $n] {
			uplevel 2 [list $self walk $child $type $vars $code]
		}
	} elseif {$type ne "none"} {
		# Breadth-first so do the children to one level only
		foreach child [$self children $n] {
			uplevel 2 [list $self walk $child none $vars $code]
		}

		# Now our grandchildren
		foreach child [$self children $n] {
			uplevel 2 [list $self walk $child child $vars $code]
		}
	}

	if {$type ne "child"} {
		# Exit this node
		set name $node
		set action exit

		uplevel 2 $code
	}
}

tree method dump {} {
	$self walk root dfs {action n} {
		set indent [string repeat "  " [$self depth $n]]
		if {$action eq "enter"} {
			puts "$indent$n ([$self getall $n])"
		}
	}
	puts ""
}