Friday, July 6, 2007

BFS

domains
node=symbol
path=symbol*
paths=path*
predicates
solve(node,path)
edge(node,node)
final(node)
p(node,node,path)
append2(path,path,paths)
bfs(paths,path)
extend(path,path,paths)
conc(paths,paths,paths)
member(node,path)
clauses
edge(n1,n2).
edge(n1,n3).
edge(n2,n4).
edge(n2,n5).
edge(n3,n6).
edge(n3,n7).
final(n4).
final(n7).
solve(Start,Sol):-
bfs([[Start]],Sol).
bfs([[NodePath]_],[NodePath]):-
final(Node).
bfs([PathPaths],Sol):-
extend(Path,Path,Newpath),
conc(Paths,Newpath,Path1),
bfs(Path1,Sol).
extend(Path1,[NodePath],New):-
findall(Newnode,p(Node,Newnode,Path1),New1),
append2(New1,Path1,New),!.
extend(Path,Path,[]).
conc([],L,L).
conc([HList1],List2,[HT1]):-
conc(List1,List2,T1).
p(Node,Newnode,Path1):-
edge(Node,Newnode),
not(member(Newnode,Path1)).
append2([],_,[]).
append2([HNew2],L2,[[HL2]T]):-
append2(New2,L2,T).
member(H,[H_]).
member(H,[_T]):-
member(H,T).
goal
solve(n1,Sol).

monkey banana problem

domains
slist=string*
predicates
member(string,slist)
check(string)
monkey(string,string,string)
check1(char)
check2(char)
clauses
monkey(C,B,S):-L=["chair","stick","banana"],member(C,L),member(B,L),member(S,L),check(C),check(B),check(S),nl,write("Climb the chair"),nl,write("Take the bananas"),nl.
check(X):-X="chair",nl,write("Is chair under bananas?(Y/N) "),readchar(CH),check1(CH).
check(X):-X="stick",nl,write("Is stick in hand? (Y/N) "),readchar(CH1),check2(CH1).
check(X):-X="banana".
check1(G):-G='N',write("Place chair under bananas"),nl.
check1(G):-G='Y'.
check2(H):-H='N',write("Take stick in hand").
check2(H):-H='Y'.
member(P,[P_]).
member(P,[_T]):-member(P,T).

BNM

domains
node = symbol
path = symbol*
database
edge(node,node)
final(node)
predicates
solve(node,path)
depth(path,node,path)
go
member(node,path)
clauses
go:-
write("enter first node"),nl,
readln(N1),
write("enter second node"),nl,
readln(N2),
assert(edge(N1,N2)),nl,
write("do you wish to continue? 'y'/'n' "),nl,
readchar(D),
D='y',
go.
go:-
write("enter start node"),nl,
readln(P1),
write("enter final node"),nl,
readln(P2),
assert(final(P2)),nl,
solve(P2,Solution),nl,
write(Solution).
member(X,[X_]) .
member(X,[_T]) :-
member(X,T).
solve(Node,Solution) :-
depth([],Node,Solution).
depth(Path,Node,[NodePath]) :- final(Node).
depth(Path,Node,Solution) :- edge(Node,Node1),
not(member(Node1,Path)),
depth([NodePath],Node1,Solution).
goal go.

depth first search

domains
list=symbol*
predicates
solve(symbol,list)
depthfirstsearch(list,symbol,list)
successor(symbol,symbol)
member(symbol,list)
final(symbol)
clauses
successor(a,b).
successor(b,d).
successor(b,e).
successor(a,c).
successor(c,f).
successor(c,g).
final(d).
final(e).
final(f).
final(g).
member(X,[X_]) .
member(X,[_T]) :-
member(X,T).
solve(Node,Solution) :-
depthfirstsearch([],Node,Solution).
depthfirstsearch(Path,Node,[NodePath]) :- final(Node).
depthfirstsearch(Path,Node,Solution) :- successor(Node,Node1),
not(member(Node1,Path)),
depthfirstsearch([NodePath],Node1,Solution).
goal solve(c,S).

n-queen Problem

domains
queen = q(integer,integer)
queens = queen*
freelist = integer*
board = board(queens,freelist,freelist,freelist,freelist)
predicates
placeN(integer,board,board)
place_a_queen(integer,board,board)
nqueens(integer)
makelist(integer,freelist)
del(integer,freelist,freelist)
clauses
nqueens(N):-
makelist(N,L),
Diagonal=N*2-1,
makelist(Diagonal,LL),
placeN(N,board([],L,L,LL,LL),Final),
write(Final).
placeN(_,board(D,[],[],D1,D2),board(D,[],[],D1,D2)):-!.
placeN(N,B1,R):-
place_a_queen(N,B1,B2),
placeN(N,B2,R).
place_a_queen(N,board(Queens,Rows,Cols,Diag1,Diag2),
board([q(Row,Col)Queens],NewR,NewC,ND1,ND2)):-
del(Row,Rows,NewR),
del(Col,Cols,NewC),
D1 = N+Col-Row,
del(D1,Diag1,ND1),
D2 = Row+Col-1,
del(D2,Diag2,ND2).
del(X,[XRest],Rest).
del(X,[YRest],[YTail]):-
del(X,Rest,Tail),X<>Y.
makelist(1,[1]).
makelist(N,[NRest]):-
N>0,
N1=N-1,
makelist(N1,Rest).

Tower of hanoi

domains
loc=symbol
predicates
hanoi(integer)
move(integer,loc,loc,loc)
inform(loc,loc)
clauses
hanoi(N):-move(N,left,right,middle).
move(1,A,_,C):-
inform(A,C),!.
move(N,A,B,C):-
N1=N-1,
move(N1,A,C,B),
inform(A,B),
move(N1,B,A,C).
inform(LOC1,LOC2):-
write("\n move disc from ",LOC1," to " ,LOC2).

water jug problem

domains
j1=integer
j2=integer
predicates
water(j1,j2)
water(integer,integer,integer,integer)
clauses
water(2,B,_,_):-B<4.
water(A,_):-A>4,write("Jug One capacity exceeded").
water(_,B):-B>3,write("Jug two capacity exceeded").
water(A,B):-A=4,B=0,X=1,Y=3,write("jug1=",X," ","jug2=",Y).
water(P,Q):-P=1,Q=3,P1=1,Q1=0,write("jug1=",P1," ","jug2=",Q1).
water(P,Q):-P=1,Q=0,P1=0,Q1=1,write("jug1=",P1," ","jug2=",Q1).
water(P,Q):-P=0,Q=1,P1=4,Q1=1,write("jug1=",P1," ","jug2=",Q1).
water(P,Q):-P=4,Q=1,P1=2,Q1=3,write("jug1=",P1," ","jug2=",Q1),write("Solution reached").