Scheme:n段多重ループ

Scheme:n段多重ループ

ちょっと面白い再帰のコードを見たので書き留める。

問題

N次元の離散空間上の各点 (i_0 i_1 ... i_N-1) について 手続きprocを呼びたい。各座標 i_kは整数で、その始点と終点は それぞれ始点ベクタ Vs = #(S_0 S_1 ... S_N-1) 及び終点ベクタ Ve = #(E_0 E_1 ... E_N-1) の k 番目の要素として与えられる。すなわち、S_k <= i_k < E_k である。

Nがあらかじめ分かっているなら簡単だし、良く出て来るパターンでもある。 例えばN=3であれば、

  (define (loop-on-3 proc Vs Ve)
    (do ((i_0 (vector-ref Vs 0) (+ i_0 1)))
        ((= i_0 (vector-ref Ve 0)))
      (do ((i_1 (vector-ref Vs 1) (+ i_1 1)))
          ((= i_1 (vector-ref Ve 1)))
        (do ((i_2 (vector-ref Vs 2) (+ i_2 1)))
            ((= i_1 (vector-ref Ve 2)))
          (proc (list i_0 i_1 i_2)))))

Nが分かっている場合はどんな言語でも似たようなものだろう。 List comprehensionがある言語ならもうすこしスマートに書けると思うが。

さて問題。次元数Nも実行時に与えられる関数

   (loop-on-N proc N Vs Ve)

はどう書いたら良いだろうか。 (= (vector-length Vs) (vector-length Ve) N) は保証されているとする。


コード

このコードの原型はSRFI-25 (多次元配列) のリファレンス実装にあったもので、 Jussi Piitulainenによる。元のコードの効率を多少落して骨格を分かりやすくした。

  (define (loop-on-N proc N Vs Ve)
    (let do-dim ((d 0)
                 (l '()))
      (if (= d N)
          (proc (reverse l))
          (do ((k (vector-ref Vs d) (+ k 1)))
              ((= k (vector-ref Ve d)))
            (do-dim (+ d 1) (cons k l))))))

実行例

  gosh> (loop-on-N print 3 #(0 0 0) #(2 2 2))
  (0 0 0)
  (0 0 1)
  (0 1 0)
  (0 1 1)
  (1 0 0)
  (1 0 1)
  (1 1 0)
  (1 1 1)

最初に見た時は何がどうなってるやらさっぱりだった。 internal defineに書き直してみると、そんなにわかりにくい構造ではない。

  (define (loop-on-N proc N Vs Ve)
    (define (do-dim d indices)
      (if (= d N)
          (proc (reverse indices))
          (do ((k (vector-ref Vs d) (+ k 1)))
              ((= k (vector-ref Ve d)))
            (do-dim (+ d 1) (cons k indices)))))
    (do-dim 0 '()))

for-all

skimu (2006/06/23 20:54:29 PDT): 適当に定義したパラメータ空間を総なめしにしたかったので、今日こんなの書いてみました。

(define (for-all proc . params)
  (if (null? params)
      (proc)
      (for-each (lambda (e)
                   (apply for-all (cut proc e <...>) (cdr params)))
                (car params))))
gosh> (for-all print '(0 1) '(0 1) '(0 1))
000
001
010
011
100
101
110
111

Last modified : 2012/02/07 08:24:18 UTC