rubik.pro

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

% eventually get_move finds a match and rotate succeeds.

rotate([], State, State).            % start with a no move
rotate(Moves, State, Crit):-         % nothing didnt work, get serious
  rotate(PriorMoves, State, NextState), % get something to build on
%  cntr_inc(4,N4),
%  check_prog(N4),
  get_move(ThisMove, NextState, Crit),  % generate possible moves
  append(PriorMoves, [ThisMove], Moves).   % build up the list

check_prog(N) :- N < 250, !.
check_prog(_) :-
  error('not converging'),
  halt.


% The following predicates all perform various useful services
% for the main predicates above.  Some are declared export as well
% and are used by other modules

% add_criteria puts a new piece on the criteria structure.  it works
% by creating two piece format lists, one of the goal state, and the
% other of the current criteria.  It then walks through the two lists
% simultaneously looking for the target piece in the goal state.
% when it finds it it adds it to the criteria.  Crit is unbound on entry

add_criteria(Piece,Crit):-
  crit(OldCrit),
  pieces(OldCrit, OldCritP),
  ghoul(Ghoul),
  pieces(Ghoul, GhoulP),
  add_crit(OldCritP, GhoulP, NewCritP, Piece),
  pieces(Crit, NewCritP),
  retract(crit(_)),
  assert(crit(Crit)), !.

add_crit([V1|V2], [V3|V4], [V3|V2], V5):-
  matches(V3, V5),!.
add_crit([V1|V2], [V3|V4], [V1|V5], V6):-
  !,add_crit(V2, V4, V5, V6).
add_crit(V1, V2, V3, V4):-
  error('something wrong with add_crit'),!.

% The center tiles dont move on the cube.  Sooo if someone enters a cube
% with different color sides then we must find the new center tiles
% and map the new colors to the sides accordingly

new_colors(Cube):- 
  rewrite(ColorCube,Cube),
  get_color(ColorCube),
  rewrite(ColorCube,NewCube),
  retract(state(_)),
  assert(state(NewCube)).

% Set up the initial mapping of sides to colors

init_color:-
  side_color(SC),
  retractall(sidecolor(_)),
  ini_col(SC).

ini_col([]):- !.
ini_col([S-C|T]):-
  assert(sidecolor(S-C)),
  ini_col(T).

% translate a piece in piece notation to color notation

color_piece(PieceC,Piece):-
  Piece=..[p|Args],
  col_p(ArgsC,Args),
  PieceC=..[p|ArgsC].

col_p([],[]):- !.
col_p([PC|RestC],[P|Rest]):-
  sidecolor(P-PC),
  col_p(RestC,Rest).

% execute about 50 or 60 random rotations to the goal cube.  due to the
% random function, the random cubes will be the same from run to
% run.  It always starts from the same seed.

random_cube(Cube):-
  ghoul(Start),
  rand_cub(Start,Cube,50).

rand_cub(Cube,Cube,0).
rand_cub(Now,Cube,N):-
  repeat,
  rand_move(M,RN),
  movel(M,Now,Next),
  NN is N - 1,
  !,rand_cub(Next,Cube,NN).

rand_move(M,RN):-
  RN is integer(random*12),
  arg(RN,m(+f,+b,+r,+l,+u,+d,-f,-b,-r,-l,-u,-d),M).

% the classic

member(V1, [V1|V2]):- !.
member(V1, [V2|V3]):-
  member(V1, V3).

% display a list of terms without the list notation

write_list([]):-true.
write_list([H|T]):-
  write(H),tab(1),
  write_list(T).

% target_loc finds the location of a given piece on the cube.  it can
% also be used to find the piece at a given location.  it returns the
% orientation as well, which is 0 if in place, or 1 if in place but
% twisted

target_loc(Piece, Pos, Orient):-
  ghoul(Gt),
  pieces(Gt, G),
  state(St),
  pieces(St, S),
  find_piece(G, S, Pos, Piece, Orient),!.
target_loc(Piece, _,_):-
  error('Failing to find piece'-Piece),
  fail.

% find_piece does the work for target_loc, walking two lists simultaneously
% looking for either the piece or the position, whichever is bound.

find_piece([Gh|Gt], [Sh|St], Pos, Piece, Orient):-
  matches(Pos, Gh),
  matches(Piece, Sh),
  comp(Gh,Sh,Orient),!.
find_piece([V1|V2], [V3|V4], V5, V6, Orient):-
  !,find_piece(V2, V4, V5, V6, Orient).

matches(V1, V2):-
  comp(V1, V2, V3),
  V3 < 2,!.

% comp returns 0 if direct hit, 1 if in place but twisted, and
% 2 if no match

comp(p(V1), p(V1), 0):- !.
comp(p(V1, V2), p(V1, V2), 0):- !.
comp(p(V1, V2), p(V2, V1), 1):- !.
comp(p(V1, V2, V3), p(V1, V2, V3), 0):- !.
comp(p(V1, V2, V3), p(V1, V3, V2), 1):- !.
comp(p(V1, V2, V3), p(V2, V1, V3), 1):- !.
comp(p(V1, V2, V3), p(V2, V3, V1), 1):- !.
comp(p(V1, V2, V3), p(V3, V1, V2), 1):- !.
comp(p(V1, V2, V3), p(V3, V2, V1), 1):- !.
comp(V1, V2, 2).

% allows easy handling of database entries used as flags

set_flag(Flag,Val):-
  retract(flag(Flag,_)),
  assert(flag(Flag,Val)), !.
set_flag(Flag,Val):-
  assert(flag(Flag,Val)).

