Peter Flach | http://www.cs.bris.ac.uk/~flach

Interactive lab examples

Simply Logical

Fibonacci sequence

Demonstrates the use of accumulators, and the difference between interpreted and uninterpreted arithmetic expressions.
This implementation of the Fibonacci sequence is very inefficient -- the 30th number takes about 90 seconds!
% fib(N,F) <- F is the N-th Fibonacci number
% inefficient doubly-recursive version
fib(1,1).
fib(2,1).
fib(N,F):-
	N>2,N1 is N-1,N2 is N-2,
	fib(N1,F1),fib(N2,F2),
	F is F1+F2.

/** <examples>

?- fib(5,F).
?- fib(10,F).
?- fib(20,F).
?- fib(25,F).
?- fib(30,F).

*/

  
Variant of fib/2 that returns an uninterpreted arithmetic expression showing the computation tree.
% :-use_rendering(svgtree). % uncomment this line to see visualisations

% fibt(N,E) <- E is an arithmetic expression
% representing the N-th Fibonacci number
% that can be rendered as a tree
% and evaluated with is/2.
fibt(1,1).
fibt(2,1).
fibt(N,(F1+F2)):-
	N>2,N1 is N-1,N2 is N-2,
	fibt(N1,F1),fibt(N2,F2).

/** <examples>

?- fibt(5,E), F is E.
?- fibt(10,E), F is E.

*/

  
We can get an efficient version by solving a more general problem!
% fibn(N,Na,Nb,F) <- F is the N-th Fibonacci number
%                    in the sequence starting with Na, Nb
fibn(1,Na,_,Na).
fibn(2,_,Nb,Nb).
fibn(N,Na,Nb,F):-
	N>2, N1 is N-1,
	Nc is Na+Nb,
	fibn(N1,Nb,Nc,F).

% the original Fibonacci sequence starts with 1, 1
fibn(N,F):-
	fibn(N,1,1,F).

/** <examples>

?- member(N,[10,20,50,100,200]), fibn(N,F).
?- maplist(fibn, [10,20,50,100,200], L).

*/

  

Second-order predicates

generate all solutions to a query.
biglist(Low,High,L):-
    bagof(X,between(Low,High,X),L).

% between/3 is built-in but could have been defined as follows:
% between(Low,_High,Low).
% between(Low,High,Number):-
% 	Low < High,
% 	NewLow is Low+1,
% 	between(NewLow,High,Number).

/** <examples>

?- biglist(1,25,L).

*/

  
Sorting, quick and dirty
:-use_module(library(random)). % for randseq/3 to generate random lists

setof_sort(In,Out):-
    setof(X,member(X,In),Out).

/** <examples>

?- randseq(20,100,In), setof_sort(In,Out).

*/

  
Existential variables
% list of pairs
p1(L,X,Y):-
	bagof((X,Y),(between(1,3,X),between(X,3,Y)),L).

% one list for each X
p2(L,X,Y):-
	bagof(Y,(between(1,3,X),between(X,3,Y)),L).

% lists for each X combined
p3(L,X,Y):-
	bagof(Y,X^(between(1,3,X),between(X,3,Y)),L).

% one list for each Y
p4(L,X,Y):-
	bagof(X,(between(1,3,X),between(X,3,Y)),L).

% lists for each Y combined
p5(L,X,Y):-
	bagof(X,Y^(between(1,3,X),between(X,3,Y)),L).

/** <examples>

?- p1(L,X,Y).
?- p2(L,X,Y).
?- p3(L,X,Y).
?- p4(L,X,Y).
?- p5(L,X,Y).

*/

  
An AI classic: N non-attacking queens
% :-use_rendering(chess). % Uncomment this line for chess renderer

nqueens(N,Columns) :-
    setof(X,between(1,N,X),Rows),
    perm(Rows,Columns), % generator
    safe(Columns).      % tester

%%% tester
safe([]).
safe([Column|Columns]) :-
    noattack(Column,Columns,1),
    safe(Columns).
    
noattack(_,[],_).
noattack(Y,[Y1|Ylist],Xdist) :-
    abs(Y-Y1) =\= Xdist,
    Xdist1 is Xdist+1,
    noattack(Y,Ylist,Xdist1).

%%% generator
perm([],[]).
perm(L,[X|PR]):-
	remove_one(X,L,R),
	perm(R,PR).
    
remove_one(X,[X|Ys],Ys).
remove_one(X,[Y|Ys],[Y|Zs]):-
	remove_one(X,Ys,Zs).

/** <examples>

?- nqueens(8,Columns).

*/

  
Finding prime factors:
% factors(N,Fs) <- Fs is the list of prime factors of N
factors(1,[1]).
factors(X,[Factor|Fs]) :-
   X > 1,
   between(2,X,Factor),    % generate candidate factor, lowest first
   (X mod Factor) =:= 0,   % test Factor is divisor of X
   !,                      % if so, stop generating!
   Rem is X // Factor,     % proceed with remainder
   factors(Rem,Fs).

/** <examples>

?-factors(27,Fs).
?-factors(28,Fs).
?-factors(29,Fs).

*/

  
How not to use generate and test:
:-use_module(library(random)). % for randseq/3 to generate random lists

% psort(L,SL) <- L and SL contain the same elements, SL is sorted
psort(L,SL):-
    perm(L,SL),   % generator
    write('. '),  % demonstrate inefficiency of generator
    sorted(SL).   % tester

% perm(L,PL) <- L and PL are permutations of each other
perm([],[]).
perm(L,[X|PR]):-
	remove_one(X,L,R),
	perm(R,PR).

% remove_one(X,Ys,Zs) <- Zs is Ys minus one occurence of X
remove_one(X,[X|Ys],Ys).
remove_one(X,[Y|Ys],[Y|Zs]):-
	remove_one(X,Ys,Zs).

% sorted(L) <- L is a sorted list
sorted([]).
sorted([_X]).
sorted([X,Y|L]):-
  ( compare('=', X, Y)
  ; compare('<', X, Y)
  ), sorted([Y|L]).

/** <examples>

?- randseq(5,100,In), psort(In,Out).

*/

  

Meta-interpreters

prove(A):-
    ( A=true    -> true              % we're done
    ; A=not(B)  -> not(prove(B))     % negation as failure
    ; A=(B,C)   -> prove(B),prove(C) % conjunctive query
    ; otherwise -> cl(A,B),prove(B)  % resolve against clause
    ).

% cl(H,B) <- (H:-B) is object-level clause
cl(rectangle,(polygon(4),angles(90))).
cl(square,(rectangle,regular)).
cl(triangle,polygon(3)).
cl(equilateral_triangle,(triangle,regular)).
%%% facts
cl(polygon(4),true).
cl(regular,true).
cl(angles(90),true).

