Solver for tetris puzzles in Prolog

tetris.pl

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Transitioning between steps
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

driver(History, History, (_,_,_,FinalBoard), FinalBoard).
driver(History, Trace, State, FinalBoard) :-
  % print_state(State),
  step(State, NewState),
  driver([NewState|History], Trace, NewState, FinalBoard).

step(State, NewState) :- step_gravitate(State, NewState).
step(State, NewState) :- step_move_right(State, NewState).
step(State, NewState) :- step_move_left(State, NewState).
step(State, NewState) :- step_clear(State, NewState).
step(State, NewState) :- step_next(State, NewState).

step_gravitate(
  (Tetrominos, _, N, Board),
  (Tetrominos, [left, right], N, NewBoard)
) :-
  gravitate(N, Board, NewBoard),
  Board \= NewBoard,
  conflict_free(N, Board, NewBoard).

step_move_right(
  (Tetrominos, Direction, N, Board),
  (Tetrominos, [right], N, NewBoard)
) :-
  member(right, Direction),
  movable(N, Board),
  move_right(N, Board, NewBoard),
  Board \= NewBoard,
  conflict_free(N, Board, NewBoard).

step_move_left(
  (Tetrominos, Direction, N, Board),
  (Tetrominos, [left], N, NewBoard)
) :-
  member(left, Direction),
  movable(N, Board),
  move_left(N, Board, NewBoard),
  Board \= NewBoard,
  conflict_free(N, Board, NewBoard).

step_clear(
  (Tetrominos, Direction, N, Board),
  (Tetrominos, Direction, M, NewBoard)
) :-
  clear(Board, NewBoard),
  M is N + 1.

step_next(
  (Tetrominos, _, N, Board),
  (RemainingTetrominos, [left, right], M, NewBoard)
) :-
  M is N + 1,
  select(Tetromino, Tetrominos, RemainingTetrominos),
  tetromino(Tetromino, M, Pattern),
  length(Board, Height),
  position_pattern(Height, Pattern, PatternBoard),
  overlay(PatternBoard, Board, NewBoard),
  conflict_free(M, Board, NewBoard).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliary definitions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

wall_row([-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]).
empty_row([-1,0,0,0,0,0,0,0,0,0,0,-1]).

% Generate an empty board of a given height
empty_board(Height, [Wall|PartialState]) :-
  wall_row(Wall),
  empty_board_aux(Height,PartialState).

empty_board_aux(0, []).
empty_board_aux(Height, [EmptyRow|Rows]) :-
  empty_row(EmptyRow),
  Height > 0,
  RemainingHeight is Height - 1,
  empty_board_aux(RemainingHeight, Rows).

% Overlay two boards so long they agree on the cell value or one of the cells
% being overlayed is 0.
overlay(Board1, Board2, OverlayedBoard) :-
  maplist(overlay_row, Board1, Board2, OverlayedBoard).

overlay_row([],YS,YS) :- !.
overlay_row(XS,[],XS) :- !.
overlay_row([0|XS],[Y|YS],[Y|ZS]) :- !, overlay_row(XS,YS,ZS).
overlay_row([X|XS],[0|YS],[X|ZS]) :- !, overlay_row(XS,YS,ZS).
overlay_row([X|XS],[X|YS],[X|ZS]) :- overlay_row(XS,YS,ZS).

% Create a board with only the pattern placed at the top of it
position_pattern(Height, Pattern, Board) :-
  maplist(right_pad_pattern_row, Pattern, PatternRows),
  length(Pattern, PatternHeight),
  RemainingHeight is Height - PatternHeight - 1,
  empty_board(RemainingHeight, PartialBoard),
  append(PartialBoard, PatternRows, Board).

right_pad_pattern_row(PartialRow, Row) :-
  empty_row(EmptyRow),
  overlay_row([-1|PartialRow], EmptyRow, Row).

