rubik.pro

来自「prolog开发工具」· PRO 代码 · 共 670 行 · 第 1/2 页

% CUBE SOLVER II
%   A Rubik's Cube Solver
%   written by Dennis Merritt
%   as described in Building Expert Systems in Prolog (Springer-Verlag)
%   available from:
%     Amzi! inc.
%     40 Samuel Prescott Dr.
%     Stow, MA 01775 USA
%     Tel [phone], FAX [phone]
%     e-mail [e-mail]
%
%  This program may be copied, modified and redistributed although proper
%  acknowledgement is appreciated.
%
%  This implementation was done with Cogent Prolog, also available
%  from Amzi! inc.
%
%  This is the main module which contains the predicates for 
%         the main control loop,
%         manual mode,
%         solve mode, and
%         utility functions.
%
% Note - The Cogent/Prolog compiler supports modules.  The export declarations
%        are for predicates defined in the current module which may be used
%        by other modules.  The import declarations are for predicates 
%        defined in other modules.

:-export main/0.
:-export append/3.
:-export get_flag/2.
:-export set_flag/2.
:-export error/1.
:-export reverse/2.

:-import add_history/1.     % rubhist
:-import cnd/2.             % rubdata
:-import cube_print/1.      % rubdisp
:-import get_color/1.       % rubedit
:-import pristine/1.        % rubdata
:-import rub_help/0.        % rubhelp
:-import m_disp/1.          % rubdisp
:-import m_choose/2.        % rubdisp
:-import move/3.            % rubmov
:-import orientation/2.     % rubdata
:-import pln/2.             % rubdata
:-import rdfield/2.         % rubdisp
:-import rdchar/2.          % rubdisp
:-import redit/1.           % rubedit
:-import rewrite/2.         % rubedit
:-import rot/3.             % rubmov
:-import seq/2.             % rubdata
:-import side_color/1.      % rubdata
:-import s_r/2.             % rubdata
:-import vw/2.              % rubdata 
:-import wrfield/2.         % rubdisp
:-import writec/2.          % rubdisp

:-import logfile/1.			% dynamic db
:-import impplan/1.        % dynamic db
:-import state/1.          % dynamic db
:-import crit/1.           % dynamic db
:-import ghoul/1.          % dynamic db
:-import sidecolor/1.      % dynamic db
:-import flag/2.				% dynamic db
:-import cand/1.				% dynamic db
:-import candmove/1.			% dynamic db

:-op(500,xfy,:).

main :- banner, go.  % The start up entry point

go:-                       % The main control loop 
  repeat,
  init_color,
  m_disp(main),            % The main menu
  m_choose(main,X),        % Select an item
  do(X),                   % Execute it
  X == exit.               % Go back to the repeat or end

% These are the predicates which are called for the various
% main menu choices.  The cut after each ensures they wont be
% backtracked into when the main loop fails.

do(solve):-solve,!.        % in this module
do(manual):-manual,!.      % in this module
do(help):-rub_help,!.      % in rubhelp
do(exit).                  % built-in predicate to exit

banner:-
  nl,nl,
  write($Cube Solver II$),nl,
  write($An illustrative Prolog program from$),nl,
  write($Building Expert Systems in Prolog (Springer-Verlag) by Dennis Merritt$),nl,
  write($implemented in Cogent Prolog$),nl,nl,
  write($For more information contact:$),nl,
  write($Amzi! inc.$),nl,
  write($40 Samuel Prescott Dr.$),nl,
  write($Stow, MA 01775 USA$),nl,
  write($Tel [phone], FAX [phone]$),nl,
  write($e-mail [e-mail]$),nl,nl.

% These predicates initialize the state to the goal state (ghoul),
% and allow you to enter single moves.  They are intended to demonstrate the
% effects of the various sequences used by the solve routines.

% They are also called by the solve routine if manual scrambling 
% is requested

manual:-
  pristine(G),                            % Start with the goal state
  retractif(state(_)),
  assert(state(G)),
  cube_print(G),                       % Display it
  disp_moves,                          % List the possible moves
  repeat,                              % Start repeat-fail loop
  rdfield(move,M),                     % Get a move
  (M==q, nl, !                         % If '', clear and end
   ;
   state(S),
   man_move(M,S,S2),                   % Apply move to it
   retract(state(_)),
   assert(state(S2)),
   cube_print(S2),fail).               % Print it and fail back

man_move(M,S,S2):-
  movel(M,S,S2),!.
man_move(M,S,S2):-               % Pop a + in front of an unsigned move
  movel(+M,S,S2),!.
man_move(M,_,_):-
  error('Unknown move'-M),!,fail. 

disp_moves:-                  % List the three types of moves
  wrfield(moves,''),          % Heading
  move(X,_,_),                % Will backtrack through all moves
  write(X),tab(1),            % Write move
  fail.                       % Go back for the next one
disp_moves:-                  
  nl,
  wrfield(rotations,''),      % No more moves, do the same for rots
  rot(X,_,_),
  write(X),tab(1),
  fail.
disp_moves:-                  % And again for seqs
  nl,
  wrfield(sequences,''),
  seq(X,_),
  write(X),tab(1),
  fail.
disp_moves:-                 % Got em all, end
  nl,
  wrfield(end_disp,'').

% This is the main body of the program which actually solves the cube.
% See rubdoc1 and rubdoc2 for the big picture

