--- pl:prolog:pllib:king_rook [2019/06/27 15:50]
+++ 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)

Pokaż stronę Poprzednie wersje

Menadżer multimediów Do góry

AIwiki

Menu

Dla Studentów

Old specialized AI courses

SMaDA/SMaIDA/AIDA

Informatyka (EAIiIB)

Studia Dr

Inne materialy dydaktyczne

Archiwum

Dyplomanci

Geist Season of Code

HeKatE

Public

Różnice