156 lines
4.1 KiB
Plaintext
156 lines
4.1 KiB
Plaintext
(def attr-map @{
|
|
:rankdir ["rankdir" false]
|
|
:newrank ["newrank" false]
|
|
:rank ["rank" false]
|
|
:label ["label" true]
|
|
:shape ["shape" false]
|
|
:group ["group" true]
|
|
:fillcolor ["fillcolor" false]
|
|
:style ["style" true] })
|
|
|
|
(defn attr-to-string [attr attr-value]
|
|
(def name (get attr 0))
|
|
(def str? (get attr 1))
|
|
(if str?
|
|
(string/format "%s=\"%s\"" name attr-value)
|
|
(string/format "%s=%s" name attr-value)))
|
|
|
|
(defn node-to-string [node]
|
|
(def attributes @[])
|
|
(def attr-keys (keys (get node :attributes)))
|
|
(each attr-key attr-keys
|
|
(when (get attr-map attr-key)
|
|
(def local-key (get attr-map attr-key))
|
|
(def local-value (get (get node :attributes) attr-key))
|
|
(array/push attributes
|
|
(attr-to-string local-key local-value))))
|
|
(string/format "%s [%s];\n"
|
|
(get node :name)
|
|
(string/join attributes ",")))
|
|
|
|
(defn relation-to-string [graph_type relations]
|
|
(def oper
|
|
(cond
|
|
(= graph_type :graph) "--"
|
|
(= graph_type :digraph) "->"))
|
|
(string/format "%s;\n"
|
|
(string/join relations oper)))
|
|
|
|
(defn subgraph-to-string [subgraph graph_type level]
|
|
(def level_sub (string/repeat "\t" level))
|
|
(def level_in (string/repeat "\t" (+ level 1)))
|
|
(def str_attributes @[])
|
|
|
|
(each attr-key (keys (get subgraph :attributes))
|
|
(when (get attr-map attr-key)
|
|
(def local-key (get attr-map attr-key))
|
|
(def local-value (get (get subgraph :attributes) attr-key))
|
|
(array/push str_attributes
|
|
(string/format "%s%s;\n"
|
|
level_in (attr-to-string local-key local-value)))))
|
|
|
|
(def str_nodes @[])
|
|
|
|
(each node (get subgraph :nodes)
|
|
(array/push str_nodes
|
|
(string/format "%s%s"
|
|
level_in (node-to-string node))))
|
|
|
|
(def str_relations @[])
|
|
|
|
(each rel (get subgraph :relations)
|
|
(array/push str_relations
|
|
(string/format "%s%s"
|
|
level_in (relation-to-string graph_type rel))))
|
|
|
|
(string/format "%ssubgraph %s {\n%s%s%s%s}\n"
|
|
level_sub
|
|
(get subgraph :name)
|
|
(string/join str_attributes "")
|
|
(string/join str_nodes "")
|
|
(string/join str_relations "")
|
|
level_sub))
|
|
|
|
|
|
(defn add-node [graph name &keys attributes]
|
|
(def new_node @{
|
|
:name name
|
|
:attributes attributes})
|
|
(array/push (get graph :nodes) new_node))
|
|
|
|
(defn add-relation [graph & rels]
|
|
(def relations (get graph :relations))
|
|
(array/push relations rels))
|
|
|
|
(defn add-relation_arr [graph rels]
|
|
(def relations (get graph :relations))
|
|
(array/push relations rels))
|
|
|
|
(defn add-subgraph [graph subgraph]
|
|
(def subgraphs (get graph :subgraphs))
|
|
(array/push subgraphs subgraph))
|
|
|
|
(defn set-attribute [graph attribute value]
|
|
(set (graph attribute) value))
|
|
|
|
(defn create-subgraph [name &keys attributes]
|
|
(def s @{
|
|
:name name
|
|
:nodes @[]
|
|
:relations @[]
|
|
:attributes attributes})
|
|
|
|
s)
|
|
|
|
(defn create [name &named rankdir graph_type]
|
|
(def base @{
|
|
:name name
|
|
:nodes @[]
|
|
:relations @[]
|
|
:subgraphs @[] })
|
|
|
|
(when rankdir
|
|
(set (base :rankdir) rankdir))
|
|
|
|
(if graph_type
|
|
(set (base :graph_type) graph_type)
|
|
(set (base :graph_type) :graph))
|
|
|
|
base)
|
|
|
|
(defn write [graph filename]
|
|
(def f (file/open filename :w))
|
|
|
|
(def name (get graph :name))
|
|
(def graph_type
|
|
(cond
|
|
(= (get graph :graph_type) :graph) "graph"
|
|
(= (get graph :graph_type) :digraph) "digraph"))
|
|
|
|
(file/write f (string/format "%s %s {" graph_type name))
|
|
|
|
(if
|
|
(or
|
|
(> (length (get graph :nodes)) 0)
|
|
(> (length (get graph :relations)) 0)
|
|
(> (length (get graph :subgraphs)) 0))
|
|
(do
|
|
(file/write f "\n")
|
|
(when (get graph :rankdir)
|
|
(file/write f (string/format "\trankdir=%s;\n" (get graph :rankdir))))))
|
|
|
|
(each node (get graph :nodes)
|
|
(file/write f (string/format "\t%s" (node-to-string node))))
|
|
|
|
(each rel (get graph :relations)
|
|
(file/write f (string/format "\t%s" (relation-to-string
|
|
(get graph :graph_type)
|
|
rel))))
|
|
|
|
(each sg (get graph :subgraphs)
|
|
(file/write f (string/format (subgraph-to-string sg (get graph :graph_type) 1))))
|
|
|
|
(file/write f "}")
|
|
(file/flush f)
|
|
(file/close f))
|