/* 

  Maze (rolling dice puzzle) in Picat.

  See the description of the problem in 
  Kenichi Sasagawa "A Puzzle 37 Years in the Solving"
  https://medium.com/@kenichisasagawa/a-puzzle-37-years-in-the-making-7d54090d7c4a
  """
  The Puzzle

  You’re given an 18x18 grid filled with numbers from 1 to 6. You start with a die placed 
  in the upper-left corner. The challenge is to roll the die (not slide it) across the 
  board to the bottom-right corner. At each square, the die’s bottom face must match the 
  number written on the grid.
  """

  The code is a port of the N-Prolog program:
  https://github.com/sasagawa888/nprolog/blob/master/example/maze.pl

  Output:
  [[[17,17],3],[[16,17],6],[[16,16],5],[[16,15],1],[[16,14],2],[[15,14],4],[[14,14],5],[[13,14],3],[[13,15],1],[[14,15],5],[[15,15],6],[[15,16],4],[[15,17],1],[[14,17],5],[[13,17],6],[[13,16],4],[[13,15],1],[[12,15],2],[[12,14],3],[[11,14],6],[[10,14],4],[[9,14],1],[[8,14],3],[[8,15],2],[[8,16],4],[[9,16],1],[[9,17],5],[[8,17],4],[[7,17],2],[[7,16],1],[[6,16],3],[[6,15],5],[[5,15],6],[[4,15],2],[[4,14],4],[[4,13],5],[[4,12],3],[[5,12],6],[[5,11],2],[[5,10],1],[[4,10],3],[[3,10],6],[[2,10],4],[[2,9],5],[[2,8],3],[[3,8],6],[[3,7],2],[[3,6],1],[[3,5],5],[[4,5],4],[[5,5],2],[[6,5],3],[[6,4],6],[[6,3],4],[[6,2],1],[[5,2],2],[[5,1],3],[[5,0],5],[[6,0],1],[[7,0],2],[[8,0],6],[[8,1],3],[[9,1],5],[[10,1],4],[[11,1],2],[[11,2],1],[[11,3],5],[[11,4],6],[[11,5],2],[[12,5],3],[[13,5],5],[[13,6],1],[[13,7],2],[[12,7],3],[[12,8],6],[[11,8],5],[[10,8],1],[[10,7],3],[[10,6],6],[[10,5],4],[[10,4],1],[[9,4],2],[[8,4],6],[[8,5],4],[[8,6],1],[[8,7],3],[[7,7],5],[[6,7],4],[[6,8],6],[[7,8],5],[[8,8],1],[[9,8],2],[[9,7],4],[[9,6],5],[[8,6],1],[[7,6],2],[[6,6],6],[[6,7],4],[[5,7],5],[[4,7],3],[[3,7],2],[[2,7],4],[[2,6],6],[[1,6],5],[[0,6],1],[[0,5],3],[[0,4],6],[[1,4],5],[[1,3],4],[[2,3],1],[[3,3],3],[[3,2],2],[[2,2],1],[[2,1],4],[[2,0],6],[[1,0],5]]
  CPU time 0.006 seconds. Backtracks: 0


  Cf my rolling_dice_maze_planner.pi for a version using the planner module.

  This model was created by Hakan Kjellerstrand, hakank@gmail.com
  See also my Picat page: http://www.hakank.org/picat/

*/

import v3_utils.

main => go.

go ?=>
  solve_x,  
  nl.
go => true.

/*
  The code below is from
  https://github.com/sasagawa888/nprolog/blob/master/example/maze.pl
  with some adjustments for Picat.
*/

/*
  dice puzzle

?- solve.
see https://qiita.com/sym_num/items/bc8bfb67fde98ce3787d
*/


