/******************************************************************************Write a prolog program for solving the blocks problem using hill climbing *******************************************************************************/
%trace
domains
heuristic_val = integer
top_type = top(integer)
node_type = on(integer,integer)
nodetype_list = node_type*
top_list = top_type*
file = xoutput
database
curr_db_list(nodetype_list,top_list,heuristic_val)
child_db_list(nodetype_list,top_list,heuristic_val)
best_child(nodetype_list,top_list,heuristic_val)
db_on(integer,integer)
db_top(integer)
heuristic_value_db(integer)
temp_nodelist(nodetype_list)
temp_toplist(top_list)
predicates
block(integer)
initial_state
retract_all_db
write_list
writelist(nodetype_list)
get_heuristic_value(integer)
compute_heuristic
create_node_top_list(nodetype_list,top_list)
create_node_list
create_top_list
append_node(nodetype_list,nodetype_list,nodetype_list)
append_top(top_list,top_list,top_list)
find_children(nodetype_list,top_list,integer)
find_path
find_best_child
move_block(integer,nodetype_list,top_list)
copy_on_top_to_db(nodetype_list,top_list)
copy_on_to_db(nodetype_list)
copy_top_to_db(top_list)
delete_curr_best_db
clauses
write_list:-
curr_db_list(NodeList,TopList,HVal),
writelist(NodeList),
nl,
nl,
fail.
writelist([]):- nl.
writelist([Head|Tail]):-
write(Head),
writelist(Tail).
retract_all_db:-
retractall(curr_db_list(_,_,_)),
retractall(db_on(_,_)),
retractall(db_top(_)),
retractall(heuristic_value_db(_)),
retractall(temp_nodelist(_)),
retractall(temp_toplist(_)),
retractall(child_db_list(_,_,_)),
retractall(best_child(_,_,_)).
block(1).
block(2).
block(3).
block(4).
block(5).
block(6).
block(7).
block(8).
block(0).
initial_state:-
assert(db_on(1,8)),
assert(db_on(8,7)),
assert(db_on(7,6)),
assert(db_on(6,5)),
assert(db_on(5,4)),
assert(db_on(4,3)),
assert(db_on(3,2)),
assert(db_on(2,0)),
assert(db_top(1)),
create_node_top_list(NodeList,TopList),
get_heuristic_value(HeuristicVal),
assert(curr_db_list(NodeList,TopList,HeuristicVal)),
writelist(NodeList).
delete_curr_best_db:-
retractall(best_child(_,_,_)),
assert(best_child([],[],-9999)),
retract(curr_db_list(_,_,_)),
!.
find_path:-
curr_db_list(NodeList,TopList,HeuristicVal),
% retract(curr_db_list(NodeList,TopList,HeuristicVal)),
delete_curr_best_db,
find_children(NodeList,TopList,HeuristicVal),
find_best_child,
best_child(BestNodeList,BestTopList,BestHVal),
writelist(BestNodeList),
BestHVal <> 8,
assert(curr_db_list(BestNodeList,BestTopList,BestHVal)),
% write("BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB\n"),
find_path.
find_path:-!.
find_children(NodeList,TopList,HeuristicVal):-
retractall(db_top(_)),
retractall(db_on(_,_)),
retractall(child_db_list(_,_,_)),
copy_on_top_to_db(NodeList,TopList),
db_top(X),
move_block(X,NodeList,TopList),
fail.
find_children(NodeList,TopList,HeuristicVal):-!.
find_best_child:-
child_db_list(NodeList,TopList,HeuristicValue),
% write("-----CHILD-----------\n"),
% writelist(NodeList),
best_child(A,B,BestValue),
HeuristicValue >= BestValue,
not(best_child(NodeList,TopList,HeuristicValue)),
retract(best_child(A,B,BestValue)),
assert(best_child(NodeList,TopList,HeuristicValue)),
fail.
find_best_child:-!.
get_heuristic_value(X):-
assert(heuristic_value_db(0)),
compute_heuristic(),
heuristic_value_db(X),
retract(heuristic_value_db(X)).
% write(X,"\n").
compute_heuristic:-
block(Y),
db_on(Y,Z),
Y = Z + 1,
heuristic_value_db(OLD_VAL),
retract(heuristic_value_db(OLD_VAL)),
NEW_VAL = OLD_VAL + 1,
assert(heuristic_value_db(NEW_VAL)),
fail.
compute_heuristic:-
block(Y),
db_on(Y,Z),
Y > Z + 1,
heuristic_value_db(OLD_VAL),
retract(heuristic_value_db(OLD_VAL)),
NEW_VAL = OLD_VAL - 1,
assert(heuristic_value_db(NEW_VAL)),
fail.
compute_heuristic:-
block(Y),
db_on(Y,Z),
Y < Z,
heuristic_value_db(OLD_VAL),
retract(heuristic_value_db(OLD_VAL)),
NEW_VAL = OLD_VAL - 1,
assert(heuristic_value_db(NEW_VAL)),
fail.
compute_heuristic.
move_block(X,OldNodeList,OldTopList):-
block(Y),
X <> Y,
Y <> 0,
retractall(db_on(_,_)),
retractall(db_top(_)),
copy_on_top_to_db(OldNodeList,OldTopList),
db_top(Y),
db_on(X,Z),
Z <> 0,
retract(db_on(X,Z)),
retract(db_top(Y)),
assert(db_on(X,Y)),
assert(db_top(Z)),
get_heuristic_value(HeuristicValue),
create_node_top_list(NodeList,TopList),
not(child_db_list(NodeList,TopList,HeuristicValue)),
assert(child_db_list(NodeList,TopList,HeuristicValue)),
% write("MOVED--------------\n"),
% writelist(NodeList),
fail.
move_block(X,OldNodeList,OldTopList):-
block(Y),
X <> Y,
Y <> 0,
retractall(db_on(_,_)),
retractall(db_top(_)),
copy_on_top_to_db(OldNodeList,OldTopList),
db_top(Y),
db_on(X,Z),
Z = 0,
retract(db_on(X,Z)),
retract(db_top(Y)),
assert(db_on(X,Y)),
get_heuristic_value(HeuristicValue),
create_node_top_list(NodeList,TopList),
not(child_db_list(NodeList,TopList,HeuristicValue)),
assert(child_db_list(NodeList,TopList,HeuristicValue)),
% write("MOVED--------------\n"),
% writelist(NodeList),
fail.
move_block(X,OldNodeList,OldTopList):-
% write("\nEntering YYYY"),
block(Y),
X <> Y,
Y = 0,
retractall(db_on(_,_)),
retractall(db_top(_)),
copy_on_top_to_db(OldNodeList,OldTopList),
not(db_on(X,Y)),
db_on(X,Z),
Z <> 0,
retract(db_on(X,Z)),
assert(db_on(X,Y)),
assert(db_top(Z)),
get_heuristic_value(HeuristicValue),
create_node_top_list(NodeList,TopList),
not(child_db_list(NodeList,TopList,HeuristicValue)),
assert(child_db_list(NodeList,TopList,HeuristicValue)),
% write("MOVED--------------\n"),
% writelist(NodeList),
fail.
move_block(X,OldNodeList,OldTopList).
create_node_top_list(NodeList,TopList):-
retractall(temp_nodelist(_)),
retractall(temp_toplist(_)),
assert(temp_nodelist([])),
assert(temp_toplist([])),
create_node_list,
create_top_list,
temp_nodelist(NodeList),
temp_toplist(TopList),
retractall(temp_nodelist(_)),
retractall(temp_toplist(_)).
create_top_list:-
db_top(X),
temp_toplist(TopList),
retract(temp_toplist(TopList)),
append_top([top(X)],TopList,TopList1),
assert(temp_toplist(TopList1)),
fail.
create_top_list.
create_node_list:-
db_on(X,Y),
temp_nodelist(NodeList),
retract(temp_nodelist(NodeList)),
append_node([on(X,Y)],NodeList,NodeList1),
assert(temp_nodelist(NodeList1)),
fail.
create_node_list.
append_node([],ListB,ListB).
append_node([X|List1],List2,[X|List3]):-
append_node(List1,List2,List3).
append_top([],ListB,ListB).
append_top([X|List1],List2,[X|List3]):-
append_top(List1,List2,List3).
copy_on_top_to_db(NodeList,TopList):-
retractall(db_on(_,_)),
retractall(db_top(_)),
copy_on_to_db(NodeList),
copy_top_to_db(TopList),
!.
copy_on_to_db([]).
copy_on_to_db([on(X,Y)|Tail]):-
assert(db_on(X,Y)),
copy_on_to_db(Tail).
copy_top_to_db([]).
copy_top_to_db([top(X)|Tail]):-
assert(db_top(X)),
copy_top_to_db(Tail).
goal
clearwindow,
retract_all_db,
openwrite(xoutput,"hill.dat"),
writedevice(xoutput),
initial_state,
find_path,
closefile(xoutput),
writedevice(screen).
Output
on(2,0)on(3,2)on(4,3)on(5,4)on(6,5)on(7,6)on(8,7)on(1,8)
on(1,0)on(8,7)on(7,6)on(6,5)on(5,4)on(4,3)on(3,2)on(2,0)
on(8,0)on(2,0)on(3,2)on(4,3)on(5,4)on(6,5)on(7,6)on(1,0)
on(7,0)on(1,0)on(6,5)on(5,4)on(4,3)on(3,2)on(2,0)on(8,0)
on(6,0)on(8,0)on(2,0)on(3,2)on(4,3)on(5,4)on(1,0)on(7,0)
on(5,0)on(7,0)on(1,0)on(4,3)on(3,2)on(2,0)on(8,0)on(6,0)
on(4,0)on(6,0)on(8,0)on(2,0)on(3,2)on(1,0)on(7,0)on(5,0)
on(3,0)on(5,0)on(7,0)on(1,0)on(2,0)on(8,0)on(6,0)on(4,0)
on(2,1)on(4,0)on(6,0)on(8,0)on(1,0)on(7,0)on(5,0)on(3,0)
on(3,2)on(5,0)on(7,0)on(1,0)on(8,0)on(6,0)on(4,0)on(2,1)
on(4,3)on(2,1)on(6,0)on(8,0)on(1,0)on(7,0)on(5,0)on(3,2)
on(5,4)on(3,2)on(7,0)on(1,0)on(8,0)on(6,0)on(2,1)on(4,3)
on(6,5)on(4,3)on(2,1)on(8,0)on(1,0)on(7,0)on(3,2)on(5,4)
on(7,6)on(5,4)on(3,2)on(1,0)on(8,0)on(2,1)on(4,3)on(6,5)
on(8,7)on(6,5)on(4,3)on(2,1)on(1,0)on(3,2)on(5,4)on(7,6)