lispをDOT言語に変換してみた

下駄配列の派生図を作成してみた - blechmusik2の日記で作成した図をlisp経由で生成してみた。つぎのように記述すると、前回と同様のスクリプトを出力する。

(print-digraph "geta"
           (set-node '((:attr (("fortsize" 12)
                   ("fontname" "APJapanesefont")
                   ("label" "下駄配列の派生図"))
                "graph")
               (:attr (("fontsize" 12)
                   ("fontname" "APJapanesefont"))
                "node")))
           ;;
           (set-node '((:attr (("label" "下駄配列"))
                "getas")
               (:attr (("label" "新下駄配列"))
                "new_getas")
               (:attr (("label" "日和下駄配列"))
                "getas_in_fine_weather")
               (:attr (("label" "黒塗り下駄配列"))
                "black_lacquered_getas")
               (:attr (("label" "黒塗り桐下駄配列"))
                "black_lacquered_getas_made_of_paulownia")
               (:attr (("label" "塗り下駄配列"))
                "lacquered_getas")
               (:attr (("label" "新JIS下駄配列"))
                "new_JIS_getas")))
           ;;
           (set-node '(("getas" "getas_in_fine_weather")
               ("getas" "lacquered_getas")
               ("getas" "new_JIS_getas")
               ("getas" "new_getas")
               ("getas" "lacquered_getas")
               ;;
               ("lacquered_getas" "black_lacquered_getas")
               ("black_lacquered_getas" "black_lacquered_getas_made_of_paulownia")
               ("black_lacquered_getas_made_of_paulownia" "black_lacquered_getas")
               ;; http://mogys.seesaa.net/article/165879868.html
               (:attr (("style" "dotted"))
                "black_lacquered_getas" "getas_in_fine_weather"))))

使用する関数とマクロを以下掲載する。

(defmacro print-space (n)
  `(dotimes (i ,n)
     (format t "~A" " ")))

(defun set-each-node (node-list)
  (print-space 2)
  (if (string= (first node-list) ':attr)
      ;; :attr
      (progn
	(format t "~{~A~^ -> ~}" (rest (rest node-list)))
	(format t "~A" " [")
	(let ((result 0))
	  (dolist (each-attr (second node-list))
	    (format t "~A~A~A"
		    (first each-attr) " = " (first (rest each-attr)))
	    (setq result (1+ result))
	    (when (< result (list-length node-list))
	      (format t "~A" ", "))))
	(format t "~A~%" "];"))
      ;; no :attr
      (format t "~{~A~^ -> ~};~%" node-list)))

(defun set-node (node-list)
  (if (listp (first node-list))
      (dolist (each-node-list node-list)
	(set-each-node each-node-list))
      (set-each-node node-list)))

(defmacro print-graph (graph-type graph-keyword &body body)
  `(progn
     ;; graph-type and graph-keyword
     (format t "~A~A~A" ,graph-type " " ,graph-keyword)
     ;; start paren
     (format t "~A~%" " {")
     ,@body
     ;; close paren
     (format t "~A" "}")))

(defmacro print-digraph (graph-keyword &body body)
  `(print-graph "digraph" ,graph-keyword ,@body)))

(defmacro print-subgraph (graph-keyword &body body)
  `(print-graph "subgraph" ,graph-keyword ,@body))

きちんと確かめていないが、Graphviz チュートリアルの各設定例にはそれなりに対応できていると思う。
なお、グラフやノードの属性値をとくに設定しないならば、lisp2dotのように木構造を操作することで、大抵のことが事足りるだろう。