Różnice

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

Odnośnik do tego porównania

pl:prolog:pllib:king_rook [2019/06/27 15:50] (aktualna)
Linia 1: Linia 1:
 +====== King rook ======
 +{{tag>​chess operators}}
 +===== Description =====
 +Game king and rook vs king.
 +
 +**Source**: ​ PROLOG programming for artificial intelligence,​ 3rd Edition, Harlow, 2001, ISBN 0-201-40375-7.
 +===== Download =====
 +Program source code: {{king_rook.pl}}
 +===== Listing =====
 +<code prolog>
 +%
 +%   ?​- ​ pos6( Position), ​   % Position of Fig. 22.8
 +%       play( Position).
 +%
 +% There are other start positions defined at the end of this file
 +
 +
 +% Figure 22.6  A miniture implementation of Advice Language 0.
 +
 +
 +% A miniature implementation of Advice Language 0
 +%
 +% This program plays a game from a given starting position using knowledge
 +% represented in Advice Language 0
 +
 +:-  op( 200, xfy, [:, ::]).
 +:-  op( 220, xfy, ..).
 +:-  op( 185, fx, if).
 +:-  op( 190, xfx, then).
 +:-  op( 180, xfy, or).
 +:-  op( 160, xfy, and).
 +:-  op( 140, fx, not).
 +
 +% The following directive forces that calls to undefined predicates just fail
 +% and not generate errors
 +
 +:- unknown( _, fail).
 +
 +playgame( Pos)  :-                    % Play a game starting in Pos
 +  playgame( Pos, nil).               % Start with empty forcing-tree ​
 +
 +playgame( Pos, ForcingTree) ​ :-
 +  show( Pos),
 +  ( end_of_game( Pos),               % End of game?
 +  write( 'End of game'​),​ nl, !
 +  ;
 +  playmove( Pos, ForcingTree,​ Pos1, ForcingTree1),​ !,
 +  playgame( Pos1, ForcingTree1) ​
 +  ).
 +
 +% Play `us' move according to forcing-tree
 +
 +playmove( Pos, Move .. FTree1, Pos1, FTree1) ​ :-
 +   side( Pos, w),% White = `us'
 +   ​legalmove( Pos, Move, Pos1),
 +   nl, write( 'My move: '​), ​
 +   ​showmove( Move).
 +
 +% Read `them' move
 +
 +playmove( Pos, FTree, Pos1, FTree1) ​ :-
 +   side( Pos, b),
 +   ​write( 'Your move: '),
 +   read( Move),
 +   ( legalmove( Pos, Move, Pos1),
 +     ​subtree( FTree, Move, FTree1), !         % Move down forcing-tree
 +     ;
 +     ​write( '​Illegal move'​),​ nl,
 +     ​playmove( Pos, FTree, Pos1, FTree1)
 +   ).
 +
 +
 +% If current forcing-tree is empty generate a new one
 +
 +playmove( Pos, nil, Pos1, FTree1) ​ :-
 +   side( Pos, w),
 +   ​resetdepth( Pos, Pos0),% Pos0 = Pos with depth 0
 +   ​strategy( Pos0, FTree), !,% Generate new forcing-tree
 +   ​playmove( Pos0, FTree, Pos1, FTree1).
 +
 +% Select a forcing-subtree corresponding to Move
 +
 +subtree( FTrees, Move, FTree) ​ :-
 +   ​member( Move .. FTree, FTrees), !.
 +
 +subtree( _, _, nil).
 +
 +strategy( Pos, ForcingTree) ​ :-           % Find forcing-tree for Pos
 +   Rule :: if Condition then AdviceList, ​ % Consult advice-table
 +   ​holds( Condition, Pos, _), !,          % Match Pos against precondition
 +   ​member( AdviceName, AdviceList), ​      % Try pieces-of-advice in turn
 +   nl, write( '​Trying '), write( AdviceName),​
 +   ​satisfiable( AdviceName, Pos, ForcingTree),​ !.  % Satisfy AdviceName in Pos 
 +
 +satisfiable( AdviceName, Pos, FTree) ​ :-
 +   ​advice( AdviceName, Advice), ​          % Retrieve piece-of-advice
 +   sat( Advice, Pos, Pos, FTree). ​        % `sat' needs two positions
 +                                          % for comparison predicates ​
 +
 +sat( Advice, Pos, RootPos, FTree) ​ :-
 +   ​holdinggoal( Advice, HG),
 +   ​holds( HG, Pos, RootPos), ​             % Holding-goal satisfied
 +   sat1( Advice, Pos, RootPos, FTree).
 +
 +sat1( Advice, Pos, RootPos, nil)  :-
 +   ​bettergoal( Advice, BG),
 +   ​holds( BG, Pos, RootPos), !.           % Better-goal satisfied
 + 
 +sat1( Advice, Pos, RootPos, Move .. FTrees) ​ :-
 +   side( Pos, w), !,% White = `us'
 +   ​usmoveconstr( Advice, UMC),
 +   move( UMC, Pos, Move, Pos1), ​          % A move satisfying move-constr.
 +   sat( Advice, Pos1, RootPos, FTrees).
 +
 +sat1( Advice, Pos, RootPos, FTrees) ​ :-
 +   side( Pos, b), !,                      % Black = `them'
 +   ​themmoveconstr( Advice, TMC),
 +   ​bagof( Move .. Pos1, move( TMC, Pos, Move, Pos1), MPlist),
 +   ​satall( Advice, MPlist, RootPos, FTrees). ​   % Satisfiable in all successors ​
 +
 +satall( _, [], _, [] ).
 +
 +satall( Advice, [Move .. Pos | MPlist], RootPos, [Move .. FT | MFTs] )  :-
 +  sat( Advice, Pos, RootPos, FT),
 +  satall( Advice, MPlist, RootPos, MFTs).
 +
 +% Interpreting holding and better-goals:​
 +% A goal is an AND/OR/NOT combination of predicate names
 +
 +holds( Goal1 and Goal2, Pos, RootPos) ​ :-  !,
 +  holds( Goal1, Pos, RootPos),
 +  holds( Goal2, Pos, RootPos).
 +
 +holds( Goal1 or Goal2, Pos, RootPos) ​ :-  !,
 +  ( holds( Goal1, Pos, RootPos)
 +    ;
 +    holds( Goal2, Pos, RootPos)
 +   ).
 +
 +holds( not Goal, Pos, RootPos) ​ :-  !,
 +  not holds( Goal, Pos, RootPos).
 +
 +holds( Pred, Pos, RootPos) ​ :-
 +  ( Cond =.. [ Pred, Pos]  % Most predicates do not depend on RootPos
 +    ;
 +    Cond =.. [ Pred, Pos, RootPos] ),
 +   call( Cond).
 +
 +% Interpreting move-constraints
 +
 +move( MC1 and MC2, Pos, Move, Pos1)  :-  !,
 +  move( MC1, Pos, Move, Pos1),
 +  move( MC2, Pos, Move, Pos1).
 +
 +move( MC1 then MC2, Pos, Move, Pos1)  :-  !,
 +   ( move( MC1, Pos, Move, Pos1)
 +     ;
 +     move( MC2, Pos, Move, Pos1)
 +   ).
 +
 +% Selectors for components of piece-of-advice
 +
 +bettergoal( BG : _, BG).
 +
 +holdinggoal( BG : HG : _, HG).
 +
 +usmoveconstr( BG : HG : UMC : _, UMC).
 +
 +themmoveconstr( BG : HG : UMC : TMC, TMC).
 +
 +
 +member( X, [X | L] ).
 +
 +member( X, [Y | L] )  :-
 +   ​member( X, L).
 +
 +
 +
 +% Figure 22.7  An AL0 advice-table for king and rook vs king.
 +% The table consists of two rules and six pieces of advice.
 +
 +
 +% King and rook vs. king in Advice Language 0
 +% Rules
 +
 +edge_rule ::
 +if
 +   ​their_king_edge and kings_close
 +then
 +   [ mate_in_2, squeeze, approach, keeproom,
 +
 +
 +divide_in_2,​ divide_in_3 ]. 
 +
 +
 +else_rule ::
 +if
 +   true
 +then
 +   [ squeeze, approach, keeproom, divide_in_2,​ divide_in_3 ].
 +
 +
 +% Pieces-of-advice
 +
 +advice( mate_in_2,
 +  mate :
 +  not rooklost and their_king_edge :
 +  (depth = 0) and legal then (depth = 2) and checkmove :
 +  (depth = 1) and legal).
 +
 +advice( squeeze,
 +  newroomsmaller and not rookexposed and
 +  rookdivides and not stalemate :
 +  not rooklost :
 +  (depth = 0) and rookmove :
 +  nomove).
 +
 +advice( approach,
 +  okapproachedcsquare and not rookexposed and not stalemate and
 +  (rookdivides or lpatt) and (roomgt2 or not our_king_edge) :
 +  not rooklost :
 +  (depth = 0) and kingdiagfirst :
 +  nomove).
 +
 +advice( keeproom,
 +  themtomove and not rookexposed and rookdivides and okorndle and
 +  (roomgt2 or not okedge) :
 +  not rooklost :
 +  (depth = 0) and kingdiagfirst :
 +  nomove).
 +
 +advice( divide_in_2,​
 +  themtomove and rookdivides and not rookexposed :
 +  not rooklost :
 +  (depth < 3) and legal :
 +  (depth < 2) and legal).
 +
 +advice( divide_in_3,​
 +  themtomove and rookdivides and not rookexposed :
 +  not rooklost :
 +  (depth < 5) and legal :
 +  (depth < 4) and legal).
 +
 +
 +% Figure 22.10  Predicate library for king an rook vs king.
 +% Predicate library for king and rook vs. king
 +% Position is represented by: Side..Wx : Wy..Rx : Ry..Bx : By..Depth
 +% Side is side to move (`w' or `b')
 +% Wx, Wy are X and Y-coordinates of White king
 +% Rx, Ry are X and Y-coordinates of White rook
 +% Bx, By are coordinates of Black king
 +% Depth is depth of position in search tree
 +% Selector relations
 +
 +side( Side.._, Side). ​              % Side to move in position
 +wk( _..WK.._, WK).                  % White king coordinates
 +wr( _.._..WR.._,​ WR).               % White rook coordinates
 +bk( _.._.._..BK.._,​ BK).            % Black king coordinates
 +depth( _.._.._.._..Depth,​ Depth). ​    % Depth of position in search tree
 +
 +resetdepth( S..W..R..B..D,​ S..W..R..B..0).% Copy of position with depth 0
 +
 +% Some relations between squares
 +
 +n( N, N1)  :-                       % Neighbour integers `within board' ​  
 +  ( N1 is N + 1
 +    ;
 +    N1 is N - 1
 +  ),
 +  in( N1).
 +
 +in( N)  :-
 +   N > 0, N < 9.
 +
 +diagngb( X : Y, X1 : Y1)  :-        % Diagonal neighbour squares ​  
 +  n( X, X1), n( Y, Y1).
 +
 +verngb( X : Y, X : Y1)  :-          % Vertical neighbour squares ​
 +  n( Y, Y1).
 +
 +horngb( X : Y, X1 : Y)  :-          % Horizontal neighbour squares ​
 +  n( X, X1).
 +
 +ngb( S, S1)  :-                     % Neighbour squares, first diagonal
 +  diagngb( S, S1);
 +  horngb( S, S1);
 +  verngb( S, S1).
 +
 +end_of_game( Pos)  :-
 +  mate( Pos).
 +
 +
 +% Move-constraints predicates
 +% These are specialized move generators:
 +% move( MoveConstr, Pos, Move, NewPos)
 +
 +move( depth < Max, Pos, Move, Pos1)  :-
 +  depth( Pos, D),
 +  D < Max, !.
 +
 +move( depth = D, Pos, Move, Pos1)  :-
 +  depth( Pos, D), !.
 +
 +move( kingdiagfirst,​ w..W..R..B..D,​ W-W1, b..W1..R..B..D1) ​ :-
 +  D1 is D + 1,
 +  ngb( W, W1),             % `ngb' generates diagonal moves first   
 +  not ngb( W1, B),         % Must not move into check 
 +  W1 \== R.               % Must not collide with rook 
 +
 +move( rookmove, w..W..Rx : Ry..B..D, Rx : Ry-R, b..W..R..B..D1) ​ :-
 +  D1 is D + 1,
 +  coord( I),                     % Integer between 1 and 8 
 +  ( R = Rx : I; R = I : Ry),     % Move vertically or horizontally ​
 +  R \== Rx : Ry,                 % Must have moved 
 +  not inway( Rx : Ry, W, R).     % White king not in way 
 +
 +move( checkmove, Pos, R-Rx : Ry, Pos1)  :-
 +  wr( Pos, R),
 +  bk( Pos, Bx : By),
 +  (Rx = Bx; Ry = By),            % Rook and Black king in line 
 +  move( rookmove, Pos, R-Rx : Ry, Pos1).
 +
 +move( legal, w..P, M, P1)  :-
 +  ( MC = kingdiagfirst;​ MC = rookmove),
 +  move( MC, w..P, M, P1).
 +
 +move( legal, b..W..R..B..D,​ B-B1, w..W..R..B1..D1) ​ :-
 +  D1 is D + 1,
 +  ngb( B, B1),
 +  not check( w..W..R..B1..D1).
 +
 +legalmove( Pos, Move, Pos1)  :-
 +  move( legal, Pos, Move, Pos1).
 +
 +check( _..W..Rx : Ry..Bx : By.._ )  :-
 +  ngb( W, Bx : By)                % King's too close  ​
 +  ;
 +  ( Rx = Bx; Ry = By),
 +  Rx : Ry \== Bx : By,            % Not rook captured ​
 +  not inway( Rx : Ry, W, Bx : By).
 +
 +inway( S, S1, S1)  :-  !.
 +
 +inway( X1 : Y, X2 : Y, X3 : Y)  :-
 +  ordered( X1, X2, X3), !.
 +
 +inway( X : Y1, X : Y2, X : Y3)  :-
 +  ordered( Y1, Y2, Y3).
 +
 +ordered( N1, N2, N3)  :-
 +  N1 < N2, N2 < N3;
 +  N3 < N2, N2 < N1.
 +
 +coord(1). coord(2). coord(3). coord(4).
 +coord(5). coord(6). coord(7). coord(8).
 +
 +% Goal predicates
 +
 +true( Pos).
 +
 +themtomove( b.._ ).           % Black = `them' to move 
 +
 +mate( Pos)  :-
 +  side( Pos, b),
 +  check( Pos),
 +  not legalmove( Pos, _, _ ).
 +
 +stalemate( Pos)  :-
 +  side( Pos, b),
 +  not check( Pos),
 +  not legalmove( Pos, _, _ ).
 +
 +newroomsmaller( Pos, RootPos) ​ :-
 +  room( Pos, Room),
 +  room( RootPos, RootRoom),
 +  Room < RootRoom.
 +
 +rookexposed( Side..W..R..B.._ )  :-
 +  dist( W, R, D1),
 +  dist( B, R, D2),
 +  ( Side = w, !, D1 > D2 + 1
 +    ;
 +    Side = b, !, D1 > D2
 +  ).
 +
 +okapproachedcsquare( Pos, RootPos) ​ :-
 +  okcsquaremdist( Pos, D1),
 +  okcsquaremdist( RootPos, D2),
 +  D1 < D2.
 +
 +okcsquaremdist( Pos, Mdist) ​ :​-  ​
 +                       % Manhattan distance between WK and critical square
 +  wk( Pos, WK),
 +  cs( Pos, CS),        % Critical square ​
 +  manhdist( WK, CS, Mdist).
 +
 +rookdivides( _..Wx : Wy..Rx : Ry..Bx : By.._ )  :-
 +  ordered( Wx, Rx, Bx), !;
 +  ordered( Wy, Ry, By).
 +
 +lpatt( _..W..R..B.._ )  :-          % L-pattern ​
 +  manhdist( W, B, 2),
 +  manhdist( R, B, 3).
 +
 +okorndle( _..W..R.._, _..W1..R1.._ )  :-
 +  dist( W, R, D),
 +  dist( W1, R1, D1),
 +  D =< D1.
 +
 +roomgt2( Pos)  :-
 +  room( Pos, Room),
 +  Room > 2.
 +
 +our_king_edge( _..X : Y.._ )  :-               % White king on edge 
 +  ( X = 1, !; X = 8, !; Y = 1, !; Y = 8).
 +
 +their_king_edge( _..W..R..X : Y.._ )  :-       % Black king on edge 
 +  ( X = 1, !; X = 8, !; Y = 1, !; Y = 8).
 +
 +kings_close( Pos)  :-             % Distance between kings < 4  ​
 +  wk( Pos, WK), bk( Pos, BK),
 +  dist( WK, BK, D),
 +  D < 4.
 +
 +rooklost( _..W..B..B.._ ).        % Rook has been captured ​
 +
 +rooklost( b..W..R..B.._ )  :-
 +  ngb( B, R),                     % Black king attacks rook 
 +  not ngb( W, R).                 % White king does not defend ​
 +
 +dist( X : Y, X1 : Y1, D)  :-      % Distance in king moves 
 +  absdiff( X, X1, Dx),
 +  absdiff( Y, Y1, Dy),
 +  max( Dx, Dy, D).
 +
 +absdiff( A, B, D)  :-
 +  A > B, !, D is A-B;
 +  D is B-A.
 +
 +max( A, B, M)  :-
 +  A >= B, !, M = A;
 +  M = B.
 +
 +manhdist( X : Y, X1 : Y1, D)  :-    % Manhattan distance  ​
 +  absdiff( X, X1, Dx),
 +  absdiff( Y, Y1, Dy),
 +  D is Dx + Dy.
 +
 +room( Pos, Room)  :-                % Area to which B. king is confined ​
 +  wr( Pos, Rx : Ry),
 +  bk( Pos, Bx : By),
 +  ( Bx < Rx, SideX is Rx - 1; Bx > Rx, SideX is 8 - Rx),
 +  ( By < Ry, SideY is Ry - 1; By > Ry, SideY is 8 - Ry),
 +  Room is SideX * SideY, !
 +  ;
 +  Room is 64.                       % Rook in line with Black king 
 +
 +cs( _..W..Rx : Ry..Bx : By.._, Cx : Cy)  :-    % `Critical square' ​
 +  ( Bx < Rx, !, Cx is Rx - 1; Cx is Rx + 1),
 +  ( By < Ry, !, Cy is Ry - 1; Cy is Ry + 1).
 +
 +% Display procedures
 +
 +show( Pos)  :-
 +  nl,
 +  coord( Y), nl,
 +  coord( X),
 +  writepiece( X : Y, Pos),
 +  fail.
 +
 +show( Pos)  :-
 +  side( Pos, S), depth( Pos, D),
 +  nl, write( 'Side= '), write( S),
 +  write( ' ​ Depth= '), write( D), nl.
 +
 +writepiece( Square, Pos)  :-
 +  wk( Pos, Square), !, write( '​W'​);​
 +  wr( Pos, Square), !, write( '​R'​);​
 +  bk( Pos, Square), !, write( '​B'​);​
 +  write( '​.'​).
 +
 +showmove( Move)  :-
 +  write( Move).
 +
 +
 +% Some positions
 +
 +pos1( w..3:​3..8:​8..4:​1..0).
 +
 +pos2( w..5:​6..4:​4..2:​2..0).
 +
 +pos3( w..2:​2..1:​1..8:​8..0).
 +
 +pos4( b..2:​2..5:​5..4:​4..1).
 +
 +pos5( w..1:​1..4:​4..3:​3..0). ​
 +
 +pos6( w..4:​4..5:​6..3:​2..0). ​   % Example from Prolog for AI book
 +
 +pos7( w..4:​4..2:​1..3:​2..0).
 + 
 +play( Pos)  :-  playgame(Pos).
 +
 +% Query to play a game, for example: ?- pos1(P), playgame(P).
 +
 +
 +
 +
 +
 +% Library of frequently used predicates
 +
 +:- op( 900, fy, not).
 +
 +% 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.
 +
 +% once( Goal):
 +%   ​Produce one solution of Goal only (only the first solution)
 +
 +once( Goal)  :-
 +  Goal, !.
 +
 +% member( X, List): X is a member of List
 +
 +member(X,[X | _]).                 % X is head of list
 +
 +member( X, [_ | Rest]) ​ :-         
 +  member( X, Rest). ​               % X is in body of list
 +
 +%  conc(L1,​L2,​L3):​ list L3 is th econcatenation of lists L1 and L2
 +
 +conc( [], L, L).
 +
 +conc( [X | L1], L2, [X | L3])  :-
 +  conc( L1, L2, L3).
 +
 +% del(X,​L0,​L):​ List L is equal to list L0 with X deleted
 +%   Note: Only one occurrence of X is deleted
 +
 +del( X, [X | Rest], Rest). ​       % Delete the head
 +
 +del( X, [Y | Rest0], [Y | Rest]) ​ :-
 +  del( X, Rest0, Rest).
 +
 +%  subset( Set, Subset): ​ list Set contains all the elements of list Subset ​
 +%    Note: The elements of Subset appear in Set in the same order as in Subset
 +
 +subset( [], []).
 +
 +subset( [First | Rest], [First | Sub])  :-       % Retain First in subset
 +  subset( Rest, Sub).
 +
 +subset( [First | Rest], Sub)  :-                 % Remove First
 +  subset( Rest, Sub).
 +
 +%  set_difference( Set1, Set2, Set3): ​ Set3 is the list representing ​
 +%    the difference of sets represented by lists Set1 and Set2
 +
 +set_difference( [], _, []).
 +
 +set_difference( [X | S1], S2, S3)  :-
 +  member( X, S2),  !,                            % X in set S2
 +  set_difference( S1, S2, S3).
 +
 +set_difference( [X | S1], S2, [X | S3])  :-      % X not in S2
 +  set_difference( S1, S2, S3).
 +
 +%  length( List, Length): Lentgh is the length of List
 +%    Note: Often provided as built-in predicate
 +%    The definition below is tail-recursive ​
 +%    It can also be used to generate efficiently list of given length
 +
 +length( L, N)  :-
 +  length( L, 0, N).
 +
 +length( [], N, N).
 +
 +length( [_ | L], N0, N)  :-
 +  N1 is N0 + 1,
 +  length( L, N1, N).
 +
 +
 +
 +%  max( X, Y, Max): Max = max(X,Y)
 +
 +max( X, Y, Max)  :-
 +  X >= Y, !, Max = X
 +  ;
 +  Max = Y.
 +
 +%  min( X, Y, Min): Min = min(X,​Y) ​
 +
 +min( X, Y, Min)  :-
 +  X =< Y, !, Min = X
 +  ;
 +  Min = Y.
 +
 +
 +% copy_term( T1, T2): T2 is equal to T1 with variables renamed
 +% This is often available as a built-in predicate
 +% Procedure below assumes that copy_term is called with T2 uninstantiated
 +
 +copy_term( Term, Copy)  :-
 +  asserta( term_to_copy( Term)),
 +  retract( term_to_copy( Copy)), !.
 +
 +
 +</​code>​
 +===== Comments =====
  
pl/prolog/pllib/king_rook.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