Refactoring A* algo from Prolog Programming for Artificial Intelligence #2585
jjtolton
started this conversation in
Show and tell
Replies: 3 comments 1 reply
-
Maybe start with aiming for a generic version, like this. |
Beta Was this translation helpful? Give feedback.
1 reply
-
Adding 8-puzzle: :- use_module(library(time)).
:- use_module(library(lambda)).
:- use_module('/path/to/astar.pl').
/* Problem-specific procedures for the eight puzzle
Current situation is represented as a list of positions of the tiles, with first item in the
list corresponding to the empty square.
Example:
3
2
1
1 2 3
8 4
7 6 5
This position is represented by:
[2/2, 1/3, 2/3, 3/3, 3/2, 3/1, 2/1, 1/1, 1/2]
1 2 3
'Empty' can move to any of its neighbours, which means that 'empty' and its
neighbour interchange their positions.
*/
% D is I A-B
% s( Node, SuccessorNode, Cost)
s( [Empty | Tiles], [Tile | Tiles1], 1) :-
swap( Empty, Tile, Tiles, Tiles1).
swap( Empty, Tile, [Tile | Ts], [Empty | Ts]):-
mandist( Empty, Tile, 1).
swap( Empty, Tile, [T1 | Ts], [T1 | Ts1]) :-
swap( Empty, Tile, Ts, Ts1).
mandist( X/Y, X1/Y1, D) :-
D #= abs(X1-X)+abs(Y1-Y).
% Heuristic estimate h is the sum of distances of each tile
% from its 'home' square plus 3 times 'sequence' score
h( [_Empty | Tiles], H) :-
goal( [_Empty1 | GoalSquares]),
totdist( Tiles, GoalSquares, D),
seq_score( Tiles, S),
H #= D + 3*S.
totdist([],[],0).
totdist( [Tile | Tiles], [Square | Squares], D) :-
mandist( Tile, Square, D1),
totdist( Tiles, Squares, D2),
D #= D1 + D2.
% seq( TilePositions, Score): sequence score
% All arc costs are 1
% Swap Empty and Tile in Tiles
% Manhattan distance = 1
% D is Manh. dist. between two squares
% Total distance from home squares
% Sequence score
seq_score( [First | OtherTiles], S) :-
seq_score( [First | OtherTiles ], First, S).
seq_score( [Tile1, Tile2 | Tiles], First, S) :-
score( Tile1, Tile2, S1),
seq_score( [Tile2 | Tiles], First, S2),
S #= S1 + S2.
seq_score( [Last], First, S) :-
score( Last, First, S).
score(2/2,_,1).
score( 1/3, 2/3, 0).
score( 2/3, 3/3, 0).
score( 3/3, 3/2, 0).
score( 3/2, 3/1, 0).
score( 3/1, 2/1, 0).
score( 2/1, 1/1, 0).
score( 1/1, 1/2, 0).
score( 1/2, 1/3, 0).
score(_, _, 2).
goal( [2/2,1/3,2/3,3/3,3/2,3/1,2/1,1/1,1/2]).
% Display a solution path as a list of board positions
showsol( [ ]).
showsol( [P | L]) :-
showsol( L),
nl,write('---'),
showpos( P).
% Display a board position
showpos( [S0,S1,S2,S3,S4,S5,S6,S7,S8]) :-
( member( Y, [3,2,1]),
nl, member( X, [1,2,3]),
member( Tile-X/Y, [' '-S0,1-S1,2-S2,3-S3,4-S4,5-S5,6-S6,7-S7,8-S8]),
write( Tile),
fail
; true
).
% Starting positions for some puzzles
start1( [2/2,1/3,3/2,2/3,3/3,3/1,2/1,1/1,1/2]).
start2( [2/1,1/2,1/3,3/3,3/2,3/1,2/2,1/1,2/3]).
start3( [2/2,2/3,1/3,3/1,1/2,2/1,3/3,1/1,3/2]).
% Backtrack to next square
% All squares done
% Requires 4 steps
% Requires 5 steps
% Requires 18 steps
% An example query:
?- _+\(time((start1(Pos),
bestfirst( Pos, Sol),
showsol( Sol)))
).
%@
%@ ---
%@ 134
%@ 8 2
%@ 765
%@ ---
%@ 134
%@ 82
%@ 765
%@ ---
%@ 13
%@ 824
%@ 765
%@ ---
%@ 1 3
%@ 824
%@ 765
%@ ---
%@ 123
%@ 8 4
%@ 765 % CPU time: 0.005s, 7_635 inferences
%@ true
%@ ; ... . |
Beta Was this translation helpful? Give feedback.
0 replies
-
Monoton-ish version of A*: :- use_module(library(debug)).
:- use_module(library(lists)).
% Start( % bestfirst, Solution): Solution is a path from Start to a goal
bestfirst( Start, Solution) :-
expand( [], leaf( Start, 0/0), _, yes, Solution).
% expand( Path, Tree, Tree1, Solved, Solution):
% Path is path between start node of search and subtree Tree,
% if goal found then Solution is solution path and Solved = yes
% Case 1: goal leaf-node, construct a solution path
expand( P, leaf( N, _), _, yes, [N | P]) :-
goal(N).
% Case 2: leaf-node, f-value less than Bound
% Generate successors and expand them within Bound
expand( P, leaf(N, F/G), Tree1, Solved, Sol) :-
( bagof( M/C, ( s(N, M, C), maplist(dif(M), P)), Succ),
succlist( G, Succ, Ts), % Make subtrees Ts
bestf( Ts, F1), % f-value of best successor
expand( P, t(N, F1/G, Ts), Tree1, Solved, Sol)
; Solved=never
).
% Case 3: non-leaf, f-value less than Bound
% Expand the most promising subtree; depending on
% results, procedure continue will decide how to proceed
expand( P, t(N, F/G, [T | Ts]), Tree1, Solved, Sol) :-
bestf( Ts, BF),
expand( [N | P], T, T1, Solved1, Sol),
continue( P, t(N, F/G, [T1 | Ts]), Tree1, Solved1, Solved, Sol).
% Case 4: non-leaf with empty subtrees
% This is a dead end which will never be solved
expand( _, t(_, _, []), _, never, _) :- !.
% continue( Path, Tree, Bound, NewTree, SubtreeSolved, TreeSolved, Solution)
continue( _,_,_, yes, yes, _Sol).
continue( P, t(N, _F/G, [T1 | Ts]), Tree1, no, Solved, Sol) :-
insert( Ts, T1, NTs),
bestf( NTs, F1),
expand( P, t(N, F1/G, NTs), Tree1, Solved, Sol).
continue( P, t(N, _F/G, [_ | Ts]), Tree1, never, Solved, Sol) :-
bestf( Ts, F1),
expand( P, t(N, F1/G, Ts), Tree1, Solved, Sol).
%% succlist( G0, [Nodel/Cost1, ...], [leaf(BestNode, BestF/G),
% make list of search leaves ordered by their f-values
succlist( _,[],[]).
succlist( G0, [N/C | NCs], Ts) :-
G #= G0 + C,
h( N, H),
F #= G + H,
succlist( G0, NCs, Ts1),
insert(Ts1, leaf(N, F/G), Ts).
% Heuristic term h(N)
% Insert T into list of trees Ts preserving order with respect to f-values
insert([], T, [T]).
insert(Ts0, T, Ts) :-
f(T, F),
bestf(Ts0, F1),
if_(clpz_t(F #=< F1),
Ts=[T|Ts0],
( Ts0=[Tx|Ts0_],
Ts =[Tx|Ts_],
insert(Ts0_, T, Ts_)
)
).
f(leaf(_, F/_), F).
f(t(_, F/_,_),F).
bestf( [T | _], F) :-
f( T, F).
bestf( [],9999).
|
Beta Was this translation helpful? Give feedback.
0 replies
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Uh oh!
There was an error while loading. Please reload this page.
Uh oh!
There was an error while loading. Please reload this page.
-
I've adapted the A* program from Prolog Programming for Artificial Intelligence with very few modifications except switching to clpz. So far I have not been able to make a "pure" version, and every effort to do so has failed.
That being said, I think the approach taken here is quite interesting, I've never seen A* done using a literal tree before (as opposed to maintaining a priority queue of nodes). Encountered a lot of interesting things while exploring this problem, may highlight a few in the discussion below.
A*
Example problem: Task Scheduling
Edit Log
insert/3
Beta Was this translation helpful? Give feedback.
All reactions