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]
|
(defn node-to-string [node]
|
||||||
(def attributes @[])
|
(def attributes @[])
|
||||||
(if (get node :label)
|
(def attr-keys (keys (get node :attributes)))
|
||||||
(array/push attributes
|
(each attr-key attr-keys
|
||||||
(string/format "label=\"%s\"" (get node :label))))
|
(when (get attr-map attr-key)
|
||||||
(if (get node :shape)
|
(def local-key (get attr-map attr-key))
|
||||||
(array/push attributes
|
(def local-value (get (get node :attributes) attr-key))
|
||||||
(string/format "shape=%s" (get node :shape))))
|
(array/push attributes
|
||||||
(if (get node :color)
|
(attr-to-string local-key local-value))))
|
||||||
(array/push attributes
|
|
||||||
(string/format "fillcolor=\"%s\" style=filled" (get node :color))))
|
|
||||||
(string/format "%s [%s];\n"
|
(string/format "%s [%s];\n"
|
||||||
(get node :name)
|
(get node :name)
|
||||||
(string/join attributes ",")))
|
(string/join attributes ",")))
|
||||||
|
|
||||||
(defn relation-to-string [graph_type relations]
|
(defn relation-to-string [graph_type relations]
|
||||||
(def oper
|
(def oper
|
||||||
|
|
@ -21,108 +35,121 @@
|
||||||
(string/format "%s;\n"
|
(string/format "%s;\n"
|
||||||
(string/join relations oper)))
|
(string/join relations oper)))
|
||||||
|
|
||||||
(defn create-graph [graph_type name &named rankdir]
|
(defn subgraph-to-string [subgraph graph_type level]
|
||||||
(def a @{
|
(def level_sub (string/repeat "\t" level))
|
||||||
:name name
|
(def level_in (string/repeat "\t" (+ level 1)))
|
||||||
:type graph_type
|
(def str_attributes @[])
|
||||||
:nodes @[]
|
|
||||||
:relations @[]
|
|
||||||
:subgraphs @[] })
|
|
||||||
|
|
||||||
(when rankdir
|
(each attr-key (keys (get subgraph :attributes))
|
||||||
(set (a :rankdir) rankdir))
|
(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]
|
(each node (get subgraph :nodes)
|
||||||
(def s @{
|
(array/push str_nodes
|
||||||
:name name
|
(string/format "%s%s"
|
||||||
:nodes @[]
|
level_in (node-to-string node))))
|
||||||
:relations @[]})
|
|
||||||
|
|
||||||
(when rankdir
|
(def str_relations @[])
|
||||||
(set (s :rankdir) rankdir))
|
|
||||||
|
|
||||||
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]
|
(string/format "%ssubgraph %s {\n%s%s%s%s}\n"
|
||||||
(def new_node @{:name name})
|
level_sub
|
||||||
(when label
|
(get subgraph :name)
|
||||||
(set (new_node :label) label))
|
(string/join str_attributes "")
|
||||||
(when shape
|
(string/join str_nodes "")
|
||||||
(set (new_node :shape) shape))
|
(string/join str_relations "")
|
||||||
(when color
|
level_sub))
|
||||||
(set (new_node :color) color))
|
|
||||||
|
|
||||||
(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]
|
(defn add-relation [graph & rels]
|
||||||
(def relations (get graph :relations))
|
(def relations (get graph :relations))
|
||||||
(array/push relations rels))
|
(array/push relations rels))
|
||||||
|
|
||||||
|
(defn add-relation_arr [graph rels]
|
||||||
|
(def relations (get graph :relations))
|
||||||
|
(array/push relations rels))
|
||||||
|
|
||||||
(defn add-subgraph [graph subgraph]
|
(defn add-subgraph [graph subgraph]
|
||||||
(def subgraphs (get graph :subgraphs))
|
(def subgraphs (get graph :subgraphs))
|
||||||
(array/push subgraphs subgraph))
|
(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 f (file/open filename :w))
|
||||||
|
|
||||||
(def name (get graph :name))
|
(def name (get graph :name))
|
||||||
(def graph_type
|
(def graph_type
|
||||||
(cond
|
(cond
|
||||||
(= (get graph :type) :graph) "graph"
|
(= (get graph :graph_type) :graph) "graph"
|
||||||
(= (get graph :type) :digraph) "digraph"))
|
(= (get graph :graph_type) :digraph) "digraph"))
|
||||||
|
|
||||||
|
(print graph_type)
|
||||||
|
(print name)
|
||||||
(file/write f (string/format "%s %s {" graph_type name))
|
(file/write f (string/format "%s %s {" graph_type name))
|
||||||
|
|
||||||
(if
|
(if
|
||||||
(or
|
(or
|
||||||
(> (length (get graph :nodes)) 0)
|
(> (length (get graph :nodes)) 0)
|
||||||
(> (length (get graph :relations)) 0))
|
(> (length (get graph :relations)) 0)
|
||||||
|
(> (length (get graph :subgraphs)) 0))
|
||||||
(do
|
(do
|
||||||
(file/write f "\n")
|
(file/write f "\n")
|
||||||
(when (get graph :rankdir)
|
(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)
|
(each node (get graph :nodes)
|
||||||
(def nodes (get graph :nodes))
|
(file/write f (string/format "\t%s" (node-to-string node))))
|
||||||
(print (length nodes))
|
|
||||||
(while (< i (length nodes))
|
|
||||||
(file/write f (string/format "\t%s" (node-to-string (get nodes i))))
|
|
||||||
(set i (+ i 1)))
|
|
||||||
|
|
||||||
(set i 0)
|
(each rel (get graph :relations)
|
||||||
(def relations (get graph :relations))
|
|
||||||
(while (< i (length relations))
|
|
||||||
(file/write f (string/format "\t%s" (relation-to-string
|
(file/write f (string/format "\t%s" (relation-to-string
|
||||||
(get graph :type)
|
(get graph :graph_type)
|
||||||
(get relations i))))
|
rel))))
|
||||||
(set i (+ i 1)))
|
|
||||||
|
|
||||||
(set i 0)
|
(each sg (get graph :subgraphs)
|
||||||
(def subgraphs (get graph :subgraphs))
|
(file/write f (string/format (subgraph-to-string sg (get graph :graph_type) 1))))
|
||||||
(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)))
|
|
||||||
|
|
||||||
(file/write f "}")
|
(file/write f "}")
|
||||||
(file/flush f)
|
(file/flush f)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user