sample.png

tree.clj

(ns ola-mundo.tree
  (:require [clojure.data.finger-tree :as ft]
            [ubergraph.core :as uber]
            [clojure.string :as string])
  (:import (clojure.data.finger_tree DoubleList DeepTree EmptyTree SingleTree
                                     Digit1 Digit2 Digit3 Digit4)))

(set! *warn-on-reflection* true)

(defn get-value
  [o n]
  (let [c (class o)
        f (.getDeclaredField c n)]
    (.get f o)))

(def type->fields
  {DoubleList [:tree]
   DeepTree   [:suf :pre :mid]
   SingleTree [:x]
   EmptyTree  []
   Digit1     [:a]
   Digit2     [:a :b]
   Digit3     [:a :b :c]
   Digit4     [:a :b :c :d]})

(defn show
  [x]
  (let [t (type x)
        ks (type->fields t)]
    (if ks
      (into {::type-name (last (string/split (pr-str t)
                                             #"\."))
             ::fields    ks}
            (for [k ks]
              [k (show (get-value x (name k)))]))
      x)))

(defn digraph-impl
  [[k {::keys [type-name fields]
       :as    v}]]
  (let [kvs (select-keys v fields)
        childs (map digraph-impl kvs)
        ident (keyword (gensym))]
    (cond-> {::ident ident
             ::nodes (apply merge {ident
                                   {:label (if type-name
                                             type-name
                                             (pr-str v))}}
                            (map ::nodes childs))
             ::edges (concat (for [child childs]
                               [ident (::ident child) {:label (::k child)}])
                             (mapcat ::edges childs))}
            k (assoc ::k (name k)))))

(defn digraph
  [x]
  (let [{::keys [nodes edges]} (digraph-impl [nil (show x)])]
    (apply uber/digraph
           (concat (for [[k v] nodes]
                     [k v])
                   edges))))

(comment
  (uber/viz-graph (digraph (apply ft/double-list (range 20)))))