Refactor dot code
This commit is contained in:
Folkert Kevelam
parent
f4447c70f7
commit
5186a84010
185
SICP/dot.janet
185
SICP/dot.janet
|
|
@ -1,17 +1,31 @@
|
|||
(def attr-map @{
|
||||
:rankdir ["rankdir" false]
|
||||
:newrank ["newrank" false]
|
||||
:label ["label" true]
|
||||
:shape ["shape" false]
|
||||
:group ["group" true]
|
||||
:fillcolor ["fillcolor" false]
|
||||
:style ["filled" 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 @[])
|
||||
(if (get node :label)
|
||||
(array/push attributes
|
||||
(string/format "label=\"%s\"" (get node :label))))
|
||||
(if (get node :shape)
|
||||
(array/push attributes
|
||||
(string/format "shape=%s" (get node :shape))))
|
||||
(if (get node :color)
|
||||
(array/push attributes
|
||||
(string/format "fillcolor=\"%s\" style=filled" (get node :color))))
|
||||
(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 ",")))
|
||||
(get node :name)
|
||||
(string/join attributes ",")))
|
||||
|
||||
(defn relation-to-string [graph_type relations]
|
||||
(def oper
|
||||
|
|
@ -21,108 +35,121 @@
|
|||
(string/format "%s;\n"
|
||||
(string/join relations oper)))
|
||||
|
||||
(defn create-graph [graph_type name &named rankdir]
|
||||
(def a @{
|
||||
:name name
|
||||
:type graph_type
|
||||
:nodes @[]
|
||||
:relations @[]
|
||||
:subgraphs @[] })
|
||||
(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 @[])
|
||||
|
||||
(when rankdir
|
||||
(set (a :rankdir) rankdir))
|
||||
(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)))))
|
||||
|
||||
a)
|
||||
(def str_nodes @[])
|
||||
|
||||
(defn create-subgraph [name &named rankdir]
|
||||
(def s @{
|
||||
:name name
|
||||
:nodes @[]
|
||||
:relations @[]})
|
||||
(each node (get subgraph :nodes)
|
||||
(array/push str_nodes
|
||||
(string/format "%s%s"
|
||||
level_in (node-to-string node))))
|
||||
|
||||
(when rankdir
|
||||
(set (s :rankdir) rankdir))
|
||||
(def str_relations @[])
|
||||
|
||||
s)
|
||||
(each rel (get subgraph :relations)
|
||||
(array/push str_relations
|
||||
(string/format "%s%s"
|
||||
level_in (relation-to-string graph_type rel))))
|
||||
|
||||
(defn add-node [graph name &named label shape color]
|
||||
(def new_node @{:name name})
|
||||
(when label
|
||||
(set (new_node :label) label))
|
||||
(when shape
|
||||
(set (new_node :shape) shape))
|
||||
(when color
|
||||
(set (new_node :color) color))
|
||||
(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))
|
||||
|
||||
(def nodes (get graph :nodes))
|
||||
(array/push nodes new_node))
|
||||
|
||||
(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 write-graph [graph filename]
|
||||
(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 :type) :graph) "graph"
|
||||
(= (get graph :type) :digraph) "digraph"))
|
||||
(= (get graph :graph_type) :graph) "graph"
|
||||
(= (get graph :graph_type) :digraph) "digraph"))
|
||||
|
||||
(print graph_type)
|
||||
(print name)
|
||||
(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 :relations)) 0)
|
||||
(> (length (get graph :subgraphs)) 0))
|
||||
(do
|
||||
(file/write f "\n")
|
||||
(when (get graph :rankdir)
|
||||
(file/write f (string/format "rankdir=%s;\n" (get graph :rankdir))))))
|
||||
(file/write f (string/format "\trankdir=%s;\n" (get graph :rankdir))))))
|
||||
|
||||
(var i 0)
|
||||
(def nodes (get graph :nodes))
|
||||
(print (length nodes))
|
||||
(while (< i (length nodes))
|
||||
(file/write f (string/format "\t%s" (node-to-string (get nodes i))))
|
||||
(set i (+ i 1)))
|
||||
(each node (get graph :nodes)
|
||||
(file/write f (string/format "\t%s" (node-to-string node))))
|
||||
|
||||
(set i 0)
|
||||
(def relations (get graph :relations))
|
||||
(while (< i (length relations))
|
||||
(each rel (get graph :relations)
|
||||
(file/write f (string/format "\t%s" (relation-to-string
|
||||
(get graph :type)
|
||||
(get relations i))))
|
||||
(set i (+ i 1)))
|
||||
(get graph :graph_type)
|
||||
rel))))
|
||||
|
||||
(set i 0)
|
||||
(def subgraphs (get graph :subgraphs))
|
||||
(while (< i (length subgraphs))
|
||||
(def subgraph (get subgraphs i))
|
||||
(file/write f (string/format "\tsubgraph %s {\n" (get subgraph :name)))
|
||||
(when (get subgraph :rankdir)
|
||||
(file/write f (string/format "\t\trankdir=%s;\n" (get subgraph :rankdir))))
|
||||
(var j 0)
|
||||
(def nodes (get subgraph :nodes))
|
||||
(print (length nodes))
|
||||
(while (< j (length nodes))
|
||||
(file/write f (string/format "\t\t%s" (node-to-string (get nodes j))))
|
||||
(set j (+ j 1)))
|
||||
|
||||
(set j 0)
|
||||
(def relations (get subgraph :relations))
|
||||
(while (< j (length relations))
|
||||
(file/write f (string/format "\t\t%s" (relation-to-string
|
||||
(get graph :type)
|
||||
(get relations j))))
|
||||
(set j (+ j 1)))
|
||||
(file/write f "\t}\n")
|
||||
(set i (+ i 1)))
|
||||
(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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user