fixedpoint.jp


2022-06-21

「電話番号教えて」と言われたら

電話番号とは次のような整数列のことです:

1, 1, 2, 4, 10, 26, 76, 232, 764, 2620, 9496, ...

(sequence A000085 in the OEIS)

これは\(n\)個の要素からなる順列のうちinvolutionであるもの全体の個数です。上の数列は\(n = 0\)から始まります。

漸化式で表せるため、Schemeでは容易に関数telephone-numberとして再帰的に定義できます:

(define (telephone-number n)
  (if (<= n 1)
      1
      (+ (telephone-number (- n 1)) (* (- n 1) (telephone-number (- n 2))))))

これで上記数列の先頭10個が計算できます:

(map telephone-number (iota 10))

しかし、これはcall stackをいたずらに消費するため非効率です。例えば、

(map telephone-number (iota 100))

はいつ計算が終わるか知れません。

telephone-numberを次のように末尾再帰で書けば、すぐに計算できるようになります。

(define (telephone-number n)
  (let loop ((i 1)
             (a 1)
             (b 1))
    (if (<= n i)
        a
        (loop (+ i 1) (+ a (* i b)) a))))

これなら

(map telephone-number (iota 1000))

でも束の間で結果が出ます。

#permalink

2022-06-10

可算無限列の順列を列挙するアルゴリズムについて

入力された有限列に対し、その順列を全て重複することなく列挙する効率的なアルゴリズムとしてHeap's algorithmがあります。このアルゴリズムの著しい特長は、「列挙している前後の順列でちょうど1組のペアを入れ替えるだけ」という点です。

これが効率的な理由でもあるのですが、同じ特長を持つアルゴリズムとしてSteinhaus–Johnson–Trotter (SJT) algorithmが知られています。こちらのSJTアルゴリズムはさらに、「全ての順列を挙げた後に元の入力列に戻る」というもう1つの顕著な特長があります。

このためHeap'sよりもSJTの方がかっこよく見えますが、Heap'sには入力列の長さに依存せず列挙するという別の特長があります。今回は、これをSchemeSRFI-41で定義されているstreamを用いて無限列を表現することで実演します。以下のプログラムはGuileで動作を確認しています。

heaps.scm
(use-modules (srfi srfi-41)
             (srfi srfi-43))

(define (Heaps-vector-proc ivec proc)
  (let* ((n (vector-length ivec))
         (cvec (make-vector n 0)))
    (define (loop i)
      (when (< i n)
        (let ((c_i (vector-ref cvec i)))
            (cond ((< c_i i)
                   (vector-swap! ivec (if (even? i) 0 c_i) i)
                   (vector-set! cvec i (+ c_i 1))
                   (proc ivec)
                   (loop 0))
                  (else
                   (vector-set! cvec i 0)
                   (loop (+ i 1)))))))
    (proc ivec)
    (loop 0)))

(define-stream (Heaps-stream istr)
  (define-stream (loop istr cstr i)
    (let ((c_i (stream-ref cstr i)))
      (cond ((< c_i i)
             (let* ((i_i (stream-ref istr i))
                    (ostr (if (even? i)
                              (stream-cons i_i
                                           (stream-append (stream-drop 1 (stream-take i istr))
                                                          (stream-cons (stream-ref istr 0)
                                                                       (stream-drop (+ i 1) istr))))
                              (stream-append (stream-take c_i istr)
                                             (stream-cons i_i
                                                          (stream-append (stream-drop (+ c_i 1) (stream-take i istr))
                                                                         (stream-cons (stream-ref istr c_i)
                                                                                      (stream-drop (+ i 1) istr))))))))
               (stream-cons ostr
                            (loop ostr
                                  (stream-append (stream-take i cstr)
                                                 (stream-cons (+ c_i 1) (stream-drop (+ i 1) cstr)))
                                  0))))
            (else
             (loop istr
                   (stream-append (stream-take i cstr)
                                  (stream-cons 0 (stream-drop (+ i 1) cstr)))
                   (+ i 1))))))
  (stream-cons istr (loop istr (stream-constant 0) 0)))

最初の関数Heaps-vector-procは、SRFI-43のvectorで表された入力列ivecの順列ごとに、与えられた手続きprocを呼び出します。例えば、以下のように長さ7の列\([a, b, c, d, e, f, g]\)を列挙します。

heaps1.txt
scheme@(guile-user)> (define input '(a b c d e f g))
scheme@(guile-user)> (Heaps-vector-proc (list->vector input) (lambda (v) (display v) (newline)))
#(a b c d e f g)
#(b a c d e f g)
#(c a b d e f g)
#(a c b d e f g)
#(b c a d e f g)
#(c b a d e f g)
#(d b a c e f g)
#(b d a c e f g)
#(a d b c e f g)
#(d a b c e f g)
#(b a d c e f g)
#(a b d c e f g)
#(a c d b e f g)
#(c a d b e f g)
#(d a c b e f g)
#(a d c b e f g)
#(c d a b e f g)
#(d c a b e f g)

...

#(c g b d e f a)
#(b g c d e f a)
#(g b c d e f a)
scheme@(guile-user)> 

一方、もう1つの関数Heaps-streamは入力としてstreamを取り、出力として順列を表すstreamを列挙するstreamを返します。入力のstreamは無限列でも構いません。

heaps2.txt
scheme@(guile-user)> (define output (Heaps-stream (list->stream input)))
scheme@(guile-user)> (stream-for-each (lambda (s) (display (stream->list s)) (newline)) (stream-take (* 1 2 3 4 5 6 7) output))
(a b c d e f g)
(b a c d e f g)
(c a b d e f g)
(a c b d e f g)
(b c a d e f g)
(c b a d e f g)
(d b a c e f g)
(b d a c e f g)
(a d b c e f g)
(d a b c e f g)
(b a d c e f g)
(a b d c e f g)
(a c d b e f g)
(c a d b e f g)
(d a c b e f g)
(a d c b e f g)
(c d a b e f g)
(d c a b e f g)

...

(c g b d e f a)
(b g c d e f a)
(g b c d e f a)
scheme@(guile-user)> (define n (stream-from 0)) ; a stream of natural numbers from 0
scheme@(guile-user)> (define s (Heaps-stream n))
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 0)))
$1 = (0 1 2 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 1)))
$2 = (1 0 2 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 2)))
$3 = (2 0 1 3 4 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 100)))
$4 = (4 1 3 2 0 5 6 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 1000)))
$5 = (2 6 0 1 5 4 3 7 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 10000)))
$6 = (3 4 0 2 1 5 7 6 8 9)
scheme@(guile-user)> (stream->list (stream-take 10 (stream-ref s 100000)))
$7 = (5 0 8 1 7 2 3 6 4 9)
scheme@(guile-user)> 

最後になりますが、Heap'sは入力が無限列でも順列を列挙しますが、あり得る順列を網羅はできないことに注意してください。集合論の言葉では、無限集合\(X\)の順列全体の集合、つまり\(X\)から\(X\)への全単射全体の集合は非可算です。Heap'sは入力列のうち有限個の要素だけ入れ替えた順列を網羅します。しかし、例えば、無限入力列の偶数番目の要素全体と奇数番目の要素全体を入れ替えた順列は含まれていません。

#permalink

Archives

2022: Jan | Feb | Mar | Apr | May

2021: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2020: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2019: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2018: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2017: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2016: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2015: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2014: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2013: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2012: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2011: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2010: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2009: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2008: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2007: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec

2006: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec


© 2006-2022 fixedpoint.jp