Yet Another Prolog Problems

●問題68

真偽値を 1 (真)、0 (偽) で表すことにします。2 つの真偽値 P, Q の論理積、論理和、排他的論理和求める述語 log_and, log_or, log_xor を定義してください。

真理値表
P	Q	AND	OR	XOR
0	0	0	0	0
0	1	0	1	1
1	0	0	1	1
1	1	1	1	0

?- log_and(X, Y, Z), write([X, Y, Z]), nl, fail.
[0, 0, 0]
[1, 0, 0]
[0, 1, 0]
[1, 1, 1]

No
?- log_or(X, Y, Z), write([X, Y, Z]), nl, fail.
[0, 0, 0]
[1, 0, 1]
[0, 1, 1]
[1, 1, 1]

No
?- log_xor(X, Y, Z), write([X, Y, Z]), nl, fail.
[0, 0, 0]
[1, 0, 1]
[0, 1, 1]
[1, 1, 0]

No

●問題69

2 つの真偽値 P, Q を与えたとき、次に示すような真偽値 S, C を出力する述語 half_adder(P, Q, S, C) を定義してください。

真理値表
P	Q	S	C
0	0	0	0
0	1	1	0
1	0	1	0
1	1	0	1

?- half_adder(P, Q, S, C), write([P, Q, S, C]), nl, fail.
[0, 0, 0, 0]
[1, 0, 1, 0]
[0, 1, 1, 0]
[1, 1, 0, 1]

No

●問題70

3 つの真偽値 P, Q, R を与えたとき、次に示すような真偽値 S, C を出力する述語 full_adder(P, Q, R, S, C) を定義してください。

真理値表
P	Q	R	S	C
0	0	0	0	0
0	1	0	1	0
1	0	0	1	0
1	1	0	0	1
0	0	1	1	0
0	1	1	0	1
1	0	1	0	1
1	1	1	1	1

?- full_adder(P, Q, R, S, C), write([P, Q, R, S, C]), nl, fail.
[0, 0, 0, 0, 0]
[0, 0, 1, 1, 0]
[1, 0, 0, 1, 0]
[1, 0, 1, 0, 1]
[0, 1, 0, 1, 0]
[0, 1, 1, 0, 1]
[1, 1, 0, 0, 1]
[1, 1, 1, 1, 1]

No

●問題71

真偽値 1, 0 とリストで n ビットの無符号整数を表すことにします。これを uint と呼ぶことにしましょう。たとえば、0 と 255 を 8 桁の unit で表すと次のようになります。

     MSB                    LSB
  0 : [0, 0, 0, 0, 0, 0, 0, 0]
255 : [1, 1, 1, 1, 1, 1, 1, 1]

0 以上の整数値 n を m 桁の uint に変換する述語 integer_to_uint(N, M, U) と、uint を整数値に変換する述語 uint_to_integer(U, N) を定義してください。

?- integer_to_uint(255, 8, N).

N = [1, 1, 1, 1, 1, 1, 1, 1] ;

No
?- integer_to_uint(0, 8, N).

N = [0, 0, 0, 0, 0, 0, 0, 0] ;

No
?- integer_to_uint(127, 8, N).

N = [0, 1, 1, 1, 1, 1, 1, 1] ;

No
?- uint_to_integer([0, 0, 0, 0, 0, 0, 0, 0], N).

N = 0 ;

No
?- uint_to_integer([0, 1, 1, 1, 1, 1, 1, 1], N).

N = 127 ;

No
?- uint_to_integer([1, 1, 1, 1, 1, 1, 1, 1], N).

N = 255 ;

No

●問題72

uint で論理演算を行う述語 uint_and(X, Y, Z), uint_or(X, Y, Z), uint_xor(X, Y, Z), uint_not(X, Z) を定義してください。

?- uint_and([0, 0, 1, 1], [0, 1, 0, 1], X).

X = [0, 0, 0, 1] ;

No
?- uint_or([0, 0, 1, 1], [0, 1, 0, 1], X).

X = [0, 1, 1, 1] ;

No
?- uint_xor([0, 0, 1, 1], [0, 1, 0, 1], X).

X = [0, 1, 1, 0] ;

No
?- uint_not([0, 1, 0, 1], X).

X = [1, 0, 1, 0] ;

No

●問題73

2 つの uint を加算する関数 uint_add(X, Y, Z, C) を定義してください。桁あふれが生じた場合、C の値は 1 になります。なお、X, Y, Z の桁は同じものとします。

?- uint_add([0, 0, 0, 0], [0, 0, 0, 1], X, C).

X = [0, 0, 0, 1],
C = 0 ;

