:- module(_,_). %% :- use_package([functions]). %% :- use_package(rstep). :- set_prolog_flag(multi_arity_warnings,off). :- set_prolog_flag(single_var_warnings,off). :- use_module(library(format)). :- use_module(library(lists),[append/3]). :- use_module(library(aggregates)). % ------------------------------------------------------------------- % Occurs-check main :- X = f(X), Y = f(Y), X=Y, write(X). % ------------------------------------------------------------------- % Operators :- op(500,xfx,is_father_of). john is_father_of peter. % is_father_of(john, peter). peter is_father_of jim. %% :- op(1100,fx,[load,mult,bne]). %% :- op( 500,fx,@). %% :- op( 500,xfx,@). %% %% label1 : load @r3,r1. %% load 5,r2. %% mult r1,r2. %% bne 0,label1. % ------------------------------------------------------------------- % The execution rules / search tree / debugger grandparent(C,G) :- parent(C,P), parent(P,G). parent(C,P) :- father(C,P). parent(C,P) :- mother(C,P). father(charles, philip). father(ana, george). mother(charles, ana). % ------------------------------------------------------------------- permutation([], []). permutation([H|T], [H1|T1]):- select_el(H1, [H|T], R), permutation(R, T1). select_el(H, [H|T], T). select_el(H1, [H|T], [H|T1]):- select_el(H1, T, T1). % Queries: % permutation([a,b,c], L). % select_el(X, [a,b,c]). % ------------------------------------------------------------------- mylist([_|T]) :- mylist(T). mylist([]). mymember(X,[X|_]). mymember(X,[_|T]) :- mymember(X,T). % Queries. % mymember(c,[a,b,c]). % mymember(d,[a,b,c]). % mymember(X,[a,b,c]). mymember2(X,Y) :- Y = [X|_]. mymember2(X,Y) :- Y = [_|T], mymember2(X,T). % ------------------------------------------------------------------- % pfactorial(s(s(s(s(s(0))))),_). % pfactorial(s(s(s(s(s(s(0)))))),_). % factorial(6,_). % factorial(1000,_). pfactorial(0,s(0)). pfactorial(s(N),F):- pfactorial(N,F1), ptimes(s(N),F1,F). ptimes(0,_,0). ptimes(s(X),Y,Z) :- pplus(W,Y,Z), ptimes(X,Y,W). pplus(0,Y,Y). pplus(s(X),Y,s(Z)) :- pplus(X,Y,Z). %% Multiple uses: %% pplus(s(s(0)),s(0),Z). %% pplus(s(s(0)),Y,s(0)). %% pplus(s(0),Y,s(s(s(0)))). %% %% Multiple solutions: %% pplus(X,Y,s(s(s(0)))). factorial(0,1). factorial(N,F):- N > 0, N1 is N-1, factorial(N1,F1), F is F1*N. % Queries: % factorial(3,F). % factorial(N,6). % ERROR! wrong_factorial(0,1). wrong_factorial(N,F):- N > 0, N1 is N-1, F is F1*N, wrong_factorial(N1,F1). % wrong_factorial(3,F). % ------------------------------------------------------------------- plus(X,Y,Z):- Z is X + Y. % Queries % plus(4,5,Z). % plus(X,5,9). % ------------------------------------------------------------------- plus2(X,Y,Z):- number(X),number(Y), Z is X + Y. plus2(X,Y,Z):- number(X),number(Z), Y is Z - X. plus2(X,Y,Z):- number(Y),number(Z), X is Z - Y. % Queries % plus2(4,5,Z). % plus2(X,5,9). % plus2(X,Y,9). % ------------------------------------------------------------------- % _T=date(9,February,1947), arg(3,_T,X). % _T=date(9,February,1947), _T=date(_,_,X). % functor(Array,array,5), arg(1,Array,black), arg(5,Array,white). % arg(2, [a,b,c,d], X). % ------------------------------------------------------------------- subterm(Term,Term). subterm(Sub,Term):- functor(Term,_F,N), subterm_arg(N,Sub,Term). subterm_arg(N,Sub,Term):- arg(N,Term,Arg), % also checks N > 0 (arg/1 fails otherwise!) subterm(Sub,Arg). subterm_arg(N,Sub,Term):- N>1, N1 is N-1, subterm_arg(N1,Sub,Term). %% subterm( f(a) , g(b,f(a)) ). %% subterm( f(b) , g(b,f(a)) ). %% subterm( g(b,f(a)) , g(b,f(a)) ). %% subterm( X , g(b,f(a)) ). %% subterm( f(X) , g(b,f(a)) ). %% subterm( X , g(X,f(a)) ). %% subterm( f(X) , g(b,f(X)) ). % ------------------------------------------------------------------- add_arrays(A1,A2,A3):- functor(A1,array,N), functor(A2,array,N), functor(A3,array,N), add_elements(N,A1,A2,A3). add_elements(0,_A1,_A2,_A3). add_elements(I,A1,A2,A3):- I>0, arg(I,A1,X1), arg(I,A2,X2), arg(I,A3,X3), X3 is X1 + X2, I1 is I - 1, add_elements(I1,A1,A2,A3). %% add_arrays(array(1,2,3),array(4,5,6),R). %% add_arrays(array(1,2,3),array(4,5,6),array(5,7,9)). %% add_arrays(array(1,2,3),array(4,5),R). add_lists([],[],[]). add_lists([X|Xs],[Y|Ys],[Z|Zs]):- Z is X + Y, add_lists(Xs,Ys,Zs). %% add_lists([1,2,3],[4,5,6],R). %% add_arrays_lists([1,2,3],[4,5,6],[5,7,9]). %% add_lists([1,2,3],[4,5],R). % ------------------------------------------------------------------- %% date(9,february,1947) =.. L. %% T =.. [date,9,february,1947]. %% _F = '+', X =.. [_F,a,b]. deriv(sin(X),X,cos(X)). deriv(cos(X),X,-sin(X)). deriv(FG_X, X, DF_G * DG_X):- FG_X =.. [_, G_X], deriv(FG_X, G_X, DF_G), deriv(G_X, X, DG_X). %% deriv(sin(cos(x)),x,D). %------------------------------------------------------------------- /* ?- name('1', X), name(Y, X). X = [49], Y = 1 ? yes ?- atom_codes(7, L). {ERROR: atomic_basic:atom_codes/2, arg 1 - expected an non-numeric atom, found 7} no ?- atom_codes('7', L). L = [55] ? yes ?- number_codes('7', L). {ERROR: atomic_basic:number_codes/2, arg 1 - expected a number, found 7} no ?- number_codes(7, L). L = [55] ? yes ?- number_codes(X, [55]). X = 7 ? yes ?- atom_codes(X, [55]). X = '7' ? yes */ % ------------------------------------------------------------------- subterm_ng(Sub,Term) :- Sub == Term. subterm_ng(Sub,Term):- nonvar(Term), functor(Term,_F,N), subterm_ng(N,Sub,Term). subterm_ng(N,Sub,Term):- arg(N,Term,Arg), % also checks N > 0 (arg/1 fails otherwise!) subterm_ng(Sub,Arg). subterm_ng(N,Sub,Term):- N>1, N1 is N-1, subterm_ng(N1,Sub,Term). %% subterm_ng( f(a) , g(b,f(a)) ). %% subterm_ng( f(b) , g(b,f(a)) ). %% subterm_ng( g(b,f(a)) , g(b,f(a)) ). %% subterm_ng( X , g(b,f(a)) ). %% subterm_ng( f(X) , g(b,f(a)) ). %% subterm_ng( X , g(X,f(a)) ). %% subterm_ng( f(X) , g(b,f(X)) ). % ------------------------------------------------------------------- insert([], Item, [Item]). insert([H|T], Item, [H|T]):- H == Item. insert([H|T], Item, [Item, H|T]):- H @> Item. insert([H|T], Item, [H|NewT]) :- H @< Item, insert(T, Item, NewT). % insert([], a, L). % insert([a,b,e], c, L). % insert([a,b,e], X, L). insert_unif([], Item, [Item]). insert_unif([H|T], Item, [H|T]):- H = Item. insert_unif([H|T], Item, [Item, H|T]):- H @> Item. insert_unif([H|T], Item, [H|NewT]) :- H @< Item, insert_unif(T, Item, NewT). % insert_unif([], a, L). % insert_unif([a,b,e], c, L). % insert_unif([a,b,e], X, L). %--------------------------------------------------------------------- length(Xs,N):- var(Xs), integer(N), length_num(N,Xs). length(Xs,N):- nonvar(Xs), length_list(Xs,N). length_num(0,[]). length_num(N,[_|Xs]):- N > 0, N1 is N - 1, length_num(N1,Xs). length_list([],0). length_list([X|Xs],N):- length_list(Xs,N1), N is N1 + 1. % length_list(L,3). % -------------------------------------- % I/O write_list_to_file(L,F) :- telling(OldOutput), % Grab current output stream. tell(F), write_list(L), told, % Write into F, close. tell(OldOutput). % Reset previous output stream. write_list([]). write_list([X|Xs]):- write_canonical(X), write('.'), nl, write_list(Xs). %% write_list([X|Xs]):- write(X), nl, write_list(Xs). % -------------------------------------- % Examples of cut. s(a). s(b). l(a). r(a). r(b). m(c). p(X,Y):- l(X),l(Y). p(X,Y):- r(X),!,r(Y). p(X,_):- m(X). % Queries: s(A),p(B,C). % s(A),B=c,p(B,C). % -------------------------------------- % white cuts. wmax(X,Y,X):- X > Y, !. wmax(X,Y,Y):- X =< Y. % -------------------------------------- % green cuts. membercheck(X,[X|_]) :- !. membercheck(X,[_|T]) :- membercheck(X,T). lmember(X,[X|_]). lmember(X,[_|T]) :- lmember(X,T). % -------------------------------------- % red cuts. rmax(X,Y,X):- X > Y, !. rmax(_,Y,Y). % ?- mymax(5,2,2). mymax(X,Y,M):- X > Y, !, M=X. mymax(X,Y,Y). % X =< Y. Red cut! itemax(X,Y,M) :- ( X>Y -> M=X ; M=Y). newmax(X,Y,Z) :- X > Y, !, Z = X. newmax(_,Y,Z) :- % X =< Y, Z = Y. days_in_year(X,366):- leap_year(X),!. days_in_year(X,365). leap_year(X):- number(X), 0 is X mod 4. % -------------------------------------- % more examples of cut. Splitting a list. split([],[],[]). split([X|L],[X|L1],L2):- X >= 0,!, split(L,L1,L2). split([X|L],L1,[X|L2]):- split(L,L1,L2). % First, test it without cut % Then, test again with cut % queries: split([1,-1,3],L1,L2). % split([1,-1,3],L1,L2),!. % -------------------------------------- k_1sol(X) :- k(X), !. k(a). k(b). % ------------------------------------------------------------------- % Meta-calls: call/1 example apply(P,Args) :- G =.. [P|Args], call(G). p(a). p(b). %% :- use_package(hiord). maplist(_P,[]). maplist(P,[Tuple|RTuples]) :- apply(P,Tuple), %% P(Tuple), maplist(P,RTuples). % query: % ?- maplist(append, [ [ [a],[c,d], X ], % [ X, [e,f], Y ], % [ X, Y, Z ] ]). myappend([],L,L). myappend([X|Y],Z,[X|W]) :- myappend(Y,Z,W). % ------------------------------------------------------------------- % Meta-calls: setof/3, bagof/3, findall/3 examples :- dynamic likes/2. likes(bill, cider). likes(dick, beer). likes(tom, beer). likes(tom, cider). likes(harry, beer). likes(jan, cider). %% setof(X, likes(X,Y), S). %% setof(X, Y^likes(X,Y), S). %% bagof(X, likes(X,Y), S). %% findall(X, likes(X,Y), S). %% bagof(X, Y^likes(X,Y), S). %% bagof(X, likes(X,water),S). % fails %% findall(X, likes(X,water),S). %% setof(X, member(X,[d,a,b,c,b,d]), L). %% bagof(X, member(X,[d,a,b,c,b,d]), L). %% findall(X, (member(X,[d,a,b,c,b,d]), X @< c), L). % ------------------------------------------------------------------- % Meta-calls: setof/3 example. subset([],[]). subset([X|Xs],[X|Ys]):- subset(Xs,Ys). subset([_|Xs],Ys):- subset(Xs,Ys). powerset(Set,Pset):- setof(X,subset(Set,X),Pset). % ------------------------------------------------------------------- % Negation as failure unmarried_student(X) :- \+ married(X), student(X). student(joe). married(john). better_unmarried_student(X) :- not(married(X)), student(X). not(G) :- ground(G), !, \+ call(G). % not_(G). not(G) :- write('ERROR: Non-ground goal in negation: '), write(G), abort. %% not(G) :- ( ground(G) -> \+ call(G) %% ; write('ERROR: Non-ground goal in negation: '), write(G), abort ). not_(G) :- call(G), !, a=b. not_(G). %not(G) :- ground(G), !, \+ G. %not(G) :- format("Warning: ~w not ground.",[G]), fail. % ------------------------------------------------------------------- % cut-fail fground(Term):- var(Term), !, fail. fground(Term):- nonvar(Term), functor(Term,F,N), fground(N,Term). fground(0,T). %% All subterms traversed fground(N,T):- N>0, arg(N,T,Arg), fground(Arg), N1 is N-1, fground(N1,T). % Comment out the first clause of fground/1 and guess what happens. %% fground_(0,T). %% All subterms traversed %% fground_(N,T):- %% N>0, %% fground(~arg(N,T)), %% fground_(N-1,T). %% debug: fground(f(a,f(c,d),Z)). % ---------------------------------------------------- :- dynamic related/2. related(1,2). relate_numbers(X, Y):- assert(related(X, Y)). unrelate_numbers(X, Y):- retract(related(X, Y)). /* related(1, 2). relate_numbers(1, 2). related(1, 2). unrelate_numbers(1, 2). related(1, 2). */ % ------------------------------------------------------------------- % Dynamic program modification: Using lemmas. fib(0, 0). fib(1, 1). fib(N, F):- N > 1, N1 is N - 1, N2 is N - 2, fib(N1, F1), fib(N2, F2), F is F1 + F2. % ------------------------------------------------------------------- %% lfib(N, F) :- %% ( lemma_fib(N, F) %% -> true %% ; N > 1, %% N1 is N - 1, %% N2 is N - 2, %% lfib(N1, F1), %% lfib(N2, F2), %% F is F1 + F2, %% assert(lemma_fib(N, F))). lfib(N, F):- lemma_fib(N, F), !. lfib(N, F):- N > 1, N1 is N - 1, N2 is N - 2, lfib(N1, F1), lfib(N2, F2), F is F1 + F2, assert(lemma_fib(N, F)). :- dynamic lemma_fib/2. lemma_fib(0, 0). lemma_fib(1, 1). %% ?- fib(30,Y). %% ?- fib(31,Y). %% ?- lfib(30,Y). %% ?- lfib(31,Y). %% ?- lfib(200,Y). %% ?- lfib(1000,Y). % ------------------------------------------------------------------- % Meta-interpreter %% :- use_module(library(dynamic),[clause/2]). %% :- meta_predicate(solve(goal)). solve(true). solve((A,B)) :- display(A), nl, solve(A), display(B), nl, solve(B). solve(A) :- clause(A,B), display('[ '), display(A), display(' :- '), display(B), display(' ]'), nl, solve(B). %% solve(true). %% solve((A,B)) :- solve(A), solve(B). %% solve(A) :- clause(A,B), solve(B). :- dynamic lappend/3. lappend([],X,X). lappend([X|Y],Z,[X|W]) :- lappend(Y,Z,W). % solve(lappend([1,2],[3,4],L)). % ------------------------------------------------------------------- % Difference lists dlist(X-Y) :- var(X), !, X == Y. dlist([_|DL]-X) :- dlist(DL-X). % Appending diference lists (in constant time): append_dl(B1-E1,E1-E2,B1-E2). % append_dl(B1-E1,B2-E2,B3-E3) :- B3 = B1, E3 = E2, B2 = E1. % Queries: % append_dl([1,2,3|X]-X,[4,5]-[],L). % append_dl([1,2,3|X]-X,[4,5]-[],L-T). % append_dl([1,2,3|X]-X,[4,5]-[],[1,2,3,4,5]-[]). % append_dl(L,[4,5]-[],[1,2,3,4,5]-[]). % append_dl(L1, L2, [1,2,3,4,5]-[]). % ------------------------------------------------------------------- % % ------------------------------------------------------------------- % Normal qsort qsort([],[]). qsort([X|L],R) :- partition(L,X,L1,L2), qsort(L2,R2), qsort(L1,R1), append(R1,[X|R2],R). partition([],_B,[],[]). partition([E|R],C,[E|Left1],Right):- E < C, partition(R,C,Left1,Right). partition([E|R],C,Left,[E|Right1]):- E >= C, partition(R,C,Left,Right1). % ------------------------------------------------------------------- % dl qsort %% dlqsort(L,SL) :- %% dlqsort_(L,SL,[]). %% %% dlqsort_([],R,R). %% dlqsort_([X|L],R,R1) :- %% partition(L,X,L1,L2), %% dlqsort_(L1,R,[X|R0]), %% dlqsort_(L2,R0,R1). % dlqsort([5,2,1,9,7], SL). % dlqsort([5,1,7], SL). % Partition is same as above! dl_qsort(L,SL) :- dl_qsort_(L,SL,T), T = []. dl_qsort_([],R,R). dl_qsort_([X|L],R,RR) :- partition(L,X,L1,L2), dl_qsort_(L1,M1,RM1), dl_qsort_(L2,R1,R0), R = M1, RR = R0, RM1 = [X|R1]. %% dlqsort(L,SL) :- %% dlqsort_(L,SL-[]). %% %% dlqsort_([],R-R). %% dlqsort_([X|L],Res) :- %% partition(L,X,L1,L2), %% dlqsort_(L1,DL1), %% dlqsort_(L2,DL2H-DL2F), %% append_dl(DL1,[X|DL2H]-DL2F,Res). % dl_qsort([5,2,1,9,7], SL). % dl_qsort([5,1,7], SL). % ------------------------------------------------------------------- % Parsing 'by hand' %% ?- phrase([t,h,e,' ',p,l,a,n,e,' ',f,l,i,e,s],[]). %% phrase(X,CV) :- %% article(X,CA), %% spaces(CA,CS1), %% noun(CS1,CN), %% spaces(CN,CS2), %% verb(CS2,CV). %% %% article([a|X],X). %% article([t,h,e|X],X). %% %% spaces([' ' | X],X). %% spaces([' ' | Y],X) :- %% spaces(Y,X). %% %% noun([c,a,r | X],X). %% noun([p,l,a,n,e | X],X). %% %% verb([f,l,i,e,s | X],X). %% verb([d,r,i,v,e,s | X],X). % ------------------------------------------------------------------- % Parsing: using some syntax %% %% ?- phrase("the plane flies",[]). %% %% phrase(X,CV) :- %% article(X,CA), spaces(CA,CS1), noun(CS1,CN), %% spaces(CN,CS2), verb(CS2,CV). %% %% article( "the" || X, X). %% article( "a" || X, X). %% %% spaces( " " || X, X). %% spaces( " " || Y, X) :- spaces(Y, X). %% %% noun( "plane" || X, X). %% noun( "car" || X, X). %% %% verb( "flies" || X, X). %% verb( "drives" || X, X). % ------------------------------------------------------------------- % Parsing: DCGs %% %% ?- phrase("the plane flies",[]). %% %% :- use_package(dcg). %% %% phrase --> article, spaces, noun, spaces, verb. %% %% article --> "the". %% article --> "a". %% %% spaces --> " ". %% spaces --> " ", spaces. %% %% noun --> "plane". %% noun --> "car". %% %% verb --> "flies". %% verb --> "drives". % ------------------------------------------------------------------- % Parsing: DCGs + Prolog %% ?- phr(NChars,"the plane flies",[]). :- use_package(dcg). phr(N) --> article(AC), spaces(S1), noun(NC), spaces(S2), verb(VC), { N is AC + S1 + NC + S2 + VC }. article(3) --> "the". article(1) --> "a". spaces(1) --> " ". spaces(N) --> " ", spaces(N1), { N is N1+1 }. noun(5) --> "plane". noun(3) --> "car". verb(5) --> "flies". verb(6) --> "drives". % ------------------------------------------------------------------- % Other issues foo :- repeat, read(X), process(X). process(end). process(X) :- display(X), fail. % ------------------------------------------------------------------- wrepeat. wrepeat:- wrepeat. %% wrepeat, X=a. %% Local Variables: %% mode: CIAO %% update-version-comments: "off" %% End: