プログラム断片（2008/06/03）

for VisualWorks 7.6 with Jun780, Prologインタプリタのマニュアル(PDF)

最大公約数と最小公倍数

２つ以上の正の整数に共通な約数（公約数）のうち最大のものが最大公約数（gcd: greatest common divisor）
２つ以上の正の整数の共通な倍数（公倍数）のうち最小のものが最小公倍数（lcm: least common multiple）

?- remove.
gcd(M,0,M).
gcd(M,N,G) :-
        integer(M),
        integer(N),
        >(M,0),
        >(N,0),
        \\(M,N,R),
        gcd(N,R,G).
lcm(M,N,L) :-
        gcd(M,N,G),
        //(M,G,V),
        *(V,N,L).
?- clear.
?- gcd(12,8,G).
?- gcd(36,27,G).
?- gcd(208,117,G).
?- gcd(24,36,A), gcd(A,54,G).
?- lcm(12,8,L).
?- lcm(36,27,L).
?- lcm(208,117,L).
?- lcm(12,18,A), lcm(A,27,L).

yes
?- gcd(12,8,G).
G = 4 ;
no
?- gcd(36,27,G).
G = 9 ;
no
?- gcd(208,117,G).
G = 13 ;
no
?- gcd(24,36,A), gcd(A,54,G).
A = 12 ,
G = 6 ;
no
?- lcm(12,8,L).
L = 24 ;
no
?- lcm(36,27,L).
L = 108 ;
no
?- lcm(208,117,L).
L = 1872 ;
no
?- lcm(12,18,A), lcm(A,27,L).
A = 36 ,
L = 108 ;
no

階乗

?- remove.
factorial(0,1).
factorial(N,F) :- 
        integer(N), 
        >(N,0), 
        -(N,1,M), 
        factorial(M,R), 
        *(N,R,F).
factorials(N) :- 
        integer(N), 
        >=(N,0), 
        factorial(N,X), 
        write(N), 
        write("! = "), 
        write(X), 
        nl, 
        -(N,1,M), 
        factorials(M).
?- clear.
?- factorials(36).

yes
?- factorials(36).
36! = 371993326789901217467999448150835200000000
35! = 10333147966386144929666651337523200000000
34! = 295232799039604140847618609643520000000
33! = 8683317618811886495518194401280000000
32! = 263130836933693530167218012160000000
31! = 8222838654177922817725562880000000
30! = 265252859812191058636308480000000
29! = 8841761993739701954543616000000
28! = 304888344611713860501504000000
27! = 10888869450418352160768000000
26! = 403291461126605635584000000
25! = 15511210043330985984000000
24! = 620448401733239439360000
23! = 25852016738884976640000
22! = 1124000727777607680000
21! = 51090942171709440000
20! = 2432902008176640000
19! = 121645100408832000
18! = 6402373705728000
17! = 355687428096000
16! = 20922789888000
15! = 1307674368000
14! = 87178291200
13! = 6227020800
12! = 479001600
11! = 39916800
10! = 3628800
9! = 362880
8! = 40320
7! = 5040
6! = 720
5! = 120
4! = 24
3! = 6
2! = 2
1! = 1
0! = 1
no

フィボナッチ数

?- remove.
fibonacci(0,0).
fibonacci(1,1).
fibonacci(N,F) :- 
        integer(N), 
        >(N,1), 
        -(N,1,N1), 
        -(N,2,N2), 
        fibonacci(N1,A1), 
        fibonacci(N2,A2), 
        +(A1,A2,F).
fibonaccies(N) :- 
        integer(N), 
        >=(N,0), 
        fibonacci(N,X), 
        write("fib("), 
        write(N), 
        write(") = "), 
        write(X), 
        nl, 
        -(N,1,M), 
        fibonaccies(M).
?- clear.
?- fibonaccies(10).

yes
?- fibonaccies(10).
fib(10) = 55
fib(9) = 34
fib(8) = 21
fib(7) = 13
fib(6) = 8
fib(5) = 5
fib(4) = 3
fib(3) = 2
fib(2) = 1
fib(1) = 1
fib(0) = 0
no

