Programing Challenge: Constructing a Tree Given Its Edges.

[Xah Lee]

Programing Challenge: Constructing a Tree Given Its Edges.
Show you are the boss.
http://xahlee.info/perl-python/python_construct_tree_from_edge.html

here's plain text.
────────── ────────── ────────── ────────── ──────────

Problem: given a list of edges of a tree: [child, parent], construct the tree. Here's a sample input: [[0, 2], [3, 0], [1, 4], [2, 4]].

Here's a sample print of a tree data structure:

4
1
2
0
3

this means, the root node's name is 4. It has 2 branches, named 1 and 2. The branche named 2 has 1 children, named 0, and it has one children named 3. The node's names are given as integers, but you can assume them to be strings.

You can choose your own data structure for the output. For example, nested list with 1st element being the node name, or use nested hash of hash, where key is the node name, and value is its children.

Here's sample data structure in python, using hash of hash.

{
"4": {
"1": {},
"2": {
"0": {
"3": {}
}
}
}
}

Other data structure are accepted.

Code it using your favorite language. I'll be able to look at and verify in Mathematica, Python, Ruby, Perl, PHP, JavaScript, Emacs Lisp, Java. But other langs, such as Clojure and other lisps, OCaml, Haskell, erlang, Fortress, APL, HOL, Coq, Lua, Factor, Rust, Julia … are very welcome. 〔☛ Proliferation of Computing Languages〕

You should be able to do this within 8 hours from scratch. Took me 5 hours.

Python solution will be posted in a week, on 2014-01-14 (or sooner if many showed solutions). Post your solution in comment (or link to github or pastebin).

[Nicolas Neuss]

Xah Lee <xah...@gmail.com> writes:

> Programing Challenge: Constructing a Tree Given Its Edges.
> Show you are the boss.
> http://xahlee.info/perl-python/python_construct_tree_from_edge.html
>
> here's plain text.
> ────────── ────────── ────────── ────────── ──────────
>
> Problem: given a list of edges of a tree: [child, parent], construct the tree. Here's a sample input: [[0, 2], [3, 0], [1, 4], [2, 4]].
>
> Here's a sample print of a tree data structure:
>
> 4
> 1
> 2
> 0
> 3
>
> this means, the root node's name is 4. It has 2 branches, named 1 and 2. The branche named 2 has 1 children, named 0, and it has one children named 3. The node's names are given as integers, but you can assume them to be strings.
>
> You can choose your own data structure for the output.

Hmm, isn't

(defun make-tree (edges)
edges)

already a correct answer?

Took me 10 seconds.

Nicolas

[tar...@google.com]

On Wednesday, January 8, 2014 6:57:58 AM UTC-8, Nicolas Neuss wrote:

|Xah Lee writes:
|
||Programing Challenge: Constructing a Tree Given Its Edges.
||Show you are the boss.
||http://xahlee.info/perl-python/python_construct_tree_from_edge.html
|
||here's plain text.
||────────── ────────── ────────── ────────── ──────────
|
||Problem: given a list of edges of a tree: [child, parent], construct the tree.
||Here's a sample input: [[0, 2], [3, 0], [1, 4], [2, 4]].
|
||Here's a sample print of a tree data structure:
|
||4
|| 1
|| 2
|| 0
|| 3

||You can choose your own data structure for the output.
|
|Hmm, isn't
|
| (defun make-tree (edges)
| edges)
|
|already a correct answer?
|
|Took me 10 seconds.
|
|Nicolas

Well, assuming that the output is supposed to be in some sort of indented tree output form, I came up with the following. Still don't understand why it should take 5 hours, though.

This isn't as efficient as it could be, since the search for root nodes in the data structure is N^2. It would be more efficient to keep track of the root nodes in a separate structure and update it. I'll leave that as an exercise for the reader:

(defstruct node id children)

(defun print-tree (node &optional (depth 0))
(format t "~vT~S~%" (* 2 depth) (node-id node))
(incf depth)
(loop for child in (node-children node)
do (print-tree child depth)))


(defun get-root-nodes (node-hashtable)
(flet ((is-root (node node-hashtable)
(loop for n being the hash-values of node-hashtable
never (member node (node-children n)))))
(loop for node being the hash-values of node-hashtable
when (is-root node node-hashtable) collect node)))

