n進数で文字列探索

4桁の整数のなかで「42」という並びを含むものを探すことを考えます（10進で考えます）。 こんな二階建ての再帰でいけそうです。

『「末尾が42の数を全部集める」』→
『「末尾が420の数を全部集める」→「末尾が421の数を全部集める」→…→「末尾が429の数を全部集める」』→
『「末尾が4200の数を全部集める」→…』

『…』の再帰は、こんな感じ。

(define (migi base hidari)
  (iota (expt 10 base) hidari))

「42」が出現してる場所より右側をなめるので、migi という名前にしました。 引数の hidari には「42なんとか」（なんとかは空か数字の列）が順番に入る、という気持ちです。 base が 0 なら「42」、base が 1 なら「420から429」、base が 2なら「4200から4299」、…という具合。「42なんとか」を始点に、10 の base 乗個とってくればよいので、iota を使っています。

「…」の再帰については、migi を受けて hidari の全パターンを集めるので、こんな unfold で書けます。

(define (hidari-all upper order)
  (lambda (migi)
    (unfold (pa$ < upper) values
            (pa$ + (expt 10 order))
            migi)))

ようするに、 migi が「42」の場合には「xx42」の xx にあらゆる数字の組み合わせをぶちこんだリストです。migi が「420から429」なら「0420, ..., 9420, 0421, ..., 9421, ..., 0429, ..., 9429」で、migi が「4200から4299」ならそのものです。 migi の要素が2桁である「42」のときは10の2乗（ = 100）を次々に加えていったもの全部、3桁である「420から429」のときは10の3乗（ = 1000）をそれぞれに次々加えていったもの全部、…という具合です。これらを unfold で作り出しています。

以上の2つの再帰を組み合わせれば完成です。（hidari-all の order を決めるときにちょっと苦心しました。）

(define (intseek order num)
  (let1 upper (+ 1 (expt 10 order)) ; 9999 + 1
    (let R ((b 0) (hidari num))
      (if (> b (- order (ord num)))
          '()
          (append
            (append-map (hidari-all upper (+ b (ord num))) (migi b hidari))
            (R (+ b 1) (* hidari 10)))))))

; 最近のGaucheなら(log x 10)で済むのだけど。
(define (ord x)
  (x->integer (/ (log x) (log 10))))

結果はこうなります（途中は省略）。

gosh> (intseek 4 42)
(42 142 242 342 442 542 642 742 842 942 1042 1142 ... 4295 4296 4297 4298 4299)

この遊び、なにも10進に限る必要はありません。2進表記で10桁の整数から「11」の並びを含むものを探すとか、16進表記で4桁の整数から「aa」の並びを含むものを探すとか、簡単に応用できます。

(define (intseek order str radix max-digit)
  (define (hidari-all upper order)
    (lambda (migi)
      (unfold (pa$ < upper) values
              (pa$ + (expt radix order))
              migi)))
  (define (migi b hidari)
    (iota (expt radix b) hidari))
  (let1 upper ; radix進でorder桁の最大数 + 1
      (+ 1 (string->number (make-string order max-digit) radix))
    (let R ((b 0) (hidari (string->number str radix)))
      (if (> b (- order (string-length str)))
          '()
          (append
            (append-map (hidari-all upper (+ b (string-length str)))
                        (migi b hidari))
            (R (+ b 1) (* hidari radix)))))))

gosh> (map (cut format "~x" <>) (intseek 4 "aa" 16 #\F))
("aa" "1aa" "2aa" "3aa" "4aa" "5aa" "6aa" "7aa" ... "aafd" "aafe" "aaff")

さらに、26進の数字で特定の並びを含むものを探すこともできるはずです。ということは、26進の数字とアルファベット26文字を対応させてやれば、n文字のアルファベット文字列から特定の文字の並びを含むものを見つける、といった問題にも応用できることになります。さすがに26進だと表記につかう26個の文字を扱うのつらいのでやる気になりませんが、次の問題くらいなら4進で済むので、この方法を使って解けそうです。

4種類のアルファベット "A,C,G,T" から成るn文字の文字列のうち、"AAG"という並びが含まれる文字列を全て列挙するプログラムを書きなさい。ただし、nは3以上の整数とし、文字列内に同じアルファベットが出現しても構わないものとし、出力順序は問わないものとします。 ... 適性検査に合格された方はその生産性を実現可能な方です。生産性に見合う初任給として年俸1000万円をご用意しております。
（via: 名古屋Scala掲示板 年俸1000万の会社の試験問題）

アルファベットと4進数との変換だけ定義してやれば、1000万ゲット。

(define mapping
  '((#\A #\3) (#\C #\2) (#\G #\1) (#\T #\0)))

(define (acgts n ls)
  (map (lambda (int)
         (ints->acgt (string-pad (number->string int 4) n #\0)))
       ls))

(define (acgt->ints str)
  (string-map (lambda (c) (cadr (assoc c mapping))) str))

(define (ints->acgt str)
  (string-map (lambda (c) (cadr (assoc c (map reverse mapping)))) str))

gosh> (acgts 5 (intseek 5 (acgt->ints "AAG") 4 #\3))
("TTAAG" "TGAAG" "TCAAG" "TAAAG" "GTAAG" "GGAAG" "GCAAG" "GAAAG" "CTAAG"
 "CGAAG" "CCAAG" "CAAAG" "ATAAG" "AGAAG" "ACAAG" "AAAAG" "TAAGT" "GAAGT"
 "CAAGT" "AAAGT" "TAAGG" "GAAGG" "CAAGG" "AAAGG" "TAAGC" "GAAGC" "CAAGC"
 "AAAGC" "TAAGA" "GAAGA" "CAAGA" "AAAGA" "AAGTT" "AAGTG" "AAGTC" "AAGTA"
 "AAGGT" "AAGGG" "AAGGC" "AAGGA" "AAGCT" "AAGCG" "AAGCC" "AAGCA" "AAGAT"
 "AAGAG" "AAGAC" "AAGAA")

一筆書きドラゴン曲線

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
     ####    ####       
    #####   #####       
    ####### #######     
      #####   #####     
 #################      
#################       
###### ### ########     
  ####  ## ########     
 ###       #######      
####       ######    ## 
####  #    ### ####   ##
  #####     ## ####   ##
  ####         #########
               #########
               ### ###  
                ##  ##  

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