上記のプログラムでは2ⁿ乗のオーダーで計算量が増加します。おそらく20よりも上のフィボナッチ数を求めるのに、ものすごい手間がかかるようになります。それを軽減するためには連想計算という手法を用いるのが効果的です。得られた計算結果を登録して（assertaで連想表を作って）おき、再計算に利用するのです。そうすれば、100ぐらいのフィボナッチ数であろうとも容易に求めることができます。

?- remove.
fibonacci(0,0).
fibonacci(1,1).
fibonacci(N,F) :- 
        integer(N), 
        >(N,1), 
        -(N,1,N1), 
        -(N,2,N2), 
        fibonacci(N1,A1), 
        fibonacci(N2,A2), 
        +(A1,A2,F),
        asserta([fibonacci(N,F) :- !]).
fibonaccies(N) :- 
        integer(N), 
        >=(N,0), 
        fibonacci(N,X), 
        write("fib("), 
        write(N), 
        write(") = "), 
        write(X), 
        nl, 
        -(N,1,M), 
        fibonaccies(M).
?- clear.
?- fibonaccies(50).

yes
?- fibonaccies(50).
fib(50) = 12586269025
fib(49) = 7778742049
fib(48) = 4807526976
fib(47) = 2971215073
fib(46) = 1836311903
fib(45) = 1134903170
fib(44) = 701408733
fib(43) = 433494437
fib(42) = 267914296
fib(41) = 165580141
fib(40) = 102334155
fib(39) = 63245986
fib(38) = 39088169
fib(37) = 24157817
fib(36) = 14930352
fib(35) = 9227465
fib(34) = 5702887
fib(33) = 3524578
fib(32) = 2178309
fib(31) = 1346269
fib(30) = 832040
fib(29) = 514229
fib(28) = 317811
fib(27) = 196418
fib(26) = 121393
fib(25) = 75025
fib(24) = 46368
fib(23) = 28657
fib(22) = 17711
fib(21) = 10946
fib(20) = 6765
fib(19) = 4181
fib(18) = 2584
fib(17) = 1597
fib(16) = 987
fib(15) = 610
fib(14) = 377
fib(13) = 233
fib(12) = 144
fib(11) = 89
fib(10) = 55
fib(9) = 34
fib(8) = 21
fib(7) = 13
fib(6) = 8
fib(5) = 5
fib(4) = 3
fib(3) = 2
fib(2) = 1
fib(1) = 1
fib(0) = 0
no

?- clear, listing(fibonacci).

以下のLispとSmalltalkのリフレクティブなフィボナッチ数の計算プログラムもたどってみてください。

集合算

?- remove.
union(X,[],X) :- 
        !.
union([],Y,Y) :- 
        !.
union([X|U],Y,Z) :- 
        member(X,Y), 
        !, 
        union(U,Y,Z).
union([X|U],Y,[X|V]) :- 
        union(U,Y,V).
intersection(X,[],[]) :- 
        !.
intersection([],Y,[]) :- 
        !.
intersection([X|U],Y,[X|V]) :- 
        member(X,Y), 
        !, 
        intersection(U,Y,V).
intersection([X|U],Y,Z) :- 
        intersection(U,Y,Z).
set([],[]) :- 
        !.
set([X|U],Y) :- 
        set(U,V), 
        union([X],V,Y).
?- clear.
?- union([1,2,3,4],[0,5,2,3,1],X).
?- intersection([1,2,3,4],[0,5,2,3,1],X).
?- set([1,2,3,4,3,2,1,0,5,2,3,1],X).

yes
?- union([1,2,3,4],[0,5,2,3,1],X).
X = [4,0,5,2,3,1] ;
no
?- intersection([1,2,3,4],[0,5,2,3,1],X).
X = [1,2,3] ;
no
?- set([1,2,3,4,3,2,1,0,5,2,3,1],X).
X = [4,0,5,2,3,1] ;
no

数リストの分割

?- remove.
split(N,[H|T],[H|L1],L2) :- 
        <(H,N), 
        split(N,T,L1,L2).
split(N,[H|T],L1,[H|L2]) :- 
        >=(H,N), 
        split(N,T,L1,L2).