% Check if there is a conflict between two boards.
% Only overlapping of identical blocks and against a 0 cell is allowed.
conflict_free(N, OldBoard, NewBoard) :-
  maplist(conflict_free_row(N), OldBoard, NewBoard).

conflict_free_row(N,OldRow, NewRow) :-
  maplist(conflict_free_cell(N), OldRow, NewRow).

conflict_free_cell(N,M,N) :- !, (M = 0; M = N).
conflict_free_cell(_,_,_).

% Clear one line of a board 
clear(Board, NewBoard) :-
  select(Row, Board, Rest),
  can_clear_row(Row),
  empty_row(EmptyRow),
  append(Rest, [EmptyRow], NewBoard).

can_clear_row(Row) :-
  maplist(can_clear_cell, Row),
  \+ sum_list(Row, -12).

can_clear_cell(-1).
can_clear_cell(N) :- N > 0.

% Make a block drop by one
gravitate(_, [Row], [Row]).
gravitate(N, [OldRow1,OldRow2|OldRest], [Row1|Rest]) :-
  gravitate_row(N, OldRow1, OldRow2, Row1, Row2),
  gravitate(N, [Row2|OldRest], Rest).

gravitate_row(_, [], [], [], []).
gravitate_row(N, [_|XS], [N|YS], [N|ZS], [0|WS]) :- !, gravitate_row(N, XS, YS, ZS, WS).
gravitate_row(N, [X|XS], [Y|YS], [X|ZS], [Y|WS]) :- gravitate_row(N, XS, YS, ZS, WS).

% Move the block to the right by one
move_right(N, State, NewState) :-
  maplist(reverse, State, RevState),
  move_left(N, RevState, NewRevState),
  maplist(reverse, NewRevState, NewState).

% Move the block to the left by one
move_left(N, State, NewState) :- maplist(move_left_row(N), State, NewState).

move_left_row(_, [Cell], [Cell]).
move_left_row(N, [_,N|Rest], [N|NewRest]) :- !,
  move_left_row(N, [0|Rest], NewRest).
move_left_row(N, [Cell1,Cell2|Rest], [Cell1|NewRest]) :-
  move_left_row(N, [Cell2|Rest], NewRest).

% Height of the stable set of blocks
% The implementation is buggy when the currently moving is right above or
% overlapping with stable blocks
height([],0).
height([Row|_],0) :- empty_row(Row), !.
height([_|Rows],Height) :- height(Rows,OldHeight), Height is OldHeight + 1.

% Distance of a block from the bottom
block_distance(_,[],0).
block_distance(N,[Row|_],0) :- member(N,Row), !.
block_distance(N,[_|Rows],Height) :-
  block_distance(N,Rows,OldHeight),
  Height is OldHeight + 1.

movable(N,State) :-
  height(State, Height),
  block_distance(N, State, MinHeight),
  MinHeight =< Height.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Tetrominos
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

tetromino(o,N,[[N,N]
              ,[N,N]
              ]).
tetromino(i,N,[[N,N,N,N]
              ]).
tetromino(i,N,[[N]
              ,[N]
              ,[N]
              ,[N]
              ]).
tetromino(t,N,[[N,N,N]
              ,[0,N]
              ]).
tetromino(t,N,[[0,N]
              ,[N,N,N]
              ]).
tetromino(t,N,[[0,N]
              ,[N,N]
              ,[0,N]
              ]).
tetromino(t,N,[[N]
              ,[N,N]
              ,[N]
              ]).
tetromino(j,N,[[0,N]
              ,[0,N]
              ,[N,N]
              ]).
tetromino(j,N,[[N]
              ,[N,N,N]
              ]).
tetromino(j,N,[[N,N]
              ,[N]
              ,[N]
              ]).
tetromino(j,N,[[N,N,N]
              ,[0,0,N]
              ]).
tetromino(l,N,[[N]
              ,[N]
              ,[N,N]
              ]).
