How to generate a list of all subtrees in Clojure using higher order functions?

Question

Given a tree, how do you generate a list of all (proper) subtrees in Clojure using higher order functions?

Background

I am working on Advent of Code 2019 Problem #6. The problem begins with an adjacency list. I have represented the adjacency list as an n-ary tree, using Clojure lists, with the following structure.

A node that is not a leaf is a list with two parts: the first part is an element representing the root of that section of the tree; the second part is a n elements representing branches from the root. Leaves are lists having a keyword as their only element. Thus, I represent a tree of the form,

  B -- C
 /
A
 \
  D

with the following list:

(:A (:B (:C)) (:D))

Solution using Recursion

I want to list every proper subtree of a given tree. I know how to do this using recursion, as follows:

(defn subtrees
  [tree]
  (loop [trees tree
         results '()]
    (if (empty? trees)
      results
      (let [subtree #(if (keyword? (first %)) (rest %) nil)
            leaf? #(and (list %) (keyword? (first %)) (= (count %) 1))
            sub (subtree (first trees))]
        (if (every? leaf? sub)
          (recur (rest trees) (into results sub))
          (recur (into (rest trees) sub) (into results sub)))))))

So I do the work with trees and results: I begin with the tree in trees, and then add each subtree that is not one or more leaves into trees and results at each step (or: just into results if I have one or more leaves). This gives me a list of all proper subtrees of tree, which is the point of the function. Here is the working solution with very detailed comments and a bunch of test cases.

My Question

I should like to know how to accomplish the same using higher-order functions. What I would really like to do is use map and call the function recursively: at each stage, just call subtree on every element in the list. The problem I have encountered is that when I do this, I end up with a huge mess of parentheses and can't consistently drill down through the mess to get to the subtrees. Something like this:

(defn subt
  [trees]
  (let [subtree #(if (keyword? (first %)) (rest %) nil)
        leaf? #(and (list %) (keyword? (first %)) (= (count %) 1))
        sub (subtree trees)]
    (if (every? leaf? sub)
      nil
      (cons (map subt sub) trees))))

You can see the (map subt sub) is what I'm going for here, but I am running into a lot of difficulty using map, even though my sense is that is what I want for my higher-order function. I thought about using reduce as a stand-in for the loop in subtrees above; but because trees changes by subtrees being added, I don't think reduce is appropriate, at least with the loop as I have constructed it. I should say, also, that I'm not interested in a library to do the work; I want to know how to solve it using core functions. Thanks in advance.

Answer 1

Let's start with a solution similar in spirit to Rulle's but improving on it:

(def subtrees-bf
  (comp
    (partial apply concat)
    (partial take-while seq)
    (partial iterate (partial mapcat rest))
    rest)) ; replace this with list to include the original tree

Notice that the subtrees are produced lazily and in breadth-first order. To produce them in depth-first order (as in leetwinski's solution but using iterate and avoiding recursion) we can write:

(def subtrees-df
  (comp
    (partial map first)
    (partial take-while seq)
    (partial iterate
      (comp
        (partial apply concat)
        (juxt (comp rest first) rest)))
    rest)) ; replace this with list to include the original tree

I wrote these functions in the point-free style, which Clojure (like most LISP's) doesn't facilitate, some of the main causes being:

• many-argument functions instead of one-sequential-argument ones
• uncurried functions
• lack of many higher-order functions that constitute basic components of the algebra of point-free functional programming (as seen in the work of Richard Bird, Lambert Meertens and their circle - this paper is a concise source of relevant information)

Two more idiomatic/comprehensible versions could be:

(defn subtrees-bf [tree]
  (->> tree
       rest ; or list
       (iterate (partial mapcat rest))
       (take-while seq)
       (apply concat)))

(defn subtrees-df [tree]
  (->> tree
       rest ; or list
       (iterate #(concat (rest (first %)) (rest %)))
       (take-while seq)
       (map first)))

And now let's generalize these approaches and rewrite tree-seq:

(defn tree-seq-bf [branch? children node]
  (let [children #(if (branch? %) (children %))]
    (->> node
         list
         (iterate (partial mapcat children))
         (take-while seq)
         (apply concat))))

(defn tree-seq-df [branch? children node]
  (let [children #(if (branch? %) (children %))]
    (->> node
         list
         (iterate #(concat (children (first %)) (rest %)))
         (take-while seq)
         (map first))))

Answer 2

Here is an attempt at computing all the subtrees using various functions from the standard library.

(defn expand-subtrees [tree-set]
  (into #{} (comp (map rest) cat) tree-set))

(defn all-subtrees [tree]
  (reduce into #{}
          (take-while seq (iterate expand-subtrees #{tree}))))

and we can call it like this:

(all-subtrees '(:A (:B (:C)) (:D)))
;; => #{(:D) (:B (:C)) (:C) (:A (:B (:C)) (:D))}

The helper function expand-subtrees takes a set of trees and produces a new set of first-level subtrees of the input set. Then we use iterate with expand-subtrees, starting with the initial tree, to produce a sequence of expanded subtrees. We take elements from this sequence until there are no more subtrees. Then we merge all subtrees into a set, which is the result. Of course, you can disj the initial tree from that set if you desire.

Answer 3

i may be mistaken, but seems like the tree-seq function from the core lib should do the trick for you:

(tree-seq seq rest '(:A (:B (:C)) (:D)))

;;=> ((:A (:B (:C)) (:D)) (:B (:C)) (:C) (:D))

you just have to exclude the first item, being the tree itself.

I know, that is not the answer to "how to write this code manually", but analyzing the tree-seq source code should clarify how to do it idiomatically in clojure.

in fact it uses something like this (simplified):

(defn my-tree-seq [data]
  (lazy-seq (cons data (mapcat my-tree-seq (rest data)))))

this one is lazy, so it doesn't lead to stack overflow despite the usage of recursion. I don't really think if should be optimized any more, but for the sake of education.

what about the task itself, i would simplify it somehow, since you don't really need subtrees, rather you only need every item's parents count. So you don't even need to build tree, just the child->parent lookup table. I can think of something like this:

(defn solve [data]
  (let [items (clojure.string/split data #"\)|\s+")
        pairs (partition 2 items)
        lookup (reduce (fn [acc [par ch]] (assoc acc ch par)) {} pairs)
        count-parents #(->> %
                            (iterate lookup)
                            (take-while identity)
                            count
                            dec)]
    (apply + (map count-parents (distinct items)))))

(def data "COM)B
           B)C
           C)D
           D)E
           E)F
           B)G
           G)H
           D)I
           E)J
           J)K
           K)L")

#'user/data

user> (solve data)
;;=> 42

user> (solve (slurp "./orb.txt"))
;;=> 402879 ;; for my task input data

this one could be further optimized with dynamic programming, but for provided inputs it is good enough.

Answer 4

You can accomplish with the function walk-with-parents-readonly from the Tupelo library. Here is the code:

(ns tst.demo.core
  (:use tupelo.test)
  (:require [tupelo.core :as t]))

(def orbits
  [:com
   [:b
    [:g
     [:h]]
    [:c
     [:d
      [:i]
      [:e
       [:f]
       [:j
        [:k
         [:l]]]]]]]])

(def sum (atom 0))

(defn parent-levels
  [parents]
  (t/it-> parents
    (count it)
    (/ it 2)))

(defn count-orbits
  [data]
  (t/walk-with-parents-readonly data
    {:enter (fn [parents item]
              (when (vector? item)
                (let [levels (parent-levels parents)]
                  (t/spyx [(first item) levels])
                  (swap! sum + levels))))}))

(dotest
  (count-orbits orbits)
  (t/spyx @sum))

with result

--------------------------------------
   Clojure 1.10.2-alpha1    Java 14
--------------------------------------

Testing tst.demo.core
[(first item) levels] => [:com 0]
[(first item) levels] => [:b 1]
[(first item) levels] => [:g 2]
[(first item) levels] => [:h 3]
[(first item) levels] => [:c 2]
[(first item) levels] => [:d 3]
[(first item) levels] => [:i 4]
[(first item) levels] => [:e 4]
[(first item) levels] => [:f 5]
[(first item) levels] => [:j 5]
[(first item) levels] => [:k 6]
[(first item) levels] => [:l 7]
(clojure.core/deref sum) => 42

You can see the docs here. The source code shows how to implement it (could be simplified for a specific use-case).