a-puzzle-a-day.prolog

:- use_module(library(clpfd)).

piece(_, []).
piece([_ | Frame], [[] | Piece]) :-
    piece(Frame, Piece).
piece([[X | FrameLine] | Frame], [[X | PieceLine] | Piece]) :-
    piece([FrameLine | Frame], [PieceLine | Piece]).

tail([], []).
tail([_ | T], T).

is_empty([]).
is_empty([[] | T]) :- is_empty(T).

horizontal_piece(Frame, _) :- is_empty(Frame), !, fail.
horizontal_piece(Frame, Piece) :- piece(Frame, Piece).
horizontal_piece(Frame, Piece) :-
    maplist(tail, Frame, FrameTail),
    horizontal_piece(FrameTail, Piece).

vertical_piece(Frame, Piece) :- horizontal_piece(Frame, Piece).
vertical_piece([_ | Frame], Piece) :- vertical_piece(Frame, Piece).

matrix_rotated(Xss, Zss) :-
    transpose(Xss, Yss),
    maplist(reverse, Yss, Zss).

rotated_piece(Frame, Piece) :- vertical_piece(Frame, Piece).
rotated_piece(Frame, Piece) :-
    matrix_rotated(Piece, Piece90),
    vertical_piece(Frame, Piece90).
rotated_piece(Frame, Piece) :-
    matrix_rotated(Piece, Piece90),
    matrix_rotated(Piece90, Piece180),
    vertical_piece(Frame, Piece180).
rotated_piece(Frame, Piece) :-
    matrix_rotated(Piece, Piece90),
    matrix_rotated(Piece90, Piece180),
    matrix_rotated(Piece180, Piece270),
    vertical_piece(Frame, Piece270).

rotated_flipped_piece(Frame, Piece) :- rotated_piece(Frame, Piece).
rotated_flipped_piece(Frame, Piece) :-
    transpose(Piece, FlippedPiece),
    rotated_piece(Frame, FlippedPiece).

flipped_piece(Frame, Piece) :- vertical_piece(Frame, Piece).
flipped_piece(Frame, Piece) :-
    transpose(Piece, FlippedPiece),
    vertical_piece(Frame, FlippedPiece).

half_rotated_flipped_piece(Frame, Piece) :- flipped_piece(Frame, Piece).
half_rotated_flipped_piece(Frame, Piece) :-
    matrix_rotated(Piece, Piece90),
    flipped_piece(Frame, Piece90).

half_rotated_piece(Frame, Piece) :- vertical_piece(Frame, Piece).
half_rotated_piece(Frame, Piece) :-
    matrix_rotated(Piece, Piece90),
    vertical_piece(Frame, Piece90).

calendar(Month, Day) :-
    Frame = [
        [Jan, Feb, Mar, Apr, Mai, Jun,   x],
        [Jul, Aug, Sep, Okt, Nov, Des,   x],
        [ _1,  _2,  _3,  _4,  _5,  _6,  _7],
        [ _8,  _9, _10, _11, _12, _13, _14],
        [_15, _16, _17, _18, _19, _20, _21],
        [_22, _23, _24, _25, _26, _27, _28],
        [_29, _30, _31,   x,   x,   x,   x]
    ],
    nth1(Month, [Jan, Feb, Mar, Apr, Mai, Jun, Jul, Aug, Sep, Okt, Nov, Des], M),
    nth1(Month, [jan, feb, mar, apr, mai, jun, jul, aug, sep, okt, nov, des], M),
    nth1(Day, [_1, _2, _3, _4, _5, _6, _7, _8, _9, _10, _11, _12, _13, _14, _15, _16, _17, _18, _19, _20, _21, _22, _23, _24, _25, _26, _27, _28, _29, _30, _31], Day),
    !,
    rotated_piece(Frame, [[a, a, a], [a, _, _], [a, _, _]]),
    rotated_piece(Frame, [[b, _, b], [b, b, b]]),
    half_rotated_flipped_piece(Frame, [[_, _, c], [c, c, c], [c, _, _]]),
    rotated_flipped_piece(Frame, [[_, d, _, _], [d, d, d, d]]),
    rotated_flipped_piece(Frame, [[_, _, e, e], [e, e, e, _]]),
    rotated_flipped_piece(Frame, [[_, _, _, f], [f, f, f, f]]),
    rotated_flipped_piece(Frame, [[g, g, _], [g, g, g]]),
    half_rotated_piece(Frame, [[h, h, h], [h, h, h]]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [Jan, Feb, Mar, Apr, Mai, Jun]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [Jul, Aug, Sep, Okt, Nov, Des]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [_1,  _2,  _3,  _4,  _5,  _6,  _7]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [_8,  _9, _10, _11, _12, _13, _14]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [_15, _16, _17, _18, _19, _20, _21]),
    format('~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~t~w~4+~n', [_22, _23, _24, _25, _26, _27, _28]),
    format('~t~w~4+~t~w~4+~t~w~4+~n', [_29, _30, _31]).

calendar_all(Month, Day, N) :-
    findall(L, calendar(Month, Day), L),
    length(L, N).

?- calendar(6, 26).
   a   a   a   g   g jun
   a   c   g   g   g   d
   a   c   c   c   d   d   f
   h   h   b   c   b   d   f
   h   h   b   b   b   d   f
   h   h   e   e  26   f   f
   e   e   e
true .