tetromino(l,N,[[0,0,N]
              ,[N,N,N]
              ]).
tetromino(l,N,[[N,N]
              ,[0,N]
              ,[0,N]
              ]).
tetromino(l,N,[[N,N,N]
              ,[N]
              ]).
tetromino(s,N,[[0,N,N]
              ,[N,N]
              ]).
tetromino(s,N,[[N]
              ,[N,N]
              ,[0,N]
              ]).
tetromino(z,N,[[N,N]
              ,[0,N,N]
              ]).
tetromino(z,N,[[0,N]
              ,[N,N]
              ,[N]
              ]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Printing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

print_trace(Trace) :-
  reverse(Trace, RevTrace),
  writeln(''),
  maplist(print_state, RevTrace).

print_state((_,_,_,State)) :- print_board(State).

print_board(Board) :-
  reverse(Board, RevBoard),
  maplist(print_row, RevBoard),
  writeln("").

print_row(Row) :- maplist(print_cell, Row), writeln("").

print_cell(Cell) :- cell_to_char(Cell, Str), format('~w', [Str]).

cell_to_char(-1, 'X') :- !.
cell_to_char(0, ' ') :- !.
cell_to_char(1, 'A').
cell_to_char(2, 'B').
cell_to_char(3, 'C').
cell_to_char(4, 'D').
cell_to_char(5, 'E').
cell_to_char(6, 'F').
cell_to_char(7, 'G').
cell_to_char(8, 'H').
cell_to_char(9, 'I').
cell_to_char(10, 'J').
cell_to_char(11, 'K').
cell_to_char(12, 'L').
cell_to_char(13, 'M').
cell_to_char(14, 'N').
cell_to_char(15, 'O').
cell_to_char(16, 'P').
cell_to_char(17, 'Q').
cell_to_char(18, 'R').
cell_to_char(19, 'S').
cell_to_char(20, 'T').
cell_to_char(21, 'U').
cell_to_char(22, 'V').
cell_to_char(23, 'W').
cell_to_char(24, 'Y').
cell_to_char(25, 'Z').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Unit testing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

prng(Seed, Random) :- Random is (Seed * 7 + 3) mod 9 + 1.

full_row(Seed, [-1,A,B,C,D,E,F,G,H,I,J,-1]) :-
  prng(Seed, A),
  prng(A, B),
  prng(B, C),
  prng(C, D),
  prng(D, E),
  prng(E, F),
  prng(F, G),
  prng(G, H),
  prng(H, I),
  prng(I, J).

test_board(
  [WallRow
  ,[-1,0,0,0,1,0,0,4,0,0,0,-1]
  ,[-1,2,2,0,1,1,0,0,3,0,0,-1]
  ,[-1,0,2,0,0,1,0,3,3,0,0,-1]
  ,[-1,0,2,0,0,0,0,3,0,0,0,-1]
  ]
) :- wall_row(WallRow).

?-
  write('Test: step clear single... '),
  wall_row(WallRow),
  empty_row(EmptyRow),
  full_row(0,FullRow),
  B0 = [WallRow,FullRow],
  B1 = [WallRow,EmptyRow],
  step_clear(
    (_,_,1,B0),
    (_,_,_,B1)
  ),
  writeln('ok').

?-
  write('Test: step clear multi... '),
  wall_row(WallRow),
  empty_row(EmptyRow),
  full_row(1,FullRow1),
  full_row(2,FullRow2),
  B0 = [WallRow,FullRow1,FullRow2],
  B1 = [WallRow,FullRow2,EmptyRow],
  B2 = [WallRow,EmptyRow,EmptyRow],
  step_clear(
    (_,_,1,B0),
    (_,_,_,B1)
  ),
  step_clear(
    (_,_,1,B1),
    (_,_,_,B2)
  ),
  writeln('ok').

?-
  write('Test: step right 1... '),
  test_board(B0),
  wall_row(WallRow),
  B1 =
  [WallRow
  ,[-1,0,0,0,0,1,0,4,0,0,0,-1]
  ,[-1,2,2,0,0,1,1,0,3,0,0,-1]
  ,[-1,0,2,0,0,0,1,3,3,0,0,-1]
  ,[-1,0,2,0,0,0,0,3,0,0,0,-1]
  ],
  step_move_right((_,_,1,B0),(_,_,_,B1)),
  writeln(' ok').

?-
  write('Test: step right 2'),
  test_board(B0),
  wall_row(WallRow),
  B1 =
  [WallRow
  ,[-1,0,0,0,1,0,0,4,0,0,0,-1]
  ,[-1,0,2,2,1,1,0,0,3,0,0,-1]
  ,[-1,0,0,2,0,1,0,3,3,0,0,-1]
  ,[-1,0,0,2,0,0,0,3,0,0,0,-1]
  ],
  step_move_right((_,_,2,B0),(_,_,_,B1)),
  writeln('ok').

?-
  write('Test: step right 3... '),
  test_board(B0),
  wall_row(WallRow),
  B1 =
  [WallRow
  ,[-1,0,0,0,1,0,0,4,0,0,0,-1]
  ,[-1,2,2,0,1,1,0,0,0,3,0,-1]
  ,[-1,0,2,0,0,1,0,0,3,3,0,-1]
  ,[-1,0,2,0,0,0,0,0,3,0,0,-1]
  ],
  step_move_right((_,_,3,B0),(_,_,_,B1)),
  writeln('ok').

?-
  write('Test: step left 1... '),
  test_board(B0),
  step_move_right((_,_,1,B0),(_,_,_,B1)),
  step_move_left((_,_,1,B1),(_,_,_,B0)),
  writeln('ok').

?-
  write('Test: step left 2... '),
  test_board(B0),
  step_move_right((_,_,2,B0),(_,_,_,B1)),
  step_move_left((_,_,2,B1),(_,_,_,B0)),
  writeln('ok').

?-
  write('Test: step left 3... '),
  test_board(B0),
  step_move_right((_,_,3,B0),(_,_,_,B1)),
  step_move_left((_,_,3,B1),(_,_,_,B0)),
  writeln('ok').

?-
  write('Test: step gravitate... '),
  test_board(B0),
  wall_row(WallRow),
   B1 =
   [WallRow
   ,[-1,0,0,0,1,0,0,4,3,0,0,-1]
   ,[-1,2,2,0,1,1,0,3,3,0,0,-1]
   ,[-1,0,2,0,0,1,0,3,0,0,0,-1]
   ,[-1,0,2,0,0,0,0,0,0,0,0,-1]
   ],
  step_gravitate((_,_,3,B0),(_,_,_,B1)),
  writeln('ok').

?-
  write('Test: integration 1... '),
  wall_row(WallRow),
  empty_row(EmptyRow),
  BasicRow = [-1,1,1,0,0,0,0,1,1,1,1,-1],
  InitBoard = [WallRow, BasicRow, BasicRow, EmptyRow, EmptyRow],
  empty_board(4, FinalBoard),
  Tetrominos = [o,o],
  InitState = (Tetrominos, [left,right], 2, InitBoard), !,
  driver([InitState], Trace, InitState, FinalBoard), !,
  writeln('ok'),
  print_trace(Trace).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solve the fucking puzzle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

?-
  empty_board(2, [Wall|EmptyRows]),
  PuzzleRow = [-1,1,0,0,0,0,0,0,0,0,1,-1],
  InitBoard = [Wall,PuzzleRow|EmptyRows],
  empty_board(3, FinalBoard),
  setof(Tetromino, N^Pattern^tetromino(Tetromino,N,Pattern), Tetrominos),
  InitState = (Tetrominos, [left,right], 2, InitBoard), !,
  driver([InitState], Trace, InitState, FinalBoard), !,
  print_trace(Trace).