Search for Descendants within a Graph

First things first: Setup

{:deps
 {org.clojure/clojure {:mvn/version "1.10.0"}
  org.clojure/tools.deps.alpha
  {:git/url "https://github.com/clojure/tools.deps.alpha.git"
   :sha "f6c080bd0049211021ea59e516d1785b08302515"}
  compliment {:mvn/version "0.3.9"}
  ubergraph {:mvn/version "0.8.2"}}}
deps.edn
Extensible Data Notation
apt-get update
apt-get install graphviz
5.3s
Bash in Clojure
Clojure
(use 'clojure.tools.deps.alpha.repl)
(ns-unmap *ns* 'ancestors)
(ns-unmap *ns* 'descendants)
(require '[ubergraph.core :as ugraph])
0.0s
Clojure
Clojure

The problem

In a project in the field of e-commerce, my team was faced with the following task: From a relevant large number of boolean statements M, the most specific super-statement S (in the sense of superset) had to be found for a requested Boolean statement R, which might be, but in most cases is not, part of M.

An example: Assume M = {a, b, a && b} and R = a && b && c, then S = a && b.

Note that the set M was the nodes of a graph that was constantly updated asynchronously. The edges of this graph expressed a relationship between the nodes, but this relationship is not important here.

As the Boolean statements become more complicated, it is relatively difficult to check whether a statement A is a super-statement of a statement B. Therefore, as the size of the graph increases, the approach of checking each node of the graph does not scale.

A variant to speed up the search would have been to build an artificial binary search tree in the graph. As an example, let us assume M = {a, b, c, d, e, f}. Then we could create the following binary search tree:

We rejected this idea because we did not want to create a disjunction with 100,000+ Boolean statements as the root node.

I would like to describe an alternative approach in the following and would therefore like to abstract from the original problem.

Reformulation

Instead of working with Boolean statements and super-statements, the problem could also be described as follows: Suppose we have a graph G whose nodes are natural numbers and whose edges express a relationship between the numbers. For simplicity's sake, this relationship should be understood as "my checksum is". So node 3 points to itself and node 13 points to node 4. Instead of looking for the super-statement, we look for the greatest divisor of a natural number which is also a node of G. (Please note that a solution for this problem must also work for the original problem).

A solution

Protocol

To make our solution work for the original problem as well as for the derived problem, we design the solution algorithm against a protocol.

(defprotocol Tree
  "The descendants search tree abstraction within a graph"
  (root [self] "This node must be the ancestor of every other node")
  (query [self] "A map to distinguish the edges already existing in the graph and the edges created for searching")
  (descendant? [self a b] "The (probably expensive) predicate, that returns true if a is a descendant of b")
  (compare-descendants [self a b] "If the search found two possible candidates, this function decides which candidate is a better fit. Should return a positive number, if a is a better fit.")
  (graph [self] "Returns the underlying graph data structure")
  (update-graph [self f] "Updates the underlying graph data structure and returns a new Tree"))
0.1s
Clojure
Clojure
Tree

Implementation

Here we implement the protocol for the derived problem and call it DivisionTree. A node A is a descendent of a node B, if B is dividable by A without a rest. The compare-descendants function can be used, if multiple candidates have been found. For the original problem, the implementation for this function would have been more complicated. We also increment a counter for each call to the expensive function descendant?.

(defrecord DivisionTree [graph counter] Tree
  (root [self] 1)
  (query [self] {:type :division})
  (graph [self] graph)
  (descendant? [self a b] (do (swap! counter inc) (= 0 (mod a b))))
  (compare-descendants [self a b] (compare a b))
  (update-graph [self f] (update self :graph f)))
(defn sum-of-digits [n]
  (loop [count n acc 0]
    (if (zero? count) acc
      (recur (quot count 10)
             (+ acc (mod count 10))))))
(defn insert-number [insert+balance tree n]
  (-> tree
    (insert+balance n)
    (update-graph (fn [g]
                    (ugraph/add-edges g
                                      [n
                                      (sum-of-digits n)
                                      {:type :sum-of-digit}])))))
(defn divison-graph [numbers]
  (reduce (fn [t n] (insert-number (fn [& args] (first args)) t n))
                    (map->DivisionTree {:graph (ugraph/digraph 1)})
                    numbers))
0.1s
Clojure
Clojure
user/divison-graph

Without any additional edges for searching, the internal graph with nodes form 1 up to 14 looks like this:

Now we add edges for a fast search of descendants.

Construction Algorithm

To create a most even balanced tree, the construction algorithm consists of two steps for inserting a value v:

  1. Walk down from the root of the tree, following each edge that is an ancestor of v. From all the deepest nodes of all paths, insert v as descendant of the node with the fewest descendants.

  2. For all the leafs of the tree that are descendants of v, move each leaf l to v, if the width of the ancestor of l is larger than the width of v.

(defn descendants-ways [tree ancestor]
  (ugraph/find-edges (graph tree)
                     (merge {:src ancestor}
                            (query tree))))
(defn descendants
  ([c-ways] (map :dest c-ways))
  ([tree ancestor] (descendants (descendants-ways tree ancestor))))
(defn ancestors [tree node]
  (map :src
       (ugraph/find-edges (graph tree)
                          (merge {:dest node}
                                 (query tree)))))
(defn ancestor [tree node]
  (first (ancestors tree node)))
(def conjj (fnil conj #{}))
(defn insert [tree v ancestor]
  (if (= v (root tree))
    tree
    (-> tree 
      (update-graph #(ugraph/add-edges % [ancestor v (query tree)]))
      (update :leafs disj ancestor)
      (update :leafs conjj v))))
(defn leaf? [tree node]
  (empty? (descendants tree node)))
(defn update-leafs-index [tree node ancestor new-ancestor]
  (-> tree
    (update :leafs disj new-ancestor)
    (update :leafs (fn [leafs] (if (leaf? tree node)
                                    (conjj leafs node)
                                      leafs)))
    (update :leafs (fn [leafs] (if (leaf? tree ancestor)
                                  (conjj leafs ancestor)
                                  leafs)))))
(defn move [tree node new-ancestor]
  (let [ancestor (ancestor tree node)]
    (-> tree
      (update-graph (fn [g]
                      (-> g
                        (ugraph/remove-edges [ancestor
                                              node
                                              (query tree)])
                        (ugraph/add-edges [new-ancestor
                                           node
                                           (query tree)]))))
      (update-leafs-index node ancestor new-ancestor))))
(defn descendants-count [tree ancestor]
  (count (descendants tree ancestor)))
(defn move-if-ancestor-is-relieved [tree node sub-node-path]
  (let [candidate (last sub-node-path)
        node-descendants-count (descendants-count tree node)
        sub-node-path-count (descendants-count tree (ancestor tree candidate))]
    (if (< node-descendants-count sub-node-path-count)
      (move tree candidate node)
      tree)))
(defn walk-leafs
  ([tree start matches?]
   (walk-leafs tree matches? [[start]] '()))
  ([tree matches? stack result]
   (if-let [frst (first stack)]
     (let [node (last frst)
           matching-descendants (seq (filter matches?
                                             (ancestors tree node)))]
       (recur tree
              matches?
              (into (vec (rest stack))
                    (map (fn [c] (conj frst c))
                         matching-descendants))
              (if matching-descendants result
                (conj result frst))))
     result)))
(defn leafs [tree]
  (if-let [$leafs (seq (:leafs tree))]
    $leafs
    (list (root tree))))
(defn self-path? [node path]
  (contains? (set path) node))
(defn alternative-paths [tree ancestor-node]
  (letfn [(ancestor? [node] (descendant? tree node ancestor-node))]
    (sequence (comp (filter ancestor?)
                    (mapcat (fn [leaf]
                              (walk-leafs tree leaf ancestor?)))
                    (remove (partial self-path? ancestor-node)))
              (leafs tree))))
(defn balance [tree node]
  (reduce (fn [t n] (move-if-ancestor-is-relieved t node n))
          tree
          (alternative-paths tree node)))
(defn select-node-with-fewest-descendants [tree node-seq]
  (first (sort-by #(descendants-count tree %) node-seq)))
(defn insert+balance
  ([tree node] (insert+balance tree (root tree) node))
  ([tree ancestor node]
   (if-let [candidate
         (select-node-with-fewest-descendants
          tree
          (filter #(descendant? tree node %)
                  (descendants tree ancestor)))]
       (recur tree candidate node)
       (balance (insert tree node ancestor) node))))
0.1s
Clojure
Clojure
user/insert+balance

Inserting an element has worst case time complexity of O(n): If a division-graph would only consist of primes and we would insert another prime, we had to check all nodes for step 1 and again all nodes for step 2.

To illustrate the algorithm, we create a balanced-divison-tree within a division-graph. 

(defn balanced-divison-tree [numbers]
  (reduce (fn [t n] (insert-number insert+balance t n))
                    (map->DivisionTree {:graph (ugraph/multidigraph 1)
                                        :counter (atom 0)})
                    numbers))
(defn reset-counter [tree]
  (let [counter @(:counter tree)]
    (reset! (:counter tree) 0)
    counter))
0.1s
Clojure
Clojure
user/reset-counter
(def $balanced-division-tree
  ; if we add the numbers in the order 14, 13, 12, etc.
  ; the balancing kicks in. Otherwise, we would have a tree with
  ; all nodes connected to the root.
  (balanced-divison-tree (reverse (range 1 15))))
(viz $balanced-division-tree {:layout :neato})
0.1s
Clojure
Clojure

The black edges represent the sum-of-digit relationship and the red edges point from an ancestor to a direct descendant.

Since we do not care about the sum-of-digit relationship at this point, we create a view of the graph that focuses on the search tree.

(defn search-tree-view [tree]
  (let [all-edges (ugraph/find-edges (graph tree) {})]
    (update-graph tree
                  (fn [g]
                    (let []
                    (reduce (fn [g* edge]
                              (if (= (ugraph/attrs g* edge)
                                      (query tree))
                                g*
                                (ugraph/remove-edges g* edge)))
                            g
                            all-edges))))))
0.0s
Clojure
Clojure
user/search-tree-view
(viz (search-tree-view $balanced-division-tree))
0.1s
Clojure
Clojure

Now that we have a search tree, we can search for the oldest known ancestor of a value.

Search Algorithm

(defn ancestor-candidates [tree ancestor node]
  (filter (partial descendant? tree node)
          (descendants tree ancestor)))
(defn choose-oldest-known-ancestor [tree a b]
  (if (pos? (compare-descendants tree a b))
    a
    b))
(defn oldest-known-ancestors
  ([tree node]
   (oldest-known-ancestors tree
                           node
                           (root tree)
                           (ancestor-candidates tree
                                                (root tree)
                                                node)))
  ([tree node $oldest-known-ancestor candidates]
   (if-let [next-candidate (first candidates)]
     (if-let [next-ancestor-candidates
              (and (not= next-candidate node)
                   (seq (ancestor-candidates tree
                                        next-candidate
                                        node)))]
       (recur tree
              node
              $oldest-known-ancestor
              (into (rest candidates)
                    next-ancestor-candidates))
       (recur tree
              node
              (choose-oldest-known-ancestor tree
                                            $oldest-known-ancestor
                                            next-candidate)
              (rest candidates)))
     $oldest-known-ancestor)))
0.1s
Clojure
Clojure
user/oldest-known-ancestors
(oldest-known-ancestors $balanced-division-tree 15)
0.0s
Clojure
Clojure
5
(reduce (fn [m n]
          (assoc m
                 n
                 (oldest-known-ancestors $balanced-division-tree n)))
        (sorted-map)
        (range 10 30))
0.0s
Clojure
Clojure
Map {10: 10, 11: 11, 12: 12, 13: 13, 14: 14, 15: 5, 16: 8, 17: 1, 18: 9, 19: 1, 20: 10, 21: 7, 22: 11, 23: 1, 24: 12, 25: 5, 26: 13, 27: 9, 28: 14, 29: 1}

Results

Performance improvements are highly dependent on the nature of the data. That means, we have to measure the reduction of expensive work against our specific dataset. For the division-graph problem and a graph size of the first 10000 natural numbers, we could measure the reduction of work like this:

(def big-tree-size 10000)
(def big-division-tree (balanced-divison-tree (range 1 big-tree-size)))
14.1s
Clojure
Clojure
user/big-division-tree
(defn work-reduction [number-of-searches]
  (let [_ (reset-counter big-division-tree)
        number-of-nodes (count (ugraph/nodes (graph big-division-tree)))
        _ (doall (map (partial oldest-known-ancestors big-division-tree)
                      (range big-tree-size
                             (+ number-of-searches big-tree-size))))
      number-of-expensive-calls (reset-counter big-division-tree)]
  (double (/ number-of-expensive-calls
             (* number-of-nodes number-of-searches)))))
(reduce (fn [m number-of-searches]
          (assoc m
          	number-of-searches
            (work-reduction number-of-searches)))
        {}
        [10 100 1000])
1.8s
Clojure
Clojure
Map {10: 0.1302930293029303, 100: 0.1316441644164416, 1000: 0.1316832683268327}

As already mentioned, the results are highly dependent on how even the data can be partitioned within the tree as well as the size of the graph. In our case the expensive work is now only about a tenth of the original work.

Conclusion

Depending on the nature of the hierarchical data, we could speed up the search for the oldest known ancestor significantly if we can tolerate the construction of the search tree in O(n) time.

Going back to the original problem and our E-Commerce project, the set of Boolean statements was small enough in our case, so that we could check all nodes of the graph for each search request by applying a fast heuristic check first, followed by the more precise but expensive check.

It was an interesting problem, though.

Addendum

Deleting

For the sake of completeness, here is the implementation for deleting elements. To support different use cases, the deletion of an element within the search tree is not coupled with the deletion of an element within the graph.

(defn delete-ways [g query]
  (let [ways (ugraph/find-edges g query)]
    (reduce ugraph/remove-edges g ways)))
(defn delete [tree node]
  (let [query (query tree)]
    (let [leaf-candidates (ugraph/find-edges (graph tree)
                                             (assoc query :dest node))
          tree* (update-graph tree
                              #(-> %
                                 (delete-ways (assoc query :dest node))
                                 (delete-ways (assoc query :src node))))]
      (reduce (fn [t {leaf-candidate :src}]
                (if (leaf? t leaf-candidate)
                  (update t conjj :leafs leaf-candidate)
                  t))
              (update tree* :leafs disj node)
              leaf-candidates))))
(defn delete+balance [tree node]
  (if-let [descendants-ways (seq (descendants-ways tree node))]
    (reduce (fn [t c] (insert+balance t c))
            (delete tree node)
            (descendants descendants-ways))
    (delete tree node)))
0.0s
Clojure
Clojure
user/delete+balance
(def balanced-divison-tree-ignoring-5 (delete+balance $balanced-division-tree 5))
(viz (search-tree-view balanced-divison-tree-ignoring-5) "wo5")
0.1s
Clojure
Clojure
(oldest-known-ancestors balanced-divison-tree-ignoring-5 15)
0.0s
Clojure
Clojure
3
(oldest-known-ancestors balanced-divison-tree-ignoring-5 5)
0.0s
Clojure
Clojure
1

5 must not be deleted from the graph, since 5 is still the sum of digits of 14. It is just not relevant for search anymore.

; shows also the black edges from the underlying graph
(viz balanced-divison-tree-ignoring-5)
0.1s
Clojure
Clojure
Runtimes (1)