/** <examples>

?- prove(rectangle).
?- prove(square).
?- prove(not(triangle)).
?- prove(not((rectangle,triangle))).

*/

  
Keep conjunctive resolvent together
prove_r(A):-
    writeln(A), % show current query
    ( A=true    -> true
    ; A=not(B)  -> not(prove_r(B))
    ; A=(B,C)   -> cl(B,D),conj_append(D,C,E),prove_r(E)
    ; otherwise -> cl(A,B),prove_r(B)
    ).

conj_append(A,B,C):-
    ( A=true    -> B=C
    ; A=(A1,A2) -> C=(A1,C2),conj_append(A2,B,C2)
    ; otherwise -> C=(A,B)
    ).

% cl(H,B) <- (H:-B) is object-level clause
cl(rectangle,(polygon(4),angles(90))).
cl(square,(rectangle,regular)).
cl(triangle,polygon(3)).
cl(equilateral_triangle,(triangle,regular)).
%%% facts
cl(polygon(4),true).
cl(regular,true).
cl(angles(90),true).

/** <examples>

?- prove_r(rectangle).
?- prove_r(square).
?- prove_r(not(triangle)).
?- prove_r(not((rectangle,triangle))).

*/

  
Show (propositional) proof tree
% display a proof tree
prove_p(A):-prove_p(A,P),write_proof(P).

prove_p(A,P):-
    ( A=true    -> P=[]
    ; A=(B,C)   -> cl(B,D),conj_append(D,C,E),
                   prove_p(E,PE),P=[p(A,(B:-D))|PE]
    ; otherwise -> cl(A,B),prove_p(B,PB),
                   P=[p(A,(A:-B))|PB]
    ).

write_proof([]):-
	write('...............[]'),nl.
write_proof([p(A,B)|Proof]):-
	write((:-A)),nl,
	write('.....|'),write('..........'),write(B),nl,
	write('.....|'),write('..................../'),nl,
	write_proof(Proof).

conj_append(A,B,C):-
    ( A=true    -> B=C
    ; A=(A1,A2) -> C=(A1,C2),conj_append(A2,B,C2)
    ; otherwise -> C=(A,B)
    ).

% cl(H,B) <- (H:-B) is object-level clause
cl(rectangle,(polygon(4),angles(90))).
cl(square,(rectangle,regular)).
cl(triangle,polygon(3)).
cl(equilateral_triangle,(triangle,regular)).
%%% facts
cl(polygon(4),true).
cl(regular,true).
cl(angles(90),true).

/** <examples>

?- prove_p(rectangle).
?- prove_p(square).

*/

  

Depth-first search and variants

search_df([Goal|_Rest],Goal):-
	goal(Goal). 
search_df([Current|Rest],Goal):-
	%writeln([Current|Rest]),
	findall(C,child(Current,C),Children),
	append(Children,Rest,NewAgenda),
	search_df(NewAgenda,Goal). 

goal(N):-7 is N.
goal(N):-42 is N.

child(N,N+1).
child(N,2*N).

/** <examples>

?- search_df([0],Goal).
?- search_df([0],Goal),42 is Goal.

*/

  
Depth-first search without agenda = transitive closure
search_bt(Goal,Goal):-
	goal(Goal). 
search_bt(Current,Goal):-
	%writeln(Current),
	child(Current,Child),
	search_bt(Child,Goal). 

goal(N):-7 is N.
goal(N):-42 is N.

child(N,N+1).
child(N,2*N).

/** <examples>

?- search_bt(0,Goal).
?- search_bt(0,Goal),42 is Goal.

*/

  
Backtracking DF search with depth bound
search_d(_D,Goal,Goal):-
	goal(Goal). 
search_d(D,Current,Goal):-
	%writeln(Current),
	D>0,D1 is D-1,
	child(Current,Child),
	search_d(D1,Child,Goal). 

goal(N):-7 is N.
goal(N):-42 is N.

child(N,N+1).
child(N,2*N).

/** <examples>

?- search_d(8,0,Goal).
?- search_d(8,0,Goal),42 is Goal.

*/

  
Iterative deepening
search_id(D,Current,Goal):-
	search_d(D,Current,Goal). 
search_id(D,Current,Goal):- 
	%writeln(Current),
	D1 is D+1,  % increase depth
	search_id(D1,Current,Goal). 

search_d(_D,Goal,Goal):-
	goal(Goal). 
search_d(D,Current,Goal):-
	D>0,D1 is D-1,
	child(Current,Child),
	search_d(D1,Child,Goal). 

goal(N):-7 is N.
goal(N):-42 is N.

child(N,N+1).
child(N,2*N).

/** <examples>

?- search_id(1,0,Goal).
?- search_id(1,0,Goal),42 is Goal.

*/

  
Don't use search if an analytic solution exists!
% hanoi(N,A,B,C,Moves) <- Moves is the list of moves to 
%                         move N disks from peg A to peg C, 
%                         using peg B as intermediary peg 
hanoi(0,_,_,_,[]).
hanoi(N,A,B,C,Moves):-
	N>0, N1 is N-1,
	hanoi(N1,A,C,B,Moves1),
	hanoi(N1,B,A,C,Moves2),
	append(Moves1,[A -> C|Moves2],Moves).

hanoi(N,Moves):-
	hanoi(N,left,middle,right,Moves).

/** <examples>

?- hanoi(3,Moves).
?- hanoi(5,Moves).

*/

  

Breadth-first search

search_bf([Goal|_Rest],Goal):-
	goal(Goal). 
search_bf([Current|Rest],Goal):-
	%writeln([Current|Rest]),
	findall(C,child(Current,C),Children),
	append(Rest,Children,NewAgenda),
	search_bf(NewAgenda,Goal). 

goal(N):-7 is N.
goal(N):-42 is N.

child(N,N+1).
child(N,2*N).

/** <examples>

?- search_bf([0],Goal).
?- search_bf([0],Goal),42 is Goal.

*/

  
Breadth-first meta-interpreter
% breadth-first version of prove_r/1
% agenda items have the form a(CurrentQuery,OriginalQuery)
% in order to obtain an answer substitution on termination
prove_bf(Goal):-
	prove_bf_a([a(Goal,Goal)],Goal).

prove_bf_a([a(true,Goal)|_Agenda],Goal).
prove_bf_a([a((A,B),G)|Agenda],Goal):-!,
	findall(a(D,G),
	        (cl(A,C),conj_append(C,B,D)),
	        Children),
	append(Agenda,Children,NewAgenda),	% breadth-first
	prove_bf_a(NewAgenda,Goal).
prove_bf_a([a(A,G)|Agenda],Goal):-
	findall(a(B,G),cl(A,B),Children),
	append(Agenda,Children,NewAgenda),	% breadth-first
	prove_bf_a(NewAgenda,Goal).

