Calculating the depth of a tree data structure - clojure - clojure

I'm trying to implement an algorithm to find the depth of a sequence expression through Clojure Zippers.
(zip/seq-zip (+ 1 (* 2 3)))
This is the way I'm interpreting a sequence to be converted into a tree data structure. Is there a direct method to calculate this through Zipper library(the depth to be calculated as 2, from the given example)?
Any suggestions would be appreciated!

You can use the following recursive approach:
(defn height [s-expr]
(if-let [sub-trees (seq (filter coll? s-expr))]
(inc
(apply max
(map height sub-trees)))
0))
=> (height '(+ 1 (* 2 3)))
=> 1
Effectively the above treats collections as branches and everything else as leaves. You can replace coll? with any other branch definition (e.g. list?) that fits your needs.

You might want to compute both the minimum and maximum heights of a tree.
In that case you can extend this approach to include a comp function argument to determine that selection criteria.
;; Compute the height (either min or max, according to the `comp` function)
;; of the tree `tree`. Trees must be expressed as nested sequences.
(defn height
[tree comp]
(if (coll? tree)
(inc (apply comp (map #(height % comp) tree)))
0))
(defn max-height [tree] (height tree max))
(defn min-height [tree] (height tree min))

Related

Clojure tree node based on depth

I've been struggling with a recursion problem and I'm running out of ideas. Basically, I have a tree representation that looks like this:
{1 {:root nil} 2 {:root 1} 3 {:root 1} 4 {:root 2} 5 {:root 1} 6 {:root 4}}
And I have to build a new tree out of the last one which indicates parent/child relationship levels. A valid output would be:
{ 1 [3 1] 2 [1] 3 [] 4 [1] 5 [] 6 [] }
Where each node has an array of a count of items by level of relationship. So node 1 has 3 direct children (2 3 5) and one grandchild (4). Node 2 has only one child (4), node 4 has one direct child (6) and all the others are empty (have no children).
I found some questions like this one that actually helped but aren't exactly what I was looking for. I'm also new to function programming and any help is going to be appreciated.
I'm going to assume that there is an error in your sample output above and that it should really be:
{ 1 [3 1 1] 2 [1 1] 3 [] 4 [1] 5 [] 6 [] }
Your sample output did not account for the fact that 6 is a great-grandchild of 1 and a grandchild of 2.
I'll detail a solution here. We'll start out by writing a function which, given a tree and a vertex in that tree, calculates the path from that vertex to the top of the tree:
(defn path-to-top [tree v]
(if (nil? v)
'()
(cons v (path-to-top tree (:root (get tree v))))))
Next up, let us write a function which takes such a path from the vertex to the top of the tree and associates with each vertex on the distance of that vertex from the starting vertex:
(defn steps-indexed-path
([upward-path steps]
(if (= upward-path '())
'()
(cons [(first upward-path) steps] (steps-indexed-path (rest upward-path) (+ steps 1)))))
([upward-path]
(steps-indexed-path upward-path 0)))
Where the first function returned a list of vertices, this function returns a list of vectors in which the first entry is a vertex and the second entry is the number of steps from the first vertex on the path to the given vertex.
Alright, when we apply this function to each of the vertices in the tree, we will have (in some nested form) for each vertex v and for each descendant w of v the data [v <# steps from v to w>]. For each of these data, we should add 1 to the <# steps from v to w> component of the vector associated with v in our final solution. Before we move to the vector stage, let us just associate levels with counts:
(defn count-descendants [tree]
(let [markers (reduce concat '() (map steps-indexed-path (map (partial path-to-top tree) (keys tree))))]
(reduce (fn [counter [vertex generation]] (assoc counter vertex (assoc (get counter vertex {}) generation (+ (get (get counter vertex {}) generation 0) 1)))) {} markers)))
This produces a hash-map whose keys are the vertices of v and such that the value corresponding to each vertex v is another hash-map in which the keys are the different possible generations of descendants of that vertex in the tree, and the values are the number of descendants at each generation.
All we have to do now is turn the output of the previous function into the format specified by you:
(defn sanitize-descendant-counts [association]
(let [max-depth (apply max (keys association))]
(map (fn [i] (get association i 0)) (range 1 (+ max-depth 1)))))
(defn solve-problem [tree]
(let [descendant-counts (count-descendants tree)]
(apply merge (map (fn [v] (hash-map v (vec (sanitize-descendant-counts (get descendant-counts v))))) (keys descendant-counts)))))
This is what I get as output when I run this code on your example:
{1 [3 1 1], 4 [1], 6 [], 3 [], 2 [1 1], 5 []}
You can access all the code here, including what you need to run on your example. Hope that helps!
I will try to outline a possible approach, stressing the recursion core, and glossing over smaller details. There are quite a few of those smaller details, and some of them aren't exactly trivial, but they have nothing to do with the recursion itself, and would just clutter the answer.
Let's abstract from the details of your tree representation. Think about a tree as a collection of nodes, where each node may be either a leaf (no children,) or a branch otherwise. Assume we have two functions branch? and children. Either receives one parameter - a node. branch? is a predicate with an obvious meaning, children returns a sequence of children of the node. (It is the same contract as expected by tree-seq core function.) I leave it to you to code branch? and children. (You may want to change your tree representation to make it easier to code these functions.)
Let's try to create a function levels that given a node will return a sequence of number of descendants by levels - children, grandchildren and so on. So we would expect for your tree
(levels 1)
;; => (3 1 1)
(levels 2)
;; => (1 1)
(You got a typo, by the way. Node 1 has a grand-grandchild - it's 6)
And here's the core - levels:
(defn levels
[node]
(if (branch? node)
(cons (count (children node)) (sum-up-levels (map levels (children node))))
[]))
This is the meat of the recursion. The base case is the leaf - when branch? returns false we know there are no children, so the levels are empty - []. Otherwise, we count the children and cons that number (i.e. add to the list) of the summed up levels below. Summing up means summing the numbers by levels - total number of children, then total number of grandchildren and so on. And here we have the recursion - we descend down to the children, invoking levels recursively for every child using map.
The sum-up-levels function is a bit annoying to code. I am leaving so much for you to fill in that I'd probably just give my code of it here (certainly not the shortest possible, but I don't have more time to polish it.)
(defn reduce-through
[f & colls]
(when-let [colls (seq (filter seq colls))]
(cons (reduce f (map first colls))
(apply reduce-through f (map rest colls)))))
(defn sum-up-levels
[levels]
(apply reduce-through + levels))
After having levels defined, it's easy to get the result in the form you need. Try it (a hint - use tree-seq.)
(defn children-depths [parents]
(let [children ; let's first build an inverted index
(reduce-kv (fn [children node {parent :root}]
(update children parent conj node))
{} parents)
depths (fn depths [node]
(if-some [nodes (children node)]
(into [(count nodes)]
; pads and sums
(reduce #(map + (concat %1 (repeat 0)) (depths %2))
nil nodes))
[]))] ; no descendants -> empty
(into {} (for [node (keys parents)] [node (depths node)]))))
=> (children-depths {1 {:root nil} 2 {:root 1} 3 {:root 1} 4 {:root 2} 5 {:root 1} 6 {:root 4}})
{1 [3 1 1], 2 [1 1], 3 [], 4 [1], 5 [], 6 []}
One obvious improvement would be to avoid recomputing depths of children.

Clojure using let variable declaration within its own instantiation?

In the language of Clojure I am trying to pass a variable that I am defining within a let as a parameter to a function within the same let. The variable itself represents a list of vectors representing edges in a graph. The function I want to pass it to uses the list to make sure that it does not generate the same value within the list.
The function in whole
(defn random-WS
([n k] (random-WS (- n 1) k (reg-ring-lattice n k)))
([n k graph]
(cond (= n -1) graph
:else
(let [rem-list (for [j (range (count (graph n))) :when (< (rand) 0.5)]
[n (nth (seq (graph n)) j)])
add-list (for [j (range (count rem-list))]
(random-WSE graph n add-list))
new-graph (reduce add-edge (reduce rem-edge graph rem-list) add-list)]
(random-WS (- n 1) k new-graph)))))
The actual problem statement is seen here
add-list (for [j (range (count rem-list))]
(random-WSE graph n add-list))
Again for clarity, the function random-WSE generates a random edge for my graph based on some rules. Given the current graph, current node n, and current list of edges to add add-list it will generate one more edge to add to the list based on some rules.
The only real idea I have is to first let add-list () to first define it before then redefining it. Though this still has somewhat the same issue, though add-list is now defined, it will be () through out the for statement. Thus the function random-WSE will not take into account the edges already in the list.
Is there a way to "evaluate" add-list at some defined point within its own definition so that it can be used, within its definition? So I would first "evaluate" it to () before the for and then "evaluate" after each iteration of the for.
If you're interested the function is used to create a random Watts-Stogatz graph.
From what I get of your description of this algorithm, add-list grows (accumulates) during the problematic for loop. Accumulation (for a very broad acceptation of accumulation) is a strong sign you should use reduce:
(reduce (fn [add-list j] (conj add-list (random-WSE graph n add-list))) [] (range (count rem-list))
Basically you're chaining results in your let, in the sense that the result of the first computation (resulting in rem-list) is the sole input for your second computation (your trouble point) which again is the sole input for your third computation, which is finally the sole input to your final computation step (your recursion step). If this chaining sounds familiar, that's because it is: think about reformulating your let construction in terms of the threading macro ->.
I.e. something along the lines of
(defn- rem-list [graph n]
...)
(defn- add-list [remlist n]
...)
(defn- new-graph [addlist]
...)
(defn random-ws
([n k] ...)
([graph n k] ;; <- note the moved parameter
(cond (= n -1) graph
:else
(-> graph
(rem-list n)
(add-list n)
(new-graph)
(random-ws (dec n) k))))
You can then formulate add-list as a simple recursive function (maybe introduce an accumulator variable) or use the reduce variant that cgrand explained.

find the n-tuples of all integers below m whose sum is a prime

I am going through the Clojure in Action book and code similar to that below is given for a function that returns all pairs of numbers below m whose sum is a prime (assume prime? is given):
(defn pairs-for-primes [m]
(let [z (range 0 m)]
(for [a z b z :when (prime? (+ a b))]
(list a b))))
How would one generalize that to return the n-tuples of all numbers below m whose sum is a prime?
(defn all-ntuples-below [n m]
...
for can be used for a sort of "special case" of cartesian product, where you know the sets in advance at compile time. Since you don't actually know the sets you want the product of, you need to use a real cartesian-product function. For example, with clojure.math.combinatorics, you could write
(defn pairs-for-primes [m n]
(let [z (range 0 m)
tuples (apply cartesian-product (repeat n z))]
(filter #(prime? (apply + %)) tuples)))
But perhaps your question is about how to implement a cartesian product? It's not that hard, although the version below is not terribly performant:
(defn cartesian-product [sets]
(cond (empty? sets) (list (list))
(not (next sets)) (map list (first sets))
:else (for [x (first sets)
tuple (cartesian-product (rest sets))]
(cons x tuple))))
You can use take to do that (as pairs-for-primes returns a sequence take will only cause it to calculate the number of items required)
(defn all-ntuples-below [n m]
(take n (pairs-for-primes m)))

How to walk an AST with tail recursion in Clojure

I have an ANTLR3 AST which I need to traverse using a post-order, depth-first traversal which I have implemented as roughly the following Clojure:
(defn walk-tree [^CommonTree node]
(if (zero? (.getChildCount node))
(read-string (.getText node))
(execute-node
(map-action node)
(map walk-tree (.getChildren node)))))))
I would like to convert this to tail recursion using loop...recur, but I haven't been able to figure out how to effectively use an explicit stack to do this since I need a post-order traversal.
Instead of producing a tail recursive solution which traverses the tree and visits each node, you could produce a lazy sequence of the depth first traversal using the tree-seq function and then get the text out of each object in the traversal. Lazy sequences never blow the stack because they store all the state required to produce the next item in the sequence in the heap. They are very often used instead of recursive solutions like this where loop and recur are more diffacult.
I don't know what your tree looks like though a typical answer would look something like this. You would need to play with the "Has Children" "list of children" functions
(map #(.getText %) ;; Has Children? List of Children Input Tree
(tree-seq #(> (.getChildCount #) 0) #(.getChildren %) my-antlr-ast))
If tree-seq does not suit your needs there are other ways to produce a lazy sequence from a tree. Look at the zipper library next.
As you mention, the only way to implement this using tail recursion is to switch to using an explicit stack. One possible approach is to convert the tree structure into a stack structure that is essentially a Reverse Polish notation representation of the tree (using a loop and an intermediate stack to accomplish this). You would then use another loop to traverse the stack and build up your result.
Here's a sample program that I wrote to accomplish this, using the Java code at postorder using tail recursion as an inspiration.
(def op-map {'+ +, '- -, '* *, '/ /})
;; Convert the tree to a linear, postfix notation stack
(defn build-traversal [tree]
(loop [stack [tree] traversal []]
(if (empty? stack)
traversal
(let [e (peek stack)
s (pop stack)]
(if (seq? e)
(recur (into s (rest e))
(conj traversal {:op (first e) :count (count (rest e))}))
(recur s (conj traversal {:arg e})))))))
;; Pop the last n items off the stack, returning a vector with the remaining
;; stack and a list of the last n items in the order they were added to
;; the stack
(defn pop-n [stack n]
(loop [i n s stack t '()]
(if (= i 0)
[s t]
(recur (dec i) (pop s) (conj t (peek s))))))
;; Evaluate the operations in a depth-first manner, using a temporary stack
;; to hold intermediate results.
(defn eval-traversal [traversal]
(loop [op-stack traversal arg-stack []]
(if (empty? op-stack)
(peek arg-stack)
(let [o (peek op-stack)
s (pop op-stack)]
(if-let [a (:arg o)]
(recur s (conj arg-stack a))
(let [[args op-args] (pop-n arg-stack (:count o))]
(recur s (conj args (apply (op-map (:op o)) op-args)))))))))
(defn eval-tree [tree] (-> tree build-traversal eval-traversal))
You can call it as such:
user> (def t '(* (+ 1 2) (- 4 1 2) (/ 6 3)))
#'user/t
user> (eval-tree t)
6
I leave it as an exercise to the reader to convert this to work with a Antlr AST structure ;)
I'm not skilled up on clojure, but I think I understand what you're looking for.
Here's some pseudocode. The stack here in my pseudocode looks like a stateful object, but it's quite feasible to use an immutable one instead. It uses something like O(depth of tree * max children per node) heap.
walk_tree(TreeNode node) {
stack = new Stack<Pair<TreeNode, Boolean>>();
push(Pair(node, True), stack)
walk_tree_aux(stack);
}
walk_tree_aux(Stack<Pair<TreeNode, Boolean>> stack) { -- this should be tail-recursive
if stack is empty, return;
let (topnode, topflag) = pop(stack);
if (topflag is true) {
push Pair(topnode, False) onto stack);
for each child of topnode, in reverse order:
push(Pair(child, True)) onto stack
walk_tree_aux(stack);
} else { -- topflag is false
process(topnode)
walk_tree_aux(stack);
}
}

Cleaning up Clojure function

Coming from imperative programming languages, I am trying to wrap my head around Clojure in hopes of using it for its multi-threading capability.
One of the problems from 4Clojure is to write a function that generates a list of Fibonacci numbers of length N, for N > 1. I wrote a function, but given my limited background, I would like some input on whether or not this is the best Clojure way of doing things. The code is as follows:
(fn fib [x] (cond
(= x 2) '(1 1)
:else (reverse (conj (reverse (fib (dec x))) (+ (last (fib (dec x))) (-> (fib (dec x)) reverse rest first))))
))
The most idiomatic "functional" way would probably be to create an infinite lazy sequence of fibonacci numbers and then extract the first n values, i.e.:
(take n some-infinite-fibonacci-sequence)
The following link has some very interesting ways of generating fibonnaci sequences along those lines:
http://en.wikibooks.org/wiki/Clojure_Programming/Examples/Lazy_Fibonacci
Finally here is another fun implementation to consider:
(defn fib [n]
(let [next-fib-pair (fn [[a b]] [b (+ a b)])
fib-pairs (iterate next-fib-pair [1 1])
all-fibs (map first fib-pairs)]
(take n all-fibs)))
(fib 6)
=> (1 1 2 3 5 8)
It's not as concise as it could be, but demonstrates quite nicely the use of Clojure's destructuring, lazy sequences and higher order functions to solve the problem.
Here is a version of Fibonacci that I like very much (I took the implementation from the clojure wikibook: http://en.wikibooks.org/wiki/Clojure_Programming)
(def fib-seq (lazy-cat [0 1] (map + (rest fib-seq) fib-seq)))
It works like this: Imagine you already have the infinite sequence of Fibonacci numbers. If you take the tail of the sequence and add it element-wise to the original sequence you get the (tail of the tail of the) Fibonacci sequence
0 1 1 2 3 5 8 ...
1 1 2 3 5 8 ...
-----------------
1 2 3 5 8 13 ...
thus you can use this to calculate the sequence. You need two initial elements [0 1] (or [1 1] depending on where you start the sequence) and then you just map over the two sequences adding the elements. Note that you need lazy sequences here.
I think this is the most elegant and (at least for me) mind stretching implementation.
Edit: The fib function is
(defn fib [n] (nth fib-seq n))
Here's one way of doing it that gives you a bit of exposure to lazy sequences, although it's certainly not really an optimal way of computing the Fibonacci sequence.
Given the definition of the Fibonacci sequence, we can see that it's built up by repeatedly applying the same rule to the base case of '(1 1). The Clojure function iterate sounds like it would be good for this:
user> (doc iterate)
-------------------------
clojure.core/iterate
([f x])
Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects
So for our function we'd want something that takes the values we've computed so far, sums the two most recent, and returns a list of the new value and all the old values.
(fn [[x y & _ :as all]] (cons (+ x y) all))
The argument list here just means that x and y will be bound to the first two values from the list passed as the function's argument, a list containing all arguments after the first two will be bound to _, and the original list passed as an argument to the function can be referred to via all.
Now, iterate will return an infinite sequence of intermediate values, so for our case we'll want to wrap it in something that'll just return the value we're interested in; lazy evaluation will stop the entire infinite sequence being evaluated.
(defn fib [n]
(nth (iterate (fn [[x y & _ :as all]] (cons (+ x y) all)) '(1 1)) (- n 2)))
Note also that this returns the result in the opposite order to your implementation; it's a simple matter to fix this with reverse of course.
Edit: or indeed, as amalloy says, by using vectors:
(defn fib [n]
(nth (iterate (fn [all]
(conj all (->> all (take-last 2) (apply +)))) [1 1])
(- n 2)))
See Christophe Grand's Fibonacci solution in Programming Clojure by Stu Halloway. It is the most elegant solution I have seen.
(defn fibo [] (map first (iterate (fn [[a b]] [b (+ a b)]) [0 1])))
(take 10 (fibo))
Also see
How can I generate the Fibonacci sequence using Clojure?