get_flag(Flag,Val):-
  flag(Flag,Val).

% get_move is used by rotate to generate moves.  the possible moves
% are stored in the database under the key cand.  backtracking causes
% successive moves to be tried

get_move(+V1, V2, V3):-
  cand(V1),
  movep(V1, V2, V3).
get_move(-V1, V2, V3):-
  cand(V1),
  movep(V1, V3, V2).

% build_cand creates the database of possible moves for a given stage.
% this is one of the important heuristics for limiting the search

build_cand(V1):-
  retractall(cand(_)),
  retractall(candmove(_)),
  build_cands(V1),!.

build_cands([]):- !.
build_cands([V1|V2]):-
  can_seq(V1),
  assertz(cand(V1)),
  !,build_cands(V2).

can_seq(M):-                      % if the search move is a sequence
  seq(M,S),                       % precompute it, so it isn't constantly
  variable(X),                    % redone during search.
  move_list(S,X,Y),
  assertz(candmove(m(M,X,Y))), !.
can_seq(_).

% another classic

append([], V1, V1).
append([V1|V2], V3, [V1|V4]):-
  append(V2, V3, V4).

% apply a list of moves to a state

move_list([], V1, V1):- !.
move_list([Move|V3], V4, V5):-
  movel(Move, V4, V6),
  !,move_list(V3, V6, V5).

% movel is the basic move predicate called from everywhere

movel(+M, V2, V3):-        % distinguish between clockwise
  movep(M, V2, V3),!.
movel(-M, V2, V3):-        % and counter clockwise moves
  movep(M, V3, V2),!.

% find the move, be it a simple move, a rotation, or a sequence.
% if its a sequence break it into its simple componenents

movep(M, X, Y):- move(M, X, V3), !, Y = V3.
movep(M, X, Y):- rot(M, X, V3), !, Y = V3.
movep(M, X, Y):- candmove(m(M,X,V3)), !, Y = V3.
movep(V1, V2, V3):-
  seq(V1, V4), !,
  move_list(V4, V2, V3),!.
movep([V1|V2], V3, V4):- move_list([V1|V2], V3, V4),!.

% same as move_list, only print new state when done

move_listp(V1, V2, V3):-
  move_list(V1, V2, V3),
  wrfield(rot,V1).

% change is move_list for keeps.
% it takes the old value changes it, updates it,
% and records the history.  it is called by the heuristic routines

change(ML):-
  retract(state(Old)),
  move_listp(ML,Old,New),
  add_history(ML),
  assert(state(New)), !.

% establish a new view.  this means not just rotating the cube, but also
% rotating the criteria and the goal structures.  this is necessary so
% any predicates working with any of the three winds up comparing
% apples and apples.

set_view([]):- !.
set_view(V):-
  retract(state(S1)),
  move_list(V, S1, S2),
  assert(state(S2)),
  retract(ghoul(G1)),
  move_list(V, G1, G2),
  assert(ghoul(G2)),
  retract(crit(C1)),
  move_list(V, C1, C2),
  assert(crit(C2)),
  wrfield(rot,V),
  add_history(V),!.

undo_view([]):- !.
undo_view(RV):-
  reverse(RV,V),
  set_view(V),!.


% convert a cube structure to a list of pieces and visa versa

pieces(cube(X1, X2, X3, X4, X5, X6,
  V7, V8, V9, V10, V11, V12, V13, V14, V15, V16, V17, 
  V18, V19, V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V30, 
  V31, V32, V33, V34, V35, V36, V37, V38, V39, V40, V41, V42, V43, 
  V44, V45, V46, V47, V48, V49, V50, V51, V52, V53, V54), 
    [p(X1), p(X2), p(X3), p(X4), p(X5), p(X6),
  p(V7, V8, V9), p(V10, V11, V12), p(V13, V14, V15), p(V16, V17, V18), 
  p(V19, V20, V21), p(V22, V23, V24), p(V25, V26, V27), p(V28, V29, V30), 
  p(V31, V32), p(V33, V34), p(V35, V36), p(V37, V38),
  p(V39, V40), p(V41, V42), 
  p(V43, V44), p(V45, V46), p(V47, V48),
  p(V49, V50), p(V51, V52), p(V53, V54)]).

% get an unbound cube

variable(cube(X1, X2, X3, X4, X5, X6,
  V7, V8, V9, V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, 
  V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V30, V31, V32, V33, 
  V34, V35, V36, V37, V38, V39, V40, V41, V42, V43, V44, V45, V46, V47, 
  V48, V49, V50, V51, V52, V53, V54)).

% the initial criteria, unbound except for the six center tiles

init_crit(cube('F', 'R', 'U', 'B', 'L', 'D',
  V7, V8, V9, V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, 
  V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V30, V31, V32, V33, 
  V34, V35, V36, V37, V38, V39, V40, V41, V42, V43, V44, V45, V46, V47, 
  V48, V49, V50, V51, V52, V53, V54)).

notsmember(X,Y):-smember(X,Y),!,fail.
notsmember(X,Y):-true.

% like the classic, but works on a structure instead

smember(X,Y):-
  Y=..[Fun|Args],
  member(X,Args).

% display errors

error(X):-
  wrfield(error,X), nl,
  get1(_).

% reverse a list of moves, and flip the signs along the way

reverse(L, R) :- rever(L, [], R).

rever([], Z, Z).
rever([H|T], X, Z) :-
  flip_sign(H, FH),
  rever(T, [FH|X], Z).

flip_sign(+ X, - X):- !.
flip_sign(- X, + X):- !.

retractif(X) :-
  retract(X),
  !.
retractif(_).