% prove_r/1 included for comparison
prove_r(A):-
    ( A=true    -> true
    ; A=(B,C)   -> cl(B,D),conj_append(D,C,E),prove_r(E)
    ; otherwise -> cl(A,B),prove_r(B)
    ).

cl(brother(X,Y),brother(Y,X)).
cl(brother(X,Y),(brother(X,Z),brother(Z,Y))).
cl(brother(peter,paul),true).
cl(brother(adrian,paul),true).

%%% auxiliary predicates

conj_append(A,B,C):-
    ( A=true    -> B=C
    ; A=(A1,A2) -> C=(A1,C2),conj_append(A2,B,C2)
    ; otherwise -> C=(A,B)
    ).

/** <examples>

?- prove_bf(brother(peter,paul)).
?- prove_r(brother(peter,paul)).
?- prove_bf(brother(peter,Y)).
?- prove_r(brother(peter,Y)).

*/

  
Meta-interpreter for full clausal logic
% refute_bf(Clause) <- Clause is refuted by clauses 
%                      defined by cl/1 
%                      (breadth-first search strategy)
refute_bf(Clause):-
	refute_bf_a([a(Clause,Clause)],Clause).

refute_bf_a([a((false:-true),Clause)|_Rest],Clause).
refute_bf_a([a(A,C)|Rest],Clause):-
	writeln(A),
	findall(a(R,C),(cl(Cl),resolve(A,Cl,R)),Children),
	append(Rest,Children,NewAgenda),	% breadth-first
	refute_bf_a(NewAgenda,Clause).

% resolve(C1,C2,R) <- R is the resolvent of C1 and C2.
resolve((H1:-B1),(H2:-B2),(ResHead:-ResBody)):-
	resolve(H1,B2,R1,R2),
	disj_append(R1,H2,ResHead),
	conj_append(B1,R2,ResBody).
resolve((H1:-B1),(H2:-B2),(ResHead:-ResBody)):-
	resolve(H2,B1,R2,R1),
	disj_append(H1,R2,ResHead),
	conj_append(R1,B2,ResBody).

resolve((A;B),C,B,E):-
	conj_remove_one(A,C,E).
resolve((A;B),C,(A;D),E):-
	resolve(B,C,D,E).
resolve(A,C,false,E):-
	conj_remove_one(A,C,E).

cl((bachelor(X);married(X):-man(X),adult(X))).
cl((has_wife(X):-man(X),married(X))).
cl((false:-has_wife(paul))).
cl((man(paul):-true)).
cl((adult(paul):-true)).


%%% auxiliary predicates

disj_append(A,B,C):-
    ( A=false    -> B=C
    ; A=(A1;A2) -> C=(A1;C2),disj_append(A2,B,C2)
    ; otherwise -> C=(A;B)
    ).

conj_append(A,B,C):-
    ( A=true    -> B=C
    ; A=(A1,A2) -> C=(A1,C2),conj_append(A2,B,C2)
    ; otherwise -> C=(A,B)
    ).

conj_remove_one(X,X,true):-	% single-element conjunction
	not(X=true),not(X=(_,_)).
conj_remove_one(X,(X,Ys),Ys).
conj_remove_one(X,(Y,Ys),(Y,Zs)):-
	conj_remove_one(X,Ys,Zs).

/** <examples>

?- refute_bf((false:-bachelor(X))).

*/

  
Forward chaining
cl((bachelor(X);married(X):-man(X),adult(X))).
cl((has_wife(X):-man(X),married(X))).
%cl((false:-has_wife(paul))).
cl((man(paul):-true)).
cl((adult(paul):-true)).

model(M0,M):-
   is_violated(Head,M0),!, % find instance of violated clause
   disj_element(L,Head),   % select ground literal from the head
   model([L|M0],M).        % and add it to the model
model(M,M).	% no more violated clauses

is_violated(H,M):-
   cl((H:-B)),
   satisfied_body(B,M),	% this will ground the variables
   not(satisfied_head(H,M)).

satisfied_body(true,_M).	% body is a conjunction
satisfied_body(A,M):-
   member(A,M).
satisfied_body((A,B),M):-
   member(A,M),
   satisfied_body(B,M).

satisfied_head(A,M):-	% head is a disjunction
   member(A,M).
satisfied_head((A;_B),M):-
   member(A,M).
satisfied_head((_A;B),M):-
   satisfied_head(B,M).

disj_element(X,X):-	% single-element disjunction
	not(X=false),not(X=(_;_)).
disj_element(X,(X;_Ys)).
disj_element(X,(_Y;Ys)):-
	disj_element(X,Ys).

/** <examples>

?- model([],M).

*/

  
Depth-bounded forward chaining for infinite domains
cl((append([],Y,Y):-list(Y))).
cl((append([X|Xs],Ys,[X|Zs]):-thing(X),append(Xs,Ys,Zs))).
cl((list([]):-true)).
cl((list([X|Y]):-thing(X),list(Y))).
cl((thing(a):-true)).
cl((thing(b):-true)).
%cl((thing(c):-true)).

model_d(0,M,M).
model_d(D,M0,M):-
	D>0,D1 is D-1,
	findall(H,is_violated(H,M0),Heads),
	satisfy_clauses(Heads,M0,M1),
	model_d(D1,M1,M).

satisfy_clauses([],M,M).
satisfy_clauses([H|Hs],M0,M):-
	disj_element(L,H),
	satisfy_clauses(Hs,[L|M0],M).

is_violated(H,M):-
   cl((H:-B)),
   satisfied_body(B,M),	% this will ground the variables
   not(satisfied_head(H,M)).

satisfied_body(true,_M).	% body is a conjunction
satisfied_body(A,M):-
   member(A,M).
satisfied_body((A,B),M):-
   member(A,M),
   satisfied_body(B,M).

satisfied_head(A,M):-	% head is a disjunction
   member(A,M).
satisfied_head((A;_B),M):-
   member(A,M).
satisfied_head((_A;B),M):-
   satisfied_head(B,M).

disj_element(X,X):-	% single-element disjunction
	not(X=false),not(X=(_;_)).
disj_element(X,(X;_Ys)).
disj_element(X,(_Y;Ys)):-
	disj_element(X,Ys).

/** <examples>

?- model_d(4,[],M).

*/

  

Informed search

Sliding tiles (best-first but not A* and with aggressive pruning)
board_size(9). % odd number, at least 3

eval_pos(Pos,Value):-
	%% uncomment exactly one of the following lines
	%bLeftOfw(Pos,Value).    
	outOfPlace(Pos,1,Value). 

/*
 * Moves are represented as triples m(From,To,Cost).
 * Agenda items are represented as pairs v(Value,[Move|Moves]) 
 * where Value is the heuristic value of Move obtained by ?-eval_move(Move,Value).
  */

