Różnice

Różnice między wybraną wersją a wersją aktualną.

Odnośnik do tego porównania

pl:prolog:pllib:8_puzzle [2019/06/27 15:50] (aktualna)
Linia 1: Linia 1:
 +====== 8 puzzle ======
 +{{tag>​puzzle}}
 +===== Description =====
 +Problem-specific procedures for the eight puzzle, to be used in best-first search
 +
 +**Source**: ​ PROLOG programming for artificial intelligence,​ 3rd Edition, Harlow, 2001, ISBN 0-201-40375-7.
 +===== Download =====
 +Program source code: {{prolog:​pllib:​8_puzzle.pl}}
 +===== Listing =====
 +<code prolog>
 +% Figure 12.6  Problem-specific procedures for the eight 
 +% puzzle.
 +
 +:- op( 900, fy, not).
 +
 +/* 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:
 +
 +                           This position is represented by:
 +3        1    2    3
 +2        8         ​4 ​      [2/2, 1/3, 2/3, 3/3, 3/2, 3/1, 2/1, 1/1, 1/2]
 +1        7    6    5
 +          ​
 +         ​1 ​   2    3
 +
 +"​Empty'​ can move to any of its neighbours which means 
 +that "​empty'​ and its neighbour interchange their positions.
 +*/
 +
 +% s( Node, SuccessorNode,​ Cost)
 +
 +s( [Empty | Tiles], [Tile | Tiles1], 1)  :-  % All arc costs are 1
 +  swap( Empty, Tile, Tiles, Tiles1). ​        % Swap Empty and Tile in Tiles 
 +
 +swap( Empty, Tile, [Tile | Ts], [Empty | Ts] )  :-
 +  mandist( Empty, Tile, 1).                  % Manhattan distance = 1
 +
 +swap( Empty, Tile, [T1 | Ts], [T1 | Ts1] )  :-
 +  swap( Empty, Tile, Ts, Ts1).
 +
 +mandist( X/Y, X1/Y1, D)  :-          % D is Manhhattan dist. between two squares
 +  dif( X, X1, Dx),
 +  dif( Y, Y1, Dy),
 +  D is Dx + Dy.
 +
 +dif( A, B, D)  :-              % D is |A-B|
 +  D is A-B, D >= 0, !
 +  ;
 +  D is B-A.
 +
 +% 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),      % Total distance from home squares
 +  seq( Tiles, S),                       % Sequence score
 +  H is D + 3*S.
 +
 +totdist( [], [], 0).
 +
 +totdist( [Tile | Tiles], [Square | Squares], D)  :-
 +  mandist( Tile, Square, D1),
 +  totdist( Tiles, Squares, D2),
 +  D is D1 + D2.
 +
 +% seq( TilePositions,​ Score): sequence score
 +
 +seq( [First | OtherTiles],​ S)  :-
 +  seq( [First | OtherTiles ], First, S).
 +
 +seq( [Tile1, Tile2 | Tiles], First, S)  :-
 +  score( Tile1, Tile2, S1),
 +  seq( [Tile2 | Tiles], First, S2),
 +  S is S1 + S2.
 +
 +seq( [Last], First, S)  :-
 +  score( Last, First, S).
 +
 +score( 2/2, _, 1)  :-  !.              % Tile in centre scores 1
 +
 +score( 1/3, 2/3, 0)  :-  !.            % Proper successor scores 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).                       % Tiles out of sequence score 2
 +
 +goal( [2/​2,​1/​3,​2/​3,​3/​3,​3/​2,​3/​1,​2/​1,​1/​1,​1/​2] ).  % Goal squares for tiles
 +
 +% 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] ),                           % Order of Y-coordinates
 +  nl, member( X, [1,2,3] ),                       % Order of X-coordinates
 +  member( Tile-X/​Y, ​                              % Tile on square X/Y
 +          [' '​-S0,​1-S1,​2-S2,​3-S3,​4-S4,​5-S5,​6-S6,​7-S7,​8-S8] ),
 +  write( Tile),
 +  fail                                            % Backtrack to next square
 +  ;
 +  true.                                           % All squares done
 +
 +% Starting positions for some puzzles
 +
 +start1( [2/​2,​1/​3,​3/​2,​2/​3,​3/​3,​3/​1,​2/​1,​1/​1,​1/​2] ).  % Requires 4 steps
 +
 +start2( [2/​1,​1/​2,​1/​3,​3/​3,​3/​2,​3/​1,​2/​2,​1/​1,​2/​3] ).  % Requires 5 steps
 +
 +start3( [2/​2,​2/​3,​1/​3,​3/​1,​1/​2,​2/​1,​3/​3,​1/​1,​3/​2] ).  % Requires 18 steps
 +
 +% An example query: ?- start1( Pos), bestfirst( Pos, Sol), showsol( Sol).
 +
 +
 +
 +
 +% not Goal): negation as failure; ​
 +%   Note: This is often available as a built-in predicate,
 +%   often written as prefix operator "​\+",​ e.g. \+ likes(mary,​snakes)
 +
 +not Goal  :-
 +  Goal, !, fail
 +  ; 
 +  true.
 +
 +% bestfirst( Start, Solution): Solution is a path from Start to a goal
 +
 +bestfirst( Start, Solution) :-
 +  expand( [], l( Start, 0/0),  9999, _, yes, Solution).
 + %  Assume 9999 is greater than any f-value
 +
 +% expand( Path, Tree, Bound, Tree1, Solved, Solution):
 +%   Path is path between start node of search and subtree Tree,
 +%   Tree1 is Tree expanded within Bound,
 +%   if goal found then Solution is solution path and Solved = yes
 +
 +%  Case 1: goal leaf-node, construct a solution path
 +
 +expand( P, l( N, _), _, _, yes, [N|P]) ​ :-
 +   ​goal(N).
 +
 +%  Case 2: leaf-node, f-value less than Bound
 +%  Generate successors and expand them within Bound.
 +
 +expand( P, l(N,F/G), Bound, Tree1, Solved, Sol)  :-
 +  F  =<  Bound,
 +  (  bagof( M/C, ( s(N,M,C), not member(M,P) ), Succ), ​
 +     ​!, ​                                   % Node N has successors
 +     ​succlist( G, Succ, Ts),               % Make subtrees Ts
 +     ​bestf( Ts, F1),                       % f-value of best successor
 +     ​expand( P, t(N,​F1/​G,​Ts),​ Bound, Tree1, Solved, Sol)
 +     ;
 +     ​Solved = never                        % N has no successors - dead end
 +  ) .
 +
 +%  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]),​ Bound, Tree1, Solved, Sol)  :-
 +  F  =<  Bound,
 +  bestf( Ts, BF), min( Bound, BF, Bound1), ​         % Bound1 = min(Bound,​BF)
 +  expand( [N|P], T, Bound1, T1, Solved1, Sol),
 +  continue( P, t(N,​F/​G,​[T1|Ts]),​ Bound, Tree1, Solved1, Solved, Sol).
 +
 +%  Case 4: non-leaf with empty subtrees
 +%  This is a dead end which will never be solved
 +
 +expand( _, t(_,_,[]), _, _, never, _) :- !.
 +
 +%  Case 5:  f-value greater than Bound
 +%  Tree may not grow.
 +
 +expand( _, Tree, Bound, Tree, no, _)  :-
 +  f( Tree, F), F > Bound.
 +
 +% continue( Path, Tree, Bound, NewTree, SubtreeSolved,​ TreeSolved, Solution)
 +
 +continue( _, _, _, _, yes, yes, Sol).
 +
 +continue( P, t(N,​F/​G,​[T1|Ts]),​ Bound, Tree1, no, Solved, Sol)  :-
 +  insert( T1, Ts, NTs),
 +  bestf( NTs, F1),
 +  expand( P, t(N,​F1/​G,​NTs),​ Bound, Tree1, Solved, Sol).
 +
 +continue( P, t(N,​F/​G,​[_|Ts]),​ Bound, Tree1, never, Solved, Sol)  :-
 +  bestf( Ts, F1),
 +  expand( P, t(N,​F1/​G,​Ts),​ Bound, Tree1, Solved, Sol).
 +
 +% succlist( G0, [ Node1/​Cost1,​ ...], [ l(BestNode,​BestF/​G),​ ...]):
 +%   make list of search leaves ordered by their F-values
 +
 +succlist( _, [], []).
 +
 +succlist( G0, [N/C | NCs], Ts)  :-
 +  G is G0 + C,
 +  h( N, H),                             % Heuristic term h(N)
 +  F is G + H,
 +  succlist( G0, NCs, Ts1),
 +  insert( l(N,F/G), Ts1, Ts).
 +
 +% Insert T into list of trees Ts preserving order w.r.t. f-values
 +
 +insert( T, Ts, [T | Ts])  :-
 +  f( T, F), bestf( Ts, F1),
 +  F  =<  F1, !.
 +
 +insert( T, [T1 | Ts], [T1 | Ts1])  :-
 +  insert( T, Ts, Ts1).
 +
 +
 +% Extract f-value
 +
 +f( l(_,F/_), F).        % f-value of a leaf
 +
 +f( t(_,F/_,_), F).      % f-value of a tree
 +
 +bestf( [T|_], F)  :-    % Best f-value of a list of trees
 +  f( T, F).
 +
 +bestf( [], 9999). ​      % No trees: bad f-value
 +  ​
 +min( X, Y, X)  :-
 +  X  =<  Y, !.
 +
 +min( X, Y, Y).
 +
 +
 +</​code>​
 +===== Comments =====
  
pl/prolog/pllib/8_puzzle.txt · ostatnio zmienione: 2019/06/27 15:50 (edycja zewnętrzna)
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0