data([[1,4,1,3,6,3,1,4,6,6,2,1,5,6,2,1,1,4],
      [5,4,2,4,5,5,5,5,5,3,2,3,5,4,2,3,5,5],
      [6,4,1,1,1,4,6,4,3,5,4,2,4,1,5,6,6,4],
      [2,4,2,3,5,5,1,2,6,2,6,5,1,2,6,3,2,2],
      [1,1,6,3,1,4,1,3,6,4,3,4,3,5,4,2,1,3],
      [5,3,2,5,1,2,5,5,1,2,1,2,6,1,3,6,6,5],
      [1,6,1,4,6,3,6,4,6,4,3,3,1,2,3,5,3,4],
      [2,2,6,5,1,2,2,5,5,5,6,5,1,2,6,2,1,2],
      [6,3,6,4,6,4,1,3,1,1,3,4,3,5,3,2,4,4],
      [5,5,5,4,2,3,5,4,2,3,1,2,6,6,1,6,1,5],
      [1,4,6,3,1,4,6,3,1,6,4,3,4,2,4,5,1,3],
      [5,2,1,5,6,2,2,4,5,3,6,5,1,2,6,5,1,2],
      [6,3,6,4,1,3,6,3,6,1,6,4,3,5,3,2,4,4],
      [2,5,2,4,2,5,1,2,5,4,2,3,6,6,3,1,4,6],
      [1,4,1,1,6,3,1,3,6,6,1,6,3,2,5,5,2,5],
      [1,5,6,3,5,3,5,4,2,3,5,4,3,1,4,6,4,1],
      [3,1,3,6,3,3,6,3,1,1,2,1,6,3,2,1,5,6],
      [6,5,1,2,6,5,1,5,1,2,6,5,5,3,2,4,5,3]]).

aref(R,C,X) :-
    data(M),
    row(R,M,V),
    col(C,V,X).

row(0,[V|Vs],V).
row(N,[V|Vs],X) :-
    N1 is N-1,
    row(N1,Vs,X).

col(0,[E|Es],E).
col(N,[E|Es],X) :-
    N1 is N-1,
    col(N1,Es,X).

diceU([F,B,U,D,L,R],[D,U,F,B,L,R]).
diceD([F,B,U,D,L,R],[U,D,B,F,L,R]).
diceL([F,B,U,D,L,R],[R,L,U,D,F,B]).
diceR([F,B,U,D,L,R],[L,R,U,D,B,F]).

%initial dice
dice([1,6,5,2,4,3]).

% hakank: Renamed solve/0 to solve_x/0
solve_x :- abolish($arrive/3),assert($arrive(-1,-1,-1)),dice(X),solve1(0,0,X,[]).

solve1(17,17,X,Root) :- write(Root).

%goto up
solve1(S,T,X,Root) :-
  S > 0,
  S1 is S - 1,
  not(bp.arrive(S,T,down)),
  not(bp.arrive(S1,T,up)),
  diceU(X,[F,B,U,D,L,R]),
  aref(S1,T,F),
  assertz($arrive(S1,T,up)),
  solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]).

%goto right
solve1(S,T,X,Root) :-
  T < 17,
  T1 is T + 1,
  not(bp.arrive(S,T,left)),
  not(bp.arrive(S,T1,right)),
  diceR(X,[F,B,U,D,L,R]),
  aref(S,T1,F),
  assertz($arrive(S,T1,right)),
  solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]).

%goto down
solve1(S,T,X,Root) :-
  S < 17,
  S1 is S + 1,
  not(bp.arrive(S,T,up)),
  not(bp.arrive(S1,T,down)),
  diceD(X,[F,B,U,D,L,R]),
  aref(S1,T,F),
  assertz($arrive(S1,T,down)),
  solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]).

%goto left
solve1(S,T,X,Root) :-
  T > 0,
  T1 is T - 1,
  not(bp.arrive(S,T,right)),
  not(bp.arrive(S,T1,left)),
  diceL(X,[F,B,U,D,L,R]),
  aref(S,T1,F),
  assertz($arrive(S,T1,left)),
  solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]).