% tiles(M,C) <- moves M lead to a goal position at cost C 
%               (best-first search strategy)
tiles(Moves,Cost):-
	start_pos(Start),
	eval_pos(Start,Value),
	tiles_a([v(Value,[m(noparent,Start,0)])],Moves,[],_Visited),
	get_cost(Moves,0,Cost).

% write solution to screen
tiles(Cost):-
	tiles(Moves,Cost),
	writeln('# Final list of moves #'),
	reverse(Moves,MovesR),
	write_moves(MovesR,0).

% tiles_a(A,M,V0,V) <- goal position can be reached from one of the
%                      positions on A with moves M (best-first)
%                      (V is list of visited nodes, V0 is accumulator)
tiles_a([v(_V,[LastMove|Moves])|_Rest],[LastMove|Moves],Visited,Visited):-
	eval_move(LastMove,0). % reached our goal
tiles_a([v(_V,[LastMove|_])|Rest],Moves,Visited0,Visited):-
	eval_move(LastMove,0),!, % to get alternate solutions
	tiles_a(Rest,Moves,Visited0,Visited).
tiles_a(Agenda,Moves,Visited0,Visited):-
	% writeln('### current agenda (reversed) ###'),reverse(Agenda,AgendaR),write_agenda(AgendaR),readln(_), 
	%% uncomment the previous line to see agenda at each iteration
	Agenda=[v(_V,[LastMove|Ms])|Rest],
	( setof(v(Value,[NextMove,LastMove|Ms]),
        candidate(LastMove,NextMove,Value,Rest,Visited0),
        Children) -> new_agenda(Children,Rest,NewAgenda)	% best-first
    ; otherwise   -> NewAgenda=Rest	% candidate/5 failed
	),tiles_a(NewAgenda,Moves,[LastMove|Visited0],Visited).

candidate(LastMove,NextMove,Value,Agenda,Visited):-
	last2next_move(LastMove,NextMove),
	NextMove=m(_Pos,NewPos,_Cost),
	eval_move(NextMove,Value),
	not((member(v(_,[m(_,NewPos,_)|_]),Agenda))), % NewPos already on Agenda
	not((member(m(_,NewPos,_),Visited))).         % NewPos already visited
% The last two lines implement aggressive pruning as only NewPos matters, 
% not the position Pos from which it is reached.

eval_move(m(_P,Pos,_C),Value):-
	eval_pos(Pos,Value).

last2next_move(m(_OldPos,Pos,_OldCost),m(Pos,NewPos,Cost)):-
	last2next_pos(Pos,NewPos,Cost).

% merge children and agenda
new_agenda([],Agenda,Agenda).
new_agenda([C|Cs],[],[C|Cs]).
new_agenda([v(V1,Moves1)|Rest1],[v(V2,Moves2)|Rest2],NewAgenda):-
	( V2>V1     -> new_agenda(Rest1,[v(V2,Moves2)|Rest2],Rest3),NewAgenda=[v(V1,Moves1)|Rest3]
	; otherwise -> new_agenda([v(V1,Moves1)|Rest1],Rest2,Rest3),NewAgenda=[v(V2,Moves2)|Rest3]
	).

get_cost([],C,C).
get_cost([m(_From,_To,C)|Moves],Cost0,Cost):-
	Cost1 is Cost0+C,
	get_cost(Moves,Cost1,Cost).

write_agenda([]):-
	writeln('-------------------').
write_agenda([P|Ps]):-
	write_agenda_item(P),nl,
	write_agenda(Ps).

write_agenda_item(v(Value,[m(_P,Pos,_C)|_Rest])):-
	write_pos(Pos),
	write(' : '),write(Value).

write_moves([],_):-
	writeln('-------------------').
write_moves([m(_P,Pos,C)|Moves],Cost):-
	eval_pos(Pos,Value),
	Cost1 is Cost+C,
	write_pos(Pos),
	format(' : ~|~` t~d~2+ :~|~` t~d~3+~n', [Value,Cost1]),
	write_moves(Moves,Cost1).

%%% board predicates

start_pos(Start):-
	board_size(N),
	start_pos(Start,N).

start_pos(Start,N):-
	N1 is (N-1)/2,
	start_lr(Left,N1,b),
	start_lr(Right,N1,w),
	append(Left,[e|Right],Start).

start_lr(LR,N,BW):-
	length(LR,N),
	start_lr(LR,BW).

start_lr([],_).
start_lr([BW|LR],BW):-
	start_lr(LR,BW).

last2next_pos(Pos,NewPos,Cost):-
	get_tile(Pos,Ne,e),get_tile(Pos,Nbw,BW),not(BW=e),
	Diff is abs(Ne-Nbw),
	Diff<4,
	replace(Pos,Ne,BW,Pos1),
	replace(Pos1,Nbw,e,NewPos),
	( Diff=1    -> Cost=1
	; otherwise -> Cost is Diff-1 ).

write_pos([]).
write_pos([P|Ps]):-
	( P=e -> write('. ')
	; P=b -> write('\x25cf'),write(' ')
	; P=w -> write('\x25cb'),write(' ')
	),write_pos(Ps).

get_tile(Pos,N,S):-
	get_tile(Pos,1,N,S).

get_tile([X|_Xs],N,N,X).
get_tile([_X|Xs],N0,N,Y):-
	N1 is N0+1,
	get_tile(Xs,N1,N,Y).

%%% heuristics

bLeftOfw(Pos,Value):-
	findall(b,(get_tile(Pos,Nb,b),get_tile(Pos,Nw,w),Nw>Nb),L),
	length(L,Value).

outOfPlace(Pos,Initial,Value):-
	append(L,[_Mid|Right],Pos),  % generate
	length(L,N),length(Right,N), % test
	reverse(L,Left), % from low to high penalty
	penalise(Left,b,Initial,0,VL),
	penalise(Right,w,Initial,0,VR),
	Value is VL+VR. 

penalise([],_,_,V,V).
penalise([H|T],BW,P,V0,V):-
	( H=BW -> V1 is V0+P
	; otherwise -> V1=V0
	),
	P1 is P+1, 
	penalise(T,BW,P1,V1,V).

%%% auxiliary predicates

% replace(In,Pos,Item,Out) <- list Out is List in with item at Pos replaced with Item
replace([_X|Xs],1,Y,[Y|Xs]).
replace([X|Xs],N,Y,[X|Zs]):-
	N>1,N1 is N-1,
	replace(Xs,N1,Y,Zs).

/** <examples>

?- tiles(Moves,Cost).
?- tiles(Cost). % prints agenda

*/

  
Path finding (depth-first, breadth-first, A*, backtracking)
path(SS):-
	width(W),height(H),empty_grid(W,H,Grid),
	setx_hor(5/3,4,Grid),setx_hor(7/6,2,Grid),setx_hor(3/9,4,Grid),
	setx_ver(2/5,3,Grid),setx_ver(4/4,3,Grid),setx_ver(7/7,2,Grid),
	search(Grid,SS),show_grid(Grid).

width(8).       height(10).
entrance(1/1).  exit(8/5).   %exit(3/5).

/*
 * Search predicates
 * move/2 enumerates all possible moves, ignoring whether cell is free
 * search/2 searches grid with various search strategies
 */

:-use_module(library(lists)).

moves(X/Y,Moves):-
	bagof(X1/Y1,move(X/Y,X1/Y1),Moves).

move(X/Y,X/Y1):-
	height(H),
	H>Y,Y1 is Y+1.	% down
move(X/Y,X1/Y):-
	width(W),
	W>X,X1 is X+1.	% right
move(X/Y,X/Y1):-
	Y>1,Y1 is Y-1.	% up
move(X/Y,X1/Y):-
	X>1,X1 is X-1.	% left

% for A* search: generates moves with increasing F-value
moves_h(F/G:X/Y,Moves):-
	setof(F1/G1:X1/Y1,move_h(F/G:X/Y,F1/G1:X1/Y1),Moves).

move_h(_/G:X/Y,F1/G1:X1/Y1):-
	move(X/Y,X1/Y1),
	h(X1/Y1,H1),
	G1 is G+1,	% increase G-value from previous
	F1 is G1+H1.	% add new H-value

h(X/Y,H):-
	exit(XE/YE),
	H is abs(XE-X)+abs(YE-Y).	% Manhattan distance
	

search(Grid,SS):-
	entrance(X/Y),
	( SS=bt -> search_bt(0,X/Y,Grid)	% backtracking search
	; SS=df -> search_df(0,[X/Y],Grid)	% agenda-based depth-first
	; SS=bf -> search_bf(0,[X/Y],Grid)	% agenda-based breadth-first
	; SS=as -> h(X/Y,H),search_as(0,[H/0:X/Y],Grid)	% A* search
	).

% backtracking search
% only path found is indicated in grid
search_bt(N,X/Y,Grid):-
	exit(X/Y),
	set(X/Y,Grid,N).
search_bt(N,X/Y,Grid):-
	N1 is N+1,
	set(X/Y,Grid,N),
	move(X/Y,X1/Y1),
	search_bt(N1,X1/Y1,Grid).

% agenda-based depth-first search
% grid is used for loop-detection: if set/3 fails, it is either an obstacle
% or we've been there already
search_df(N,[X/Y|_],Grid):-
	exit(X/Y),
	set(X/Y,Grid,N).
search_df(N,[X/Y|Agenda],Grid):-
	( set(X/Y,Grid,N) -> moves(X/Y,Moves),N1 is N+1,
	                     append(Moves,Agenda,NewAgenda)
	; otherwise -> NewAgenda=Agenda,N1=N	% ignore: can't go there
	),search_df(N1,NewAgenda,Grid).

% agenda-based breadth-first search
search_bf(N,[X/Y|_],Grid):-
	exit(X/Y),
	set(X/Y,Grid,N).
search_bf(N,[X/Y|Agenda],Grid):-
	( set(X/Y,Grid,N) -> moves(X/Y,Moves),N1 is N+1,
	                     append(Agenda,Moves,NewAgenda)
	; otherwise -> NewAgenda=Agenda,N1=N	% ignore: can't go there
	),search_bf(N1,NewAgenda,Grid).

% A* search: agenda contains F/G:X/Y with F=G+H evaluation of position X/Y
search_as(N,[_:X/Y|_],Grid):-
	exit(X/Y),
	set(X/Y,Grid,N).
search_as(N,[F/G:X/Y|Agenda],Grid):-
	( set(X/Y,Grid,N) -> moves_h(F/G:X/Y,Moves),N1 is N+1,
	                     merge_h(Moves,Agenda,NewAgenda)
	; otherwise -> NewAgenda=Agenda,N1=N	% ignore: can't go there
	),search_as(N1,NewAgenda,Grid).

merge_h([],Agenda,Agenda).
merge_h(Moves,[],Moves).
merge_h([F/G:X/Y|Moves],[F1/G1:X1/Y1|Agenda],[F/G:X/Y|NewAgenda]):-
	F1>F,
	merge_h(Moves,[F1/G1:X1/Y1|Agenda],NewAgenda).
merge_h([F/G:X/Y|Moves],[F1/G1:X1/Y1|Agenda],[F1/G1:X1/Y1|NewAgenda]):-
	F>=F1,
	merge_h([F/G:X/Y|Moves],Agenda,NewAgenda).


/*
 * Grid datastructure: list of H rows of length W. 
 * A variable indicates cell is empty, so it can be 
 * instantiated once with 'x' to indicate an obstacle
 * or with a number to indicate at which search iteration
 * it was explored.
 */
 
empty_grid(W,H,Grid):-
	length(Grid,H),	% generate a list of variables of length H
	empty_rows(W,Grid).	% and instantiate each variable to an empty row

empty_rows(_,[]).
empty_rows(W,[Row|Rows]):-
	length(Row,W),	% generate a list of variables of length W
	empty_rows(W,Rows).

get_row(N,Grid,Row):-
	nth1(N,Grid,Row).

get_col(_,[],[]).
get_col(N,[Row|Rows],[X|Col]):-
	nth1(N,Row,X),
	get_col(N,Rows,Col).

% Create horizontal/vertical obstacles at position X/Y with length L
setx_hor(X/Y,L,Grid):-
	get_row(Y,Grid,Row),
	setx(X,L,Row).

setx_ver(X/Y,L,Grid):-
	get_col(X,Grid,Col),
	setx(Y,L,Col).

setx(_,0,_).
setx(X,L,Row):-
	L>0,L1 is L-1,X1 is X+1,
	nth1(X,Row,x),
	setx(X1,L1,Row).

% Set cell X/Y to N; fails if cell has been set already
set(X/Y,Grid,N):-
	get_row(Y,Grid,Row),
	nth1(X,Row,C),
	var(C),
	C=N.

show_grid(Grid):-
	nl,
	show_rows(Grid),
	nl.

show_rows([]).
show_rows([Row|Rows]):-
	show_row(Row),
	show_rows(Rows).

show_row([]):-nl.
show_row([H|T]):-
	( var(H)    -> format('~|~` t~w~3+ ',['.'])
	; H=x       -> format('~|~` t~w~3+ ',[H])
	; otherwise -> format('~|~` t~d~3+ ',[H])
	),show_row(T). 


/** <examples>

?- member(SS,[df,bf,as,bt]),path(SS).

*/

  

Definite Clause Grammars

Roman numerals
%% Roman numerals %%
% adapted from https://groups.google.com/forum/#!topic/comp.compilers/g8Qvp-KGbig

