●問題86
自然数 n を素因数分解する関数 factorization n を定義してください。返り値はリスト ((p . q) ...) で、(p . q) は pq を表します。
gosh> (factorization 6) ((2 . 1) (3 . 1)) gosh> (factorization 12345678) ((2 . 1) (3 . 2) (47 . 1) (14593 . 1)) gosh> (factorization 123456789) ((3 . 2) (3607 . 1) (3803 . 1)) gosh> (factorization 1234567890) ((2 . 1) (3 . 2) (5 . 1) (3607 . 1) (3803 . 1)) gosh> (factorization 1111111111) ((11 . 1) (41 . 1) (271 . 1) (9091 . 1))
●問題87
自然数 n の約数の個数を求める関数 divisor-num を定義してください。
gosh> (divisor-num 6) 4 gosh> (divisor-num 12345678) 24 gosh> (divisor-num 123456789) 12 gosh> (divisor-num 1234567890) 48 gosh> (divisor-num 1111111111) 16
●問題88
自然数 n の約数の合計値を求める関数 divisor-sum を定義してください。
gosh> (divisor-sum 6) 12 gosh> (divisor-sum 12345678) 27319968 gosh> (divisor-sum 123456789) 178422816 gosh> (divisor-sum 1234567890) 3211610688 gosh> (divisor-sum 1111111111) 1246404096
●問題89
自然数 n の約数をリストに格納して返す関数 divisor を定義してください。
gosh> (divisor 6) (1 2 3 6) gosh> (divisor 12345678) (1 2 3 6 9 18 47 94 141 282 423 846 14593 29186 43779 87558 131337 262674 685871 1371742 2057613 4115226 6172839 12345678) gosh> (divisor 123456789) (1 3 9 3607 3803 10821 11409 32463 34227 13717421 41152263 123456789) gosh> (divisor 1234567890) (1 2 3 5 6 9 10 15 18 30 45 90 3607 3803 7214 7606 10821 11409 18035 19015 21642 22818 32463 34227 36070 38030 54105 57045 64926 68454 108210 114090 162315 171135 324630 342270 13717421 27434842 41152263 68587105 82304526 123456789 137174210 205761315 246913578 411522630 617283945 1234567890) gosh> (divisor 1111111111) (1 11 41 271 451 2981 9091 11111 100001 122221 372731 2463661 4100041 27100271 101010101 1111111111)
●問題90
gosh> (perfect-number 10000) 6 28 496 8128 #<undef>
●問題91
友愛数 - Wikipedia によると、『友愛数（ゆうあいすう）とは、異なる2つの自然数の組で、自分自身を除いた約数の和が、互いに他方と等しくなるような数をいう。』 とのことです。自然数 n 以下の友愛数を求める関数 yuuai-number を定義してください。
gosh> (yuuai-number 100000) (220 284) (1184 1210) (2620 2924) (5020 5564) (6232 6368) (10744 10856) (12285 14595) (17296 18416) (63020 76084) (66928 66992) (67095 71145) (69615 87633) (79750 88730) #<undef>
●問題92
整数 n を 1 以上の自然数の和で表すことを考えます。これを「整数の分割」といいます。整数を分割するとき、同じ自然数を何回使ってもかまいませんが、並べる順序が違うだけのものは同じ分割とします。簡単な例を示します。
n = 6
6 分割 : 1 + 1 + 1 + 1 + 1 + 1
5 分割 : 1 + 1 + 1 + 1 + 2
4 分割 : 1 + 1 + 1 + 3
1 + 1 + 2 + 2
3 分割 : 1 + 1 + 4
1 + 2 + 3
2 + 2 + 2
2 分割 : 1 + 5
2 + 4
3 + 3
1 分割 : 6
6 の場合、分割の仕方は 11 通りあります。この数を「分割数」といいます。自然数 n の分割数を求める関数 partition-number を定義してください。
gosh> (partition-number 1) 1 gosh> (partition-number 2) 2 gosh> (partition-number 3) 3 gosh> (partition-number 4) 5 gosh> (partition-number 5) 7 gosh> (partition-number 6) 11 gosh> (partition-number 7) 15 gosh> (partition-number 8) 22 gosh> (partition-number 10) 42 gosh> (partition-number 50) 204226
●問題93
整数 n の分割の仕方をすべて求める高階関数 partition-of-integer fn n を定義してください。
gosh> (partition-of-integer print 5) (1 1 1 1 1) (1 1 1 2) (1 2 2) (1 1 3) (2 3) (1 4) (5) #<undef> gosh> (partition-of-integer print 6) (1 1 1 1 1 1) (1 1 1 1 2) (1 1 2 2) (2 2 2) (1 1 1 3) (1 2 3) (3 3) (1 1 4) (2 4) (1 5) (6) #<undef>
●問題94
m 個の整数 0, 1, 2, ..., m - 1 の順列を考えます。このとき、i 番目の要素が整数 i ではない順列を「完全順列」といいます。0 から m - 1 までの整数値で完全順列を生成する高階関数 perfect-permutation fn m を定義してください。
gosh> (perfect-permutation print 3) (1 2 0) (2 0 1) #<undef> gosh> (perfect-permutation print 4) (1 0 3 2) (1 2 3 0) (1 3 0 2) (2 0 3 1) (2 3 0 1) (2 3 1 0) (3 0 1 2) (3 2 0 1) (3 2 1 0) #<undef>
●問題95
完全順列の総数を「モンモール数 (Montmort number) 」といいます。モンモール数は次の漸化式で求めることができます。
A1 = 0 A2 = 1 An = (n - 1) * (An-1 + An-2) ; n >= 3
モンモール数を求める関数 montmort-number を定義してください。
gosh> (montmort-number 1) 0 gosh> (montmort-number 2) 1 gosh> (montmort-number 3) 2 gosh> (montmort-number 4) 9 gosh> (montmort-number 5) 44 gosh> (montmort-number 6) 265 gosh> (montmort-number 7) 1854 gosh> (montmort-number 10) 1334961 gosh> (montmort-number 20) 895014631192902121 gosh> (montmort-number 30) 97581073836835777732377428235481
●問題96
リストで表した集合 ls を分割することを考えます。たとえば、集合 (1 2 3) は次のように分割することができます。
1 分割 : ((1 2 3)) 2 分割 : ((1 2) (3)), ((1 3) (2)), ((1) (2 3)) 3 分割 ; ((1) (2) (3))
このように、分割した集合 xs は元の集合 ls の部分集合になります。分割した部分集合の積は空集合になり、分割した部分集合のすべての和を求めると元の集合になります。
ls の分割の仕方をすべて求める高階関数 parititon-of-set fn ls を定義してください。
gosh> (partition-of-set print '(1 2 3)) ((1 2 3)) ((1 2) (3)) ((1 3) (2)) ((1) (2 3)) ((1) (2) (3)) #<undef> gosh> (partition-of-set print '(1 2 3 4)) ((1 2 3 4)) ((1 2 3) (4)) ((1 2 4) (3)) ((1 2) (3 4)) ((1 2) (3) (4)) ((1 3 4) (2)) ((1 3) (2 4)) ((1 3) (2) (4)) ((1 4) (2 3)) ((1) (2 3 4)) ((1) (2 3) (4)) ((1 4) (2) (3)) ((1) (2 4) (3)) ((1) (2) (3 4)) ((1) (2) (3) (4)) #<undef>
●問題97
集合を分割する方法の総数を「ベル数 (Bell Number) 」といい、次の漸化式で求めることができます。
B(0) = 1
n
B(n+1) = Σ nＣk * B(k) ; n >= 1
k=0
ベル数を求める関数 bell-number n を定義してください。
gosh> (bell-number 0) 1 gosh> (bell-number 1) 1 gosh> (bell-number 2) 2 gosh> (bell-number 3) 5 gosh> (bell-number 4) 15 gosh> (bell-number 5) 52 gosh> (bell-number 10) 115975 gosh> (bell-number 20) 51724158235372 gosh> (bell-number 30) 846749014511809332450147 gosh> (bell-number 40) 157450588391204931289324344702531067 gosh> (bell-number 50) 185724268771078270438257767181908917499221852770
●問題98
k 個の要素をもつ集合 ls を要素数が等しい m 個の部分集合に分割することを考えます。部分集合の要素数 n は k / m になります。分割の仕方をすべて求める高階関数 group-partition fn n m ls を定義してください。
gosh> (group-partition print 2 2 '(1 2 3 4)) ((1 2) (3 4)) ((1 3) (2 4)) ((1 4) (2 3)) #<undef> gosh> (group-partition print 2 3 '(1 2 3 4 5 6)) ((1 2) (3 4) (5 6)) ((1 2) (3 5) (4 6)) ((1 2) (3 6) (4 5)) ((1 3) (2 4) (5 6)) ((1 3) (2 5) (4 6)) ((1 3) (2 6) (4 5)) ((1 4) (2 3) (5 6)) ((1 5) (2 3) (4 6)) ((1 6) (2 3) (4 5)) ((1 4) (2 5) (3 6)) ((1 4) (2 6) (3 5)) ((1 5) (2 4) (3 6)) ((1 6) (2 4) (3 5)) ((1 5) (2 6) (3 4)) ((1 6) (2 5) (3 4)) #<undef>
●問題99
集合を group-partition で分割するとき、その仕方の総数を求める関数 group-partition-number n m を定義してください。引数 n は部分集合の要素数、m は部分集合の個数です。
gosh> (group-partition-number 2 2) 3 gosh> (group-partition-number 2 3) 15 gosh> (group-partition-number 3 3) 280 gosh> (group-partition-number 3 4) 15400 gosh> (group-partition-number 3 5) 1401400
●問題100
15 人の女生徒が毎日 3 人ずつ 5 組に分かれて散歩をするとき、1 週間 (7 日) のうちに、どの女生徒も他のすべての女生徒と 1 回ずつ同じ組になるような組み合わせを作ってください。
出典 : 大村平 (著), 『数理パズルの話』, 日科技連出版社, 1998
「カークマンの 15 人の女生徒」を解くプログラムを作ってください。
●解答86
リスト : 素因数分解
(define (factorization n)
(define (factor-sub n m)
(let loop ((i 0) (n n))
(if (zero? (modulo n m))
(loop (+ i 1) (quotient n m))
(values i n))))
;
(receive (c n) (factor-sub n 2)
(let loop ((i 3) (n n) (a (if (zero? c) '() (list (cons 2 c)))))
(cond ((= n 1) (reverse! a))
((< n (* i i))
(reverse! (cons (cons n 1) a)))
(else
(receive (c m) (factor-sub n i)
(if (zero? c)
(loop (+ i 2) n a)
(loop (+ i 2) m (cons (cons i c) a)))))))))
素因数分解は素数 2, 3, 5, ... で順番に割り算していけばいいのですが、いちいち素数を求めるのは大変なので、2 と 3 以上の奇数列で割り算していきます。局所関数 factor-sub は n を m で割り算します。このとき、m で割り切れる回数を求めます。factor-sub は m で割った回数と商を多値で返します。
次に、factor-sub を呼び出して n を 2 で割り算します。それから、named-let で奇数列を生成します。変数 i は 3 で初期化します。a は結果を格納するリストです。n が 1 になる、または √n < i になったら繰り返しを終了します。そうでなければ、factor-sub を呼び出して n を i で割り算します。奇数列には素数ではないものがありますが、その前に小さな素数で素因数分解されているので、n がその値で割り切れることはありません。
●解答87
n の素因数分解ができると、約数の個数を求めるのは簡単です。n = pa * qb * rc とすると、約数の個数は (a + 1) * (b + 1) * (c + 1) になります。たとえば、12 は 22 * 31 になるので、約数の個数は 3 * 2 = 6 になります。実際、12 の約数は 1, 2, 3, 4, 6, 12 の 6 個です。
プログラムは次のようになります。
リスト : 約数の個数
(define (divisor-num n)
(fold (lambda (x a) (* a (+ 1 (cdr x))))
1
(factorization n)))
divisor-num は fold を使って (+ 1 (cdr x)) を a に掛け算していくだけです。
●解答88
n の素因数分解ができると、約数の合計値を求めるのは簡単です。n の素因数分解が pa だった場合、その約数の合計値は次の式で求めることができます。
σ(p, a) = pa + pa-1 + ... + p2 + p + 1
たとえば、8 の素因数分解は 23 になり、素数の合計値は 8 + 4 + 2 + 1 = 15 になります。
pa の約数の合計値を σ(p, a) で表すことにします。n = pa * qb * rc の場合、n の約数の合計値は σ(p, a) * σ(q, b) * σ(r, c) になります。たとえば、12 は 22 * 3 に素因数分解できますが、その合計値は (4 + 2 + 1) * (3 + 1) = 28 となります。12 の約数は 1, 2, 3, 4, 6, 12 なので、その合計値は確かに 28 になります。
プログラムは次のようになります。
リスト : 約数の合計値
(define (divisor-sum n)
; p は素数
(define (div-sum-sub p n)
(let loop ((n n) (a 0))
(if (zero? n)
(+ a 1)
(loop (- n 1) (+ a (expt p n))))))
;
(fold (lambda (x a) (* a (div-sum-sub (car x) (cdr x))))
1
(factorization n)))
局所関数 div-sum-sub は σ(p, n) を計算します。あとは fold で div-sum-sub の返り値を累積変数 a に掛け算していくだけです。
●解答89
p が素数の場合、pa の約数は次のように簡単に求めることができます。
pa, pa-1, ... p2, p, 1
n の素因数分解が pa * qb だったとすると、その約数は次のようになります。
(pa, pa-1, ... p2, p, 1) * qb,
(pa, pa-1, ... p2, p, 1) * qb-1,
.....
(pa, pa-1, ... p2, p, 1) * q2,
(pa, pa-1, ... p2, p, 1) * q,
(pa, pa-1, ... p2, p, 1) * 1
たとえば、12 の約数は 24 = (1, 2, 4) と 3 = (1, 3) から、(1, 2, 4) * 1 と (1, 2, 4) * 3 のすべての要素 (1, 2, 4, 3, 6, 12) になります。
プログラムは次のようになります。
リスト : 約数をすべて求める
(define (divisor n)
; p は素数
(define (divisor-sub p n a)
(if (zero? n)
(cons 1 a)
(divisor-sub p (- n 1) (cons (expt p n) a))))
;
(define (list-product p q a)
(if (null? p)
a
(list-product (cdr p) q (append (map (lambda (x) (* (car p) x)) q) a))))
;
(let ((x (factorization n)))
(sort (fold (lambda (y a)
(list-product (divisor-sub (car y) (cdr y) '()) a '()))
(divisor-sub (caar x) (cdar x) '())
(cdr x)))))
局所関数 divisor-sub は pn の約数をリストに格納して返します。局所関数 list-product は 2 つのリスト p, q の要素を掛け合わせたものをリストに格納して返します。あとは fold で素因数分解した結果を順番に取り出し、(p . n) を divisor-sub でリストに変換して、それを list-product で累積変数 a のリストと掛け合わせていくだけです。
●解答90
リスト : 完全数
(define (perfect-number n)
(let loop ((x 2))
(cond ((<= x n)
(when (= (- (divisor-sum x) x) x)
(print x))
(loop (+ x 1))))))
完全数を求める perfect-number は簡単です。x の約数の合計値を divisor-sub で求め、その値から x を引いた値が x と等しければ完全数です。print で x を表示します。
●解答91
リスト : 友愛数
(define (yuuai-number n)
(let loop ((x 2))
(cond ((<= x n)
(let ((m (- (divisor-sum x) x)))
(when (and (< x m)
(= x (- (divisor-sum m) m)))
(print (list x m))))
(loop (+ x 1))))))
友愛数を求める yuuai-number も簡単です。divisor-sum で x の約数の合計値を求め、その値から x を引いた値を変数 m にセットします。m の約数の合計値から m を引いた値が x と等しければ、x と m は友愛数です。print で x と m を表示します。同じ組を表示しないようにするため、(< x m) を条件に入れています。
●解答92
整数 n を k 以下で分割する総数を求める関数を p(n, k) で表します。参考文献 [1] によると、p(n, k) は次の式で表すことができるそうです。
p(n, 1) = 1 p(1, k) = 1 p(0, k) = 1 p(n, k) = p(n - 1, 1) + p(n - 2, 2) + ... + p(n - k, k)
r = 1 の場合は簡単ですね。n 個の 1 を選ぶ方法しかありません。同様に n = 1 の場合も、1 を選ぶ方法しかありません。なお、n = 0 の場合は 1 とします。
p(n, k) の場合、まず 1 を選ぶとすると、残りの n - 1 から 1 で分割する方法は p(n - 1, 1) 通りになります。2 を選ぶとすると、残りの n - 2 から 2 以下で分割する方法は p(n - 2, 2) 通りになります。つまり、1 から k までを選んだあとの分割数を計算し、その総和を求めればいいわけです。
簡単な例を示しましょう。次の図を見てください。
p(6, 6) = p(5, 1)
+ p(4, 2) => p(3, 1) + p(2, 2)
=> p(1, 1) + p(0, 2)
+ p(3, 3) => p(2, 1) + p(1, 2) + p(0, 3)
+ p(2, 4) => p(1, 1) + p(0, 2)
+ p(1, 5)
+ p(0, 6)
= 11 通り
p(6, 6) は p(5, 1) + p(4, 2) + p(3, 3) + p(2, 4) + p(1, 5) + p(0, 6) の総和になります。このうち、p(5, 1), p(1, 5), p(0, 6) は 1 になります。p(3, 3) は p(2, 1) + p(1, 2) + p(0, 3) になるので 3 通り、p(2, 4) は p(1, 1) + p(0, 2) になるので、2 通りになります。p(4, 2) はちょっと複雑です。p(4, 2) = p(3, 1) + p(2, 2) になります。ここで、p(2, 2) を求めると p(2, 2) = p(1, 1) + p(0, 2) になるので 2 通りになります。したがって、合計は 11 通りになります。
これをプログラムすると次のようになります。
リスト : 分割数
(define (partition-number n)
(define (p n k)
(if (or (<= n 1) (= k 1))
1
(let loop ((i 1) (a 0))
(if (or (< k i) (< n i))
a
(loop (+ i 1) (+ a (p (- n i) i)))))))
(p n n))
実際の処理は局所関数 p で行います。引数 n が 1 以下、または k が 1 の場合は 1 を返します。それ以外の場合は、i を 1 から k まで +1 していき、p(n - i, i) の合計値を累積変数 a に求めます。このとき、n - i が負の値にならないようにするため、n < i になったら繰り返しを終了します。なお、このプログラムはナイーブな実装なため、実行速度はとても遅いです。ご注意くださいませ。
●別解 (2011/12/24)
上記プログラムは「二重再帰」でプログラムすることもできます。
リスト : 分割数 (別解)
(define (partition-number n)
(define (part-num n k)
(cond ((or (zero? n) (= n 1) (= k 1)) 1)
((or (< n 0) (< k 1)) 0)
(else
(+ (part-num (- n k) k) (part-num n (- k 1))))))
(part-num n n))
また、次のように局所関数 part-num をメモ化することで高速化することができます。
リスト : メモ化関数による高速化
; メモ化関数
(define (memoize func)
(let ((table (make-hash-table 'equal?)))
(lambda args
(if (hash-table-exists? table args)
(hash-table-get table args)
(let ((value (apply func args)))
(hash-table-put! table args value)
value)))))
; 分割数
(define (part-num n k)
(cond ((or (zero? n) (= n 1) (= k 1)) 1)
((or (< n 0) (< k 1)) 0)
(else
(+ (part-num (- n k) k) (part-num n (- k 1))))))
; メモ化
(set! part-num (memoize part-num))
(define (partition-number1 n)
(part-num n n))
動的計画法を使うと、もっと速くなります。
リスト : 分割数 (動的計画法)
(define (partition-number2 n)
(let ((a (make-vector (+ n 1) 1)))
(do ((k 2 (+ k 1)))
((< n k) (vector-ref a n))
(do ((m k (+ m 1)))
((< n m))
(inc! (vector-ref a m)
(vector-ref a (- m k)))))))
実行例を示します。
gosh> (time (partition-number1 1000)) ;(time (partition-number1 1000)) ; real 17.734 ; user 17.672 ; sys 0.063 24061467864032622473692149727991 gosh> (time (partition-number2 1000)) ;(time (partition-number2 1000)) ; real 0.281 ; user 0.281 ; sys 0.000 24061467864032622473692149727991 (Windows XP, celeron 1.40 GHz, Gauche ver 0.9.1)
[1] 奥村晴彦,『Ｃ言語による最新アルゴリズム事典』, 技術評論社, 1991
●解答93
リスト : 整数の分割
(define (partition-of-integer func n)
; k 以下で n を分割する
(define (p n k a)
(cond ((zero? n)
(func a))
((= n 1)
(func (cons 1 a)))
((= k 1)
(func (append (make-list n 1) a)))
(else
(let loop ((i 1))
(cond ((and (<= i k) (<= i n))
(p (- n i) i (cons i a))
(loop (+ i 1))))))))
;
(p n n '()))
基本的な考え方は partition-number と同じです。局所関数 p に累積変数 a を追加して、選んだ数値を a に格納していくだけです。n が 0 の場合は (func a) を評価し、n が 1 の場合は a に 1 を追加してから func を評価します。k が 1 の場合は make-list で要素が 1 で長さが n のリストを作成します。そして、それを append で a と連結してから func を評価します。
●別解 (2011/12/24)
リスト : 整数の分割
(define (partition-of-integer f n)
(define (part-int n k a)
(cond ((zero? n) (f (reverse a)))
((= n 1) (f (reverse (cons 1 a))))
((= k 1) (f (reverse (append (make-list n 1) a))))
(else
(when (>= (- n k) 0)
(part-int (- n k) k (cons k a)))
(part-int n (- k 1) a))))
(part-int n n '()))
別解は局所関数 part-int を二重再帰でプログラムしたものです。
●解答94
リスト : 完全順列
(define (perfect-permutation func m)
(define (perm-sub n ls a)
(if (null? ls)
(func (reverse a))
(for-each
(lambda (x)
(unless (= n x)
(perm-sub (+ n 1) (remove (lambda (y) (= x y)) ls) (cons x a))))
ls)))
;
(perm-sub 0 (iota m 0) '()))
perfect-permutation は簡単です。実際の処理は局所関数 perm-sub で行います。iota で 0 から m - 1 までの数値を格納したリストを生成し、それを引数 ls に渡します。引数 n が順番を表します。for-each のラムダ式の中で、数字 x が n と等しくない場合、その数字を選択することできます。等しい場合は選択しません。ls が空リストになったら、reverse で a を反転して func を評価します。これで完全順列を生成することができます。
●解答95
リスト : 完全順列の総数
(define (montmort-number n)
(cond ((= n 1) 0)
((= n 2) 1)
(else
(* (- n 1) (+ (montmort-number (- n 1))
(montmort-number (- n 2)))))))
; 別解
(define (montmort-number1 n)
(let loop ((i 1) (a 0) (b 1))
(if (= i n)
a
(loop (+ i 1) b (* (+ i 1) (+ a b))))))
関数 montmort-number は公式をそのままプログラムしただけです。二重再帰になっているので、実行速度はとても遅くなります。これを繰り返しに変換すると別解のようになります。考え方はフィボナッチ数列と同じです。累積変数 a に i 番目の値を、b に i + 1 番目の値を保存しておきます。すると、i + 2 番目の値は (* (+ i 1) (+ a b)) で計算することができます。あとは、b の値を a に、新しい値を b にセットして処理を繰り返すだけです。
●解答96
集合を分割するアルゴリズムは簡単です。たとえば、n -1 個の要素 x1, ..., xn-1 を持つ集合を分割したところ、i 個の部分集合 S1, ..., Si が生成されたとしましょう。ここに、n 番目の要素 xn を追加すると、要素が n 個の集合を分割することができます。
新しい要素を追加する場合は次に示す手順で行います。
- 部分集合 Sk (k = 1 から i まで) に要素 xn を追加する
- 新しい部分集合 Si+1 (要素が xn だけの集合) を生成する
簡単な例を示しましょう。次の図を見てください。
部分集合を格納するリストを用意します。最初、部分集合は空集合なので空リストに初期化します。次に、要素 1 を追加します。部分集合は空リストなので、手順 1 は適用できません。手順 2 を適用して新しい部分集合 (1) を追加します。
次に要素 2 を追加します。((1)) に 手順 1 を適用すると、部分集合 (1) に要素を追加して ((1 2)) になります。手順 2 を適用すると、新しい部分集合 (2) を追加して ((1) (2)) になります。最後に 3 を追加します。((1 2)) に手順 1 を適用すると ((1 2 3)) に、手順 2 を適用すると ((1 2) (3)) になります。((1) (2)) に手順 1 を適用すると ((1 3) (2)) と ((1) (2 3)) になり、手順 2 を適用すると ((1) (2) (3)) になります。
このように、簡単な方法で集合を分割することができます。実際にプログラムを作る場合、上図を木と考えて、深さ優先で木をたどると簡単です。次のリストを見てください。
リスト : 集合の分割
(define (append1 ls x) (append ls (list x)))
(define (append1-nth ls n x)
(cond ((zero? n)
(cons (append1 (car ls) x) (cdr ls)))
(else
(cons (car ls) (append1-nth (cdr ls) (- n 1) x)))))
(define (partition-of-set fn ls)
(define (partition-sub ls a)
(if (null? ls)
(fn a)
; a に格納されている部分集合に (car ls) を追加する
(let loop ((i 0))
(cond ((= i (length a))
; 新しい集合を追加する
(partition-sub (cdr ls) (append1 a (list (car ls)))))
(else
(partition-sub (cdr ls) (append1-nth a i (car ls)))
(loop (+ i 1)))))))
;
(partition-sub (cdr ls) (list (list (car ls)))))
関数 append1 はリスト ls の最後尾に x を追加します。関数 append1-nth はリスト ls の i 番目の要素 (リスト) に x を追加します。partition-of-set はアルゴリズムをそのままプログラムしただけです。
実際の処理は局所関数 partition-sub で行います。生成した部分集合は累積変数 a に格納します。ls が空リストの場合、追加する要素がなくなったので (fn a) を評価します。要素がある場合、append1-nth で i 番目の部分集合に要素 (car ls) を追加します。すべての部分集合に要素を追加したら、(car ls) を要素として持つ部分集合を生成して累積変数 a に追加します。
●別解 (2011/12/24)
リスト : 集合の分割
(define (partition-of-set f xs)
(define (part-set xs a)
(cond ((null? xs) (f a))
(else
(for-each (lambda (y)
(part-set (cdr xs)
(cons (cons (car xs) y)
(remove (lambda (x) (equal? x y)) a))))
a)
(part-set (cdr xs) (cons (list (car xs)) a)))))
(part-set (reverse xs) '()))
別解は append を使わないでプログラムしたものです。part-set に集合 xs をそのまま渡すと要素が逆順になるので、xs を reverse で反転してから part-set に渡しています。
●解答97
リスト : ベル数
; 畳み込み
(define (fold-with-index fn a ls)
(let loop ((ls ls) (i 0) (a a))
(if (null? ls)
a
(loop (cdr ls) (+ i 1) (fn (car ls) i a)))))
; 組み合わせの数
(define (comb-num n r)
(if (or (= n r) (= r 0))
1
(/ (* (comb-num n (- r 1)) (+ (- n r) 1)) r)))
;
(define (bell-number n)
(let loop ((i 0) (bs (list 1)))
(if (= i n)
(car bs)
(loop (+ i 1)
(cons (fold-with-index (lambda (x k a) (+ (* (comb-num i k) x) a)) 0 bs)
bs)))))
bell-number は公式をそのままプログラムするだけです。累積変数 bs にベル数を逆順で格納します。nＣk は関数 comb-num で求めます。nＣk * B(k) の総和は関数 fold-with-index で計算します。fold-with-index は添字を関数に渡して畳み込みを行います。ラムダ式の引数 x がリストの要素、k が添字、a が累積変数です。bs は逆順になっていますが、二項係数は nＣi と nＣn - i の値が同じになるので、そのまま計算しても大丈夫です。もちろん、reverse で bs を逆順にしてから計算してもかまいません。
●解答98
リスト : 集合のグループ分け
(define (group-partition func n m ls)
(define (group-partition-sub ls a)
(if (null? ls)
(func a)
; a に格納されている部分集合に (car ls) を追加する
(let loop ((i 0))
(cond ((= i (length a))
; 新しい集合を追加する
(when (< (length a) m)
(group-partition-sub (cdr ls) (append1 a (list (car ls))))))
(else
(when (< (length (list-ref a i)) n)
(group-partition-sub (cdr ls) (append1-nth a i (car ls))))
(loop (+ i 1)))))))
;
(group-partition-sub (cdr ls) (list (list (car ls)))))
group-partition は partition-of-set を改造するだけで簡単に作成することができます。生成する部分集合の大きさを n に、部分集合の個数を m に制限するだけです。i 番目の部分集合に要素を追加する場合、(length (list-ref a i)) が n 未満であることをチェックします。新しい部分集合を追加する場合、(length a) が m 未満であることをチェックします。これで集合をグループに分けることができます。
●別解 (2011/12/24)
リスト : 集合のグループ分け
(define (group-partition f n m xs)
(define (group-part xs a)
(cond ((null? xs) (f a))
(else
(for-each (lambda (y)
(when (< (length y) n)
(group-part (cdr xs)
(cons (cons (car xs) y)
(remove (lambda (x) (equal? x y)) a)))))
a)
(when (< (length a) m)
(group-part (cdr xs) (cons (list (car xs)) a))))))
(group-part (reverse xs) '()))
別解は append を使わないでプログラムしたものです。
●解答99
グループ分けの総数は次の式で求めることができます。
k = n * m kＣn * k-nＣn * k-2*nＣn * ... * 2*nＣn * nＣn / m!
たとえば、n = 3, m = 5 の場合は次のようになります。
15Ｃ3 * 12Ｃ3 * 9Ｃ3 * 6Ｃ3 * 3Ｃ3 / 5! = 1401400
これをそのままプログラムすると次のようになります。
リスト : グループ分けの総数
; 階乗
(define (fact n)
(if (zero? n)
1
(* n (fact (- n 1)))))
(define (group-partition-number n m)
(let loop ((k (* n m)) (a 1))
(if (zero? k)
(/ a (fact m))
(loop (- k n) (* a (comb-num k n))))))
階乗は関数 fact で、組み合わせの個数は関数 comb-num で計算します。要素の個数を変数 k にセットし、累積変数 a に (comb-num k n) を乗算します。あとは k から n を減算し、k が 0 でなければ処理を繰り返すだけです。最後に (/ a (fact m)) を計算して返します。
●解答100
「カークマンの 15 人の女生徒」の解法プログラムは group-partition を改造することで簡単に作成することができます。次のリストを見てください。
リスト : カークマンの 15 人の女生徒
(define *check-table* #f)
(define (check-person ls x)
(let loop ((ls ls))
(cond ((null? ls) #t)
((member x (vector-ref *check-table* (car ls))) #f)
(else (loop (cdr ls))))))
(define (add-person ls x)
(for-each (lambda (y)
(push! (vector-ref *check-table* x) y)
(push! (vector-ref *check-table* y) x))
ls))
(define (del-person ls x)
(for-each (lambda (y)
(pop! (vector-ref *check-table* x))
(pop! (vector-ref *check-table* y)))
ls))
(define (kirkman)
(define (kirkman-sub cont ls a b)
(if (null? ls)
(cond ((= (length b) 6)
(print (reverse (cons a b)))
(cont #t))
(else
(kirkman-sub cont (iota 14 2) (list (list 1)) (cons a b))))
; a に格納されている部分集合に (car ls) を追加する
(let loop ((i 0))
(cond ((= i (length a))
; 新しい集合を追加する
(when (< (length a) 5)
(kirkman-sub cont (cdr ls) (append1 a (list (car ls))) b)))
(else
(when (and (< (length (list-ref a i)) 3)
(check-person (list-ref a i) (car ls)))
(add-person (list-ref a i) (car ls))
(kirkman-sub cont (cdr ls) (append1-nth a i (car ls)) b)
(del-person (list-ref a i) (car ls)))
(loop (+ i 1)))))))
;
(call/cc
(lambda (cont)
(set! *check-table* (make-vector 16 '()))
(kirkman-sub cont (iota 14 2) (list (list 1)) '()))))
15 人の女生徒を 1 から 15 までの数値で表します。大域変数 *check-table* は、いっしょに散歩した人を格納する配列です。0 番目はダミーです。たとえば、(1 2 3) というグループを作った場合、*check-table* の 1 番目には (2 3) を、2 番目には (1 3) を、 3 番目には (2 3) をセットします。この *check-table* を使って、同じ女生徒と 2 回以上散歩しないようにグループ分けを行います。
関数 check-person はグループ ls に x を追加するとき、既に散歩した女生徒がいるかチェックします。*check-table* からリストを取り出し、それに x が含まれていれば、(car ls) は既に x と散歩をしています。この場合は #f を返します。x が ls の女生徒達とまだ散歩していない場合は #t を返します。
関数 add-person は *check-table* にグループ ls と x の関係を追加します。ls の要素を y とすると、*check-table* の x 番目のリストに y を、y 番目のリストに x を追加するだけです。関数 del-person は ls と x の関係を削除します。ls の要素を y とすると、*check-table* の x 番目の先頭要素と、y 番目の先頭要素を削除します。
解法プログラム kirkman の実際の処理は局所関数 kirkman-sub で行います。引数 cont が脱出用の継続、ls が女生徒を格納したリスト、a が作成中のグループ分けを格納するリスト、b が完成したグループ分けを格納するリストです。b の長さが 7 になれば解を見つけたことになります。
プログラムでは ls が空リストになり (a がひとつ完成する)、b の長さが 6 の場合、完成した a を b に追加し、それを reverse で反転して print で表示します。そうでない場合は、a を b に追加して、kirkman-sub を再帰呼び出しして次の日のグループ分けを作成します。グループ分けの処理は group-partition とほぼ同じですが、check-person でチェックを行い、add-person で *check-table* を更新してから、kirkman-sub を再帰呼び出しします。再帰呼び出しから戻ってきたら、del-person で *check-table* を元に戻します。
それでは実行結果を示します。
(((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13 14 15)) ((1 4 7) (2 5 10) (3 6 13) (8 11 14) (9 12 15)) ((1 5 14) (2 4 15) (3 8 12) (6 9 11) (7 10 13)) ((1 9 13) (2 7 12) (3 4 11) (5 8 15) (6 10 14)) ((1 8 10) (2 11 13) (3 5 9) (4 12 14) (6 7 15)) ((1 6 12) (2 9 14) (3 10 15) (4 8 13) (5 7 11)) ((1 11 15) (2 6 8) (3 7 14) (4 9 10) (5 12 13)))
実行時間は 5 分 40 秒 (Windows XP, celeron 1.40 GHz, Gauche ver 0.9.1) でした。けっこう時間がかかりますね。興味のある方は高速化に挑戦してみてください。
●別解 (2011/12/24)
リスト : カークマンの 15 人の女生徒
(define *check-table* #f)
(define (check-person ls x)
(let loop ((ls ls))
(cond ((null? ls) #t)
((member x (vector-ref *check-table* (car ls))) #f)
(else (loop (cdr ls))))))
(define (add-person ls x)
(for-each (lambda (y)
(push! (vector-ref *check-table* x) y)
(push! (vector-ref *check-table* y) x))
ls))
(define (del-person ls x)
(for-each (lambda (y)
(pop! (vector-ref *check-table* x))
(pop! (vector-ref *check-table* y)))
ls))
(define (kirkman)
(define (kirkman-sub cont ls a b)
(cond ((null? ls)
(cond ((= (length b) 6)
(print (reverse (cons a b)))
(cont #t))
(else
(kirkman-sub cont (iota 14 2) (list (list 1)) (cons a b)))))
(else
(for-each (lambda (y)
(when (and (< (length y) 3)
(check-person y (car ls)))
(add-person y (car ls))
(kirkman-sub cont
(cdr ls)
(cons (cons (car ls) y)
(remove (lambda (x) (equal? x y)) a))
b)
(del-person y (car ls))))
a)
(when (< (length a) 5)
(kirkman-sub cont (cdr ls) (cons (list (car ls)) a) b)))))
;
(call/cc
(lambda (cont)
(set! *check-table* (make-vector 16 '()))
(kirkman-sub cont (iota 14 2) (list (list 1)) '()))))
別解は append を使わないでプログラムしたものです。実行結果は次のようになりました。
gosh> (time (kirkman)) (((15 14 13) (12 11 10) (9 8 7) (6 5 4) (3 2 1)) ((15 4 3) (14 10 9) (13 11 8) (12 5 2) (7 6 1)) ((15 12 7) (14 11 1) (13 10 6) (9 4 2) (8 5 3)) ((15 11 2) (14 7 5) (13 9 3) (12 8 6) (10 4 1)) ((15 9 6) (14 12 3) (13 5 1) (11 7 4) (10 8 2)) ((15 10 5) (14 8 4) (13 7 2) (12 9 1) (11 6 3)) ((15 8 1) (14 6 2) (13 12 4) (11 9 5) (10 7 3))) ;(time (kirkman)) ; real 342.906 ; user 326.953 ; sys 15.937 #t
実行速度に大きな変化はありませんでした。