From 795e4a83d5254a98be0e15e0fe194cb371d1ea96 Mon Sep 17 00:00:00 2001 From: Folkert Kevelam Date: Sun, 23 Mar 2025 21:35:08 +0100 Subject: [PATCH] Initial commit --- SICP/dot.janet | 129 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 SICP/dot.janet diff --git a/SICP/dot.janet b/SICP/dot.janet new file mode 100644 index 0000000..007ffad --- /dev/null +++ b/SICP/dot.janet @@ -0,0 +1,129 @@ +(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)))) + (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 create-graph [graph_type name &named rankdir] + (def a @{ + :name name + :type graph_type + :nodes @[] + :relations @[] + :subgraphs @[] }) + + (when rankdir + (set (a :rankdir) rankdir)) + + a) + +(defn create-subgraph [name &named rankdir] + (def s @{ + :name name + :nodes @[] + :relations @[]}) + + (when rankdir + (set (s :rankdir) rankdir)) + + s) + +(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)) + + (def nodes (get graph :nodes)) + (array/push nodes new_node)) + +(defn add-relation [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] + (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")) + + (file/write f (string/format "%s %s {" graph_type name)) + + (if + (or + (> (length (get graph :nodes)) 0) + (> (length (get graph :relations)) 0)) + (do + (file/write f "\n") + (when (get graph :rankdir) + (file/write f (string/format "rankdir=%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))) + + (set i 0) + (def relations (get graph :relations)) + (while (< i (length relations)) + (file/write f (string/format "\t%s" (relation-to-string + (get graph :type) + (get relations i)))) + (set i (+ i 1))) + + (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))) + + (file/write f "}") + (file/flush f) + (file/close f))