roman(N) --> d(N4,4),d(N3,3),d(N2,2),d(N1,1),{N is N4*1000+N3*100+N2*10+N1}.

i(1) --> [i].
i(2) --> [x].
i(3) --> [c].
i(4) --> [m].

v(1) --> [v].
v(2) --> [l].
v(3) --> [d].

d(0,_) --> [].
d(1,N) --> i(N).
d(2,N) --> i(N),i(N).
d(3,N) --> i(N),i(N),i(N).
d(4,N) --> i(N),v(N).
%d(4,N) --> i(N),i(N),i(N),i(N).
d(5,N) --> v(N).
d(6,N) --> v(N),i(N).
d(7,N) --> v(N),i(N),i(N).
d(8,N) --> v(N),i(N),i(N),i(N).
d(9,N) --> i(N),{N1 is N+1},i(N1).

/** <examples>

?- phrase(roman(1984),R).
?- phrase(roman(Y),[m,c,m,l,x,x,x,i,v]).

*/
  

Inductive reasoning

Bottom-up induction
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                                      %
%   Prolog programs from Section 9.2 of the book       %
%   SIMPLY LOGICAL: Intelligent reasoning by example   %
%   (c) Peter A. Flach/John Wiley & Sons, 1994.        %
%                                                      %
%   Predicates: induce_rlgg/2                          %
%               rlgg/4                                 %
%                                                      %
%   NB. This file needs predicates defined in          %
%   the file 'library'.                                %
%                                                      %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%:-consult(library).


%%% 9.2  Bottom-up induction %%%

induce_rlgg(Exs,Clauses):-
	writeln('%%% Bottom-up induction %%%'),
	writeln('Examples'),
	writelns(Exs),
	pos_neg(Exs,Poss,Negs),
	bg_model(BG),
	append(Poss,BG,Model),
	induce_rlgg(Poss,Negs,Model,Clauses).

induce_rlgg(Poss,Negs,Model,Clauses):-
	covering(Poss,Negs,Model,[],Clauses).

% split positive and negative examples
pos_neg([],[],[]).
pos_neg([+E|Exs],[E|Poss],Negs):-
	pos_neg(Exs,Poss,Negs).
pos_neg([-E|Exs],Poss,[E|Negs]):-
	pos_neg(Exs,Poss,Negs).

% covering algorithm
covering(Poss,Negs,Model,H0,H):-
	construct_hypothesis(Poss,Negs,Model,Hyp),!,
	remove_pos(Poss,Model,Hyp,NewPoss),
	nl,writeln(' to continue'),
	readln(_),nl,nl,
	covering(NewPoss,Negs,Model,[Hyp|H0],H).
covering(P,_N,_M,H0,H):-
	append(H0,P,H).	% add uncovered examples to hypothesis

% remove covered positive examples
remove_pos([],_M,_H,[]).
remove_pos([P|Ps],Model,Hyp,NewP):-
	covers_ex(Hyp,P,Model),!,
	write('Covered example: '),write(P),nl,
	remove_pos(Ps,Model,Hyp,NewP).
remove_pos([P|Ps],Model,Hyp,[P|NewP]):-
	remove_pos(Ps,Model,Hyp,NewP).


% extensional coverage, relative to a ground model
covers_ex((Head:-Body),Example,Model):-
	try((Head=Example,forall(element(L,Body),element(L,Model)))).

% construct a clause by means of RLGG
construct_hypothesis([E1,E2|_Es],Negs,Model,Clause):-
	write('RLGG of '),write(E1),write(' and '),write(E2),write(' is'),
	rlgg(E1,E2,Model,Cl),
	reduce(Cl,Negs,Model,Clause),!,
	nl,portray_clause(Clause),nl.
construct_hypothesis([_E1,E2|Es],Negs,Model,Clause):-
	write(' too general'),nl,
	construct_hypothesis([E2|Es],Negs,Model,Clause).


% rlgg(E1,E2,M,C) <- C is RLGG of E1 and E2 relative to M
rlgg(E1,E2,M,(H:-B)):-
	anti_unify(E1,E2,H,[],S10,[],S20),
	varsin(H,V),	% determine variables in head of clause
	rlgg_bodies(M,M,[],B,S10,_S1,S20,_S2,V).

rlgg_bodies([],_B2,B,B,S1,S1,S2,S2,_V).
rlgg_bodies([L|B1],B2,B0,B,S10,S1,S20,S2,V):-
	rlgg_literal(L,B2,B0,B00,S10,S11,S20,S21,V),
	rlgg_bodies(B1,B2,B00,B,S11,S1,S21,S2,V).

rlgg_literal(_L1,[],B,B,S1,S1,S2,S2,_V).
rlgg_literal(L1,[L2|B2],B0,B,S10,S1,S20,S2,V):-
	same_predicate(L1,L2),
	anti_unify(L1,L2,L,S10,S11,S20,S21),
 varsin(L,Vars),var_proper_subset(Vars,V),	% no new variables in literal
	!,rlgg_literal(L1,B2,[L|B0],B,S11,S1,S21,S2,V).
rlgg_literal(L1,[_L2|B2],B0,B,S10,S1,S20,S2,V):-
	rlgg_literal(L1,B2,B0,B,S10,S1,S20,S2,V).


:-op(600,xfx,'<-').

anti_unify(Term1,Term2,Term):-
	anti_unify(Term1,Term2,Term,[],_S1,[],_S2).

anti_unify(Term1,Term2,Term1,S1,S1,S2,S2):-
	Term1 == Term2,!.
anti_unify(Term1,Term2,V,S1,S1,S2,S2):-
	subs_lookup(S1,S2,Term1,Term2,V),!.
anti_unify(Term1,Term2,Term,S10,S1,S20,S2):-
	nonvar(Term1),nonvar(Term2),
	functor(Term1,F,N),functor(Term2,F,N),!,
	functor(Term,F,N),
	anti_unify_args(N,Term1,Term2,Term,S10,S1,S20,S2).
anti_unify(Term1,Term2,V,S10,[Term1<-V|S10],S20,[Term2<-V|S20]).

anti_unify_args(0,_Term1,_Term2,_Term,S1,S1,S2,S2).
anti_unify_args(N,Term1,Term2,Term,S10,S1,S20,S2):-
	N>0,N1 is N-1,
	arg(N,Term1,Arg1),
	arg(N,Term2,Arg2),
	arg(N,Term,Arg),
	anti_unify(Arg1,Arg2,Arg,S10,S11,S20,S21),
	anti_unify_args(N1,Term1,Term2,Term,S11,S1,S21,S2).

subs_lookup([T1<-V|_Subs1],[T2<-V|_Subs2],Term1,Term2,V):-
	T1 == Term1,
	T2 == Term2,!.
subs_lookup([_S1|Subs1],[_S2|Subs2],Term1,Term2,V):-
	subs_lookup(Subs1,Subs2,Term1,Term2,V).