No
?- uint_add([0, 0, 0, 1], [0, 0, 0, 1], X, C).

X = [0, 0, 1, 0],
C = 0 ;

No
?- uint_add([1, 1, 1, 1], [0, 0, 0, 1], X, C).

X = [0, 0, 0, 0],
C = 1

No

●問題74

uint を +1 する述語 uint_inc(X, Z, C) を定義してください。桁あふれが生じた場合、C の値は 1 になります。

?- uint_inc([0, 0, 0, 0], X, C).

X = [0, 0, 0, 1],
C = 0 ;

No
?- uint_inc([0, 0, 0, 1], X, C).

X = [0, 0, 1, 0],
C = 0 ;

No
?- uint_inc([1, 1, 1, 1], X, C).

X = [0, 0, 0, 0],
C = 1 ;

No

●問題75

2 つの uint を減算する関数 uint_sub(X, Y, Z, C) を定義してください。桁借りが生じた場合、C の値は 1 になります。なお、X, Y, Z の桁は同じものとします。

?- uint_sub([0, 0, 0, 1], [0, 0, 0, 1], X, C).

X = [0, 0, 0, 0],
C = 0 ;

No
?- uint_sub([0, 0, 0, 0], [0, 0, 0, 1], X, C).

X = [1, 1, 1, 1],
C = 1 ;

No
?- uint_sub([0, 0, 1, 1], [0, 0, 0, 1], X, C).

X = [0, 0, 1, 0],
C = 0 ;

No

●問題76

uint を左へ 1 ビット論理シフトする述語 uint_sll(X, Z, C) と、右へ 1 ビット論理シフトする述語 uint_srl(X, Z, C) を定義してください。C の値は uint_sll であれば MSB、uint_srl であれば LSB になります。

?- uint_sll([1, 1, 1, 1], X, C).

X = [1, 1, 1, 0],
C = 1 ;

No
?- uint_sll([0, 1, 1, 1], X, C).

X = [1, 1, 1, 0],
C = 0 ;

No
?- uint_srl([1, 1, 1, 1], X, C).

X = [0, 1, 1, 1],
C = 1 ;

No
?- uint_srl([1, 1, 1, 0], X, C).

X = [0, 1, 1, 1],
C = 0 ;

No

●問題77

次に示す uint の比較述語を定義してください。なお、X, Y の桁は同じものとします。

表 ; uint の比較関数
関数名	機能
uint_equal(X, Y)	X と Y が等しいときに成功する
uint_greater(X, Y)	X が Y より大きいときに成功する
uint_lesser(X, Y)	X が Y より小さいときに成功する
uint_zero(X)	X が 0 のときに成功する

?- uint_equal([1, 0, 1, 0], [1, 0, 1, 0]).

Yes
?- uint_equal([1, 0, 1, 0], [1, 0, 1, 1]).

No
?- uint_greater([1, 0, 1, 1], [1, 0, 1, 0]).

Yes
?- uint_greater([1, 0, 1, 1], [1, 0, 1, 1]).

No
?- uint_lesser([1, 0, 1, 0], [1, 0, 1, 1]).

Yes
?- uint_lesser([1, 0, 1, 0], [1, 0, 0, 1]).

No
?- uint_zero([1, 0, 1, 0]).

No
?- uint_zero([0, 0, 0, 0]).

Yes

●問題78

2 つの uint を乗算する述語 uint_mul(X, Y, Z) を定義してください。桁あふれは無視してください。なお、X, Y の桁は同じものとします。

?- uint_mul([0, 0, 0, 1], [1, 0, 0, 0], X).

X = [1, 0, 0, 0] ;

No
?- uint_mul([0, 0, 1, 1], [0, 1, 0, 0], X).

X = [1, 1, 0, 0] ;

No
?- uint_mul([0, 0, 1, 1], [0, 0, 1, 1], X).

X = [1, 0, 0, 1] ;

No

●問題79

2 つの uint を除算する関数 uint_div(X, Y, P, Q) を定義してください。P は商を、Q は余りを表します。なお、X, Y の桁は同じものとします。

?- uint_div([0, 1, 0, 0], [0, 0, 1, 0], P, Q).

P = [0, 0, 1, 0],
Q = [0, 0, 0, 0] ;

No
?- uint_div([0, 1, 1, 0], [0, 0, 1, 0], P, Q).

P = [0, 0, 1, 1],
Q = [0, 0, 0, 0] ;

No
?- uint_div([0, 1, 1, 1], [0, 0, 1, 0], P, Q).

P = [0, 0, 1, 1],
Q = [0, 0, 0, 1] ;

No
?- uint_div([0, 1, 1, 1], [0, 0, 1, 1], P, Q).

P = [0, 0, 1, 0],
Q = [0, 0, 0, 1] ;

No

●問題80

リスト Ls のべき集合を求める述語 power_set(Ls, Xs) を定義してください。たとえば、リスト [a, b, c] のべき集合は [[], [a], [b], [c], [a, b], [a, c], [b, c], [a, b, c]] になります。

?- power_set([a,b], Xs).

Xs = [[], [b], [a], [a, b]] ;

No
?- power_set([a,b,c], Xs).

Xs = [[], [c], [b], [b, c], [a], [a, c], [a, b], [a|...]] ;

No

●問題81

リスト Xs がリスト Ys の部分集合か判定する述語 subset(Xs, Ys) を定義してください。なお、並び方が異なるだけのリスト、たとえば [a, b] と [b, a] は同じ集合とします。

?- subset([a, b], [a, b, c]).

Yes
?- subset([b, a], [a, b, c]).

Yes
?- subset(Xs, [a, b, c]), write(Xs), nl, fail.
[]
[a]
[a, b]
[a, b, c]
[a, c]
[a, c, b]
[b]
[b, a]
[b, a, c]
[b, c]
[b, c, a]
[c]
[c, a]
[c, a, b]
[c, b]
[c, b, a]

No

●問題82

集合を表すリスト Xs と Ys が等しいか判定する述語 seteql(Xs, Ys) を定義してください。

?- seteql([a, b, c], [a, b, c]).

Yes
?- seteql([a, b, c], [c, a, b]).

Yes
?- seteql([a, b, c], [a, b]).

No
?- seteql(Xs, [a,b,c]), write(Xs), nl, fail.
[a, b, c]
[a, c, b]
[b, a, c]
[b, c, a]
[c, a, b]
[c, b, a]

No

●問題83

集合を表すリスト Xs と Ys の排他的論理和を求める述語 exclusive_or(Xs, Ys, Zs) を定義してください。Zs は Xs と Ys の両方にちょうど 1 つだけ現れているような要素のリストになります。

?- exclusive_or([a, b, c, d], [c, d, e, f], Xs).

Xs = [a, b, e, f] ;

No

●問題84

集合を表すリスト Xs, Ys の直積集合を求める述語 product(Xs, Ys, Zs) を定義してください。Xs の要素を x_i, Ys 要素を y_j とすると、直積集合の要素は [x_i, y_j] となります。たとえば、Xs = [a, b, c], Ys = [1, 2] とすると、直積集合は[[a, 1], [a, 2], [b, 1], [b, 2], [c, 1], [c, 2]] になります。

?- product([a, b, c], [1, 2], L).

L = [[a, 1], [a, 2], [b, 1], [b, 2], [c, 1], [c, 2]] ;

No

●問題85

リスト Lsを生成する述語 make_list(N, Item, Ls) と tabulate(N, Pred, Ls) を定義してください。make_list は Item を N 個格納したリストを生成します。tabulate はリストの添字 (0 <= I < N) を述語 Pred に渡して実行し、その結果を格納したリストを生成します。

?- make_list(5, 1, Ls).

Ls = [1, 1, 1, 1, 1] ;

No
?- assert(identity(X, X)).

Yes
?- identity(1, X).

X = 1 ;

No
?- tabulate(8, identity, Ls).

Ls = [0, 1, 2, 3, 4, 5, 6, 7] ;

No
?- assert(square(X, A) :- A is X * X).

Yes
?- tabulate(8, square, Ls).

Ls = [0, 1, 4, 9, 16, 25, 36, 49] ;

No

●問題86

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

?- kakko(3, K), name(K1, K), write(K1), nl, fail.
((()))
(()())
(())()
()(())
()()()

No
?- kakko(4, K), name(K1, K), write(K1), nl, fail.
(((())))
((()()))
((())())
((()))()
(()(()))
(()()())
(()())()
(())(())
(())()()
()((()))
()(()())
()(())()
()()(())
()()()()

No

●問題87

バランスの取れた N 対のカッコ列の総数を求める述語 kakko_num(N, M) を定義してください。

?- between(1, 10, I), kakko_num(I, N), write(N), nl, fail.
1
2
5
14
42
132
429
1430
4862
16796

No

●解答68

リスト : 論理積、論理和、排他的論理和

log_and(0, 0, 0).
log_and(1, 0, 0).
log_and(0, 1, 0).
log_and(1, 1, 1).

log_or(0, 0, 0).
log_or(1, 0, 1).
log_or(0, 1, 1).
log_or(1, 1, 1).

