├── README.md ├── deps.edn ├── doc └── images │ └── sexp-tree.png ├── pom.xml ├── src └── clj_tree_layout │ ├── core.cljc │ └── core_specs.cljc └── test └── clj_tree_layout └── core_test.cljc /README.md: -------------------------------------------------------------------------------- 1 | # clj-tree-layout 2 | 3 | A library for laying out tree nodes in 2D space for Clojure and ClojureScript. 4 | 5 | It features tidy tree representations as per [Tilford and Reingold](http://hci.stanford.edu/cs448b/f09/lectures/CS448B-20091021-GraphsAndTrees.pdf) 6 | 7 | This library doesn't contain any functionality to draw a tree on any canvas, just 8 | the calculations needed so you can draw it however you want. 9 | 10 | For libraries that uses this for drawing check : 11 | 12 | - [reagent-flowgraph](https://github.com/jpmonettas/reagent-flowgraph) A reagent component for laying out tree nodes in 2D space. 13 | 14 | ## Installation 15 | 16 | [![Clojars Project](https://img.shields.io/clojars/v/clj-tree-layout.svg)](https://clojars.org/clj-tree-layout) 17 | 18 | ## Usage 19 | 20 | First 21 | 22 | ```clojure 23 | (require '[clj-tree-layout.core :refer [layout-tree]]) 24 | ``` 25 | 26 | Given a tree structure 27 | 28 | ```clojure 29 | 30 | (def tree {:id 1 31 | :lable "1" 32 | :childs [{:id 2 33 | :label "2" 34 | :childs [{:id 12 35 | :label "12"}]} 36 | {:id 3 37 | :label "3"}]}) 38 | 39 | (layout-tree tree 40 | {:branch-fn :childs 41 | :childs-fn :childs 42 | :id-fn :id}) 43 | 44 | ;;=> 45 | ;; {1 {:x 7.5, :y 0, :width 10, :height 10}, 46 | ;; 2 {:x 0, :y 15, :width 10, :height 10}, 47 | ;; 12 {:x 0, :y 30, :width 10, :height 10}, 48 | ;; 3 {:x 15, :y 15, :width 10, :height 10}} 49 | 50 | ``` 51 | 52 | You can use the returning information to draw the tree however you want. 53 | 54 | No problem if you have a different tree structure 55 | 56 | ```clojure 57 | (def sexp-tree '(+ 1 2 (- 4 2) (/ 123 3) (inc 25))) 58 | 59 | (layout-tree sexp-tree 60 | {:branch-fn #(when (seq? %) %) 61 | :childs-fn #(when (seq? %) %) 62 | :id-fn str 63 | :sizes {"(+ 1 2 (- 4 2) (/ 123 3) (inc 25))" [43 10] 64 | "(- 4 2)" [15 10] 65 | "(/ 123 3)" [20 10] 66 | "(inc 25)" [16 10]}}) 67 | 68 | ;;=> 69 | ;; {"3" {:x 45, :y 30, :width 10, :height 10}, 70 | ;; "(inc 25)" {:x 127.5, :y 15, :width 10, :height 10}, 71 | ;; "4" {:x 60, :y 30, :width 10, :height 10}, 72 | ;; "(+ 1 2 (- 3 4) (/ 5 6) (inc 25))" {:x 63.75, :y 0, :width 10, :height 10} , 73 | ;; "(- 3 4)" {:x 45, :y 15, :width 10, :height 10}, 74 | ;; "/" {:x 75, :y 30, :width 10, :height 10}, 75 | ;; "-" {:x 30, :y 30, :width 10, :height 10}, 76 | ;; "25" {:x 135, :y 30, :width 10, :height 10}, 77 | ;; "5" {:x 90, :y 30, :width 10, :height 10}, 78 | ;; "inc" {:x 120, :y 30, :width 10, :height 10}, 79 | ;; "6" {:x 105, :y 30, :width 10, :height 10}, 80 | ;; "1" {:x 15, :y 15, :width 10, :height 10}, 81 | ;; "(/ 5 6)" {:x 90, :y 15, :width 10, :height 10}, 82 | ;; "2" {:x 30, :y 15, :width 10, :height 10}, 83 | ;; "+" {:x 0, :y 15, :width 10, :height 10}} 84 | 85 | ``` 86 | 87 | You can use that information to draw something like 88 | 89 | 90 | 91 | ## Options 92 | 93 | #### :sizes 94 | 95 | Is a map from node id to [width height]. Can be used to give `layout-tree` information about 96 | node sizes. If no size info is given for a node [10 10] is assumed. 97 | 98 | #### :branch-fn 99 | 100 | Is a fn that, given a node, returns true if can have 101 | children, even if it currently doesn't. 102 | 103 | #### :childs-fn 104 | 105 | Is a fn that, given a branch node, returns a seq of its 106 | children. 107 | 108 | #### :id-fn 109 | 110 | Is a fn that, given a node, returns anything that can be used as 111 | a node uniq id. Is used to return the result. 112 | 113 | #### :h-gap 114 | 115 | An integer used as horizontal gap between nodes. 116 | 117 | #### :v-gap 118 | 119 | An integer used as vertical gap between nodes. 120 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/test.check {:mvn/version "0.9.0"}} ;; need this for specs generators 2 | :paths ["src"] 3 | :aliases {:dev {:extra-deps {org.clojure/clojurescript {:mvn/version "1.10.238"} 4 | org.clojure/clojure {:mvn/version "1.9.0"} 5 | com.cemerick/piggieback {:mvn/version "0.2.2"} 6 | expound {:mvn/version "0.5.0"}} 7 | :extra-paths ["test"]}}} 8 | -------------------------------------------------------------------------------- /doc/images/sexp-tree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jpmonettas/clj-tree-layout/39b2ff8a95ec947ff0ad1a5d7e1afaad5c141d40/doc/images/sexp-tree.png -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | clj-tree-layout 5 | clj-tree-layout 6 | 0.1.0 7 | clj-tree-layout 8 | 9 | 10 | org.clojure 11 | clojure 12 | 1.9.0 13 | 14 | 15 | org.clojure 16 | test.check 17 | 0.9.0 18 | 19 | 20 | 21 | src 22 | 23 | 24 | src 25 | 26 | 27 | 28 | 29 | 30 | 31 | clojars 32 | Clojars repository 33 | https://clojars.org/repo 34 | 35 | 36 | 37 | 38 | 39 | clojars 40 | https://clojars.org/repo 41 | 42 | 43 | 44 | A library for laying out tree nodes in 2D space for Clojure and ClojureScript. 45 | https://github.com/jpmonettas/clj-tree-layout 46 | 47 | https://github.com/jpmonettas/clj-tree-layout 48 | 49 | 50 | -------------------------------------------------------------------------------- /src/clj_tree_layout/core.cljc: -------------------------------------------------------------------------------- 1 | (ns clj-tree-layout.core 2 | (:require [clj-tree-layout.core-specs] 3 | [clojure.string :as str])) 4 | 5 | (defn- contours 6 | "Given a normalized tree returns a map with its right and left contours. 7 | Contours are returned as a sequence of x coordinates from the root." 8 | [t] 9 | (->> (tree-seq :childs :childs t) 10 | (group-by :depth) 11 | (map (fn [[l nodes]] 12 | (let [fnode (apply (partial min-key :depth-order) nodes) 13 | lnode (apply (partial max-key :depth-order) nodes)] 14 | [l (:x fnode) (+ (:x lnode) (:width lnode))]))) 15 | (sort-by first) 16 | (reduce (fn [r [_ left right]] 17 | (-> r 18 | (update :left conj left) 19 | (update :right conj right))) 20 | {:left [] :right []}))) 21 | 22 | (defn- max-conflict 23 | "Given two sequences representing paths, returns the biggest conflict. 24 | A conflict is how much you need to push the conflicting path right so conflictive path 25 | is 100% at the right of normal-path at every level." 26 | [normal-path conflictive-path] 27 | (let [conflicts (->> (map vector normal-path conflictive-path) 28 | (filter (fn [[n c]] (< c n))) 29 | (map (fn [[n c]] (- n c))))] 30 | (if-not (empty? conflicts) 31 | (apply max conflicts) 32 | 0))) 33 | 34 | (defn- push-tree-right 35 | "Given a normalized tree and a delta, push every node :x position delta 36 | to the right." 37 | [t delta] 38 | (-> t 39 | (update :x #(+ % delta)) 40 | (update :childs (fn [chlds] (mapv #(push-tree-right % delta) chlds))))) 41 | 42 | (defn- tilford-raingold 43 | "Given a normalized tree and a horizontal gap, add :x coordinates to nodes 44 | so the follow aesthetics rules as defined by Tilford and Raingold paper on 45 | tidy trees layouts." 46 | [{:keys [width depth childs] :as node} h-gap] 47 | (if (not-empty childs) 48 | (let [layout-childs (mapv #(tilford-raingold % h-gap) childs) 49 | pushed-childs (loop [pusheds [(first layout-childs)] 50 | [c & r] (rest layout-childs)] 51 | (if c 52 | (let [right-contour (:right (contours (assoc node :x 0 :width 0 :childs pusheds))) 53 | left-contour (:left (contours (assoc node :x 0 :width 0 :childs [c]))) 54 | delta (+ (max-conflict right-contour left-contour) h-gap)] 55 | (recur (conj pusheds (push-tree-right c delta)) r)) 56 | pusheds)) 57 | firstc (first pushed-childs) 58 | lastc (last pushed-childs) 59 | childs-width (- (+ (:x lastc) (:width lastc)) (:x firstc))] 60 | (assoc node 61 | :x (float (- (+ (:x firstc) (/ childs-width 2)) (/ width 2))) 62 | :childs pushed-childs)) 63 | (assoc node :x 0.0))) 64 | 65 | (defn- layers-heights 66 | "Given a normalized tree returns a map from depths to tree layer height. 67 | The layer height is the height of the tallest node for the layer." 68 | [t] 69 | (->> t 70 | (tree-seq :childs :childs) 71 | (group-by :depth) 72 | (map (fn [[d nodes]] 73 | [d (apply max (map :height nodes))])) 74 | (into {}))) 75 | 76 | (defn- add-ys 77 | "Given a normalized tree, add :y coordinates to every node so that 78 | nodes at the same layers have the same :y coordinate." 79 | ([t layer-height v-gap] (add-ys t layer-height v-gap 0)) 80 | ([t layer-height v-gap y] 81 | (let [lh (layer-height (:depth t))] 82 | (-> t 83 | (assoc :y (float y)) 84 | (update :childs (fn [childs] 85 | (->> childs 86 | (mapv #(add-ys % layer-height v-gap (+ y lh v-gap)))))))))) 87 | 88 | (defn- annotate 89 | "Given a normalized tree add :depth and :depth-order to every node." 90 | [t] 91 | (let [x-numbers (atom {}) 92 | aux (fn aux [tr depth] 93 | (-> tr 94 | (assoc :depth depth 95 | :depth-order (-> (swap! x-numbers update depth (fnil inc 0)) 96 | (get depth))) 97 | (update :childs (fn [chlds] 98 | (mapv (fn [c] 99 | (aux c (inc depth))) 100 | chlds)))))] 101 | (aux t 0))) 102 | 103 | (defn- normalize 104 | "Given any tree, a childs-fn, id-fn, branch-fn and sizes build a normalized tree. 105 | In the normalized tree every node is a map {:keys [:node-id :width :height :childs]}" 106 | [t sizes childs-fn id-fn branch-fn] 107 | (let [[width height] (get sizes (id-fn t) [10 10])] 108 | {:node-id (id-fn t) 109 | :width width 110 | :height height 111 | :childs (mapv #(normalize % sizes childs-fn id-fn branch-fn) 112 | (childs-fn t))})) 113 | 114 | (defn- ensure-all-positive 115 | "Given a normalized positioned tree pushes it to the right until all nodes 116 | :x coordinate is positive (> 0)." 117 | [t h-gap] 118 | (let [left-contour (:left (contours t)) 119 | delta (+ (max-conflict (repeat 0) left-contour) h-gap) 120 | pushed (push-tree-right t delta)] 121 | pushed)) 122 | 123 | (defn- dimensions 124 | "Given a normalized positioned tree returns a map from :node-id 125 | to {:x :y :width :height} for every node." 126 | [t] 127 | (reduce (fn [r n] 128 | (assoc r (:node-id n) (select-keys n [:x :y :width :height]))) 129 | {} (tree-seq :childs :childs t))) 130 | 131 | (defn layout-tree 132 | "Given any tree and a map of directives, returns a map from node ids to 133 | {:x :y :width :height} for every node. 134 | Directives: 135 | 136 | :sizes a map from node ids to [width height] 137 | :childs-fn a fn that, given a branch node, returns a seq of its children. 138 | :id-fn a fn that, given a node, returns anything that can be used as a node uniq id. 139 | :branch-fn a fn that, given a node, returns true if can have children, even if it currently doesn't. 140 | :h-gap an integer used as horizontal gap between nodes. 141 | :v-gap an integer used as vertical gap between nodes." 142 | 143 | [t {:keys [sizes childs-fn id-fn branch-fn h-gap v-gap] 144 | :or {h-gap 5 v-gap 5}}] 145 | (let [internal-tree (-> t 146 | (normalize sizes childs-fn id-fn branch-fn) 147 | annotate) 148 | layers-heights (layers-heights internal-tree)] 149 | (-> internal-tree 150 | (add-ys layers-heights v-gap) 151 | (tilford-raingold h-gap) 152 | (ensure-all-positive h-gap) 153 | dimensions))) 154 | 155 | (comment 156 | 157 | 158 | (layout-tree {:id 1 159 | :lable "1" 160 | :childs [{:id 2 161 | :label "2" 162 | :childs [{:id 12 163 | :label "12"}]} 164 | {:id 3 165 | :label "3"}]} 166 | {:branch-fn :childs 167 | :childs-fn :childs 168 | :id-fn :id}) 169 | 170 | (layout-tree '(1 2 3) 171 | {:branch-fn #(when (seq? %) %) 172 | :childs-fn #(when (seq? %) %) 173 | :id-fn str 174 | :sizes {"(1 2 3)" , [43 18] 175 | "1" , [8 18] 176 | "2" , [8 18] 177 | "3" [8 18]}}) 178 | ) 179 | -------------------------------------------------------------------------------- /src/clj_tree_layout/core_specs.cljc: -------------------------------------------------------------------------------- 1 | (ns clj-tree-layout.core-specs 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.spec.gen.alpha :as sgen] 4 | [clojure.test.check.generators :as gen] 5 | [clojure.set :as set])) 6 | 7 | (def simple-tree-gen (gen/recursive-gen 8 | #(gen/hash-map :id gen/uuid :childs (gen/vector %)) 9 | (gen/hash-map :id gen/uuid))) 10 | 11 | (s/def ::tree any?) 12 | 13 | (s/def ::width (s/with-gen pos-int? 14 | #(s/gen (s/int-in 0 10e5)))) 15 | (s/def ::height (s/with-gen pos-int? 16 | #(s/gen (s/int-in 0 10e5)))) 17 | (s/def ::x (s/and float? #(<= 0 %))) 18 | (s/def ::y (s/and float? #(<= 0 %))) 19 | 20 | (s/def ::sizes (s/map-of any? (s/tuple ::width ::height))) 21 | (s/def ::childs-fn ifn?) 22 | (s/def ::id-fn ifn?) 23 | (s/def ::branch-fn ifn?) 24 | (s/def ::h-gap (s/with-gen (s/and pos-int? #(<= 2 %)) 25 | #(s/gen (s/int-in 2 100)))) 26 | (s/def ::v-gap (s/with-gen (s/and pos-int? #(<= 2 %)) 27 | #(s/gen (s/int-in 2 100)))) 28 | 29 | (s/def ::layout-tree-config (s/keys :req-un [::sizes 30 | ::childs-fn 31 | ::id-fn 32 | ::branch-fn 33 | ::h-gap 34 | ::v-gap])) 35 | 36 | 37 | (defn collisions? 38 | "Returns true if there are any collisions in a seq of boxes maps with 39 | keys :x :y :width :height" 40 | [boxes-seq] 41 | (let [colliding? (fn [a b] 42 | (and (< (:x a) (+ (:x b) (:width b))) 43 | (> (+ (:x a) (:width a)) (:x b)) 44 | (< (:y a) (+ (:y b) (:height b))) 45 | (> (+ (:y a) (:height a)) (:y b)))) 46 | boxes-set (into #{} boxes-seq)] 47 | (->> (for [b boxes-set 48 | other (disj boxes-set b)] 49 | (let [c? (colliding? b other)] 50 | (when c? (println b other)) 51 | c?)) 52 | (reduce #(or %1 %2) false)))) 53 | 54 | 55 | (s/def ::positions-map (s/and (s/map-of any? (s/keys :req-un [::x ::y ::width ::height])) 56 | #(not (collisions? (vals %))))) 57 | 58 | (s/def ::layout-tree-args (s/with-gen 59 | (s/cat :tree ::tree 60 | :config ::layout-tree-config) 61 | 62 | ;; generate arguments with simple trees for testing 63 | #(sgen/fmap (fn [[tree w-and-hs hgap vgap]] 64 | (let [tree-ids (map :id (tree-seq :childs :childs tree))] 65 | [tree {:sizes (->> (map vector (shuffle tree-ids) w-and-hs) 66 | (into {})) 67 | :childs-fn :childs 68 | :id-fn :id 69 | :branch-fn :childs 70 | :h-gap hgap 71 | :v-gap vgap}])) 72 | (sgen/tuple 73 | simple-tree-gen 74 | (s/gen (s/coll-of (s/tuple ::width ::height))) 75 | (s/gen ::h-gap) 76 | (s/gen ::v-gap))))) 77 | 78 | 79 | (s/fdef clj-tree-layout.core/layout-tree 80 | :args ::layout-tree-args 81 | :ret ::positions-map) 82 | -------------------------------------------------------------------------------- /test/clj_tree_layout/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns clj-tree-layout.core-test 2 | (:require [clj-tree-layout.core :refer [layout-tree]] 3 | [clojure.test :refer [deftest is testing run-tests]] 4 | [clojure.spec.test.alpha :as stest] 5 | [expound.alpha :as ex] 6 | [clojure.spec.alpha :as s] 7 | [clojure.test.check.generators :as gen] 8 | [clojure.spec.gen.alpha :as sgen] 9 | [clj-tree-layout.core-specs :refer :all])) 10 | 11 | (stest/instrument ['clj-tree-layout.core/layout-tree]) 12 | (alter-var-root #'s/*explain-out* (constantly ex/printer)) 13 | 14 | (deftest layout-tree-generative-test 15 | (let [{:keys [total check-passed]} (stest/summarize-results (stest/check `layout-tree))] 16 | (is (= total check-passed)))) 17 | --------------------------------------------------------------------------------