% remove redundant literals
reduce((H:-B0),Negs,M,(H:-B)):-
	setof0(L,(element(L,B0),not(var_element(L,M))),B1),
	reduce_negs(H,B1,[],B,Negs,M).

% reduce_negs(H,B1,B0,B,N,M) <- B is a subsequence of B1
%                               such that H:-B does not
%                               cover elements of N
reduce_negs(H,[_L|B0],In,B,Negs,M):-
	append(In,B0,Body),
	not(covers_neg((H:-Body),Negs,M,_N)),!,
	reduce_negs(H,B0,In,B,Negs,M).
reduce_negs(H,[L|B0],In,B,Negs,M):-
	reduce_negs(H,B0,[L|In],B,Negs,M).
reduce_negs(H,[],Body,Body,Negs,M):-
	not(covers_neg((H:-Body),Negs,M,_N)).

covers_neg(Clause,Negs,Model,N):-
	element(N,Negs),
	covers_ex(Clause,N,Model).


%%% From library %%%

%%% Lists and sets

% element(X,Ys) <- X is an element of the list Ys
element(X,[X|_Ys]).
element(X,[_Y|Ys]):-
	element(X,Ys).

var_element(X,[Y|_Ys]):-
	X == Y.	% syntactic identity
var_element(X,[_Y|Ys]):-
	var_element(X,Ys).

var_remove_one(X,[Y|Ys],Ys):-
	X == Y.	% syntactic identity
var_remove_one(X,[Y|Ys],[Y|Zs]):-
	var_remove_one(X,Ys,Zs).

var_proper_subset([],Ys):-
	Ys \= [].
var_proper_subset([X|Xs],Ys):-
	var_remove_one(X,Ys,Zs),
	var_proper_subset(Xs,Zs).


% try(Goal) <- Goal succeeds, but variables are not instantiated
try(Goal):-
	not(not(Goal)).


%%% Various.

% variant of setof/3 which succeeds with the empty list
% if no solutions can be found
setof0(X,G,L):-
	setof(X,G,L),!.
setof0(_X,_G,[]).

% same_predicate(L1,L2) <- literals L1 and L2 have 
%                          the same predicate and arity
same_predicate(L1,L2):-
	functor(L1,P,N),functor(L2,P,N).

varsin(Term,Vars):-
        varsin(Term,[],V),
        sort(V,Vars).

varsin(V,Vars,[V|Vars]):-
        var(V),!.
varsin(Term,V0,V):-
        functor(Term,_,N),
        varsin_args(N,Term,V0,V).

varsin_args(0,_,Vars,Vars).
varsin_args(N,Term,V0,V):-
        N>0, N1 is N-1,
        arg(N,Term,ArgN),
        varsin(ArgN,V0,V1),
        varsin_args(N1,Term,V1,V).


%%% For lectures

writelns(X):-
	( X=[] -> nl
	; X=[H|T] -> writelns(H),writelns(T)
	; otherwise -> write(X),nl
	).


%%% Queries %%%

%%%%%%%%%%%%%%%%%%  element/2  %%%%%%%%%%%%%%%%%%%%%%%%

% bg_model([]).