log_xor(0, 0, 0).
log_xor(1, 0, 1).
log_xor(0, 1, 1).
log_xor(1, 1, 0).

Prolog の場合、事実を定義するだけで論理積、論理和、排他的論理和を実現できます。もちろん、ビット演算を使っても定義できますが、その場合は逆方向の演算ができなくなります。簡単な例を示しましょう。

?- assert(log_and(P, Q, Z) :- Z is P /\ Q).

Yes
?- log_and(1, 1, X).

X = 1 ;

No
?- log_and(1, 0, X).

X = 0 ;

No
?- log_and(P, Q, 1).
ERROR: is/2: Arguments are not sufficiently instantiated

●解答69

真理値表から S = P XOR Q, C = P AND Q であることがすぐにわかります。

リスト : 半加算器

half_adder(P, Q, S, C) :- log_xor(P, Q, S), log_and(P, Q, C).

これを論理回路で実現すると「半加算器」になります。S は 1 ビットの加算、C が桁上がりを表します。ただし、半加算器は入力が 2 つしかないので、下位の桁上がりを受け取ることができません。整数の加算回路を実現するには、次に示す全加算器を使います。

●解答70

R を桁上がりと考えると、真理値表は 1 ビットの加算を表していることがわかります。この真理値表を出力する論理回路を「全加算器」といいます。全加算器は 2 つの半加算器と OR を使って実現することができます。

リスト : 全加算器

full_adder(P, Q, R, C, E) :-
    half_adder(P, Q, A, B),
    half_adder(A, R, C, D),
    log_or(B, D, E).

最初に P と Q を half_adder で加算します。値は A, B にセットされます。次に、A と R を half_adder で加算します。値は C と D にセットします。加算の結果は C になり、桁上がり E は log_or(B, D, E) で求めることができます。

●解答71

リスト : 数値を M 桁の uint に変換

i_to_u(_, M, Acc, Acc) :- length(Acc, M), !.
i_to_u(Num, M, Acc, Uint) :-
    N is Num mod 2,
    Num1 is Num // 2,
    i_to_u(Num1, M, [N | Acc], Uint).
integer_to_uint(N, M, Uint) :- i_to_u(N, M, [], Uint).

実際の処理は述語 i_to_u で行います。引数 Acc が累積変数です。数値 Num の下位から順番にビットを取り出して Acc に格納します。そして、Acc のリストの長さが M になった時点で処理を終了します。

リスト : uint を数値に変換

u_to_i([], Acc, Acc).
u_to_i([X | Xs], Acc, Num) :-
    Acc1 is Acc * 2 + X,
    u_to_i(Xs, Acc1, Num).
uint_to_integer(Uint, Num) :- u_to_i(Uint, 0, Num).

実際の処理は述語 u_to_i で行います。引数 Acc が累積変数です。リストの要素 X を順番に取り出して、Acc * 2 + X を計算していくだけです。

●解答72

リスト : 論理演算

/* 論理積 */
uint_and([], [], []).
uint_and([X | Xs], [Y | Ys], [Z | Zs]) :-
    log_and(X, Y, Z),
    uint_and(Xs, Ys, Zs).

/* 論理和 */
uint_or([], [], []).
uint_or([X | Xs], [Y | Ys], [Z | Zs]) :-
    log_or(X, Y, Z),
    uint_or(Xs, Ys, Zs).

/* 排他的論理和 */
uint_xor([], [], []).
uint_xor([X | Xs], [Y | Ys], [Z | Zs]) :-
    log_xor(X, Y, Z),
    uint_xor(Xs, Ys, Zs).

/* 否定 */
log_not(0, 1).
log_not(1, 0).

uint_not([], []).
uint_not([X | Xs], [Y | Ys]) :-
    log_not(X, Y),
    uint_not(Xs, Ys).

uint_and, uint_or, uint_xor は簡単です。リストの先頭要素 X, Y を取り出して、対応する述語 log_and, log_or, log_xor で計算し、その結果 Z をリストに格納するだけです。uint_not は否定を表す述語 log_not を定義し、その計算結果をリストに格納するだけです。

●解答73

リスト : 加算

uint_add([X], [Y], [Z], C) :- half_adder(X, Y, Z, C).
uint_add([X | Xs], [Y | Ys], [Z | Zs], C) :-
    uint_add(Xs, Ys, Zs, C1),
    full_adder(X, Y, C1, Z, C).

