一筆書きドラゴン曲線

TeX でドラゴン曲線を描こうと思ったのですが、クヌース先生がとっくにやってしまっていて、あろうことか『TeXブック』にまで載せていました。出力結果は『TeXブック』に載っていないので、とりあえず写経して pdftex にかけてみたら、確かにきれいな龍が現れました。

そのクヌース先生のコードですが、実際にドラゴン曲線を描くコードはたったの 2行です。

\def\dragon{\ifnum\n>0{\advance\n-1 \dragon\L\nogard}\fi}
\def\nogard{\ifnum\n>0{\advance\n-1 \dragon\R\nogard}\fi}

どうやら相互再帰みたいですね。 Scheme で書くならこんな感じでしょうか。

(define (dragon-curve dim)
  (define (dragon i)
    (if (> i 0)
        (append (dragon (- i 1)) 
                turn-left
                (nogard (- i 1)))
        '()))
  (define (nogard i)
    (if (> i 0)
        (append (dragon (- i 1))
                turn-right
                (nogard (- i 1)))
        '()))
  (dragon dim))

ドラゴン曲線は、「線分を真ん中で直角に折る」という操作を、折り曲げてできた 2つの線分に繰り返し適用して得られる自己相似なフラクタル図形です。ただし、折り曲げてできた 2つの線分を再び折り曲げる際には、それぞれ違う向きに操作を適用します。最初の線分の向きが「→→」だとしたら、「→←」という具合に、折り曲げてできた 2つの線分の双方に対して逆向きに繰り返し操作を適用するわけです。

で、クヌース先生はこれをうまく利用することで、\dragon と \nogard （dragon を逆から読んだ）を相互再帰させているわけですね。それぞれの真ん中にある \L と \R は曲げる方向で、結果として \dragon は \L と \R からなる列に展開されます。この \L と \R にしたがって頭から進んでいけば、一筆書きの要領でドラゴン曲線が得られるという寸法です。

TeXもいいですが、一筆書きといったら『関数プログラミング』（R. バード,P.ワドラー著/武市 正人訳）の亀の子図形でしょう。むかし書いた Scheme 版でドラゴン曲線をやってみます。切り貼りして説明書くの面倒くさくなったのでファイルまるごと掲載。

;;;; dragon.scm
(use srfi-1)
(use srfi-42)
(use util.match)

;; state -> state
(define (move state)
  (match state
    (`((,x ,y) 0) (make-state (- x 1) y 0))    ;; N
    (`((,x ,y) 1) (make-state x (- y 1) 1))    ;; W
    (`((,x ,y) 2) (make-state (+ x 1) y 2))    ;; S
    (`((,x ,y) 3) (make-state x (+ y 1) 3))    ;; E
    ))

(define-syntax let-state
  (syntax-rules ()
    ((_ e1 (e2 e3 e4) e5 ...)
     (let ((e2 (caar e1))
           (e3 (cadar e1))
           (e4 (cadr e1)))
       e5 ...))))

;; state -> state
(define (turn-left state)
  (let-state state
      (x y d)
    (make-state x y (remainder (+ d 1) 4))))

;; state -> state
(define (turn-right state)
  (let-state state
      (x y d)
    (make-state x y (remainder (+ d 3) 4))))

;; state
(define (make-state x y d)
  (list (list x y) d))

;; state -> [state -> state] -> [state]
(define (scanf init procs)
  (if (null? procs)
      '()
      (let ((value ((car procs) init)))
        (cons value
              (scanf value (cdr procs))))))

;; draw as ASCII art

;; [state] -> [[boole]]
(define (to-bitmap ps)
  (define (range xs)
    (list-ec (: i (apply min xs) (+ (apply max xs) 1)) i))
  (define (orlist ls)
    (cond ((null? ls) #f)
          ((car ls) #t)
          (else
           (orlist (cdr ls)))))
  (define (in? x xs)
    (orlist (map (cut equal? <> x) xs)))
  (let ((codes (map car ps)))
    (list-ec (: x (range (map car codes)))
             (list-ec (: y (range (map cadr codes)))
                      (in? (list x y) codes)))))

;; [[boole]] -> string
(define (draw bitmap)
  (string-join
   (map (lambda (y)
          (string-join (map (lambda (x) (if x "#" " ")) y)
                       "" 'strict-infix))
        bitmap)
   "\n" 'strict-infix))

(define (dragon-curve dim)
  (define (dragon i)
    (if (> i 0)
        (append (nogard (- i 1))
                (list move turn-left)
                (dragon (- i 1)))
        '()))
  (define (nogard i)
    (if (> i 0)
        (append (nogard (- i 1))
                (list move turn-right)
                (dragon (- i 1)))
        '()))
  (scanf (make-state 0 0 0) (dragon dim)))

(define (main args)
  (print
   (draw
    (to-bitmap
     (dragon-curve (x->integer (cadr args))))))
  0)

$ gosh dragon.scm 8
     ####    ####       
    #####   #####       
    ####### #######     
      #####   #####     
 #################      
#################       
###### ### ########     
  ####  ## ########     
 ###       #######      
####       ######    ## 
####  #    ### ####   ##
  #####     ## ####   ##
  ####         #########
               #########
               ### ###  
                ##  ##  

なんかひっくり返ってますが、無事にドラゴン出ました。