query1(Clauses):-
	induce_rlgg([+element(b,[b]),
	             +element(2,[2,3]),
	             +element(3,[1,2,3]),
	             +element(b,[a,b]),
	             +element(3,[2,3]),
	             +element(3,[3]),
	             -element(3,[a,b]),
	             -element(a,[])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%  append/3   %%%%%%%%%%%%%%%%%%%%%%%

% bg_model([]).

query2(Clauses):-
	induce_rlgg([+append([1,2],[3,4],[1,2,3,4]),
	             +append([a],[],[a]),
	             +append([],[],[]),
	             +append([],[1,2,3],[1,2,3]),
	             +append([2],[3,4],[2,3,4]),
	             +append([],[3,4],[3,4]),
	             -append([a],[b],[b]),
	             -append([c],[b],[c,a]),
	             -append([1,2],[],[1,3])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%   num/2    %%%%%%%%%%%%%%%%%%%%%%%

bg_model([num(1,one),
	         num(2,two),
	         num(3,three),
	         num(4,four),
	         num(5,five)
	        ]).

query3(Clauses):-
	induce_rlgg([+listnum([],[]),
	             +listnum([2,three,4],[two,3,four]),
	             +listnum([4],[four]),
	             +listnum([three,4],[3,four]),
	             +listnum([two],[2]),
	             -listnum([1,4],[1,four]),
	             -listnum([2,three,4],[two]),
	             -listnum([five],[5,5])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%   names/2    %%%%%%%%%%%%%%%%%%%%%%%

/*
bg_model([person(mick,jagger),
	         person(david,bowie),
	         person(tina,turner),
	         person(johann,sebastian),
	         person(ludwig,van)
	        ]).
*/

query4(Clauses):-
	induce_rlgg([+names([],[]),
	             +names([david,turner,johann],[p(david,bowie),p(tina,turner),p(johann,sebastian)]),
	             +names([johann],[p(johann,sebastian)]),
	             +names([turner,johann],[p(tina,turner),p(johann,sebastian)]),
	             +names([bowie],[p(david,bowie)]),
	             -names([mick,johann],[p(mick,mick),p(johann,sebastian)]),
	             -names([david,turner,johann],[p(david,bowie)]),
	             -names([van],[p(ludwig,van),p(ludwig,van)])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%






  
Top-down induction
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                                      %
%   Prolog programs from Section 9.3 of the book       %
%   SIMPLY LOGICAL: Intelligent reasoning by example   %
%   (c) Peter A. Flach/John Wiley & Sons, 1994.        %
%                                                      %
%   Predicates: induce_spec/2                          %
%                                                      %
%   NB. This file needs predicates defined in          %
%   the file 'library'.                                %
%                                                      %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


:-consult(library).


%%% 9.3  Top-down induction %%%

induce_spec(Examples,Clauses):-
  writeln('%%% Top-down induction %%%'),
  writeln('Examples'),
  writelns(Examples),
  process_examples([],[],Examples,Clauses).

% process the examples
process_examples(Clauses,Done,[],Clauses).
process_examples(Cls1,Done,[Ex|Exs],Clauses):-
  process_example(Cls1,Done,Ex,Cls2),
  process_examples(Cls2,[Ex|Done],Exs,Clauses).

% process one example
process_example(Clauses,Done,+Example,Clauses):-
  covers(Clauses,Example).
process_example(Cls,Done,+Example,Clauses):-
  not covers(Cls,Example),
  generalise(Cls,Done,Example,Clauses).
process_example(Cls,Done,-Example,Clauses):-
  covers(Cls,Example),
  specialise(Cls,Done,Example,Clauses).
process_example(Clauses,Done,-Example,Clauses):-
  not covers(Clauses,Example).


% covers(Clauses,Ex) <- Ex can be proved from Clauses and
%                       background theory in max. 10 steps
covers(Clauses,Example):-
	prove_d(10,Clauses,Example).

prove_d(D,Cls,true):-!.
prove_d(D,Cls,(A,B)):-!,
	prove_d(D,Cls,A),
	prove_d(D,Cls,B).
prove_d(D,Cls,A):-
	D>0,D1 is D-1,
	copy_element((A:-B),Cls),	% make copy of clause
	prove_d(D1,Cls,B).
prove_d(D,Cls,A):-
	prove_bg(A).

prove_bg(true):-!.
prove_bg((A,B)):-!,
	prove_bg(A),
	prove_bg(B).
prove_bg(A):-
	bg((A:-B)),
	prove_bg(B).


% Specialisation by removing a refuted clause
specialise(Cls,Done,Example,Clauses):-
	false_clause(Cls,Done,Example,C),
	remove_one(C,Cls,Cls1),
	write('     ...refuted: '),write(C),nl,nl,
	writeln(' to continue'),readln(_),
	process_examples(Cls1,[],[-Example|Done],Clauses).

% false_clause(Cs,E,E,C) <- C is a false clause in the proof of E (or ok)
false_clause(Cls,Exs,true,ok):-!.
false_clause(Cls,Exs,(A,B),X):-!,
	false_clause(Cls,Exs,A,Xa),
	( Xa = ok   -> false_clause(Cls,Exs,B,X)
	; otherwise -> X = Xa
	).
false_clause(Cls,Exs,E,ok):-
	element(+E,Exs),!.
false_clause(Cls,Exs,A,ok):-
	bg((A:-B)),!.
false_clause(Cls,Exs,A,X):-
	copy_element((A:-B),Cls),
	false_clause(Cls,Exs,B,Xb),
	( Xb \= ok		-> X = Xb
	; otherwise		-> X = (A:-B)
	).


% Generalisation by adding a covering clause
generalise(Cls,Done,Example,Clauses):-
	write('Generalising example: '),write(Example),nl,
	search_clause(Done,Example,Cl),
	writeln('Found clause: '),portray_clause(Cl),nl,
	writeln(' to continue'),readln(_),
	process_examples([Cl|Cls],[],[+Example|Done],Clauses).


% search_clause(Exs,E,C) <- C is a clause covering E and
%                           not covering negative examples
%                           (iterative deepening search)
search_clause(Exs,Example,Clause):-
	literal(Head,Vars),
	try((Head=Example)),
	search_clause(3,a((Head:-true),Vars),Exs,Example,Clause).

search_clause(D,Current,Exs,Example,Clause):-
	write(D),write('..'),
	search_clause_d(D,Current,Exs,Example,Clause),!.
search_clause(D,Current,Exs,Example,Clause):-
	D1 is D+1,
	!,search_clause(D1,Current,Exs,Example,Clause).

search_clause_d(D,a(Clause,Vars),Exs,Example,Clause):-
	covers_ex(Clause,Example,Exs),	% goal
	not((element(-N,Exs),covers_ex(Clause,N,Exs))),!.
search_clause_d(D,Current,Exs,Example,Clause):-
	D>0,D1 is D-1,
	specialise_clause(Current,Spec),
	search_clause_d(D1,Spec,Exs,Example,Clause).


% Extensional coverage
covers_ex((Head:-Body),Example,Exs):-
        try((Head=Example,covers_ex(Body,Exs))).

covers_ex(true,Exs):-!.
covers_ex((A,B),Exs):-!,
	covers_ex(A,Exs),
	covers_ex(B,Exs).
covers_ex(A,Exs):-
	element(+A,Exs).
covers_ex(A,Exs):-
	prove_bg(A).


% specialise_clause(C,S) <- S is a minimal specialisation
%                           of C under theta-subsumption
specialise_clause(Current,Spec):-
	add_literal(Current,Spec).
specialise_clause(Current,Spec):-
	apply_subs(Current,Spec).

add_literal(a((H:-true),Vars),a((H:-L),Vars)):-!,
	literal(L,LVars),
	proper_subset(LVars,Vars).
add_literal(a((H:-B),Vars),a((H:-L,B),Vars)):-
	literal(L,LVars),
	proper_subset(LVars,Vars).

apply_subs(a(Clause,Vars),a(Spec,SVars)):-
	copy_term(a(Clause,Vars),a(Spec,Vs)),
	apply_subs1(Vs,SVars).

apply_subs1(Vars,SVars):-
	unify_two(Vars,SVars).
apply_subs1(Vars,SVars):-
	subs_term(Vars,SVars).

unify_two([X|Vars],Vars):-
	element(Y,Vars),
	X=Y.
unify_two([X|Vars],[X|SVars]):-
	unify_two(Vars,SVars).

subs_term(Vars,SVars):-
	remove_one(X,Vars,Vs),
	term(Term,TVars),
	X=Term,
	append(Vs,TVars,SVars).


%%% Queries %%%

term(list([]),[]).
term(list([X|Y]),[item(X),list(Y)]).

%%%%%%%%%%%%%%%%%%  element/2  %%%%%%%%%%%%%%%%%%%%%%%%

/*
literal(element(X,Y),[item(X),list(Y)]).

bg(true).
*/

query1(Clauses):-
	induce_spec([+element(a,[a,b]),
 	             -element(x,[a,b]),
	             +element(b,[b]),
	             +element(b,[a,b])
	            ],Clauses).


%%%%%%%%%%%%%%%%%%  append/3   %%%%%%%%%%%%%%%%%%%%%%%

/*
literal(append(X,Y,Z),[list(X),list(Y),list(Z)]).

bg(true).
*/

query2(Clauses):-
	induce_spec([+append([],[b,c],[b,c]),
	             -append([],[a,b],[c,d]),
	             -append([a,b],[c,d],[c,d]),
	             -append([a],[b,c],[d,b,c]),
	             -append([a],[b,c],[a,d,e]),
	             +append([a],[b,c],[a,b,c])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%   listnum/2    %%%%%%%%%%%%%%%%%%%%%%%


literal(listnum(X,Y),[list(X),list(Y)]).
literal(num(X,Y),[item(X),item(Y)]).

bg((num(1,one):-true)).
bg((num(2,two):-true)).
bg((num(3,three):-true)).
bg((num(4,four):-true)).
bg((num(5,five):-true)).


query3(Clauses):-
	induce_spec([+listnum([],[]),
 	            -listnum([one],[one]),
	             -listnum([1,two],[one,two]),
	             +listnum([1],[one]),
	             -listnum([five,two],[5,two]),
	             +listnum([five],[5])
	            ],Clauses).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


  
Peter Flach | http://www.cs.bris.ac.uk/~flach