uint_add は half_adder と full_adder を使うと簡単です。最初の規則はリストの要素がひとつだけになった場合です。half_adder で要素 X, Y を足し算します。その結果 Z をリストに格納します。桁上がりの値は C になります。次の規則で、リストの要素を順番に取り出します。まず、残りのリスト Xs, Ys を uint_add で足し算します。そして、桁上がりの値 C1 とリストの要素 X, Y を full_adder で足し算すればいいわけです。

●解答74

リスト : uint をインクリメントする

uint_inc([X], [Z], C) :- half_adder(X, 1, Z, C).
uint_inc([X | Xs], [Z | Zs], C) :-
    uint_inc(Xs, Zs, C1),
    half_adder(X, C1, Z, C).

uint_inc は uint_add とほとんど同じです。最初の規則でリストの要素がひとつだけになったら、half_adder でリストの要素 X と 1 を足し算します。次の規則でリストの要素 X を取り出します。uint_inc を再帰呼び出しして、残りのリスト Xs に 1 を加算します。そして、half_adder で要素 X と桁上がりの値 C1 を足し算すればいいわけです。

●解答75

減算は 2 の補数を使って計算します。簡単な例として 4 ビットの整数値を考えてみましょう。負の整数を 2 の補数で表した場合、4 ビットで表される整数は -8 から 7 になります。次の図を見てください。

 0 : 0000
 1 : 0001    -1 : 1111
 2 : 0010    -2 : 1110
 3 : 0011    -3 : 1101
 4 : 0100    -4 : 1100
 5 : 0101    -5 : 1011
 6 : 0110    -6 : 1010
 7 : 0111    -7 : 1001
             -8 : 1000

    図 : 2 の補数

2 の補数はビットを反転した値 (1 の補数) に 1 を加算することで求めることができます。たとえば 7 - 2 は 7 + (-2) = 0111 + 1110 = 1 0101 となり、桁上がりを無視すると値は 5 になります。また、15 - 14 は (-1) - (-2) = (-1) + 2 = 1111 + 0010 = 1 0001 となり、正しく計算することができます。

逆に、2 - 7 は 2 + (-7) = 0010 + 1001 = 1011 になります。この場合、2 の補数で考えると 1011 は -5 になるので、符号付き整数では正しい値になりますが、無符号整数で考えると桁借りが発生しています。したがって、減算したときの桁借りの有無は、加算したときの桁上がりの値を反転することで求めることができます。

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

リスト : 減算

uint_sub(Xs, Ys, Zs, C) :-
    uint_not(Ys, Ys1),
    uint_inc(Ys1, Ys2, _),
    uint_add(Xs, Ys2, Zs, C1),
    log_not(C1, C).

uint_not で 1 の補数を求め、uint_inc で +1 することで 2 の補数を求めることができます。あとは uint_add で Xs と加算するだけです。log_not で C1 の値を反転することをお忘れなく。

ところで、Prolog の場合は uint_add だけで減算を実現することができます。uint_add(Xs, Ys, Zs, C) は Xs + Ys = Zs を表していますが、これは Xs = Zs - Ys の関係でもあるわけです。実際に試してみましょう。

?- uint_add(X, [0,0,0,1], [0,0,0,0], C).

X = [1, 1, 1, 1],
C = 1 ;

No
?- uint_add(X, [0,0,0,1], [0,0,0,1], C).

X = [0, 0, 0, 0],
C = 0 ;

No
?- uint_add(X, [0,0,0,0], [0,0,0,1], C).

X = [0, 0, 0, 1],
C = 0 ;

No

最初の例は 0 - 1 = -1, 次の例は 1 - 1 = 0, 最後の例は 1 - 0 = 1 の場合です。正しく計算されていますね。

●解答76

リスト : 論理シフト

uint_srl(Xs, [0 | Zs], C) :- append(Zs, [C], Xs).
uint_sll([C | Xs], Ys, C) :- append(Xs, [0], Ys).

論理シフトは append だけで実現することができます。uint_srl は Xs を append で Zs と [C] に分割して、Zs の先頭に 0 を追加するだけです。uint_sll は uint を表すリストを [C | Xs] に分解して、append で Xs に [0] を追加するだけです。

●解答77

リスト : uint の比較関数

uint_equal(Xs, Ys) :- Xs == Ys.

/* 別解 */
uint_equal([], []).
uint_equal([X | Xs], [X | Ys]) :- uint_equal(Xs, Ys).

uint_greater([X | _], [Y | _]) :- X > Y, !.
uint_greater([X | Xs], [X | Ys]) :- uint_greater(Xs, Ys).

uint_lesser([X | _], [Y | _]) :- X < Y, !.
uint_lesser([X | Xs], [X | Ys]) :- uint_lesser(Xs, Ys).

