Clojure tree node based on depth - clojure

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.

Related

How to calculate the sum of all depths in a tree using basic `recur`?

For a given tree I would like to sum the depth of each node and calculate that recursively (so not with map/flatten/sum).
Is there a way to do that with recur or do I need to use a zipper in this case?
recur is for tail recursion, meaning if you could do it with normal recursion, where the return value is exactly what a single recursive call would return, then you can use it.
Most functions on trees cannot be written in a straightforward way when restricted to using only tail recursion. Normal recursive calls are much more straightforward, and as long as the tree depth is not thousands of levels deep, then normal recursive calls are just fine in Clojure.
The reason you may have found recommendations against using normal recursive calls in Clojure is for cases when the call stack could grow to tens or hundreds of thousands of calls deep, e.g. a recursive call one level deep for each element of a sequence that could be tens or hundreds of thousands of elements long. That would exceed the default maximum call stack depth limits of many run-time systems.
Using normal stack consuming recursion you can accomplish this pretty easily, by doing a depth-first traversal and summing the depth on the way back out.
(defn sum-depths
([tree]
(sum-depths tree 0))
([node depth]
(if-not (vector? node)
depth
(do
(apply
+
(for [child-node (second node)]
(sum-depths child-node (inc depth))))))))
(sum-depths [:root
[:a1
[:b1
[:a2 :b2]]
:c1]])
;; => 6
(sum-depths ["COM"
[["B"
[["C"
[["D"
[["E"
["F"
["J"
[["K"
["L"]]]]]]
"I"]]]]
["G"
["H"]]]]]])
;; => 19
The details depend a little bit on how you model your tree, so the above assumes that a node is either a vector pair where the first element is the value and the second element is a vector of children nodes, or if it is a leaf node then it's not a vector.
So a leaf node is anything that's not a vector.
And a node with children is a vector of form: [value [child1 child2 ...]
And here I assumed you wanted to sum the depth of all leaf nodes. Since I see from your answer, that your example gives 42, I'm now thinking you meant the sum of the depth of every node, not just leaves, if so it only takes one extra line of code to do so:
(defn sum-depths
([tree]
(sum-depths tree 0))
([node depth]
(if-not (vector? node)
depth
(do
(apply
+
depth
(for [child-node (second node)]
(sum-depths child-node (inc depth))))))))
(sum-depths [:root
[:a1
[:b1
[:a2 :b2]]
:c1]])
;; => 7
(sum-depths ["COM"
[["B"
[["C"
[["D"
[["E"
["F"
["J"
[["K"
["L"]]]]]]
"I"]]]]
["G"
["H"]]]]]])
;; => 42
And like your own answer showed, this particular algorithm can be solved without a stack as well, by doing a level order traversal (aka breadth-first traversal) of the tree. Here it is working on my tree data-structure (similar strategy then your own answer otherwise):
(defn sum-depths [tree]
(loop [children (second tree) depth 0 total 0]
(if (empty? children)
total
(let [child-depth (inc depth)
level-total (* (count children) child-depth)]
(recur (into [] (comp (filter vector?) (mapcat second)) children)
child-depth
(+ total level-total))))))
(sum-depths [:root
[:a1
[:b1
[:a2 :b2]]
:c1]])
;; => 7
(sum-depths ["COM"
[["B"
[["C"
[["D"
[["E"
["F"
["J"
[["K"
["L"]]]]]]
"I"]]]]
["G"
["H"]]]]]])
;; => 42
And for completeness, I also want to show how you can do a depth-first recursive traversal using core.async instead of the function call stack in order to be able to traverse trees that would cause a StackOverFlow otherwise, but still using a stack based recursive depth-first traversal instead of an iterative one. As an aside, there exists some non stack consuming O(1) space depth-first traversals as well, using threaded trees (Morris algorithm) or tree transformations, but I won't show those as I'm not super familiar with them and I believe they only work on binary trees.
First, let's construct a degenerate tree of depth 10000 which causes a StackOverFlow when run against our original stack-recursive sum-depths:
(def tree
(loop [i 0 t [:a [:b]]]
(if (< i 10000)
(recur (inc i)
[:a [t]])
t)))
(defn sum-depths
([tree]
(sum-depths tree 0))
([node depth]
(if-not (vector? node)
depth
(do
(apply
+
depth
(for [child-node (second node)]
(sum-depths child-node (inc depth))))))))
(sum-depths tree)
;; => java.lang.StackOverflowError
If it works on your machine, try increasing 10000 to something even bigger.
Now we rewrite it to use core.async instead:
(require '[clojure.core.async :as async])
(defmacro for* [[element-sym coll] & body]
`(loop [acc# [] coll# ~coll]
(if-let [~element-sym (first coll#)]
(recur (conj acc# (do ~#body)) (next coll#))
acc#)))
(def tree
(loop [i 0 t [:a [:b]]]
(if (< i 10000)
(recur (inc i)
[:a [t]])
t)))
(defn sum-depths
([tree]
(async/<!! (sum-depths tree 0)))
([node depth]
(async/go
(if-not (vector? node)
depth
(do
(apply
+
depth
(for* [child-node (second node)]
(async/<!
(sum-depths child-node (inc depth))))))))))
;; => (sum-depths tree)
50015001
It is relatively easy to rewrite a stack-recursive algorithm to use core.async instead of the call stack, and thus make it so it isn't at risk of causing a StackOverFlow in the case of large inputs. Just wrap it in a go block, and wrap the recursive calls in a <! and the whole algorithm in a <!!. The only tricky part is that core.async cannot cross function boundaries, which is why the for* macro is used above. The normal Clojure for macro crosses function boundaries internally, and thus we can't use <! inside it. By rewriting it to not do so, we can use <! inside it.
Now for this particular algorithm, the tail-recursive variant using loop/recur is probably best, but I wanted to show this technique of using core.async for posterity, since it can be useful in other cases where there isn't a trivial tail-recursive implementation.
i would also propose this one, which is kinda straightforward:
it uses more or less the same approach, as tail recursive flatten does:
(defn sum-depth
([data] (sum-depth data 1 0))
([[x & xs :as data] curr res]
(cond (empty? data) res
(coll? x) (recur (concat x [:local/up] xs) (inc curr) res)
(= :local/up x) (recur xs (dec curr) res)
:else (recur xs curr (+ res curr)))))
the trick is that when you encounter the collection at the head of the sequence, you concat it to the rest, adding special indicator that signals the end of branch and level up. It allows you to track the current depth value. Quite simple, and also using one pass.
user> (sum-depth [1 [2 7] [3]])
;;=> 7
user> (sum-depth [1 2 3 [[[[[4]]]]]])
;;=> 9
You can use map/mapcat to walk a tree recursively to produce a lazy-seq (of leaf nodes). If you need depth information, just add it along the way.
(defn leaf-seq
[branch? children root]
(let [walk (fn walk [lvl node]
(if (branch? node)
(->> node
children
(mapcat (partial walk (inc lvl))))
[{:lvl lvl
:leaf node}]))]
(walk 0 root)))
To run:
(->> '((1 2 ((3))) (4))
(leaf-seq seq? identity)
(map :lvl)
(reduce +))
;; => 10
where the depths of each node are:
(->> '((1 2 ((3))) (4))
(leaf-seq seq? identity)
(map :lvl))
;; => (2 2 4 2)
Updates - sum all nodes instead of just leaf nodes
I misread the original requirement and was assuming leaf nodes only. To add the branch node back is easy, we just need to cons it before its child sequence.
(defn node-seq
"Returns all the nodes marked with depth/level"
[branch? children root]
(let [walk (fn walk [lvl node]
(lazy-seq
(cons {:lvl lvl
:node node}
(when (branch? node)
(->> node
children
(mapcat (partial walk (inc lvl))))))))]
(walk 0 root)))
Then we can walk on the hiccup-like tree as before:
(->> ["COM" [["B" [["C" [["D" [["E" [["F"] ["J" [["K" [["L"]]]]]]] ["I"]]]]] ["G" [["H"]]]]]]]
(node-seq #(s/valid? ::branch %) second)
(map :lvl)
(reduce +))
;; => 42
Note: above function uses below helper specs to identify the branch/leaf:
(s/def ::leaf (s/coll-of string? :min-count 1 :max-count 1))
(s/def ::branch (s/cat :tag string? :children (s/coll-of (s/or :leaf ::leaf
:branch ::branch))))
Here's my alternative approach that does use recur:
(defn sum-of-depths
[branches]
(loop [branches branches
cur-depth 0
total-depth 0]
(cond
(empty? branches) total-depth
:else (recur
(mapcat (fn [node] (second node)) branches)
(inc cur-depth)
(+ total-depth (* (count branches) cur-depth))))))
(def tree ["COM" (["B" (["C" (["D" (["E" (["F"] ["J" (["K" (["L"])])])] ["I"])])] ["G" (["H"])])])])
(sum-of-depths [tree]) ; For the first call we have to wrap the tree in a list.
=> 42
You can do this using the Tupelo Forest library. Here is a function to extract information about a tree in Hiccup format. First, think about how we want to use the information for a simple tree with 3 nodes:
(dotest
(hid-count-reset)
(let [td (tree-data [:a
[:b 21]
[:c 39]])]
(is= (grab :paths td) [[1003]
[1003 1001]
[1003 1002]])
(is= (grab :node-hids td) [1003 1001 1002])
(is= (grab :tags td) [:a :b :c])
(is= (grab :depths td) [1 2 2])
(is= (grab :total-depth td) 5) ))
Here is how we calculate the above information:
(ns tst.demo.core
(:use tupelo.forest tupelo.core tupelo.test)
(:require
[schema.core :as s]
[tupelo.schema :as tsk]))
(s/defn tree-data :- tsk/KeyMap
"Returns data about a hiccup tree"
[hiccup :- tsk/Vec]
(with-forest (new-forest)
(let [root-hid (add-tree-hiccup hiccup)
paths (find-paths root-hid [:** :*])
node-hids (mapv xlast paths)
tags (mapv #(grab :tag (hid->node %)) node-hids)
depths (mapv count paths)
total-depth (apply + depths)]
(vals->map paths node-hids tags depths total-depth))))
and an example on a larger Hiccup-format tree:
(dotest
(let [td (tree-data [:a
[:b 21]
[:b 22]
[:b
[:c
[:d
[:e
[:f
[:g 7]
[:h
[:i 9]]]]]]
[:c 32]]
[:c 39]])]
(is= (grab :tags td) [:a :b :b :b :c :d :e :f :g :h :i :c :c])
(is= (grab :depths td) [1 2 2 2 3 4 5 6 7 7 8 3 2])
(is= (grab :total-depth td) 52)))
Don't be afraid of stack size for normal processing. On my computer, the default stack doesn't overflow until you get to a stack depth of over 3900 recursive calls. For a binary tree, just 2^30 is over a billion nodes, and 2^300 is more nodes than the number of protons in the universe (approx).

How to make reduce more readable in Clojure?

A reduce call has its f argument first. Visually speaking, this is often the biggest part of the form.
e.g.
(reduce
(fn [[longest current] x]
(let [tail (last current)
next-seq (if (or (not tail) (> x tail))
(conj current x)
[x])
new-longest (if (> (count next-seq) (count longest))
next-seq
longest)]
[new-longest next-seq]))
[[][]]
col))
The problem is, the val argument (in this case [[][]]) and col argument come afterward, below, and it's a long way for your eyes to travel to match those with the parameters of f.
It would look more readable to me if it were in this order instead:
(reduceb val col
(fn [x y]
...))
Should I implement this macro, or am I approaching this entirely wrong in the first place?
You certainly shouldn't write that macro, since it is easily written as a function instead. I'm not super keen on writing it as a function, either, though; if you really want to pair the reduce with its last two args, you could write:
(-> (fn [x y]
...)
(reduce init coll))
Personally when I need a large function like this, I find that a comma actually serves as a good visual anchor, and makes it easier to tell that two forms are on that last line:
(reduce (fn [x y]
...)
init, coll)
Better still is usually to not write such a large reduce in the first place. Here you're combining at least two steps into one rather large and difficult step, by trying to find all at once the longest decreasing subsequence. Instead, try splitting the collection up into decreasing subsequences, and then take the largest one.
(defn decreasing-subsequences [xs]
(lazy-seq
(cond (empty? xs) []
(not (next xs)) (list xs)
:else (let [[x & [y :as more]] xs
remainder (decreasing-subsequences more)]
(if (> y x)
(cons [x] remainder)
(cons (cons x (first remainder)) (rest remainder)))))))
Then you can replace your reduce with:
(apply max-key count (decreasing-subsequences xs))
Now, the lazy function is not particularly shorter than your reduce, but it is doing one single thing, which means it can be understood more easily; also, it has a name (giving you a hint as to what it's supposed to do), and it can be reused in contexts where you're looking for some other property based on decreasing subsequences, not just the longest. You can even reuse it more often than that, if you replace the > in (> y x) with a function parameter, allowing you to split up into subsequences based on any predicate. Plus, as mentioned it is lazy, so you can use it in situations where a reduce of any sort would be impossible.
Speaking of ease of understanding, as you can see I misunderstood what your function is supposed to do when reading it. I'll leave as an exercise for you the task of converting this to strictly-increasing subsequences, where it looked to me like you were computing decreasing subsequences.
You don't have to use reduce or recursion to get the descending (or ascending) sequences. Here we are returning all the descending sequences in order from longest to shortest:
(def in [3 2 1 0 -1 2 7 6 7 6 5 4 3 2])
(defn descending-sequences [xs]
(->> xs
(partition 2 1)
(map (juxt (fn [[x y]] (> x y)) identity))
(partition-by first)
(filter ffirst)
(map #(let [xs' (mapcat second %)]
(take-nth 2 (cons (first xs') xs'))))
(sort-by (comp - count))))
(descending-sequences in)
;;=> ((7 6 5 4 3 2) (3 2 1 0 -1) (7 6))
(partition 2 1) gives every possible comparison and partition-by allows you to mark out the runs of continuous decreases. At this point you can already see the answer and the rest of the code is removing the baggage that is no longer needed.
If you want the ascending sequences instead then you only need to change the < to a >:
;;=> ((-1 2 7) (6 7))
If, as in the question, you only want the longest sequence then put a first as the last function call in the thread last macro. Alternatively replace the sort-by with:
(apply max-key count)
For maximum readability you can name the operations:
(defn greatest-continuous [op xs]
(let [op-pair? (fn [[x y]] (op x y))
take-every-second #(take-nth 2 (cons (first %) %))
make-canonical #(take-every-second (apply concat %))]
(->> xs
(partition 2 1)
(partition-by op-pair?)
(filter (comp op-pair? first))
(map make-canonical)
(apply max-key count))))
I feel your pain...they can be hard to read.
I see 2 possible improvements. The simplest is to write a wrapper similar to the Plumatic Plumbing defnk style:
(fnk-reduce { :fn (fn [state val] ... <new state value>)
:init []
:coll some-collection } )
so the function call has a single map arg, where each of the 3 pieces is labelled & can come in any order in the map literal.
Another possibility is to just extract the reducing fn and give it a name. This can be either internal or external to the code expression containing the reduce:
(let [glommer (fn [state value] (into state value)) ]
(reduce glommer #{} some-coll))
or possibly
(defn glommer [state value] (into state value))
(reduce glommer #{} some-coll))
As always, anything that increases clarity is preferred. If you haven't noticed already, I'm a big fan of Martin Fowler's idea of Introduce Explaining Variable refactoring. :)
I will apologize in advance for posting a longer solution to something where you wanted more brevity/clarity.
We are in the new age of clojure transducers and it appears a bit that your solution was passing the "longest" and "current" forward for record-keeping. Rather than passing that state forward, a stateful transducer would do the trick.
(def longest-decreasing
(fn [rf]
(let [longest (volatile! [])
current (volatile! [])
tail (volatile! nil)]
(fn
([] (rf))
([result] (transduce identity rf result))
([result x] (do (if (or (nil? #tail) (< x #tail))
(if (> (count (vswap! current conj (vreset! tail x)))
(count #longest))
(vreset! longest #current))
(vreset! current [(vreset! tail x)]))
#longest)))))))
Before you dismiss this approach, realize that it just gives you the right answer and you can do some different things with it:
(def coll [2 1 10 9 8 40])
(transduce longest-decreasing conj coll) ;; => [10 9 8]
(transduce longest-decreasing + coll) ;; => 27
(reductions (longest-decreasing conj) [] coll) ;; => ([] [2] [2 1] [2 1] [2 1] [10 9 8] [10 9 8])
Again, I know that this may appear longer but the potential to compose this with other transducers might be worth the effort (not sure if my airity 1 breaks that??)
I believe that iterate can be a more readable substitute for reduce. For example here is the iteratee function that iterate will use to solve this problem:
(defn step-state-hof [op]
(fn [{:keys [unprocessed current answer]}]
(let [[x y & more] unprocessed]
(let [next-current (if (op x y)
(conj current y)
[y])
next-answer (if (> (count next-current) (count answer))
next-current
answer)]
{:unprocessed (cons y more)
:current next-current
:answer next-answer}))))
current is built up until it becomes longer than answer, in which case a new answer is created. Whenever the condition op is not satisfied we start again building up a new current.
iterate itself returns an infinite sequence, so needs to be stopped when the iteratee has been called the right number of times:
(def in [3 2 1 0 -1 2 7 6 7 6 5 4 3 2])
(->> (iterate (step-state-hof >) {:unprocessed (rest in)
:current (vec (take 1 in))})
(drop (- (count in) 2))
first
:answer)
;;=> [7 6 5 4 3 2]
Often you would use a drop-while or take-while to short circuit just when the answer has been obtained. We could so that here however there is no short circuiting required as we know in advance that the inner function of step-state-hof needs to be called (- (count in) 1) times. That is one less than the count because it is processing two elements at a time. Note that first is forcing the final call.
I wanted this order for the form:
reduce
val, col
f
I was able to figure out that this technically satisfies my requirements:
> (apply reduce
(->>
[0 [1 2 3 4]]
(cons
(fn [acc x]
(+ acc x)))))
10
But it's not the easiest thing to read.
This looks much simpler:
> (defn reduce< [val col f]
(reduce f val col))
nil
> (reduce< 0 [1 2 3 4]
(fn [acc x]
(+ acc x)))
10
(< is shorthand for "parameters are rotated left"). Using reduce<, I can see what's being passed to f by the time my eyes get to the f argument, so I can just focus on reading the f implementation (which may get pretty long). Additionally, if f does get long, I no longer have to visually check the indentation of the val and col arguments to determine that they belong to the reduce symbol way farther up. I personally think this is more readable than binding f to a symbol before calling reduce, especially since fn can still accept a name for clarity.
This is a general solution, but the other answers here provide many good alternative ways to solve the specific problem I gave as an example.

Counting nodes in two different subtrees in clojure

Very new to Clojure and I haven't got a clue how to do this, i need to traverse a premade binary search tree and count the number of nodes in 2 difference subtrees like this question
https://uva.onlinejudge.org/external/116/11615.pdf
Thank you for any help at all, Just need a push to get started
(defn familytree [tree i x]
(cond
(= (first(tree) i) )
(count (zip/children))
(= (first(tree) x))
(count (zip/children))
:else
(familytree (rest tree)x i)
))
Input data
(def test1 '[ 1 [ 2 [ 4 [8 9 ] 5 [ 10 11 ]] 3 [ 6 [ 12 13 ] 7 [ 14 15 ]]]])
Cameron
Start with deciding which Clojure persistent data type you will store the information in. Once that is decided:
Take a look at Clojure zippers.
Take a look at Clojure walk
As you know about recursion, depending on how big a tree it is, you may elect to forego somethings like a zipper for straight forward recursion. In this case for, loop and reduce may be applicable.
Updated
Here is my understanding of the requirements:
Input tree will be in a vector/nested vector structure
Each vector in the tree has a 'node identifier' (in your case a number)
Require a function that counts the children for a node when a node matches some criteria
Should be able to specify multiple nodes for which counts will be returned
Given that, I've decided to use a zipper as it reasonably demonstrates the break down of logic to attain the requirement goals. I've also abstracted aspects to make it so the predicate for counting children may change.
You will need to read up on clojure.zip (there is a wealth of information on the inter-web for this.
The Counter
Now that the core traversal is covered (zippers) lets start with the counting function. As per requirements: regardless on how I arrive at a node I want to count the children of the node:
(defn count-children-at-node
"Takes a zipper location and counts
elements of it's chidren vector. Uses flatten on the
children to sequence all the elements for counting.
Returns a tuple identifiying the node and it's children count"
[loc]
(let [cnodes (zip/right loc)]
[:node (zip/node loc)
:count (if (nil? cnodes) ; test for no children
0
(count (flatten (zip/node cnodes))))]))
The Workhorse
This is where traversal occurs. It will be exhaustive so as to find all possible nodes of interest. Counts will also be inclusive (see results below). I also want to accumulate my results and have a flexible predicate function to test for inclusion in the results:
(defn find-nodes-to-count
"Accumulate results of performing a reduction function on a node in
the tree that matches the predicate criteria"
[acc predfn redfn loc]
(if (zip/end? loc)
acc
(if (predfn (zip/node loc))
(recur (conj acc (redfn loc)) predfn redfn (zip/next loc))
(recur acc predfn redfn (zip/next loc)))))
The Wrapper
With my core counter and traversal mechanisms in place, use a easy wrapping function to exercise the core:
(defn nodes-counter
"Takes a tree collection and variable number of node identifiers
and return an accumulation of tuples, each identifying the node and it's children
count"
[coll & nodevals]
(find-nodes-to-count
[] ; accumultator
#(contains? (into #{} nodevals) %) ; predicate function
count-children-at-node ; reduction function
(zip/vector-zip coll))) ; the tree collection
Test/Verify
Some REPL examples of calling nodes-counter with node identifier variations:
(def mytree [1 [2 [4 [8 9] 5 [ 10 11 ]] 3 [ 6 [ 12 13 ] 7 [ 14 15 ]]]])
(nodes-counter mytree 16) ; => []
(nodes-counter mytree 15) ; => [[:node 15 :count 0]]
(nodes-counter mytree 2 4) ; => [[:node 2 :count 6] [:node 4 :count 2]]
(nodes-counter mytree 4 2) ; => [[:node 2 :count 6] [:node 4 :count 2]]

Swap nodes in binary tree in clojure

I am trying to solve [this][1] problem where you need to create a binary tree that looks like this:
1
/ \
2 3
/ /
4 5
/ /
/ /\
/ / \
6 7 8
\ / \
\ / \
9 10 11
From this input where -1 represents a null node
[2 3] [4 -1] [5 -1] [6 -1] [7 8] [-1 9] [-1 -1] [10 11] [-1 -1] [-1 -1] [-1 -1]
Once you have done that, the problem asks you to swap nodes at a given depth.
So far I have this code that creates the tree:
(ns scratch.core
(require [clojure.string :as str :only (split-lines join split)]))
(defn numberify [str]
(vec (map read-string (str/split str #" "))))
(defrecord TreeNode [val left right])
(defn preprocess-input [n xs]
(let [source (map vector (range 1 n) xs)]
(->> source
(map (fn [[k v]]
{k v}))
(into {}))))
(defn build-tree [val source]
(when-let [[l r] (get source val)]
(TreeNode. val (build-tree l source) (build-tree r source))))
(let [input "11\n2 3\n4 -1\n5 -1\n6 -1\n7 8\n-1 9\n-1 -1\n10 11\n-1 -1\n-1 -1\n-1 -1\n2\n2\n4"
lines (str/split-lines input)
tree-length (read-string (first lines))
tree-lines (map numberify (drop 1 (take (inc tree-length) lines)))
tree-source (preprocess-input tree-length tree-lines)
tree (build-tree 1 tree-source)
swap-depths (map read-string (vec (take-last (Integer/parseInt (get lines (inc tree-length))) lines)))])
I am totally stuck with how to swap the nodes, I have tried this function:
(defn walk-tree [node curr swap-depth]
(when node
(let [left (:left node)
right (:right node)
val (:val node)]
(if (= curr swap-depth)
(TreeNode. val (walk-tree right (inc curr) swap-depth) (walk-tree left (inc curr) swap-depth))
(TreeNode. val (walk-tree left (inc curr) swap-depth) (walk-tree right (inc curr) swap-depth))))))
But I think I should be going BFS rather than DFS because while I can swap a node this way, it gets swapped back when the right node is encountered.
Like I've said in the comment, I'd approach this in these two ways:
Take this as a String manipulation problem. First split it into a seq of lines. Then define a function that takes m and a-seq, and eats the first m elements from the a-seq, and produces a n where n indicates the number of valid nodes in this layer and the remaining seq. Repeat this depth times and you are now at the given depth. Do whatever required. There should be other viable methods as well.
Construct a tree-like structure. But instead of simply keeping the value given at each node, the depth is also attached. Then use clojure.walk/postwalk to traverse the tree, update value when seeing nodes at the given depth.

Clojure transients - assoc! causing exception

Here is the function I'm trying to run...
(defn mongean [cards times]
(let [_cards (transient cards)]
(loop [i 0 c (get cards i) _count (count cards) _current (/ _count 2)]
(assoc! _cards _current c)
(if ((rem i 2) = 0)
(def _newcur (- _current (inc i)))
(def _newcur (+ _current (inc i))))
(if (<= i _count)
(recur (inc i) (get cards i) _count _newcur )))
(persistent! _cards)))
It's resulting in this Exception...
Exception in thread "main" java.lang.ClassCastException: clojure.lang.PersistentHashSet$TransientHashSet cannot be cast to clojure.lang.ITransientAssociative
Being new to clojure, I'd also appreciate any constructive criticism of my approach above. The goal is to take a List, and return a re-ordered list.
I assume that you are trying to implement the Mongean shuffle. Your approach is very imperative and you should try to use a more functional approach.
This would be a possible implementation, were we calculate the final order of the cards (as per Wikipedia formula) and then we use the built-in replace function to do the mapping:
(defn mongean [cards]
(let [num-cards (count cards)
final-order (concat (reverse (range 1 num-cards 2)) (range 0 num-cards 2))]
(replace cards final-order)))
user> (mongean [1 2 3 4 5 6 7 8])
(8 6 4 2 1 3 5 7)
How do you call that function? It looks like you're passing a set, so that its transient version will also be a set and hence can't be used with any of the assoc functions, as they work on associative data structures and vectors:
user=> (assoc #{} :a 1)
ClassCastException clojure.lang.PersistentHashSet cannot be cast to clojure.lang.Associative clojure.lang.RT.assoc (RT.java:691)
user=> (assoc! (transient #{}) :a 1)
ClassCastException clojure.lang.PersistentHashSet$TransientHashSet cannot be cast to clojure.lang.ITransientAssociative clojure.core/assoc! (core.clj:2959)
; the following works as it uses maps and vectors
user=> (assoc {} :a 1)
{:a 1}
user=> (assoc! (transient {}) :a 1)
#<TransientArrayMap clojure.lang.PersistentArrayMap$TransientArrayMap#65cd1dff>
user=> (assoc [] 0 :a)
[:a]
Now, let's try to discuss the code itself. It's a bit hard to follow your code and try to understand what the goal really is without some more hints on what you want to achieve, but as general comments:
you have a times input parameter you don't use at all
you are supposed to use the result of a transient mutation, not assume that the transient will mutate in place
avoid transients if you can, they're only meant as a performance optimization
the binding _current (/ _count 2) is probably not what you want, as (/ 5 2) really returns 5/2 and it seems that you want to use it as a position in the result
constants like _count don't need to be part of the loop binding, you can use the outer let so that you don't have to pass them at each and every iteration
use let instead of def for naming things inside a function
(if ((rem 1 2) = 0)) is definitely not what you want
Now, leaving aside the shuffling algorithm, if you need to rearrange a sequence you might just produce a sequence of new positions, map them with the original cards to produce pairs of [position card] and finally reduce them by placing the card at the new position, using the original sequence as the seed:
(defn generate [coll] ; counts down from (count coll) to 0, change to
; implement your shuffling algorithm
(range (dec (count coll)) -1 -1))
(defn mongean [cards times]
(let [positions (generate cards) ; get the new positions
assemble (fn [dest [pos card]] ; assoc the card at the wanted position
(assoc dest pos card))]
(reduce assemble cards (map vector positions cards))))
If you simply want to shuffle:
(defn mongean [cards times] (shuffle cards))