M.Hiroi's Home Page

Common Lisp Programming

Yet Another Common Lisp Problems

[ PrevPage | Common Lisp | NextPage ]

●問題81

バランスの取れた n 対のカッコ列を生成する高階関数 kakko func n を定義してください。カッコ列は ( と ) からなる列のことで、バランスが取れているカッコ列は、右カッコで閉じることができる、つまり右カッコに対応する左カッコがある状態のことをいいます。たとえば n = 1 の場合、( ) はバランスの取れたカッコ列ですが、) ( はバランスが取れていません。

> (kakko #'print 3)

"((()))"
"(()())"
"(())()"
"()(())"
"()()()"
NIL
> (kakko #'print 4)

"(((())))"
"((()()))"
"((())())"
"((()))()"
"(()(()))"
"(()()())"
"(()())()"
"(())(())"
"(())()()"
"()((()))"
"()(()())"
"()(())()"
"()()(())"
"()()()()"
NIL

解答

●問題82

カッコ列は二分木に対応させることができます。二分木の節をリスト (N L L) で表すことにします。N は節を表すシンボル、L は葉を表すシンボルとします。二分木をカッコ列に変換する関数 tree->kakko ls を定義してください。

> (tree->kakko '(N (N (N L L) L) L))

"((()))"
> (tree->kakko '(N (N L L) (N L L)))

"(())()"
> (tree->kakko '(N L (N L (N L L))))

"()()()"
> (tree->kakko '(N L (N (N L L) L)))

"()(())"
> (tree->kakko '(N (N L (N L L)) L))

"(()())"

解答

●問題83

tree->kakko の逆変換を行う関数 kakko->tree を定義してください。

> (kakko->tree "((()))")

(N (N (N L L) L) L)
NIL
> (kakko->tree "(())()")

(N (N L L) (N L L))
NIL
> (kakko->tree "()()()")

(N L (N L (N L L)))
NIL
> (kakko->tree "()(())")

(N L (N (N L L) L))
NIL
> (kakko->tree "(()())")

(N (N L (N L L)) L)
NIL

解答

●問題84

バランスの取れた n 対のカッコ列の総数を求める関数 kakko-num n を定義してください。

> (kakko-num 1)

1
> (kakko-num 2)

2
> (kakko-num 3)

5
> (kakko-num 4)

14
> (kakko-num 5)

42
> (kakko-num 10)

16796
> (kakko-num 50)

1978261657756160653623774456
> (kakko-num 100)

896519947090131496687170070074100632420837521538745909320

解答

●問題85

1 桁の 4 つの数字 (0 - 9 から 4 つ選ぶ) と *, -, *, /, ( ,) を使って、値が N になる式を求めるプログラムを作ってください。数字は並べ替えて使うことができます。ただし、18 や 26 のように複数の数字を連結して使ってはいけません。-を符号として使うことも禁止します。

解答

●問題86

自然数 n を素因数分解する関数 factorization n を定義してください。返り値はリスト ((p . q) ...) で、(p . q) は pq を表します。

> (factorization 6)

((2 . 1) (3 . 1))
> (factorization 12345678)

((2 . 1) (3 . 2) (47 . 1) (14593 . 1))
> (factorization 123456789)

((3 . 2) (3607 . 1) (3803 . 1))
> (factorization 1234567890)

((2 . 1) (3 . 2) (5 . 1) (3607 . 1) (3803 . 1))
> (factorization 1111111111)

((11 . 1) (41 . 1) (271 . 1) (9091 . 1))

解答86

●問題87

自然数 n の約数の個数を求める関数 divisor-num を定義してください。

> (divisor-num 6)

4
> (divisor-num 12345678)

24
> (divisor-num 123456789)

12
> (divisor-num 1234567890)

48
> (divisor-num 1111111111)

16

解答87

●問題88

自然数 n の約数の合計値を求める関数 divisor-sum を定義してください。

> (divisor-sum 6)

12
> (divisor-sum 12345678)

27319968
> (divisor-sum 123456789)

178422816
> (divisor-sum 1234567890)

3211610688
> (divisor-sum 1111111111)

1246404096

解答88

●問題89

自然数 n の約数をリストに格納して返す関数 divisor を定義してください。

> (divisor 6)

(1 2 3 6)
> (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)
> (divisor 123456789)

(1 3 9 3607 3803 10821 11409 32463 34227 13717421 41152263 123456789)
> (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)
> (divisor 1111111111)

(1 11 41 271 451 2981 9091 11111 100001 122221 372731 2463661 4100041 27100271
 101010101 1111111111)

解答89

●問題90

完全数 - Wikipedia によると、『完全数(かんぜんすう,perfect number)とは、その数自身を除く約数の和が、その数自身と等しい自然数のことである。』 とのことです。自然数 n 以下の完全数を求める関数 perfect-number を定義してください。

> (perfect-number 10000)

6
28
496
8128
NIL

解答90

●問題91

友愛数 - Wikipedia によると、『友愛数(ゆうあいすう)とは、異なる2つの自然数の組で、自分自身を除いた約数の和が、互いに他方と等しくなるような数をいう。』 とのことです。自然数 n 以下の友愛数を求める関数 yuuai-number を定義してください。

> (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)
NIL

解答91

●問題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 を定義してください。

> (partition-number 1)

1
> (partition-number 2)

2
> (partition-number 3)

3
> (partition-number 4)

5
> (partition-number 5)

7
> (partition-number 6)

11
> (partition-number 7)

15
> (partition-number 8)

22
> (partition-number 10)

42
> (partition-number 50)

204226

解答92

●問題93

整数 n の分割の仕方をすべて求める高階関数 partition-of-integer fn n を定義してください。

> (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)
NIL
> (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)
NIL

解答93

●問題94

m 個の整数 0, 1, 2, ..., m - 1 の順列を考えます。このとき、i 番目の要素が整数 i ではない順列を「完全順列」といいます。0 から m - 1 までの整数値で完全順列を生成する高階関数 perfect-permination fn m を定義してください。

> (perfect-permination #'print 3)

(1 2 0)
(2 0 1)
NIL
> (perfect-permination #'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)
NIL

解答94

●問題95

完全順列の総数を「モンモール数 (Montmort number) 」といいます。モンモール数は次の漸化式で求めることができます。

A1 = 0
A2 = 1
An = (n - 1) * (An-1 + An-2)  ; n >= 3

モンモール数を求める関数 montmort-number を定義してください。

> (montmort-number 1)

0
> (montmort-number 2)

1
> (montmort-number 3)

2
> (montmort-number 4)

9
> (montmort-number 5)

44
> (montmort-number 6)

265
> (montmort-number 7)

1854
> (montmort-number 10)

1334961
> (montmort-number 20)

895014631192902121
> (montmort-number 30)

97581073836835777732377428235481

解答95

●問題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 を定義してください。

> (partition-of-set #'print '(1 2 3))

((1 2 3))
((1 2) (3))
((1 3) (2))
((1) (2 3))
((1) (2) (3))
> (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))

解答96

●問題97

集合を分割する方法の総数を「ベル数 (Bell Number) 」といい、次の漸化式で求めることができます。

B(0) = 1
          n
B(n+1) =  Σ nk * B(k)    ; n >= 1
          k=0

ベル数を求める関数 bell-number n を定義してください。

> (bell-number 0)

1
> (bell-number 1)

1
> (bell-number 2)

2
> (bell-number 3)

5
> (bell-number 4)

15
> (bell-number 5)

52
> (bell-number 10)

115975
> (bell-number 20)

51724158235372
> (bell-number 30)

846749014511809332450147
> (bell-number 40)

157450588391204931289324344702531067
> (bell-number 50)

185724268771078270438257767181908917499221852770

解答97

●問題98

k 個の要素をもつ集合 ls を要素数が等しい m 個の部分集合に分割することを考えます。部分集合の要素数 n は k / m になります。分割の仕方をすべて求める高階関数 group-partition fn n m ls を定義してください。

> (group-partition #'print 2 2 '(1 2 3 4))

((1 2) (3 4))
((1 3) (2 4))
((1 4) (2 3))
NIL
> (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))
NIL

解答98

●問題99

集合を group-partition で分割するとき、その仕方の総数を求める関数 group-partition-number n m を定義してください。引数 n は部分集合の要素数、m は部分集合の個数です。

> (group-partition-number 2 2)

3
> (group-partition-number 2 3)

15
> (group-partition-number 3 3)

280
> (group-partition-number 3 4)

15400
> (group-partition-number 3 5)

1401400

解答99

●問題100

[問題] カークマンの 15 人の女生徒

15 人の女生徒が毎日 3 人ずつ 5 組に分かれて散歩をするとき、1 週間 (7 日) のうちに、どの女生徒も他のすべての女生徒と 1 回ずつ同じ組になるような組み合わせを作ってください。

出典 : 大村平 (著), 『数理パズルの話』, 日科技連出版社, 1998

「カークマンの 15 人の女生徒」を解くプログラムを作ってください。

解答100


●解答81

リスト : カッコ列の生成

(defun kakko (func m)
  (labels ((kakko-sub (x y a)
             (cond ((= x y m)
                    (funcall func (coerce (reverse a) 'string)))
                   (t
                    (when (< x m)
                      (kakko-sub (+ 1 x) y (cons #\( a)))
                    (when (< y x)
                      (kakko-sub x (+ 1 y) (cons #\) a)))))))
    ;
    (kakko-sub 0 0 '())))

カッコ列の生成は簡単です。局所関数 kakko-sub の引数 x が左カッコの個数、引数 y が右カッコの個数を表します。引数 a は累積変数で、文字 #\(, #\) を格納したリストです。

バランスの取れたカッコ列の場合、x, y, m には y <= x <= m の関係が成り立ちます。x = y = m の場合、カッコ列がひとつ完成しました。リスト a を反転して coerce で文字列に変換し、引数の関数 func を呼び出します。そうでなければ、kakko-sub を再帰呼び出しします。x < m であれば左カッコを追加し、y < x であれば右カッコを追加します。これでカッコ列を生成することができます。

●解答82

バランスの取れたカッコ列と二分木は 1 対 1 に対応します。二分木を行きがけ順で巡回するとき、途中の節では左カッコ ( を出力して左右の枝をたどり、葉に到達したら右カッコ ) を出力すると、カッコ列を生成することができます。

リスト : 二分木をカッコ列に変換

(defun tree->kakko (ls)
  (labels ((tree-kakko-sub (ls)
             (cond ((consp ls)
                    (append (list #\()
                            (tree-kakko-sub (cadr ls))
                            (tree-kakko-sub (caddr ls))))
                   (t (list #\))))))
    ;
    (coerce (butlast (tree-kakko-sub ls)) 'string)))

実際の処理は局所関数 tree-kakko-sub で行います。引数 ls がリストの場合、#\( を出力してから再帰呼び出しして左部分木 (cadr ls) をたどり、それから右部分木 (caddr ls) をたどります。その結果を append で連結すればいいわけです。葉 (要素) の場合は #\) を格納したリストを返します。ただし、このままでは最後に余分な右カッコが付いてくるので、関数 butlast で最後の要素を削除してから、coerce で文字列に変換しています。

●解答83

リスト : カッコ列を二分木に変換

(defun kakko->tree (ks)
  (labels ((kakko-sub (ls)
             (cond ((null ls) 
                    (values 'L nil))
                   ((eql (car ls) #\))
                    (values 'L (cdr ls)))
                   (t
                    (multiple-value-bind (x xs)
                        (kakko-sub (cdr ls))
                      (multiple-value-bind (y ys)
                          (kakko-sub xs)
                        (values (list 'N x y) ys)))))))
    ;
    (kakko-sub (coerce ks 'list))))

実際の処理は局所関数 kakko-sub で行います。kakko-sub は生成した二分木と残りのデータを多値で返します。リスト ls の先頭要素が #\) の場合、kakko-sub を再帰呼び出しして左部分木 x を生成し、それから右部分木 y を生成します。あとは (list 'N x y) を返すだけです。ls の先頭要素が #\) の場合は葉なので、'L と (cdr ls) を返すだけです。ただし、右カッコがひとつ少ないので、引数 ls が空リストの場合は葉 L と nil を返すようにします。

●解答84

カタラン数 - Wikipedia によると、カッコ列の総数は「カタラン数 (Catalan number) 」になるとのことです。カタラン数は次に示す公式で求めることができます。

         (2n)!
Cn = ----------
       (n+1)!n!

これをそのままプログラムしてもいいのですが、それではちょっと面白くないので別な方法でプログラムを作ってみましょう。カタラン数は次に示す経路図において、A から B までの最短距離の道順を求めるとき、対角線を超えないものの総数に一致します。


              図 : 道順の総数の求め方

A からある地点にいたる最短距離の道順の総数は、左隣と真下の地点の値を足したものになります。一番下の地点は 1 で、対角線を越えた地点は 0 になります。あとは下から順番に足し算していけば、A から B までの道順の総数を求めることができます。上図の場合はカラタン数 C4 に相当し、その値は 14 となります。

これをそのままプログラムすると、次のようになります。

リスト : カッコ列の総数

(defun kakko-num (m)
  (do ((a (make-list (+ m 1) :initial-element 1)))
      ((null (cdr a)) (car a))
    (setq a (cdr (reverse (reduce #'(lambda (b x) (cons (+ x (car b)) b))
                                  (cdr a)
                                  :initial-value (list 0)))))))

最初に make-list で一番下の地点の道順の総数 (1) を格納したリスト生成します。これが変数 a の初期値になります。引数 m のカラタン数を求める場合、リストの大きさは m + 1 になります。あとは、リストの要素がひとつになるまで do で処理を繰り返します。

一段上の地点の値を求める場合、畳み込み reduce を使うと簡単です。初期値はリスト (0) とします。これが対角線を越えた地点の値を表します。a の先頭要素は不要なので、cdr で削除してから reduce に渡します。ラムダ式の引数 x が真下の地点の値、引数 b の先頭要素が左隣の地点の値になります。

あとは x と (car b) を足し算して、それを cons でリスト b の先頭に追加すればいいわけです。この場合、reduce が返すリストは逆順になるので、reverse で反転してから cdr で先頭要素 (対角線を越えた地点の値) を削除します。これでカッコ列の総数 (カラタン数) を求めることができます。

●別解 (2012/01/08)

ベクタを使うともっと簡単になります。次の図を見てください。

0 : #(1 1 1 1 1)

1 : #(1 1 1 1 1)

2 : #(1 1 1+1=2 2+1=3 3+1=4)
 => #(1 1 2 3 4)

3 : #(1 1 2 3+2=5 5+4=9)
 => #(1 1 2 5 9)

4 : #(1 1 2 5 5+9=14)
 => #(1 1 2 5 14)

上図は Cn (n = 4) を求める場合です。大きさが n + 1, 要素の値が 1 のベクタを用意します。n = 0, 1 の場合は n 番目の要素をそのまま返します。n が 2 よりも大きい場合、変数 i を 2 に初期化して、i - 1 番目以降の要素の累積和を求めます。

たとえば i = 2 の場合、2 番目の要素は 1 番目の要素と自分自身を加算した値 2 になります。3 番目の要素は 2 番目の要素と自分自身を足した値 3 になり、4 番目の要素は 3 + 1 = 4 になります。次に i を +1 して同じことを繰り返します。3 番目の要素は 2 + 3 = 5 になり、4 番目の要素は 5 + 4 = 9 になります。i = 4 のとき、4 番目の要素は 5 + 9 = 14 となり、C4 の値を求めることができました。

プログラムは次のようになります。

リスト : カッコ列の総数

(defun catalan-number (n)
  (let ((table (make-array (1+ n) :initial-element 1)))
    (do ((i 2 (1+ i)))
	((< n i) (aref table n))
      (do ((j i (1+ j)))
	  ((< n j))
	(incf (aref table j) (aref table (1- j)))))))

説明したことをそのままプログラムしただけなので、とくに難しいところはないと思います。

●解答85

それではプログラムを作りましょう。数式を二分木で表すと、次に示す 5 つのパターンになります。

X, Y, Z が演算子を表します。これを式で表すと、次のようになります。

(1) (a Y b) X (c Z d)
(2) a X (b Y (c Z d))
(3) ((a Z b) Y c) X d
(4) a X ((b Z c) Y d)
(5) (a Y (b Z c)) X d

あとは、a, b, c, d に数字を、X, Y, Z に演算子 +, -, *, / を入れて数式を計算すればいいわけです。ただし、Common Lisp の場合、0 で除算するとエラー division by zero が送出されるので、それを捕捉する処理が必要になります。ご注意くださいませ。

プログラムは次のようになります。

リスト : 切符番号の問題

; 数式を作る
(defun make-expr (x y z a b c d)
  `(((,a ,y ,b) ,x (,c ,z ,d))
    (,a ,x (,b ,y (,c ,z ,d)))
    (((,a ,z ,b) ,y ,c) ,x ,d)
    (,a ,x ((,b ,z ,c) ,y ,d))
    ((,a ,y (,b ,z ,c)) ,x ,d)))

; 判定関数の生成
(defun make-checker (n)
  (let ((table '()))
    #'(lambda (expr)
        (let ((e1 (flatexpr expr)))
          (when (and (eql (ignore-errors (expression e1)) n)
                     (not (member e1 table :test #'equal)))
            (push e1 table)
            (print e1))))))

; 解法
(defun solve (fn ls)
  (dolist (op (repeat-perm 3 '(+ - * /)))
    (dolist (nums (permutation 4 ls))
      (dolist (expr (apply #'make-expr (append op nums)))
        (funcall fn expr)))))

関数 make-expr は数字と演算子から 5 つ数式をリストに格納して返します。関数 make-checker は数式をチェックする関数を生成して返します。この関数の中で数式 expr を計算します。数式の計算は expression を使うと簡単です。このとき、flatexpr で冗長なカッコをはずしておきます。値が引数 n と等しくて、今までに出現していない数式であれば、それを table に格納して print で表示します。

expression を評価するとき、マクロ ignore-errors を使ってエラーを捕捉していることに注意してください。ignore-errors は expression でエラーが送出された場合、そのエラーを捕捉して nil とエラーを表すコンディションを返します。エラーが送出されない場合は、expression の返り値をそのまま返します。このため、引数 n と返り値の比較は eql を使っています。

関数 solve は dolist を 3 重で使います。最初に演算子の組み合わせを求めます。これは重複順列になるので関数 repeat-perm を使うと簡単です。次に数字の並びを求めます。これは順列になるので関数 permutaiton を使います。最後に、make-expr で 5 つの数式を生成し、引数として渡された関数 fn を呼び出して、条件を満たしている数式を出力します。

簡単な実行例を示します。

> (solve (make-checker 10) '(6 7 8 9))

(6 + 8 / (9 - 7))
(8 / (9 - 7) + 6)
(8 * (9 - 7) - 6)
((9 - 7) * 8 - 6)
(6 - 8 / (7 - 9))
((7 + 8) * 6 / 9)
((8 + 7) * 6 / 9)
(6 * (7 + 8) / 9)
(6 * (8 + 7) / 9)
(6 / 9 * (7 + 8))
(6 / 9 * (8 + 7))
((7 + 8) / 9 * 6)
((8 + 7) / 9 * 6)
NIL
> (solve (make-checker 10) '(1 2 6 9))

(6 + (9 - 1) / 2)
((9 - 1) / 2 + 6)
(2 * (9 - 1) - 6)
((9 - 1) * 2 - 6)
(6 - (1 - 9) / 2)
NIL

●解答86

リスト : 素因数分解

(defun factor-sub (n m)
  (do ((i 0 (1+ i)) (n n))
      ((not (zerop (mod n m))) (values i n))
    (setq n (floor n m))))

(defun factorization (n)
  (multiple-value-bind (c n)
      (factor-sub n 2)
    (do ((i 3 (+ i 2))
         (n n)
         (a (if (zerop c) '() (list (cons 2 c)))))
        ((or (= n 1) (< n (* i i)))
         (nreverse (if (= n 1) a (cons (cons n 1) a))))
      (multiple-value-bind (c m)
          (factor-sub n i)
        (when (not (zerop c))
          (setq n m)
          (push (cons i c) a))))))

素因数分解は素数 2, 3, 5, ... で順番に割り算していけばいいのですが、いちいち素数を求めるのは大変なので、2 と 3 以上の奇数列で割り算していきます。関数 factor-sub は n を m で割り算します。このとき、m で割り切れる回数を求めます。factor-sub は m で割った回数と商を多値で返します。

次に、factor-sub を呼び出して n を 2 で割り算します。それから、do で奇数列を生成します。変数 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 個です。

プログラムは次のようになります。

リスト : 約数の個数

(defun divisor-num (n)
  (reduce #'(lambda (a x) (* a (+ 1 (cdr x))))
          (factorization n)
          :initial-value 1))

divisor-num は reduce を使って (+ 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 になります。

プログラムは次のようになります。

リスト : 約数の合計値

(defun div-sum-sub (p n)
  (do ((n n (1- n))
       (a 0))
      ((zerop n) (+ a 1))
    (incf a (expt p n))))

(defun divisor-sum (n)
  (reduce #'(lambda (a x) (* a (div-sum-sub (car x) (cdr x))))
          (factorization n)
          :initial-value 1))

関数 div-sum-sub は σ(p, n) を計算します。あとは reduce で 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) になります。

プログラムは次のようになります。

リスト : 約数をすべて求める

(defun divisor-sub (p n a)
  (if (zerop n)
      (cons 1 a)
    (divisor-sub p (- n 1) (cons (expt p n) a))))

(defun list-product (p q a)
  (if (null p)
      a
    (list-product (cdr p) q (append (mapcar #'(lambda (x) (* (car p) x)) q) a))))

(defun divisor (n)
  (let ((x (factorization n)))
    (sort (reduce #'(lambda (a y)
                      (list-product (divisor-sub (car y) (cdr y) '()) a '()))
                  (cdr x)
                  :initial-value (divisor-sub (caar x) (cdar x) '()))
          #'<)))

関数 divisor-sub は pn の約数をリストに格納して返します。関数 list-product は 2 つのリスト p, q の要素を掛け合わせたものをリストに格納して返します。あとは reduce で素因数分解した結果を順番に取り出し、(p . n) を divisor-sub でリストに変換して、それを list-product で累積変数 a のリストと掛け合わせていくだけです。

●解答90

リスト : 完全数

(defun perfect-number (n)
  (do ((x 2 (1+ x)))
      ((< n x))
    (when (= (- (divisor-sum x) x) x)
      (print x))))

完全数を求める perfect-number は簡単です。x の約数の合計値を divisor-sub で求め、その値から x を引いた値が x と等しければ完全数です。print で x を表示します。

●解答91

リスト : 友愛数

(defun yuuai-number (n)
  (do ((x 2 (1+ x)))
      ((< n x))
    (let ((m (- (divisor-sum x) x)))
      (when (and (< x m)
                 (= x (- (divisor-sum m) m)))
        (print (list x m))))))

友愛数を求める 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 通りになります。

これをプログラムすると次のようになります。

リスト : 分割数

(defun partition-number (n)
  (labels ((p (n k)
             (if (or (<= n 1) (= k 1))
                 1
               (do ((i 1 (1+ i))
                    (a 0))
                   ((or (< k i) (< n i)) a)
                 (setq a (+ 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/25)

上記プログラムは「二重再帰」でプログラムすることもできます。

リスト : 分割数 (別解)

(defun part-num (n k)
  (cond ((or (zerop n) (= n 1) (= k 1)) 1)
        ((or (< n 0) (< k 1)) 0)
        (t (+ (part-num (- n k) k) (part-num n (- k 1))))))

(defun partition-number (n)
  (part-num n n))

また、次のように関数 part-num をメモ化することで高速化することができます。

リスト : 分割数 (メモ化による高速化)

; メモ化関数
(defun memoize (func)
  (let ((table (make-hash-table :test #'equal)))
    #'(lambda (&rest args)
        (let ((value (gethash args table nil)))
          (unless value
            (setf value (apply func args))
            (setf (gethash args table) value))
          value))))

; メモ化
(setf (symbol-function 'part-num) (memoize #'part-num))

(defun partition-number1 (n)
  (part-num n n))

動的計画法を使うと、もっと速くなります。

リスト : 分割数 (動的計画法)

(defun partition-number2 (n)
  (let ((a (make-array (+ n 1) :initial-element 1)))
    (do ((k 2 (1+ k)))
        ((< n k) (aref a n))
      (do ((m k (1+ m)))
          ((< n m))
        (incf (aref a m) (aref a (- m k)))))))

実行例を示します。

* (time (partition-number1 1000))

Evaluation took:
  6.875 seconds of real time
  6.875000 seconds of total run time (6.578125 user, 0.296875 system)
  [ Run times consist of 0.187 seconds GC time, and 6.688 seconds non-GC time. ]

  100.00% CPU
  9,623,093,846 processor cycles
  67,090,904 bytes consed

24061467864032622473692149727991
* (time (partition-number2 1000))

Evaluation took:
  0.219 seconds of real time
  0.218750 seconds of total run time (0.140625 user, 0.078125 system)
  [ Run times consist of 0.125 seconds GC time, and 0.094 seconds non-GC time. ]

  100.00% CPU
  307,823,617 processor cycles
  11,854,264 bytes consed

24061467864032622473692149727991

(Windows XP, celeron 1.40 GHz, SBCL ver 1.0.37)
-- 参考文献 --------
[1] 奥村晴彦,『C言語による最新アルゴリズム事典』, 技術評論社, 1991

●解答93

リスト : 整数の分割

(defun partition-of-integer (func n)
  ; k 以下で n を分割する
  (labels ((p (n k a)
             (cond ((zerop n) 
                    (funcall func a))
                   ((= n 1)
                    (funcall func (cons 1 a)))
                   ((= k 1)
                    (funcall func (append (make-list n :initial-element 1) a)))
                   (t
                    (do ((i 1 (1+ i)))
                        ((or (> i k) (> i n)))
                      (p (- n i) i (cons i a)))))))
    ;
    (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 を評価します。

●別解

リスト : 整数の分割

(defun partition-of-integer (f n)
  (labels ((part-int (n k a)
             (cond ((zerop n) (funcall f (reverse a)))
                   ((= n 1) (funcall f (reverse (cons 1 a))))
                   ((= k 1) (funcall f (reverse (append (make-list n :initial-element 1) a))))
                   (t
                    (when (>= n k)
                      (part-int (- n k) k (cons k a)))
                    (part-int n (1- k) a)))))
    (part-int n n nil)))

別解は局所関数 part-int を二重再帰でプログラムしたものです。

●解答94

リスト : 完全順列

; m から始まって n 個の数列を作る
(defun iota (n m)
  (if (zerop n)
      nil
    (cons m (iota (1- n) (1+ m)))))

(defun perfect-permination (func m)
  (labels ((perm-sub (n ls a)
             (if (null ls)
                 (funcall func (reverse a))
               (dolist (x ls)
                 (unless (= n x)
                   (perm-sub (+ n 1)
                             (remove-if #'(lambda (y) (= x y)) ls)
                             (cons x a)))))))
    ;
    (perm-sub 0 (iota m 0) '())))

perfect-permination は簡単です。実際の処理は局所関数 perm-sub で行います。iota で 0 から m - 1 までの数値を格納したリストを生成し、それを引数 ls に渡します。引数 n が順番を表します。dolist で数字 x が n と等しくない場合、その数字を選択することできます。等しい場合は選択しません。ls が空リストになったら、reverse で a を反転して func を評価します。これで完全順列を生成することができます。

●解答95

リスト : 完全順列の総数

(defun montmort-number (n)
  (cond ((<= n 1) 0)
        ((= n 2) 1)
        (t
         (* (- n 1) (+ (montmort-number (- n 1))
                       (montmort-number (- n 2)))))))

; 別解
(defun montmort-number1 (n)
  (do ((i 1 (1+ i))
       (a 0)
       (b 1))
      ((>= i n) a)
      (psetq a b
             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 個の集合を分割することができます。

新しい要素を追加する場合は次に示す手順で行います。

  1. 部分集合 Sk (k = 1 から i まで) に要素 xn を追加する
  2. 新しい部分集合 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)) になります。

このように、簡単な方法で集合を分割することができます。実際にプログラムを作る場合、上図を木と考えて、深さ優先で木をたどると簡単です。次のリストを見てください。

リスト : 集合の分割

(defun append1 (ls x) (append ls (list x)))

(defun append1-nth (ls n x)
  (if (zerop n)
      (cons (append (car ls) (list x)) (cdr ls))
    (cons (car ls) (append1-nth (cdr ls) (- n 1) x))))

(defun partition-of-set (fn ls)
  (labels ((partition-sub (ls a)
             (if (null ls)
                 (funcall fn a)
               ; a に格納されている部分集合に (car ls) を追加する
               (do ((i 0 (1+ i)))
                   ((= i (length a))
                    ; 新しい集合を追加する
                    (partition-sub (cdr ls) (append1 a (list (car ls)))))
                 (partition-sub (cdr ls) (append1-nth a i (car ls)))))))
    ;
    (partition-sub (cdr ls) (list (list (car ls))))))

関数 append1 はリスト ls の最後尾に x を追加します。関数 append1-nth はリスト ls の i 番目の要素 (リスト) に x を追加します。partition-of-set はアルゴリズムをそのままプログラムしただけです。

実際の処理は局所関数 partition-sub で行います。生成した部分集合は累積変数 a に格納します。ls が空リストの場合、追加する要素がなくなったので fn を評価します。要素がある場合、append1-nth で i 番目の部分集合に要素 (car ls) を追加します。すべての部分集合に要素を追加したら、(car ls) を要素として持つ部分集合を生成して累積変数 a に追加します。

●別解

リスト : 集合の分割

(defun partition-of-set (f xs)
  (labels ((part-set (xs a)
             (cond ((null xs) (funcall f a))
                   (t
                    (dolist (y a)
                      (part-set (cdr xs)
                                (cons (cons (car xs) y)
                                      (remove y a :test #'equal))))
                    (part-set (cdr xs) (cons (list (car xs)) a))))))
    (part-set (reverse xs) nil)))

別解は append を使わないでプログラムしたものです。part-set に集合 xs をそのまま渡すと要素が逆順になるので、xs を reverse で反転してから part-set に渡しています。

●解答97

リスト : ベル数

; 組み合わせの数
(defun comb-num (n r)
  (if (or (= n r) (= r 0))
      1
      (/ (* (comb-num n (- r 1)) (+ (- n r) 1)) r)))

;
(defun bell-number (n)
  (do ((i 0 (1+ i))
       (bs (list 1)))
      ((= i n) (car bs))
    (push (fold-left-with-index #'(lambda (a k x) (+ (* (comb-num i k) x) a)) 0 bs)
          bs)))

bell-number は公式をそのままプログラムするだけです。累積変数 bs にベル数を逆順で格納します。nk は関数 comb-num で求めます。nk * B(k) の総和は関数 fold-left-with-index で計算します。fold-left-with-index は添字を関数に渡して畳み込みを行います。ラムダ式の引数 x がリストの要素、k が添字、a が累積変数です。bs は逆順になっていますが、二項係数は ninn - i の値が同じになるので、そのまま計算しても大丈夫です。もちろん、reverse で bs を逆順にしてから計算してもかまいません。

●解答98

リスト : 集合のグループ分け

(defun group-partition (func n m ls)
  (labels ((group-partition-sub (ls a)
             (if (null ls)
                 (funcall func a)
               ; a に格納されている部分集合に (car ls) を追加する
               (do ((i 0 (1+ i)))
                   ((= i (length a))
                    ; 新しい集合を追加する
                    (when (< (length a) m)
                      (group-partition-sub (cdr ls) (append1 a (list (car ls))))))
                 (when (< (length (nth i a)) n)
                   (group-partition-sub (cdr ls) (append1-nth a i (car ls))))))))
    ;
    (group-partition-sub (cdr ls) (list (list (car ls))))))

group-partition は partition-of-set を改造するだけで簡単に作成することができます。生成する部分集合の大きさを n に、部分集合の個数を m に制限するだけです。i 番目の部分集合に要素を追加する場合、(length (nth i a)) が n 未満であることをチェックします。新しい部分集合を追加する場合、(length a) が m 未満であることをチェックします。これで集合をグループに分けることができます。

●別解

リスト : 集合のグループ分け

(defun group-partition (f n m xs)
  (labels ((group-part (xs a)
             (cond ((null xs) (funcall f a))
                   (t
                    (dolist (y a)
                      (when (< (length y) n)
                        (group-part (cdr xs)
                                    (cons (cons (car xs) y)
                                          (remove y a :test #'equal)))))
                    (when (< (length a) m)
                      (group-part (cdr xs) (cons (list (car xs)) a)))))))
    (group-part (reverse xs) nil)))

別解は append を使わないでプログラムしたものです。

●解答99

グループ分けの総数は次の式で求めることができます。

k = n * m
kn * k-nn * k-2*nn * ... * 2*nn * nn / m!

たとえば、n = 3, m = 5 の場合は次のようになります。

153 * 123 * 93 * 63 * 33 / 5! = 1401400

これをそのままプログラムすると次のようになります。

リスト : グループ分けの総数

; 階乗
(defun fact (n)
  (if (zerop n)
      1
    (* n (fact (- n 1)))))

(defun group-partition-number (n m)
  (do ((k (* n m) (- k n))
       (a 1))
      ((zerop k) (/ a (fact m)))
    (setq a (* 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 人の女生徒

(defun append1 (ls x) (append ls (list x)))

(defun append1-nth (ls n x)
  (if (zerop n)
      (cons (append (car ls) (list x)) (cdr ls))
    (cons (car ls) (append1-nth (cdr ls) (- n 1) x))))

(defvar *check-table* nil)

(defun check-person (ls x)
  (dolist (y ls t)
    (when (member x (aref *check-table* y))
      (return nil))))

(defun add-person (ls x)
  (dolist (y ls)
    (push y (aref *check-table* x))
    (push x (aref *check-table* y))))

(defun del-person (ls x)
  (dolist (y ls)
    (pop (aref *check-table* x))
    (pop (aref *check-table* y))))

(defun kirkman-sub (ls a b)
  (if (null ls)
      (cond ((= (length b) 6)
             (print (reverse (cons a b)))
             (throw 'found t))
            (t
             (kirkman-sub (iota 14 2) (list (list 1)) (cons a b))))
    ; a に格納されている部分集合に (car ls) を追加する
    (dotimes (i (length a)
                (when (< (length a) 5)
                  (kirkman-sub (cdr ls) (append1 a (list (car ls))) b)))
      (when (and (< (length (nth i a)) 3)
                 (check-person (nth i a) (car ls)))
        (add-person (nth i a) (car ls))
        (kirkman-sub (cdr ls) (append1-nth a i (car ls)) b)
        (del-person (nth i a) (car ls))))))

;
(defun kirkman ()
  (catch 'found
    (setq *check-table* (make-array 16 :initial-element nil))
    (kirkman-sub (iota 14 2) (list (list 1)) nil)))

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 と散歩をしています。この場合は nil を返します。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 で行います。引数 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)))

実行時間は約 51 秒 (Windows XP, celeron 1.40 GHz, SBCL 1.0.37) でした。SBCL でもけっこう時間がかかりますね。興味のある方は高速化に挑戦してみてください。

●別解

リスト : カークマンの 15 人の女生徒

; m から始まって n 個の数列を作る
(defun iota (n m)
  (if (zerop n)
      nil
    (cons m (iota (1- n) (1+ m)))))

(defvar *check-table* nil)

(defun check-person (ls x)
  (dolist (y ls t)
    (when (member x (aref *check-table* y))
      (return nil))))

(defun add-person (ls x)
  (dolist (y ls)
    (push y (aref *check-table* x))
    (push x (aref *check-table* y))))

(defun del-person (ls x)
  (dolist (y ls)
    (pop (aref *check-table* x))
    (pop (aref *check-table* y))))

(defun kirkman-sub (ls a b)
  (if (null ls)
      (cond ((= (length b) 6)
             (print (reverse (cons a b)))
             (throw 'found t))
            (t
             (kirkman-sub (iota 14 2) (list (list 1)) (cons a b))))
    (progn
      (dolist (y a)
        (when (and (< (length y) 3)
                   (check-person y (car ls)))
          (add-person y (car ls))
          (kirkman-sub (cdr ls)
                       (cons (cons (car ls) y)
                             (remove y a :test #'equal))
                       b)
          (del-person y (car ls))))
      (when (< (length a) 5)
        (kirkman-sub (cdr ls) (cons (list (car ls)) a) b)))))

;
(defun kirkman ()
  (catch 'found
    (setq *check-table* (make-array 16 :initial-element nil))
    (kirkman-sub (iota 14 2) (list (list 1)) nil)))

別解は append を使わないでプログラムしたものです。実行結果は次のようになりました。

* (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)))
Evaluation took:
  33.828 seconds of real time
  33.828125 seconds of total run time (33.703125 user, 0.125000 system)
  [ Run times consist of 0.458 seconds GC time, and 33.371 seconds non-GC time.
]
  100.00% CPU
  47,365,924,211 processor cycles
  1,430,501,728 bytes consed

T

append を使わないように改良しただけですが、実行速度はけっこう速くなりました。check-person, add-person, del-person の処理をビット演算で行うと、もう少し速くなるかもしれません。興味のある方は挑戦してみてください。


Copyright (C) 2011-2012 Makoto Hiroi
All rights reserved.

[ PrevPage | Common Lisp | NextPage ]