uint_zero([]).
uint_zero([0 | Xs]) :- uint_zero(Xs).

uint_equal は演算子 == で Xs と Ys を比較するだけです。別解は、再帰定義で要素が等しいことを確かめています。uint_greater はリストの要素を先頭から順番に比較し、X > Y ならば成功します。次の規則で X と Y が等しい場合は uint_greater を再帰呼び出しします。同様に、uint_lesser もプログラムできます。unit_zero は要素がすべて 0 であれば成功します。

●解答78

筆算のアルゴリズムをそのまま 2 進数に適用します。たとえば、[1, 1, 0, 1] と [0, 1. 0, 1] の乗算は次のように計算します。

       1 1 0 1
 *       1 0 1
 --------------
       1 1 0 1
     0 0 0 0
   1 1 0 1
 -------------
 1 0 0 0 0 0 1

図 : 1101 * 101

このアルゴリズムはビットシフトと加算で実現することができます。桁あふれのチェックは行わないことにすると、プログラムは次のようになります。

リスト : uint の 乗算

/* 0 の作成 */
make_zero([], []).
make_zero([_ | Xs], [0 | Ys]) :- make_zero(Xs, Ys).

/* 乗算 */
uint_mul_sub(Xs, [1], Xs, Xs).
uint_mul_sub(Xs, [0], Xs, Ys) :- make_zero(Xs, Ys).
uint_mul_sub(Xs, [1 | Ys], Xs2, Zs) :-
    uint_mul_sub(Xs, Ys, Xs1, Zs1),
    uint_sll(Xs1, Xs2, _),
    uint_add(Zs1, Xs2, Zs, _).
uint_mul_sub(Xs, [0 | Ys], Xs2, Zs) :-
    uint_mul_sub(Xs, Ys, Xs1, Zs),
    uint_sll(Xs1, Xs2, _).
uint_mul(Xs, Ys, Ans) :- uint_mul_sub(Xs, Ys, _, Ans).

実際の処理は述語 uint_mul_sub で行います。第 3 引数は第 1 引数を左シフトした値に、第 4 引数は乗算した結果になります。第 2 引数が [1] の場合、第 3, 4 引数の値は Xs になります。[0] の場合、第 4 引数の値は 0 になります。述語 make_zero で値が 0 の uint を生成します。

第 2 引数の先頭要素が 1 の場合、残りのリスト Ys と Xs の乗算を、uint_mul_sub を再起呼び出しして求めます。次に、uint_sll で Xs1 を左シフトします。そして、uint_add で Zs1 と Xs2 を足し算します。第 2 引数の先頭要素が 0 の場合、足し算は行わないで Xs1 を uint_sll で左シフトするだけです。

●解答79

筆算のアルゴリズムをそのまま 2 進数に適用します。次の図を見てください。

     1 0 1 0 1
---------------
 1 1 0 1 0 1 1
 1 0 1 0 0 0 0
---------------
     1 1 0 1 1
     1 0 1 0 0
   ------------
         1 1 1
         1 0 1
         ------
           1 0


図 : 1101011 / 101

x (1101011) を y (101) で除算する場合、最初に y を左シフトして桁合わせを行います。上図の場合、1101011 から y を 4 ビットシフトした値 z (1010000) を引き算して余り q が 11011 になります。このとき、商 p に 1 をセットします。次に、z を右へ 1 ビットシフトした 101000 と q を比較します。この場合、q のほうが小さいので引き算できません。p の値は左へ 1 ビットシフトして 10 になります。

あとは同様に、z を右へ 1 ビットシフトして q と比較します。引き算できる場合は p を左へ 1 ビットシフトしてから値を +1 します。引き算できない場合は p を左へ 1 ビットシフトするだけです。上図の場合、10100 は 11011 よりも小さいので、p の値は 101 になり、q の値は 111 になります。次に、1010 は 111 よりも大きいので p の値は 1010 になります。最後に、101 は 111 よりも小さいので、p の値は 10101 になり、q の値は 10 になります。これで商 p と余り q を求めることができます。

プログラムは再帰定義を使うと簡単です。次のリストを見てください。

リスト : uint の除算

/* uint で 1 を作る */
make_one([_], [1]).
make_one([_ | Xs], [0 | Ys]) :- make_one(Xs, Ys).

uint_div(Xs, Ys, P, Xs) :-
    uint_lesser(Xs, Ys), make_zero(Xs, P), !.
uint_div(Xs, Ys, P, Q) :-
    uint_equal(Xs, Ys), make_one(Xs, P), make_zero(Xs, Q), !.
uint_div(Xs, [1 | Ys], P, Q) :-
    make_one(Xs, P), uint_sub(Xs, [1 | Ys], Q, _), !.
uint_div(Xs, Ys, P, Q) :-
    uint_sll(Ys, Ys1, _),
    uint_div(Xs, Ys1, P1, Q1),
    (uint_lesser(Q1, Ys) ->
        (uint_sll(P1, P, _), Q = Q1)
      ;
        (uint_sll(P1, P2, _), uint_inc(P2, P, _), uint_sub(Q1, Ys, Q, _))).

uint_div は再帰呼び出しするたびに引数 Ys を 1 ビット左シフトして桁合わせを行います。最初の規則で、Xs が Ys よりも小さい場合は除算できないので、商は 0 で余りは Xs になります。次の規則で、Xs と Ys が等しい場合は割り切れるので、商は 1 で余りは 0 になります。1 は述語 make_one で生成します。3 番目の規則で、Ys の MSB が 1 の場合、商は 1 で余りが Xs - Ys になります。

これ以外の場合、Ys を 1 ビット左シフトして uint_div を再帰呼び出しします。余り Q1 が Ys よりも小さい場合、P1 を 1 ビット左シフトした値が商 P になり、Q1 が余り Q になります。そうでなければ、P1 を 1 ビット左シフトしてから +1 した値が商 P になり、余り Q は Q1 - Ys になります。

●解答80

リスト : べき集合

power_set_sub([], []).
power_set_sub([_ | Xs], Ys) :- power_set_sub(Xs, Ys).
power_set_sub([X | Xs], [X | Ys]) :- power_set_sub(Xs, Ys).

power_set(Ls, Xs) :- findall(X, power_set_sub(Ls, X), Xs).

実際の処理は述語 power_set_sub で行います。最初の規則は空集合のべき集合は空集合であることを表しています。これが再帰呼び出しの停止条件になります。2 番目の規則は先頭要素を取り除いたリスト Xs のべき集合を求めます。3 番目の規則は、先頭要素を取り除いたリスト Xs のべき集合 Ys を求め、Ys の先頭に X を追加します。あとは findall で power_set_sub を呼び出して、生成した要素をリストに格納するだけです。

●解答81

リスト : 部分集合の判定 */

subset([], Ys).
subset([X | Xs], Ys) :- select(X, Ys, Ys1), subset(Xs, Ys1).

subset は select を使えば簡単に定義できます。最初の規則は、「空集合は Ys の部分集合である」ということを表しています。これが再帰呼び出しの停止条件となります。次の規則で、リストの先頭要素 X が Ys の要素であることを select で確認し、それから Xs が Ys1 の部分集合であることを subset で確認すればいいわけです。

●解答82

リスト : 等しい集合か

seteql(Xs, Ys) :- subset(Xs, Ys), subset(Ys, Xs).

seteql は subset を使って簡単に定義することができます。subset(Xs, Ys) が真で、かつ subset(Ys, Xs) が真であれば、Xs と Ys は等しい集合であることがわかります。

●解答83

リスト : 排他的論理和

exclusive_or(Xs, Ys, Zs):-
    difference(Xs, Ys, Zs1),
    difference(Ys, Xs, Zs2),
    union(Zs1, Zs2, Zs).

exclusive_or は union と difference を使って簡単に定義することができます。Xs と Ys の差集合 Zs1 は Xs にしか属していない要素になります。同様に、Ys と Xs の差集合 Zs2 は Ys にしか属していない要素になります。あとは、union で Zs1 と Zs2 の和集合を求めればいいわけです。

●解答84

リスト : 直積集合

product_sub(Xs, Ys, [X, Y]) :- member(X, Xs), member(Y, Ys).
product(Xs, Ys, Zs) :- findall(Z, product_sub(Xs, Ys, Z), Zs).

述語 product は要素を生成する述語 product_sub(Xs, Ys, Z) を定義すると簡単です。要素は member でリストの要素を取り出し、それを組み合わせるだけです。あとは findall で生成した要素 Z をリスト Zs に格納するだけです。

●解答85

リスト : リストの生成

make_list(0, _, []).
make_list(N, X, [X | Xs]) :-
    N > 0, N1 is N - 1, make_list(N1, X, Xs).

tabulate_sub(N, N, _, []).
tabulate_sub(I, N, Pred, [X | Ys]) :-
    I < N,
    G =.. [Pred, I, X],
    call(G),
    I1 is I + 1,
    tabulate_sub(I1, N, Pred, Ys).
tabulate(N, Pred, Ls) :- tabulate_sub(0, N, Pred, Ls).

make_list は簡単です。最初の規則は、個数 N が 0 の場合です。生成されるリストは空リストで、これが再帰呼び出しの停止条件になります。次の規則で、N を -1 して make_list を再帰呼び出しします。そして、リスト Xs の先頭に X を追加すればいいわけです。

tabulate は高階述語 =.. と call を使って述語 Pred を呼び出します。高階述語の説明は、拙作のページ「高階プログラミング」をお読みください。実際の処理は述語 tabulate_sub で行います。最初の規則が再帰呼び出しの停止条件です。次の規則で、最初の引数が添字を表します。G =.. [Pred, I, X] でゴールを組み立て、それを call(G) で実行します。値は変数 X に格納されるので、それをリスト Ys の先頭に追加します。あとは I を +1 して tabulate_sub を再帰呼び出しします。

●解答86

リスト : カッコ列の生成

kakko_sub(X, Y, M, Acc, Ans) :-
    X =:= Y,
    Y =:= M,
    reverse(Acc, Ans).
kakko_sub(X, Y, M, Acc, Ans) :-
    X < M,
    X1 is X + 1,
    kakko_sub(X1, Y, M, ['(' | Acc], Ans).
kakko_sub(X, Y, M, Acc, Ans) :-
    Y < X,
    Y1 is Y + 1,
    kakko_sub(X, Y1, M, [')' | Acc], Ans).

kakko(M, Ks) :- kakko_sub(0, 0, M, [], Ks).

カッコ列の生成は簡単です。実際の処理は述語 kakko_sub で行います。kakko_sub の引数 X が左カッコの個数、引数 Y が右カッコの個数を表します。引数 Acc は累積変数で、アトム '(', ')' を格納したリストです。

バランスの取れたカッコ列の場合、X, Y, M には Y <= X <= M の関係が成り立ちます。最初の規則が X = Y = M の場合で、カッコ列がひとつ完成しました。reverse でリスト Acc を反転します。2 番目の規則は X < M の場合です。Acc に左カッコを追加して kakko_sub を再帰呼び出しします。3 番目の規則が Y < X の場合です。Acc に右カッコを追加します。これでカッコ列を生成することができます。

●解答87

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

\( \mathrm{C}_n = \dfrac{(2n)!}{(n+1)!n!} \)

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

                    Ｂ                      Ｂ  
  ┌─┬─┬─┬─┐      ┌─┬─┬─０─14    
  │  │  │  │  │      │  │  │  │  │    
  ├─┼─┼─┼─┤      ├─┼─０─５─14    
  │  │  │  │  │      │  │  │  │  │    
  ├─┼─┼─┼─┤      ├─０─２─５─９    
  │  │  │  │  │      │  │  │  │  │    
  ├─┼─┼─┼─┤      ０─１─２─３─４    
  │  │  │  │  │      │  │  │  │  │    
  └─┴─┴─┴─┘      １─１─１─１─１    
Ａ                      Ａ                      

            図 : 道順の総数の求め方

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

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

リスト : カッコ列の総数

kakko_num1([], Ys, Zs) :- reverse(Ys, Zs).
kakko_num1([X | Xs], [Y | Ys], Zs) :-
    N is X + Y,
    kakko_num1(Xs, [N, Y | Ys], Zs).

kakko_num2([N], N) :- !.
kakko_num2([_ | Xs], N) :-
    kakko_num1(Xs, [0], [_ | Zs]),
    kakko_num2(Zs, N).

kakko_num(M, N) :- 
    M1 is M + 1,
    make_list(M1, 1, L),
    kakko_num2(L, N).

最初に make_list で一番下の地点の道順の総数 (1) を格納したリスト生成します。これが kakko_num2 の引数の初期値になります。引数 M のカラタン数を求める場合、リストの大きさは M + 1 になります。あとは、リストの要素がひとつになるまで kakko_num2 を再帰呼び出しします。

述語 kakko_num1 は一段上の地点の値を求めます。第 1 引数に先頭要素を取り除いたリスト、第 2 引数が累積変数、第 3 引数が一段上の値を格納したリストです。累積変数に求めた値を格納します。累積変数の初期値は [0] で、先頭要素が左側の地点の値になります。あとは、第 1 引数の先頭要素と第 2 引数の先頭要素を足し算して、その値を累積変数の先頭に追加していけば、一段上の値を求めることができます。

なお、累積変数のリストは逆順になるので、第 1 引数が空リストになったら reverse で反転します。また、kakko_num1 で求めたリストの先頭要素は 0 になるので、それを取り除くことに注意してください。これでカッコ列の総数 (カラタン数) を求めることができます。

お気楽 Prolog プログラミング入門