split(N,[],[],[]).
?- clear.
?- split(4,[1,6,4,3,5,2,7],L1,L2).
?- split(44,[33,55,22,77,88,11],L1,L2).

yes
?- split(4,[1,6,4,3,5,2,7],L1,L2).
L1 = [1,3,2] ,
L2 = [6,4,5,7] ;
no
?- split(44,[33,55,22,77,88,11],L1,L2).
L1 = [33,22,11] ,
L2 = [55,77,88] ;
no

数リストの整列

?- remove.
split(N,[H|T],[H|L1],L2) :- 
        <(H,N), 
        split(N,T,L1,L2).
split(N,[H|T],L1,[H|L2]) :- 
        >=(H,N), 
        split(N,T,L1,L2).
split(N,[],[],[]).
quicksort([],[]).
quicksort([H|T],S) :- 
        split(H,T,U1,U2), 
        quicksort(U1,V1), 
        quicksort(U2,V2), 
        append(V1,[H|V2],S).
?- clear.
?- quicksort([8,1,6,0,4,3,5,2,7,9],X).
?- quicksort([9,8,7,6,5,4,3,2,1,0],X).

yes
?- quicksort([8,1,6,0,4,3,5,2,7,9],X).
X = [0,1,2,3,4,5,6,7,8,9] ;
no
?- quicksort([9,8,7,6,5,4,3,2,1,0],X).
X = [0,1,2,3,4,5,6,7,8,9] ;
no

主語と好物を求める

?- remove.
likes(john, apple).
likes(john, wine).
likes(john, mary).
likes(mary, wine).
likes(mary, john).
subjects(~) :- 
        assert(result([])), 
        likes(X,~), 
        result(Z), 
        not(member(X,Z)), 
        retract(result(Z)), 
        assert(result([X|Z])), 
        fail.
subjects(X) :- 
        result(X), 
        retract(result(X)).
favorites(~) :- 
        assert(result([])), 
        likes(~,Y), 
        result(Z), 
        not(member(Y,Z)), 
        retract(result(Z)), 
        assert(result([Y|Z])), 
        fail.
favorites(X) :- 
        result(X), 
        retract(result(X)).
?- clear.
?- subjects(X).
?- favorites(X).

yes
?- subjects(X).
X = [mary,john] ;
no
?- favorites(X).
X = [john,mary,wine,apple] ;
no

経路探索（未完成なので完成させてください）

?- remove.
connect(entrance,a).
connect(a,b).
connect(a,h).
connect(b,c).
connect(b,i).
connect(c,j).
connect(d,e).
connect(d,k).
connect(e,f).
connect(f,g).
connect(f,m).
connect(h,i).
connect(h,o).
connect(i,j).
connect(j,k).
connect(j,q).
connect(k,l).
connect(k,r).
connect(m,n).
connect(m,t).
connect(p,w).
connect(r,y).
connect(s,t).
connect(s,z).
connect(t,u).
connect(v,w).
connect(w,x).
connect(x,y).
connect(v,exit).
connect(z,exit).
route(exit,P,R) :- 
        reverse(P,R).
route(X,P,R) :- 
        作成してください.
route(X,P,R) :- 
        作成してください.
route(R) :- 
        route(entrance,[entrance],R).
?- clear.
?- route(X).

yes
?- route(X).
X = [entrance,a,b,c,j,k,r,y,x,w,v,exit] ;
X = [entrance,a,b,c,j,k,d,e,f,m,t,s,z,exit] ;
X = [entrance,a,b,i,j,k,r,y,x,w,v,exit] ;
X = [entrance,a,b,i,j,k,d,e,f,m,t,s,z,exit] ;
X = [entrance,a,h,i,j,k,r,y,x,w,v,exit] ;
X = [entrance,a,h,i,j,k,d,e,f,m,t,s,z,exit] ;
X = [entrance,a,h,i,b,c,j,k,r,y,x,w,v,exit] ;
X = [entrance,a,h,i,b,c,j,k,d,e,f,m,t,s,z,exit] ;
no

for VisualWorks 7.6 with Jun780, Prologインタプリタのマニュアル(PDF)

Updated: 2015/11/08 (Created: 2008/06/03)