(defun output-trees (node-hashtable)
(loop for root in (get-root-nodes node-hashtable)
do (print-tree root)))

(defun make-tree (edges)
(let ((nodes (make-hash-table)))
(loop for (child parent) in edges
do (let ((child-node (gethash child nodes))
(parent-node (gethash parent nodes)))
(unless child-node
(setq child-node (make-node :id child))
(setf (gethash child nodes) child-node))
(unless parent-node
(setq parent-node (make-node :id parent))
(setf (gethash parent nodes) parent-node))
(push child-node (node-children parent-node))))
nodes))

[Michael Kappert]

And it won't fail on forests or cycles!

Here is another solution:

(defun make-tree (edges)
(let ((nodes nil))
(flet ((find-node (n)
(find n nodes :key #'car)))
(flet ((add-node (n)
(unless (find-node n) (push (cons n nil) nodes))))
;; construct nodes
(loop :for (c p) :in edges :do (add-node c) (add-node p))
;; assemble nodes into (sub-) trees
(loop :for (c p) :in edges :do (push (find-node c) (cdr
(find-node p))))
;; return maximal nodes
(delete-if (lambda (n) (find (car n) edges :key #'car)) nodes)))))

> (make-tree '((0 1) (1 0)))
NIL

[Raymond Wiker]

Here's my version of make-tree:

(defun make-tree (children-with-parents &optional (test #'eql))
(let ((roots (make-hash-table :test test))
(tree (make-hash-table :test test)))
(loop for (child . parent) in children-with-parents
do (progn
(remhash child roots)
(unless (gethash parent tree)
(setf (gethash parent roots) t))
(let ((parent-node (or (gethash parent tree)
(setf (gethash parent tree)
(make-hash-table :test test))))
(child-node (or (gethash child tree)
(setf (gethash child tree)
(make-hash-table :test test)))))
(setf (gethash child parent-node) child-node))))
(let ((ret (make-hash-table :test test)))
(loop for k being the hash-keys of roots
do (setf (gethash k ret) (gethash k tree)))
ret)))

--- and no, I cannot see that this is a 5-hour problem...

[Chris Riesbeck]

Indeed, without further constraints on the data structure.

To get

> (EDGES-TO-TREE '((0 2) (3 0) (1 4) (2 4)))
(4 (2 (0 3)) 1)

took me 15 minutes,, and I'm not a fast coder. The code is modular and
passes my fussy Lisp Critic, but could certainly be improved.

http://www.cs.northwestern.edu/academics/courses/325/exercises/critic.html#critic

Won't post so others can play but this is pretty basic.

[Raymond Wiker]

Raymond Wiker <rwi...@gmail.com> writes:

> Here's my version of make-tree:
>
> (defun make-tree (children-with-parents &optional (test #'eql))
> (let ((roots (make-hash-table :test test))
> (tree (make-hash-table :test test)))
> (loop for (child . parent) in children-with-parents
> do (progn
> (remhash child roots)
> (unless (gethash parent tree)
> (setf (gethash parent roots) t))
> (let ((parent-node (or (gethash parent tree)
> (setf (gethash parent tree)
> (make-hash-table :test test))))
> (child-node (or (gethash child tree)
> (setf (gethash child tree)
> (make-hash-table :test test)))))
> (setf (gethash child parent-node) child-node))))
> (let ((ret (make-hash-table :test test)))
> (loop for k being the hash-keys of roots
> do (setf (gethash k ret) (gethash k tree)))
> ret)))
>
> --- and no, I cannot see that this is a 5-hour problem...

Of course, if I had spent a few more minutes on this, I could have avoided
the final (let), and just returned roots directly:

(defun make-tree (children-with-parents &optional (test #'eql))
(let ((roots (make-hash-table :test test))
(tree (make-hash-table :test test)))
(loop for (child . parent) in children-with-parents
do (progn
(remhash child roots)

(let ((parent-node (or (gethash parent tree)

(setf (gethash parent roots)
(setf (gethash parent tree)
(make-hash-table :test test)))))

(child-node (or (gethash child tree)
(setf (gethash child tree)
(make-hash-table :test test)))))
(setf (gethash child parent-node) child-node))))

roots))

[Xah Lee]

On Tuesday, January 7, 2014 7:29:26 PM UTC-8, Xah Lee wrote:
> Programing Challenge: Constructing a Tree Given Its Edges.
>
> Show you are the boss.
>
> http://xahlee.info/perl-python/python_construct_tree_from_edge.html

4 python results are on the altar, 2, drenched in blood.

'tis like the braggadocio in the Roman Arena. If u mouth bigger than what u got, be prepared to drop in epic fail.

ye lispers, let that be a warning. I haven't looked at your code yet, but you still have time to post lil' mendings.

yours truely, Xah

[Michael Kappert]

Ok, here is an optimized version (solving taruss' exercise as requested)

(defstruct node id (children ()) (is-root t))

(defun make-tree1 (edges)
(let ((nodes (make-hash-table)))
(flet ((find-or-create-node (n)
(or (gethash n nodes)
(setf (gethash n nodes) (make-node :id n)))))
(loop :for (c p) :in edges :do
(let ((child-node (find-or-create-node c))
(parent-node (find-or-create-node p)))
(setf (node-is-root child-node) nil)
(push child-node (node-children parent-node))))
(loop
:for n :being :the :hash-values :of nodes
:when (node-is-root n)
:collect n))))

[Chris Riesbeck]

My focus was on being non-destructive and side-effecty. I assumed the
edges described a single valid tree, though generalizing to forests
would just require changing the top-level function. This is my 2nd
version (another 10 minutes). Result for ((0 2) (3 0) (1 4) (2 4))) is
(4 (1) (2 (0 (3))))



(defun edges-to-tree (edges)
(build-tree (find-root edges) edges))

(defun build-tree (node edges)
(cons node
(mapcar #'(lambda (child) (build-tree child edges))
(find-children node edges))))

(defun find-root (edges)
(cadr (find-if #'(lambda (edge)
(notany #'(lambda (other-edge)
(eql (cadr edge) (car other-edge)))
edges))
edges)))

(defun find-children (node edges)
(mapcan #'(lambda (edge)
(and (eql (cadr edge) node) (list (car edge))))
edges))

[Dimitri Fontaine]

Xah Lee <xah...@gmail.com> writes:
> Programing Challenge: Constructing a Tree Given Its Edges.

[…]

> You should be able to do this within 8 hours from scratch. Took me 5 hours.

I didn't understand why it would take anyone that much time. The only
way out of that was to try, right? That's what make this thread a
successful troll I suppose.

So here's what I got in about 20 minutes. I'll admit I'm slow.

I opted for a solution where we scan the list quite a lot, because it
was easier and I just wanted to understand what difficulty would hide.
Didn't find it. Forest certainly isn't it. What did I miss, apart from
feeding what looks very much like a troll?

(defpackage #:print-forest (:use :cl) (:export print-forest))
(in-package #:print-forest)

(defun child (pair) (car pair))
(defun parent (pair) (cadr pair))

(defun children (pairs parent)
"Returns the list of children having PARENT as a parent."
(loop :for (c p) :in pairs :when (eq p parent) :collect c))

(defun roots (pairs)
"Given PAIRS, a list of PAIR elements, return tree ROOTS, that is pairs
where the parent has no parent…"
(let ((parents (mapcar #'parent pairs))
(children (mapcar #'child pairs)))
(set-difference parents children)))

(defun print-forest (pairs &optional (roots nil r-s-p) (depth 0))
"PAIRS is a list of PAIR where each PAIR is a (children parent) list."
(let ((roots (or roots (unless r-s-p (roots pairs)))))
(loop :with visited
:while roots
:for r :in roots
:unless (member r visited)
:do (progn
(format t "~&~a~a" (make-string depth :initial-element #\Space) r)
(print-forest pairs (children pairs r) (+ depth 1))
(push r visited)))))

Regards,
--
dim

[Dimitri Fontaine]

Dimitri Fontaine <d...@tapoueh.org> writes:
> So here's what I got in about 20 minutes. I'll admit I'm slow.

Ok, in fairness, I realized after sending my solution that I didn't
build the nested data structure, only printed it. So here's my recursive
solution with both the printing and the building:

(defpackage #:print-forest (:use :cl) (:export print-forest))
(in-package #:print-forest)

(defun child (pair) (car pair))
(defun parent (pair) (cadr pair))

(defun children (pairs parent)
"Returns the list of children having PARENT as a parent."
(loop :for (c p) :in pairs :when (eq p parent) :collect c))

(defun roots (pairs)
"Given PAIRS, a list of PAIR elements, return tree ROOTS, that is pairs

where the parent has no parent..."

(let ((parents (mapcar #'parent pairs))
(children (mapcar #'child pairs)))
(set-difference parents children)))

(defun print-forest (pairs &optional (roots nil r-s-p) (depth 0))
"PAIRS is a list of PAIR where each PAIR is a (children parent) list."
(let ((roots (or roots (unless r-s-p (roots pairs))))

(indent (make-string depth :initial-element #\Space)))
(when roots
(let ((subtree
(loop :with visited

:for r :in roots
:unless (member r visited)
:do (progn

(format t "~&~a~a" indent r)
(push r visited))
:and
:collect (let ((children (children pairs r)))
(if children
(list r (print-forest pairs children (+ depth 1)))
(list r))))))
;; when we did :collect a single element, refrain from nesting it
(if (cdr subtree) subtree (car subtree))))))

And some testing too:

PRINT-FOREST> (print-forest:print-forest '((0 2) (3 0) (1 4) (2 4)))

4
1
2
0
3

(4 ((1) (2 (0 (3)))))

PRINT-FOREST> (print-forest:print-forest '((0 2) (3 0) (1 4) (2 4) (9 8)))
8
9

4
1
2
0
3

((8 (9)) (4 ((1) (2 (0 (3))))))

PRINT-FOREST> (print-forest:print-forest '((0 2) (3 0) (1 4) (2 4) (5 1) (5 0) (7 2)))
4
1
5
2
0
3
5
7
(4 ((1 (5)) (2 ((0 ((3) (5))) (7)))))

So that's still not 5 hours, not 8 hours, more like 45 minutes tops.

Regards,
--
dim

[Michael Kappert]

Did you try
> (print-forest:print-forest '((0 1) (1 0) (1 2)))
?

Also, Xah seems to use a list containing 2,000,000 edges for testing :-)

[Dimitri Fontaine]

Michael Kappert <michael...@gmx.net> writes:
> Did you try
>> (print-forest:print-forest '((0 1) (1 0) (1 2)))

Hehe, obviously I didn't ;-)

> Also, Xah seems to use a list containing 2,000,000 edges for testing :-)

So my toy example isn't a solution. Fair enough. I would find it quite
hard to believe that a real solution would take 5 hours to develop, that
said, and you already proved that part.


--
dim

[Nicolas Neuss]

Please note that my one-liner

(defun make-tree (edges) edges)

besides meeting all of Xah's requirements[*] is also extremely
performant and can cope easily with 2e6 edges. More precisely,
preceding it with the additional line

(declaim (inline make-tree))

it takes an execution time of precisely 0 seconds which makes it -at
least in this respect- infinitely superior to any other non-equivalent
solution.

Furthermore, since I used only 10 seconds for producing it, whereas Xah
needed 5*3600 seconds for his Python solution, we have also a data point
for a productivity gain of 1800 when switching from Python to Common
Lisp:-)

Nicolas

[*] At least the requirements he posted here. I did not study his
trollish webpage.

[Michael Kappert]

On 01/10/2014 09:58 AM, Nicolas Neuss wrote:
> Dimitri Fontaine <d...@tapoueh.org> writes:
>
>> Michael Kappert <michael...@gmx.net> writes:
>>> Did you try
>>>> (print-forest:print-forest '((0 1) (1 0) (1 2)))

> Please note that my one-liner
>
> (defun make-tree (edges) edges)
>
> besides meeting all of Xah's requirements[*]

> [*] At least the requirements he posted here.

Ah indeed. Sorry for the confusing example.
Actually I had seen this requirement but I forgot about it along the way.

[Mark Tarver]

I changed the format to [parent child] which is a bit more natural. A type secure version in Shen which returns a string in columnar format.

Nice to see friendly challenge problems here again.

Mark

(define tree
{(list (list A)) --> string}
Edges -> (let Root (root Edges (map (function reverse) Edges))
TreeString (cn "c#10;" (tree-string Root Edges 0))
TreeString))

(define root
{(list (list A)) --> (list (list A)) --> A}
[[Root | _] | Edges] All -> Root where (empty? (assoc Root All))
[_ | Edges] All -> (root Edges All))

(define tree-string
{A --> (list (list A)) --> number --> string}
Node Edges Indent -> (let Daughters (daughters Node Edges)
String (str-node Node Indent)
DStrings (map (/. D (tree-string D Edges (+ 1 Indent))) Daughters)
DString (list->str DStrings)
(@s String "c#10;" DString)))

(define list->str
{(list string) --> string}
[] -> ""
[X | Y] -> (@s X (list->str Y)))

(define str-node
{A --> number --> string}
Node 0 -> (str Node)
Node Indent -> (cn " " (str-node Node (- Indent 1))))

(define daughters
{A --> (list (list A)) --> (list A)}
Node Edges -> (mapcan (/. Edge (if (= (head Edge) Node) (tail Edge) [])) Edges))

(85+) (tree [[0 1] [0 2] [2 6] [2 7] [1 3] [1 4] [4 5]])
"
0
1
3
4
5
2
6
7
" : string

[Kaz Kylheku]

On 2014-01-08, Xah Lee <xah...@gmail.com> wrote:
> Problem: given a list of edges of a tree: [child, parent], construct the tree. Here's a sample input: [[0, 2], [3, 0], [1, 4], [2, 4]].
>
> Here's a sample print of a tree data structure:
>
> 4
> 1
> 2
> 0
> 3

TXR Lisp.

@(do
(defun tree-hash (edges)
(let ((th [group-by second edges]))
(dohash (key value th th)
(set [th key] [mapcar first value]))))

(defun discover-roots (th)
(let* ((children [reduce-left append (hash-values th)])
(child-hash '#H(() ,*[mapcar list children]))
(th-no-kids (hash-diff th child-hash)))
(hash-keys th-no-kids)))

(defun extract-tree (th root)
(let ((children [th root]))
(if children
'(,root ,*[mapcar (op extract-tree th) children]) ;; internal
root))) ;; leaf

(defun make-tree (edges)
(let* ((th (tree-hash edges))
(r (discover-roots th)))
(if (rest r)
[mapcar (op extract-tree th) r] ;; forest
(extract-tree th (first r))))) ;; tree

;; test
(print (make-tree '((1 4) (2 4) (0 2) (3 0))))
(put-line "")
(print (make-tree '((1 2) (3 4))))
(put-line "")
(print (make-tree '((1 2) (2 3) (3 4))))
(put-line ""))

Output:

$ txr trees.txr
(4 1 (2 (0 3)))
((2 1) (4 3))
(4 (3 (2 1)))

[Kaz Kylheku]

On 2014-01-08, Xah Lee <xah...@gmail.com> wrote:

> Programing Challenge: Constructing a Tree Given Its Edges.
> Show you are the boss.
> http://xahlee.info/perl-python/python_construct_tree_from_edge.html

By the way, this type of activity is carried out at the Rosetta Code site,
where you could just propose this as a task.

[His Kennyness]

(defun edges-tree (edges)
(loop with trs
for (k p) in edges
for pt = (assoc p trs)
for kt = (assoc k trs)
collect k into ks
do
(unless kt (setf kt (car (push (list k) trs))))
(unless pt (setf pt (car (push (list p) trs))))
(rplacd pt (cons kt (cdr pt)))
finally (return
(loop for tr in trs
unless (find (car tr) ks)
return tr))))

Fifteen minutes. Use a hash table if sufficiently large trees expected.

-kt

[His Kennyness]

On Monday, February 3, 2014 3:28:52 AM UTC-5, Stefan Ram wrote:

> His Kennyness <kent...@gmail.com> writes:
>
> >>Problem: given a list of edges of a tree: [child, parent], construct the tree.
>

> >Fifteen minutes. Use a hash table if sufficiently large trees expected.
>
>
>

> 0 seconds. (For me, I /have/ the tree, when I got a list of the edges.
>
> Storing a list of all edges is just a fine way to store a tree. I call
>
> it »the edge-list storage representation of the tree«.)

Yes, I saw this Deep Insight earlier and liked it then.

Now can I see your traversal routine?

:)

-hk