(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))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment