% solving a number place puzzle (np07.pl)
% 2007.1.24-26,27,29 (last edit. 22 Feb 2007)
% language: prolog
% creator: Kenryo Indo
% reference for sample problems:
% Koronbusu: Daisuuraku:Sho Kyu Hen, Mirion Shuppan, 2006(Japanese)
% Koronbusu: Daisuuraku:Chu-Jo Kyu Hen, Mirion Shuppan, 2006(Japanese)

list_of_numbers([1,2,3,4,5,6,7,8,9]).
n(X):- list_of_numbers(L),member(X,L).

lateral(1,l).
lateral(2,c).
lateral(3,r).

vertical(1,u).
vertical(2,m).
vertical(3,d).

coordinate((U,V),(X,Y)):- 
   lateral(_,U),vertical(_,V),
   lateral(_,X),vertical(_,Y).

has_same_X_coordinate(((U,_),(X,_)),((U,_),(X,_))).
has_same_Y_coordinate(((_,V),(_,Y)),((_,V),(_,Y))).

solve_np(Z):-
   init_solution,
   findall((X,Y),coordinate(X,Y),W),
   solve_np_1(W,[],Z).

solve_np_r(Z):-
   init_solution,
   findall((X,Y),coordinate(X,Y),W),
   reverse(W,W1),
   solve_np_1(W1,[],Z1),
   reverse(Z1,Z).

solve_np_s(Z):-
   init_solution,
   findall_coordinates_sorted(W),
   solve_np_1(W,[],Z1),
   findall((X,Y,K),(coordinate(X,Y),member((X,Y,K),Z1)),Z).


solve_np_a(Z):-
   init_solution,
   findall((X,Y),coordinate(X,Y),W),
   solve_np_2(W,[],Z).

solve_np_r_a(Z):-
   init_solution,
   findall((X,Y),coordinate(X,Y),W),
   reverse(W,W1),
   solve_np_2(W1,[],Z1),
   reverse(Z1,Z).

solve_np_s_a(Z):-
   init_solution,
   findall_coordinates_sorted(W),
   solve_np_2(W,[],Z1),
   findall((X,Y,K),(coordinate(X,Y),member((X,Y,K),Z1)),Z).

findall_coordinates_sorted(W):-
   findall((K,X,Y),(permissible_numbers(X,Y,O),length(O,K)),W1),
   sort(W1,W2),
   findall((X,Y),member((K,X,Y),W2),W).

solve_np_1([],_,[]).
solve_np_1([(P,Q)|H],Z,[(P,Q,N)|W]):-
   element_of_plate(P,Q,N),
   constraint_for_each((P,Q),Z,N),
   update_solution(P,Q,N),
   solve_np_1(H,[(P,Q,N)|Z],W).

solve_np_2([],_,[]).
solve_np_2([(P,Q)|H],Z,[(P,Q,N)|W]):-
   solve_np_2(H,[(P,Q,N)|Z],W),
   element_of_plate(P,Q,N),
   constraint_for_each((P,Q),W,N),
   update_solution(P,Q,N).

constraint_for_each((P,Q),Z,N):-
   check_block((P,Q),Z,N),
   check_vertical((P,Q),Z,N),
   check_lateral((P,Q),Z,N).

check_block((P,_),Z,N):- \+ member((P,_,N),Z).

check_vertical((P,Q),Z,N):-
   \+ ( member((P1,Q1,N),Z),
     has_same_X_coordinate((P1,Q1),(P,Q))
   ).

check_lateral((P,Q),Z,N):-
   \+ ( member((P1,Q1,N),Z),
     has_same_Y_coordinate((P1,Q1),(P,Q))
   ).

element_of_plate(P,Q,N):-
   plate(P,Q,N),
   permissible_element(P,Q,N).

% depriciated version based on triplets

element_of_plate_1(P,Q,T,N):-
   plate(P,Y,T),
   lateral(K,X),
   nth1(K,T,N),
   Q=(X,Y).

element_of_plate_2(P,Q,T,N):-
   element_of_plate_1(P,Q,T,N),
   plate(P,Q,N),
%   n(N).
   permissible_element(P,Q,N).

permissible_element(P,Q,N):-
   permissible_numbers(P,Q,R), member(N,R).

:- dynamic permissible_numbers/3.

generate_permissible_elements:-
   abolish( permissible_numbers/3),
   list_of_numbers(L),
   coordinate(P,Q),
   findall(N,inhibited_element_at(_,P,Q,N),NoGood),
   subtract(L,NoGood,Permitted),
   plate(P,Q,F),
   (\+ var(F)->PL=[F];PL=Permitted),
   assert(permissible_numbers(P,Q,PL)),
   fail.
generate_permissible_elements.

inhibited_element_at(block,P,Q,N):-
   plate(P,Q1,N),\+ var(N),Q1\=Q.
inhibited_element_at(lateral,(U,V),(X,Y),N):-
   plate((U,V1),(X,Y1),N),\+ var(N),(V1,Y1)\=(V,Y).
inhibited_element_at(vertical,(U,V),(X,Y),N):-
   plate((U1,V),(X1,Y),N),\+ var(N),(U1,X1)\=(U,X).


:- dynamic solution/4, solution_step_id/1.

number_of_revisions(N):-
   setof(A:B:C,D^solution(A,B,C,D),L),length(L,N).

init_solution:- 
   abolish(solution/4),
   forall(plate(A,B,C),assert(solution(A,B,C,on))),
   abolish(solution_step_id/1),
   assert(solution_step_id(0)).

update_solution(P,Q,N):-
   assert(solution(P,Q,N,on)),
   retract(solution_step_id(K)),
   K1 is K + 1,
   assert(solution_step_id(K1)).

coordinate_of_triplet((U,V),Y):-
   lateral(_,U),
   vertical(_,V),
   vertical(_,Y).

solution_in_triplet((U,V),Y,L):-
   coordinate_of_triplet((U,V),Y),
   setof(Z,X^solution((U,V),(X,Y),Z,on),L).

plate_in_triplet((U,V),Y,L):-
   coordinate_of_triplet((U,V),Y),
   setof(Z,X^plate((U,V),(X,Y),Z,on),L).

display_solution:-
   vertical(_,V),
   nl,
   write('---------------------------'),
   vertical(_,Y1),
   nl,
   lateral(_,U),
   solution_in_triplet((U,V),Y1,L,on),
   write(L),
   fail.
display_solution.

display_plates_head(H,V,V1):-
   vertical(H,V),
   (H=1->true;(nl,write('---------------------------'))),
   vertical(_,V1),
   nl.

/*
display_plates:-
   display_plates_head(_,V,V1),
   lateral(_,U),
   plate_in_triplet((U,V),V1,L),
   findall(A,(member(A,L),(var(A)->A='_';true)),L),
   write(L),
   fail.
display_plates.
*/

display_plates:-
   findall((P,Q,A),(plate(P,Q,A),(var(A)->A='_';true)),Z),
   display_plates(Z).

display_plates(Z):-
   \+ var(Z),
   display_plates_head(_,V,V1),
   lateral(_,U),
   bagof(N,S^(
     member(((U,V),(S,V1),N),Z)
   ),L),
   write(L),
   fail.
display_plates(_).

histogram_of_permissible_numbers:-
   n(K),
   findall(1,(permissible_numbers(_,_,O),length(O,K)),L),
   length(L,M),nl,write(K:M),fail.
histogram_of_permissible_numbers.

upper_bound_of_steps(N):-
   list_of_numbers(L),
   upper_bound_of_steps(L,N).

upper_bound_of_steps([],0).
upper_bound_of_steps([K|L],N):-
   upper_bound_of_steps(L,N0),
   findall(1,(permissible_numbers(_,_,O),length(O,K)),W),
   length(W,M),
   N is N0 + K ^ M.

:- dynamic plate/3, current_problem/1.

select_problem(K):-
   problem(q(K)),
   abolish(plate/3),
   abolish(current_problem/1),
   transform_plates(q(K)),
   assert(current_problem(q(K))),
   generate_permissible_elements.

element_of_triple_in_plate(q(K),(U,V),(X,Y),T,N):-
   plate(q(K),(V,Y),A,B,C),
   which_block_of_lateral_in_row([A,B,C],T,U),
   which_element_of_block_in_row(T,N,X).

which_block_of_lateral_in_row([A,B,C],T,U):-
   nth1(Ku,[A,B,C],T),
   lateral(Ku,U).

which_element_of_block_in_row(T,N,X):-
   nth1(Kx,T,N),
   lateral(Kx,X).

transform_plates(q(K)):-
   element_of_triple_in_plate(q(K),(U,V),(X,Y),_,N),
   assert(plate((U,V),(X,Y),N)),
   fail.
transform_plates(_).

% sample problems 

problem(q(K)):- member(K,[1,2,3,4,5,6]).

% q1
%

plate(q(1),(u,u),[7,_,6],[_,_,_],[1,_,5]).
plate(q(1),(u,m),[_,8,_],[2,1,4],[_,6,_]).
plate(q(1),(u,d),[3,_,4],[_,7,_],[2,_,8]).
plate(q(1),(m,u),[2,_,8],[1,_,5],[6,_,9]).
plate(q(1),(m,m),[_,5,_],[_,_,_],[_,3,_]).
plate(q(1),(m,d),[6,_,3],[4,_,7],[5,_,1]).
plate(q(1),(d,u),[5,_,2],[_,4,_],[9,_,3]).
plate(q(1),(d,m),[_,6,_],[3,5,1],[_,8,_]).
plate(q(1),(d,d),[8,_,1],[_,_,_],[4,_,6]).

% q2
%

plate(q(2),(u,u),[2,_,_],[_,_,_],[_,5,8]).
plate(q(2),(u,m),[1,_,_],[_,6,5],[_,_,_]).
plate(q(2),(u,d),[_,4,7],[_,_,9],[_,1,_]).
plate(q(2),(m,u),[_,_,_],[3,_,_],[8,_,_]).
plate(q(2),(m,m),[_,8,4],[_,2,1],[7,_,_]).
plate(q(2),(m,d),[_,_,_],[9,_,_],[3,_,_]).
plate(q(2),(d,u),[_,1,6],[_,_,7],[_,8,_]).
plate(q(2),(d,m),[8,_,_],[_,9,2],[_,_,_]).
plate(q(2),(d,d),[4,_,_],[_,_,_],[_,9,6]).

% q3

plate(q(3),(u,u),[_,9,_],[_,_,5],[_,3,_]).
plate(q(3),(u,m),[2,_,_],[6,_,_],[_,_,9]).
plate(q(3),(u,d),[_,_,4],[_,1,_],[8,_,_]).
plate(q(3),(m,u),[_,2,_],[4,_,_],[_,_,7]).
plate(q(3),(m,m),[_,_,8],[_,_,_],[6,_,_]).
plate(q(3),(m,d),[7,_,_],[_,_,8],[_,2,_]).
plate(q(3),(d,u),[_,_,6],[_,8,_],[3,_,_]).
plate(q(3),(d,m),[8,_,_],[_,_,9],[_,_,5]).
plate(q(3),(d,d),[_,5,_],[3,_,_],[_,7,_]).

% q4
%

plate(q(4),(u,u),[_,_,_],[_,_,_],[_,_,_]).
plate(q(4),(u,m),[_,_,9],[_,_,_],[7,_,_]).
plate(q(4),(u,d),[1,_,_],[3,8,2],[_,_,6]).
plate(q(4),(m,u),[_,1,_],[_,5,_],[_,6,_]).
plate(q(4),(m,m),[_,_,7],[_,_,_],[3,_,_]).
plate(q(4),(m,d),[_,2,_],[_,_,_],[_,5,_]).
plate(q(4),(d,u),[_,8,1],[_,_,_],[6,9,_]).
plate(q(4),(d,m),[3,_,2],[5,_,9],[1,_,8]).
plate(q(4),(d,d),[9,_,_],[_,_,_],[_,_,4]).

% q5
%

plate(q(5),(u,u),[4,_,1],[_,5,_],[_,_,9]).
plate(q(5),(u,m),[7,_,_],[8,_,_],[_,1,_]).
plate(q(5),(u,d),[_,8,_],[_,1,_],[5,4,_]).
plate(q(5),(m,u),[_,_,9],[_,3,8],[_,_,1]).
plate(q(5),(m,m),[_,_,8],[_,_,9],[3,2,_]).
plate(q(5),(m,d),[_,_,7],[_,6,5],[_,_,4]).
plate(q(5),(d,u),[_,1,_],[_,9,_],[2,3,_]).
plate(q(5),(d,m),[3,_,_],[7,_,_],[_,9,_]).
plate(q(5),(d,d),[9,_,_],[_,4,_],[_,_,8]).

% q6
%

plate(q(6),(u,u),[_,_,_],[8,_,7],[_,_,_]).
plate(q(6),(u,m),[_,_,_],[_,_,9],[_,2,6]).
plate(q(6),(u,d),[_,_,_],[_,_,2],[8,_,5]).
plate(q(6),(m,u),[9,_,_],[_,4,1],[3,_,_]).
plate(q(6),(m,m),[_,_,_],[7,_,_],[9,_,_]).
plate(q(6),(m,d),[5,7,6],[9,_,_],[_,_,1]).
plate(q(6),(d,u),[_,_,7],[6,8,_],[_,3,9]).
plate(q(6),(d,m),[_,8,_],[_,_,_],[1,7,4]).
plate(q(6),(d,d),[_,9,_],[_,_,5],[6,8,_]).

:- select_problem(1).

% demo

/*

?- [np07].

% nplate01 compiled 0.00 sec, 4 bytes

% q1. An easy puzzle.

?- display_plates.

[7, _, 6][_, _, _][1, _, 5]
[_, 8, _][2, 1, 4][_, 6, _]
[3, _, 4][_, 7, _][2, _, 8]
---------------------------
[2, _, 8][1, _, 5][6, _, 9]
[_, 5, _][_, _, _][_, 3, _]
[6, _, 3][4, _, 7][5, _, 1]
---------------------------
[5, _, 2][_, 4, _][9, _, 3]
[_, 6, _][3, 5, 1][_, 8, _]
[8, _, 1][_, _, _][4, _, 6]

Yes
?- solve_np(Z),display_plates(Z).
[7, 2, 6][8, 9, 3][1, 4, 5]
[9, 8, 5][2, 1, 4][3, 6, 7]
[3, 1, 4][5, 7, 6][2, 9, 8]
---------------------------
[2, 4, 8][1, 3, 5][6, 7, 9]
[1, 5, 7][9, 6, 2][8, 3, 4]
[6, 9, 3][4, 8, 7][5, 2, 1]
---------------------------
[5, 7, 2][6, 4, 8][9, 1, 3]
[4, 6, 9][3, 5, 1][7, 8, 2]
[8, 3, 1][7, 2, 9][4, 5, 6]

Z = [ ((l, u), (l, u), 7), ((l, u), (l, m), 9), ((l, u), (l, d), 3), ((l, u), (c, u), 2), ((l, u), (c, m), 8), ((l, u), (c, d), 1), ((l, u), (..., ...), 6), ((..., ...), ..., ...), (..., ...)|...] 

Yes
?- 

% Histogram: q3. 

?- select_problem(3),generate_permissible_elements,
histogram_of_permissible_numbers.

1:26
2:4
3:25
4:21
5:5
6:0
7:0
8:0
9:0

Yes
?- 

% Histogram: q4.

?- select_problem(4),generate_permissible_elements,
histogram_of_permissible_numbers.

1:28
2:4
3:17
4:12
5:15
6:5
7:0
8:0
9:0

Yes
?- 
*/

test_np:- 
   select_problem(A),nl,nl,write(problem(A)),
   stopwatch((solve_np(Z);(nl,write('no more.'))
   ),_Time),display_plates(Z),
   solution_step_id(K),
   nl,write('#'),write(steps:K),fail.

/*
?- [menu].
% menu compiled 0.02 sec, 0 bytes

Yes
?- test_np.


problem(1)
% time elapsed (sec): 0.016

[7, 2, 6][8, 9, 3][1, 4, 5]
[9, 8, 5][2, 1, 4][3, 6, 7]
[3, 1, 4][5, 7, 6][2, 9, 8]
---------------------------
[2, 4, 8][1, 3, 5][6, 7, 9]
[1, 5, 7][9, 6, 2][8, 3, 4]
[6, 9, 3][4, 8, 7][5, 2, 1]
---------------------------
[5, 7, 2][6, 4, 8][9, 1, 3]
[4, 6, 9][3, 5, 1][7, 8, 2]
[8, 3, 1][7, 2, 9][4, 5, 6]
#steps:117
no more.
% time elapsed (sec): 0.063

#steps:234

problem(2)
% time elapsed (sec): 0.406

[2, 6, 3][7, 1, 4][9, 5, 8]
[1, 9, 8][2, 6, 5][4, 3, 7]
[5, 4, 7][8, 3, 9][6, 1, 2]
---------------------------
[7, 5, 9][3, 4, 6][8, 2, 1]
[3, 8, 4][5, 2, 1][7, 6, 9]
[6, 2, 1][9, 7, 8][3, 4, 5]
---------------------------
[9, 1, 6][4, 5, 7][2, 8, 3]
[8, 3, 5][6, 9, 2][1, 7, 4]
[4, 7, 2][1, 8, 3][5, 9, 6]
#steps:5271
no more.
% time elapsed (sec): 0.469

#steps:5521

problem(3)
% time elapsed (sec): 1.546

[6, 9, 1][8, 7, 5][2, 3, 4]
[2, 8, 5][6, 3, 4][7, 1, 9]
[3, 7, 4][9, 1, 2][8, 5, 6]
---------------------------
[1, 2, 3][4, 9, 6][5, 8, 7]
[5, 4, 8][7, 2, 3][6, 9, 1]
[7, 6, 9][1, 5, 8][4, 2, 3]
---------------------------
[9, 1, 6][5, 8, 7][3, 4, 2]
[8, 3, 7][2, 4, 9][1, 6, 5]
[4, 5, 2][3, 6, 1][9, 7, 8]
#steps:16732
no more.
% time elapsed (sec): 4.781

#steps:49819

problem(4)
% time elapsed (sec): 0.172

[2, 6, 8][7, 9, 4][5, 1, 3]
[4, 3, 9][6, 1, 5][7, 8, 2]
[1, 7, 5][3, 8, 2][9, 4, 6]
---------------------------
[8, 1, 3][2, 5, 7][4, 6, 9]
[5, 9, 7][8, 4, 6][3, 2, 1]
[6, 2, 4][9, 3, 1][8, 5, 7]
---------------------------
[7, 8, 1][4, 2, 3][6, 9, 5]
[3, 4, 2][5, 6, 9][1, 7, 8]
[9, 5, 6][1, 7, 8][2, 3, 4]
#steps:1374
no more.
% time elapsed (sec): 18.407

#steps:168083

problem(5)
% time elapsed (sec): 0.157

[4, 2, 1][6, 5, 3][8, 7, 9]
[7, 9, 5][8, 2, 4][6, 1, 3]
[6, 8, 3][9, 1, 7][5, 4, 2]
---------------------------
[5, 4, 9][2, 3, 8][7, 6, 1]
[1, 6, 8][4, 7, 9][3, 2, 5]
[2, 3, 7][1, 6, 5][9, 8, 4]
---------------------------
[8, 1, 4][5, 9, 6][2, 3, 7]
[3, 5, 2][7, 8, 1][4, 9, 6]
[9, 7, 6][3, 4, 2][1, 5, 8]
#steps:848
no more.
% time elapsed (sec): 0.203

#steps:1160

problem(6)
% time elapsed (sec): 0.0929999

[1, 6, 2][8, 5, 7][4, 9, 3]
[8, 5, 4][3, 1, 9][7, 2, 6]
[7, 3, 9][4, 6, 2][8, 1, 5]
---------------------------
[9, 2, 8][5, 4, 1][3, 6, 7]
[3, 4, 1][7, 2, 6][9, 5, 8]
[5, 7, 6][9, 3, 8][2, 4, 1]
---------------------------
[2, 1, 7][6, 8, 4][5, 3, 9]
[6, 8, 5][2, 9, 3][1, 7, 4]
[4, 9, 3][1, 7, 5][6, 8, 2]
#steps:1909
% time elapsed (sec): 0.156

[1, 6, 2][8, 5, 7][4, 9, 3]
[8, 5, 3][4, 1, 9][7, 2, 6]
[7, 4, 9][3, 6, 2][8, 1, 5]
---------------------------
[9, 2, 8][5, 4, 1][3, 6, 7]
[4, 3, 1][7, 2, 6][9, 5, 8]
[5, 7, 6][9, 3, 8][2, 4, 1]
---------------------------
[2, 1, 7][6, 8, 4][5, 3, 9]
[6, 8, 5][2, 9, 3][1, 7, 4]
[3, 9, 4][1, 7, 5][6, 8, 2]
#steps:2123
no more.
% time elapsed (sec): 1.328

#steps:21541

No
?- 

*/