solve:-
  m_disp(solve),              % solve submenu
  m_choose(solve,X),
  rdchar(stepmode,SM),
  (SM==`y , set_flag(stepmode,on)   % check for a y (scan code 21)
   ;
   set_flag(stepmode,off)),
  solve(X).                   % call solve w/ arity one with menu choice

solve(X):-
  init_solve(X),              % initialize all the stuff
  T1 is cputime,
  stages,
  T is cputime - T1,
  state(S),
  cube_print(S),
  write($Done  time = $),
  write(T), nl, nl.
solve(X):-
  error('failing to solve'),
  halt.             % something wrong, back to main

init_solve(X):-
  wrfield(prob,X),
  initialize(X),               % getting closer to the real work
  !.

initialize(X):-
  pristine(G),
  retractall(ghoul(_)),
  assert(ghoul(G)),
  init_crit(Crit),           % set up the initial criteria (all variables
  retractall(crit(_)),
  assert(crit(Crit)),
  retractall(stage(_)),
  assert(stage(1)),           % the first stage will call the others
  !,initial(X).              % get specific start state in the database

initial(random):-                 % create a new random cube
  random_cube(Cube),
  retractall(state(_)),
  assert(state(Cube)), !.
initial(edit):-                   % edit your own
  redit(Cube),
  retractall(state(_)),
  assert(state(Cube)),
  new_colors(Cube), !.
initial(manual):-                 % scramble your own
  manual,
  state(Cube),
  new_colors(Cube),!.

stages:-
  repeat,
  retract(stage(N)),
  init_stage(N,Plan),        % Set the stage, get the plan
  state(S),
  cube_print(S),
  build_plan(Plan),
  improve(N,Plan),                % Put the pieces in the plan in place
  vw(N,V),                   % undo the stage view (done by init_stage)
  undo_view(V),
  N2 is N + 1,               % next stage
  assert(stage(N2)),
  N2 >= 7.

build_plan([]) :- !.
build_plan([H|T]) :-
  assert(impplan(H)),
  build_plan(T).

% init_stage goes to rubdata to get the table entries which define
% the heuristics for the stage

init_stage(N,Plan):-         % return list of target pieces for this stage
  wrfield(stage,N),
  cnd(N,Cands),              % set up candidate moves used by search
  build_cand(Cands),
  vw(N,V),                   % set up preferred view for stage
  set_view(V),
  pln(N,Plan),!.             % get list of target pieces

% improve - works through the list of target pieces for the stage.
%           it first checks to see if its already in place

improve(Stage,[]) :- !.
improve(Stage,[Piece|Rest]) :-
  impro(Stage,Piece),
  !, improve(Stage,Rest).

improve(Stage):-
  impplan(Piece),
  impro(Stage,Piece).

impro(Stage,Piece) :-
  add_criteria(Piece,Crit),                % Add new piece to criteria
  target_loc(Piece,Pos,Orient),            % Where is it
  impr(Orient,Stage,Pos,Piece),
  !.

impr(0,_,_,_) :- !.                        % In place and oriented
impr(_,Stage,Pos,Piece) :- imp(Stage,Pos,Piece).

% imp - getting into the real work

imp(Stage,Pos,Piece):-
  color_piece(PieceC,Piece),         % translate side notation to
  wrfield(target,PieceC),            %   color notation for display
  heuristics(Stage,Pos),             % See if special help is needed.
  orientation(Piece, View),          % Preferred view for this piece.
  set_view(View),
  crit(Crit),
  state(State),
  cntr_set(4,0),						% to limit wild searches
%  gc(7),
  rotate(Moves,State,Crit),      % Search for moves which transform
  retract(state(_)),
  assert(state(Crit)),
  wrfield(rot,Moves),
  add_history(Moves),
  undo_view(View),!.

heuristics(Stage,Pos):-
  (shift_right_1(Stage,Pos);
   shift_right_2(Stage,Pos)),!.
heuristics(_,_):-true.

% The shift_right heuristics are used to avoid the situations where
% the piece is in one of the target positions for the stage, but the
% wrong one, or mis-oriented.  By blindly moving it to the right the
% search is reduced since it doesn't have to search to move it both 
% out of a critical target position and back into the correct one.

shift_right_1(1,Pos):-
  smember('L',Pos),            % Is the target piece already on the left?
  s_r(Pos,Moves),              % If so get the canned moves to move it 
  change(Moves),               % right for easy search.
  !.

shift_right_2(Stage,Pos):-
  Stage < 4,                   % If the target piece is not on the right
  notsmember('R',Pos),         % side, get the canned moves to put it
  s_r(Pos,Moves),              % there to allow easier search
  change(Moves),
  !.

% rotate - the real guts of the solution, all the rest of the code provides
%          support for these six lines.

% These lines illustrate the power and obscurity of Prolog.
% Prolog can be very expressive when the main information is carried
% in the predicate.  However, sometimes the work is being done by
% unification, and it is not at all apparent by reading the code.
% Furthermore, since Prolog predicates often work backwards and
% forwards, it is not clear in a given case what is intended to be
% be input, and what is the output, and, as in this case, what might
% be an in-out.

% The input and output states of rotate are:

% Input: Moves - unbound
%        State - bound to the cube structure for the current state
%        Crit  - partially bound cube structure.  the bound portions
%                represent the pieces in place + the current goal piece

% Output: Moves - a list of moves
%         State - same as input
%         Crit  - fully bound to the new state

% rotate does a breadth first search by recursively calling itself
% before it calls get_move which trys new moves.  it does not save the
% search trees as most breadth first algorithms do, but rather recalculates
% the moves since they can be executed so fast.

% get_move fails when called with the partially bound Crit, unless
% it is a move which reaches the desired state.  The failure causes
% backtracking.  However when rotate calls itself, it gives it a
% fully unbound variable NextState.  This call to rotate succeeds and
% keeps adding new moves generated by get_move on backtracking.