Best First Search
% ----------------------------------------------------
% Alan Lupsha
% Knight's tour - using best-first search
% June 4th, 2007
% ----------------------------------------------------
:- [adts].
state_record(State, Parent, G, H, F, [State, Parent, G, H, F]).
precedes([_,_,_,_,F1], [_,_,_,_,F2]) :- F1 =< F2.
go(Start,Goal) :-
empty_set(Closed),
empty_sort_queue(Empty_open),
heuristic(Start,Goal,H),
state_record(Start, nil, 0, H, H, First_record),
insert_sort_queue(First_record,Empty_open,Open),
path(Open,Closed,Goal).
path(Open,_,_) :-
empty_sort_queue(Open),
write('No solution found with these rules').
path(Open, Closed, Goal) :-
remove_sort_queue(First_record, Open, _),
state_record(State, _, _, _, _, First_record),
State = Goal,
write('A solution is found!'), nl,
printsolution(First_record, Closed).
path(Open, Closed, Goal) :-
remove_sort_queue(First_record, Open, Rest_of_open),
(bagof(Child, moves(First_record, Open, Closed, Child, Goal), Children);Children = []),
insert_list(Children, Rest_of_open, New_open),
add_to_set(First_record, Closed, New_closed),
path(New_open, New_closed, Goal),!.
moves(State_record,Open,Closed,Child,Goal) :-
state_record(State,_,G,_,_,State_record),
move(State,Next),
state_record(Next,_,_,_,_,Test),
not(member_sort_queue(Test,Open)),
not(member_set(Test,Closed)),
G_new is G + 1,
heuristic(Next, Goal, H),
F is G_new + H,
state_record(Next, State, G_new, H, F, Child).
insert_list([], L, L).
insert_list([State | Tail], L, New_L) :-
insert_sort_queue(State, L, L2),
insert_list(Tail, L2, New_L).
printsolution(Next_record, _):-
state_record(State, nil, _,_,_, Next_record),
write(State), nl.
printsolution(Next_record, Closed) :-
state_record(State, Parent, _,_,_, Next_record),
state_record(Parent, _, _, _, _, Parent_record),
member_set(Parent_record, Closed),
printsolution(Parent_record, Closed),
write(State), nl.
% 1 2 3
% 4 5 6
% 7 8 9
move(1,8).
heuristic(1,8,0).
move(1,6).
heuristic(1,6,1).
move(2,7).
heuristic(2,7,1).
move(2,9).
heuristic(2,7,0).
move(3,4).
heuristic(3,4,0).
move(3,8).
heuristic(3,4,1).
move(4,3).
heuristic(4,3,1).
move(4,9).
heuristic(4,3,0).
move(6,1).
heuristic(6,1,1).
move(6,7).
heuristic(6,7,0).
move(7,2).
heuristic(7,2,0).
move(7,6).
heuristic(7,2,1).
move(8,1).
heuristic(8,1,1).
move(8,3).
heuristic(8,3,0).
move(9,4).
heuristic(9,4,0).
move(9,2).
heuristic(9,2,1).
heuristic(X,Y,0).
Example run
% c:/alan/prolog/knight-best.pl compiled 0.00 sec, 16,596 bytes Welcome to SWI-Prolog (Multi-threaded, Version 5.6.34) Copyright (c) 1990-2007 University of Amsterdam. SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software, and you are welcome to redistribute it under certain conditions. Please visit http://www.swi-prolog.org for details. For help, use ?- help(Topic). or ?- apropos(Word). 1 ?- go(1,3). A solution is found! 1 8 3 Yes 2 ?- go(1,9). A solution is found! 1 6 7 2 9 Yes 3 ?- go(1,5). No solution found with these rules Yes 4 ?-
Breadth First Search
% ----------------------------------------------------
% Alan Lupsha
% Knight's tour - using breadth-first search
% June 4th, 2007
% ----------------------------------------------------
:- [adts].
state_record(State, Parent, [State, Parent]).
go(Start,Goal) :-
empty_queue(Empty_open),
state_record(Start, nil, State),
add_to_queue(State, Empty_open, Open),
empty_set(Closed),
path(Open,Closed,Goal).
path(Open,_,_) :-
empty_queue(Open),
write('No solution found with these rules').
path(Open,Closed,Goal) :-
remove_from_queue(Next_record,Open,_),
state_record(State, _, Next_record),
State = Goal,
write('A solution is found!'), nl,
printsolution(Next_record,Closed).
path(Open,Closed,Goal) :-
remove_from_queue(Next_record,Open,Rest_Open),
(bagof(Child, moves(Next_record, Open, Closed, Child), Children);Children = []),
add_list_to_queue(Children,Rest_Open,New_Open),
add_to_set(Next_record, Closed, New_Closed),
path(New_Open,New_Closed,Goal),!.
moves(State_record,Open,Closed,Child_record) :-
state_record(State,_,State_record),
move(State,Next),
state_record(Next,_,Test),
not(member_queue(Test,Open)),
not(member_set(Test,Closed)),
state_record(Next,State,Child_record).
printsolution(State_record, _) :-
state_record(State,nil,State_record),
write(State), nl.
printsolution(State_record,Closed) :-
state_record(State, Parent, State_record),
state_record(Parent, _, Parent_record),
member(Parent_record,Closed),
printsolution(Parent_record,Closed),
write(State),nl.
% 1 2 3
% 4 5 6
% 7 8 9
move(1,8).
move(1,6).
move(2,7).
move(2,9).
move(3,4).
move(3,8).
move(4,3).
move(4,9).
move(6,1).
move(6,7).
move(7,2).
move(7,6).
move(8,1).
move(8,3).
move(9,4).
move(9,2).
unsafe(0).
add_to_queue(E, [], [E]).
add_to_queue(E, [H|T], [H|Tnew]) :- add_to_queue(E, T, Tnew).
add_list_to_queue([], Queue, Queue).
add_list_to_queue([H|T], Queue, New_queue) :-
add_to_queue(H, Queue, Temp_queue),
add_list_to_queue(T, Temp_queue, New_queue).
enqueue( X, Y, Z ) :- add_to_queue(X, Y, Z). % Redefined using file adts
dequeue( X, Y, Z ) :- remove_from_queue(X, Y, Z). % Redefined using file adts
Example run:
% c:/documents and settings/wise grasshopper/pl.ini compiled 0.00 sec, 512 bytes
Warning: (c:/alan/prolog/adts:7):
Singleton variables: [T]
Warning: (c:/alan/prolog/adts:8):
Singleton variables: [Y]
Warning: (c:/alan/prolog/adts:74):
Singleton variables: [E]
% adts compiled 0.00 sec, 10,584 bytes
Warning: (c:/alan/prolog/knight-breadth.pl:79):
Redefined static procedure add_to_queue/3
% c:/alan/prolog/knight-breadth.pl compiled 0.00 sec, 15,112 bytes
Welcome to SWI-Prolog (Multi-threaded, Version 5.6.34)
Copyright (c) 1990-2007 University of Amsterdam.
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit http://www.swi-prolog.org for details.
For help, use ?- help(Topic). or ?- apropos(Word).
1 ?- go(1,3).
A solution is found!
1
8
3
Yes
2 ?- go(1,9).
A solution is found!
1
8
3
4
9
Yes
3 ?- go(1,5).
No solution found with these rules
Yes
4 ?-
Depth First Search
% ----------------------------------------------------
% Alan Lupsha
% Knight's tour - using depth-first search
% June 4th, 2007
% ----------------------------------------------------
:- [adts].
printsolution([State, nil], _) :-
write(State), nl.
printsolution([State,Parent],Closed_set) :-
member_set([Parent,Grandparent],Closed_set),
printsolution([Parent,Grandparent],Closed_set),
write(State),nl.
go(Start,Goal) :-
empty_stack(Empty_open),
stack([Start,nil], Empty_open, Open_stack),
empty_set(Closed_set),
path(Open_stack,Closed_set,Goal).
path(Open_stack,_,_) :-
empty_stack(Open_stack),
write('No solution found with these rules').
path(Open_stack,Closed_set,Goal) :-
stack([State,Parent],_,Open_stack),
State=Goal,
write('A solution is found!'), nl,
printsolution([State, Parent],Closed_set).
path(Open_stack,Closed_set,Goal) :-
stack([State,Parent],Rest_open_stack,Open_stack),
get_children(State,Rest_open_stack,Closed_set,Children),
add_list_to_stack(Children,Rest_open_stack,New_open_stack),
union([[State,Parent]],Closed_set,New_closed_set),
path(New_open_stack,New_closed_set,Goal),!.
get_children(State,Rest_open_stack,Closed_set,Children) :-
bagof(Child,moves(State,Rest_open_stack,Closed_set,Child), Children).
moves(State,Rest_open_stack,Closed_set,[Next,State]) :-
move(State,Next),
not(unsafe(Next)),
not(member_stack([Next,_],Rest_open_stack)),
not(member_set([Next,_],Closed_set)).
% 1 2 3
% 4 5 6
% 7 8 9
move(1,8).
move(1,6).
move(2,7).
move(2,9).
move(3,4).
move(3,8).
move(4,3).
move(4,9).
move(6,1).
move(6,7).
move(7,2).
move(7,6).
move(8,1).
move(8,3).
move(9,4).
move(9,2).
unsafe(0).
add_to_queue(E, [], [E]).
add_to_queue(E, [H|T], [H|Tnew]) :- add_to_queue(E, T, Tnew).
add_list_to_stack( NewList , OldList , ResultList ) :-
append( NewList, OldList, ResultList ).
Example run:
% c:/documents and settings/wise grasshopper/pl.ini compiled 0.00 sec, 512 bytes
Warning: (c:/alan/prolog/adts:7):
Singleton variables: [T]
Warning: (c:/alan/prolog/adts:8):
Singleton variables: [Y]
Warning: (c:/alan/prolog/adts:74):
Singleton variables: [E]
% adts compiled 0.00 sec, 10,584 bytes
Warning: (c:/alan/prolog/knight-depth.pl:65):
Redefined static procedure add_to_queue/3
% c:/alan/prolog/knight-depth.pl compiled 0.02 sec, 14,668 bytes
Welcome to SWI-Prolog (Multi-threaded, Version 5.6.34)
Copyright (c) 1990-2007 University of Amsterdam.
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit http://www.swi-prolog.org for details.
For help, use ?- help(Topic). or ?- apropos(Word).
1 ?- go(1,2).
A solution is found!
1
8
3
4
9
2
Yes
2 ?- go(1,9).
A solution is found!
1
8
3
4
9
Yes
3 ?- go(1,5).
No
4 ?-
Knight’s Tour – operations
%%%%%%%%%%%%%%%%%%%% stack operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%% % These predicates give a simple, list based implementation of stacks % empty stack generates/tests an empty stack member(X,[X|T]). member(X,[Y|T]):-member(X,T). empty_stack([]). % member_stack tests if an element is a member of a stack member_stack(E, S) :- member(E, S). % stack performs the push, pop and peek operations % to push an element onto the stack % ?- stack(a, [b,c,d], S). % S = [a,b,c,d] % To pop an element from the stack % ?- stack(Top, Rest, [a,b,c]). % Top = a, Rest = [b,c] % To peek at the top element on the stack % ?- stack(Top, _, [a,b,c]). % Top = a stack(E, S, [E|S]). %%%%%%%%%%%%%%%%%%%% queue operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % These predicates give a simple, list based implementation of % FIFO queues % empty queue generates/tests an empty queue empty_queue([]). % member_queue tests if an element is a member of a queue member_queue(E, S) :- member(E, S). % add_to_queue adds a new element to the back of the queue add_to_queue(E, [], [E]). add_to_queue(E, [H|T], [H|Tnew]) :- add_to_queue(E, T, Tnew). % remove_from_queue removes the next element from the queue % Note that it can also be used to examine that element % without removing it remove_from_queue(E, [E|T], T). append_queue(First, Second, Concatenation) :- append(First, Second, Concatenation). %%%%%%%%%%%%%%%%%%%% set operations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % These predicates give a simple, % list based implementation of sets % empty_set tests/generates an empty set. empty_set([]). member_set(E, S) :- member(E, S). % add_to_set adds a new member to a set, allowing each element % to appear only once add_to_set(X, S, S) :- member(X, S), !. add_to_set(X, S, [X|S]). remove_from_set(E, [], []). remove_from_set(E, [E|T], T) :- !. remove_from_set(E, [H|T], [H|T_new]) :- remove_from_set(E, T, T_new), !. union([], S, S). union([H|T], S, S_new) :- union(T, S, S2), add_to_set(H, S2, S_new). intersection([], _, []). intersection([H|T], S, [H|S_new]) :- member_set(H, S), intersection(T, S, S_new),!. intersection([_|T], S, S_new) :- intersection(T, S, S_new),!. set_diff([], _, []). set_diff([H|T], S, T_new) :- member_set(H, S), set_diff(T, S, T_new),!. set_diff([H|T], S, [H|T_new]) :- set_diff(T, S, T_new), !. subset([], _). subset([H|T], S) :- member_set(H, S), subset(T, S). equal_set(S1, S2) :- subset(S1, S2), subset(S2, S1). %%%%%%%%%%%%%%%%%%%%%%% priority queue operations %%%%%%%%%%%%%%%%%%% % These predicates provide a simple list based implementation % of a priority queue. % They assume a definition of precedes for the objects being handled empty_sort_queue([]). member_sort_queue(E, S) :- member(E, S). insert_sort_queue(State, [], [State]). insert_sort_queue(State, [H | T], [State, H | T]) :- precedes(State, H). insert_sort_queue(State, [H|T], [H | T_new]) :- insert_sort_queue(State, T, T_new). remove_sort_queue(First, [First|Rest], Rest).