/*** Assignment 3 ***/

%% Handy predicate to display the result image:
writelist([]).
writelist([H|T]) :- write(H), nl, writelist(T).

/*** Question 1 ***/
/*
 * generateRowcheck(Runs,H,Row) generates a list of x's and blanks of
 * length H where the runs of x's are specified in the list Runs.
 */

generateRowCheck(Constr,H,Row) :- generateRow(H,Row), blackRuns(Row,Runs), Runs = Constr.

% generate(H,R) generates a list R of black and white pixels of length H.
generateRow(0, []).
generateRow(H, [Pixel|Rest]) :- H > 0, member(Pixel,[' ',x]), H1 is H - 1, generateRow(H1,Rest).

% blackruns(Row,Runs) calculates the runs of black pixels in Row and
% puts the result in Runs.
blackRuns(Row,Runs) :- blackRuns(Row,0,Runs).

% Helper for blackRuns/2, works as above but maintains the length of
% the current run in the second argument.
blackRuns([],0,[]).
blackRuns([],N,[N]) :- N > 0.
blackRuns([x|Row],N,Runs) :- N1 is N + 1, blackRuns(Row,N1,Runs).
blackRuns([' '|Row],0,Runs) :- blackRuns(Row,0,Runs).
blackRuns([' '|Row],N,[N|Runs]) :- N > 0, blackRuns(Row,0,Runs).

/*** Question 2 ***/
/*
 * generateImage(V,H,Runs,Image) binds Image to a list of V rows, each
 * row having the length H and observing the respective constraint in
 * Runs on the length of its black runs.
 */

generateImage(0,_,_,[]).
generateImage(V,H,[Constr|Constrs],[Row|Rows]) :-
    V > 0, generateRowCheck(Constr,H,Row), V1 is V - 1, generateImage(V1,H,Constrs,Rows).

/*** Question 3 ***/
/*
 * transposeImage(X,I) converts a list of rows (X) into a
 * corresponding list of columns (I).
 */

transposeImage([[]|_],[]).
transposeImage(Image,[Col|Cols]) :- splitFirstCol(Image,Col,R), transposeImage(R,Cols).

% helper for transposeImage/2, where splitFirstCol(I,F,R) binds F to
% the first column of I and R to the rest of I (that is, I without the
% first column).
splitFirstCol([],[],[]).
splitFirstCol([[X|L]|T],[X|R],[L|R1]) :- splitFirstCol(T,R,R1).

/*** Question 4 ***/
/*
 * nonogram/3 (might as well give it an appropriate name now) solves a
 * nonogram: nonogram(LH,LV,N) receives the lists of constraints (LH
 * and LV) and binds N to a nonogram compatible with those
 * constraints.
 */

nonogram(LH,LV,G) :-
    length(LH,V), length(LV,H),
    generateImage(V,H,LH,G),
    transposeImage(G,G2),
    allBlackRuns(G2,X2), X2 = LV.

% Check the black runs of a list of rows, trivial wrapper for blackRuns/2
allBlackRuns([],[]).
allBlackRuns([Row|Rows],[Run|Runs]) :- blackRuns(Row,Run), allBlackRuns(Rows,Runs).

/*

  The query that solves the nonogram from the hanout would be:

  ?- nonogram([[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]],
              [[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]], N), writelist(N).

  Note that the run time is quite extensive.  On an I7 CPU it took
  about 10 minutes to solve the nonogram given in the handout and 2
  more minutes thereafter to make sure that no other solution is
  possible.  More on this below.

  The nonograms that are usually solved by enthusiasts are much larger
  (see https://www.nonograms.org/nonograms).  Here is a smallish
  (45x16) example:

  ?- nonogram([[2], [4], [4], [3,4], [9], [8], [7], [8], [9], [3,4], [3],
               [3], [3], [3], [3], [3], [3], [3], [3], [3], [3], [3], [3],
               [5], [3], [7], [7], [5], [10], [13], [14], [4,4,3], [3,2],
               [2,1,2], [2,3,3,2], [2,4,3,2], [3,3,2,3], [6,6], [4,4], [2,2],
               [2,2,2], [8], [6], [4], [2]],
              [[6], [8], [4,3], [4,2], [3,2,5], [2,3,10], [2,1,7,4,3],
               [32,2,5], [32,5], [31,4,3], [5,1,6,5,2], [5,2,3,2,5],
               [7,3,4], [7,3,3], [3,3,9], [2,2,6]],
              N), writelist(N).
  
 */

/*** Question 5 ***/

% Anybody who has dabbed into classical AI could not help but notice
% that this puzzle can be solved as a constraint satisfaction problem
% (CSP for short).  In such a problem we are given a set of variables
% (such as the rows of the puzzle), a domain for each variable (such
% as the possible combinations of black and white pixels that could
% form a row), and a number of constraints over the variables (such as
% the horizontal and vertical constraints).  The goal is then to
% assign all the variables in such a way that the constraints are all
% satisfied.
%
% Basic solutions to CSP (implemented simply by following direct
% logical formulations) result in huge proof trees that are
% impractical to traverse in all by the smallest instances.
%
% In our case a basic solution would be to use generateRow/2 to assign
% to all the rows, and then once an image is formed check the
% constraints.  I tried that and it did not go well, meaning that I
% was not capable of solving even the small puzzle proposed in the
% handout.
%
% The next approach is to prune the domain of the variables before
% assigning to them.  This approach is known as forward checking (a
% particular instance of arc consistency) and is partially implemented
% by generaleRowCheck/3: it does not make sense to assign to rows
% values that would violate the respective horizontal constraint,
% thereofore those values are excluded form assignment.
%
% Obviously forward checking can be tightened.  The most logical such
% a tightening is to exclude from assignment those values that would
% violate the vertical constraints.  Suppose that the first vertical
% constraint is [1, ...]  and we have already assigned [x, ...] to the
% first row.  In this case it would make no sense to assign any value
% [x, ...] to the second row, since that would violate the vertical
% constraint.
%
% This forward checking tightening is relatively easy to do since we
% will continue to use the existing predicates.  In fact the only
% somehow substantial change is in generateImage/4 (which becomes
% below generateImageX/5) where as promised we check the vertical
% constraints each time we produce a new row.
%
% To do that we need to reorganize generateImage a bit.  For one
% thing, we need to generate the rows from first to last; we use for
% the purpose an accummulating argument and so an "inner" version of
% the predicate with one extra argument.  Secondly, we need to pass
% along the vertical constraints (so that we can check them after each
% row generation); this is the last argument.

/*
 * generateImage(V,H,Runs,Image,Vconstrs) binds Image to a list of V
 * rows, each row having the length H and observing the respective
 * constraint in Runs on the length of its black runs.  Additionally,
 * we do not generate rows that are inconsistent with the vertical
 * constraints Vconstrs.
 */

generateImageX(V,H,Constrs,Rows,Vconstrs) :- generateImageX(V,H,Constrs,Rows,[],Vconstrs).

% generateImageX/6 is the workhorse of the generating process.  The
% additional argument (the fifth) accummulates the rows so that when
% we are done we just copy it over into the result (fourth argument).
generateImageX(0,_,_,Result,Result,_).
generateImageX(V,H,[Constr|Constrs],Result,Rows,Vconstrs) :- V > 0,
    generateRowCheckX(Constr,H,Row),
    append(Rows,[Row],NewRows),
    %% new check against the vertical constraints
    transposeImage(NewRows,NewCols),     % need the columns
    allBlackRuns(NewCols,Runs),          % get all the black runs of the columns
    length(Runs,N), trim(Vconstrs,N,VP), % trim Vconstrs to the length of the columns generated so far
    allPrefixes(Runs,VP),                % all the runs should be plausible against the vertical constraints
    %% we now continue as before
    V1 is V - 1, generateImageX(V1,H,Constrs,Result,NewRows,Vconstrs).

% While at it we can also perform the same kind of forward checking on
% the rows by modifying generateRowCheck/3 in the same spirit.  The
% resuls is generateRowCheckX/3 below.  Note that generateRowCheckX/3
% is a drop-in replacement for generateRowCheck/3 in generateImageX/6.

generateRowCheckX(Constr,H,Row) :- generateRowCheckX(Constr,H,Row,[]),
    % At this point we can only guarantee that Row satisfies a prefix
    % of Constr, and so we need to check it again.
    blackRuns(Row,Runs), Runs = Constr.

generateRowCheckX(_,0,Row,Row).
generateRowCheckX(Constr,H,Result,Row) :- H > 0,
    member(Pixel,[' ',x]),
    append(Row,[Pixel],NewRow),
    blackRuns(NewRow,Runs),
    prefix(Runs,Constr),
    H1 is H - 1, generateRowCheckX(Constr,H1,Result,NewRow).

% trim(L,N,R) binds R to the first N values in L.
trim(_,0,[]).
trim([X|XS],N,[X|YS]) :- N > 0, N1 is N-1, trim(XS,N1,YS).

% prefix/2 succeeds if the first argument X is a prefix of the second
% argument Y.  It is also acceptable for the last value in X to be
% smaller than the corresponding value in Y.
prefix([],_).
prefix([X],[Y|_]) :- X < Y, !.
prefix([X|T],[X|R]) :- prefix(T,R).

% The ! predicate (pronounced "cut") is a special inference control
% predicate.  Once satisfied we cannot go back, so that the rest of
% the proof tree above this predicate is pruned out.  I used it here
% to make sure that allPrefixes/2 succeeds at most once.  I tried hard
% to avoid its use but I could find no easy alternatve (sorry).

% allPrefixes/2 is true whenever all the values in the first argument
% are prefixes (in the prefix/2 sense) of the respective values in the
% second argument.
allPrefixes([],[]).
allPrefixes([X|XS],[Y|YS]) :- prefix(X,Y), allPrefixes(XS,YS).

% Solving the nonogram is as before, only simpler.  We do not need to
% check the vertical constraints at the end anymore, since we have
% been checking them while generating the image:
nonogramX(LH,LV,G) :-
    length(LH,V), length(LV,H),
    generateImageX(V,H,LH,G,LV).

% This implements a fairly tight forward checking.  How well did we
% do?  Quite well actually for small nonograms:
%
% On the small 9x9 nonogram from the handout the original forward
% checking (Question 4) performed almost 8M inferences to obtain the
% solution (which took about 10 minutes on my I7 CPU) and a further
% 1.7M inferences to ensure that only one solution exists (that took a
% further 2 minutes on my CPU)
%
% By contrast the new and improved forward checking (Question 5 but
% with the old generateRowCheck/3) performed under 1.3M inferences to
% obtain a solution and a bit more than 200K inferences thereafter to
% ensure the uniqueness of that solution.  This is a 5- to 6-fold
% improvement which is not that bad but also not terribly impressive.
% Until you consider time that is.  The answer was produced
% practically instantateously (94 milliseconds to the solution and 21
% more milliseconds to the end failure).
%
% The forward checking on rows should not offer a huge improvement
% since we avoid some combinations but on the other hand we perform a
% relatively expensive test repeatedly.  Indeed, using
% generateRowCheckX/3 shaves off another 150K inferences or so (some
% 10 milliseconds).
%
% Tightening the forward checking paid off big time, but is it enough
% to allow us to solve real-world nonograms?  Not quite.  The problem
% is that the running time increases exponentially with the number of
% inferences performed (since those inferences are nodes in a proof
% tree that has to be traversed).  Therefore the time it takes to
% solve the second nonogram above (which is larger but still
% relatively modest in size) continues to be impractically large;
% indeed, like with the previous implementation I failed to obtain a
% solution within 6 hours.  Exponential running time is a bitch, you
% think you can solve a problem and then you discover that you cannot
% after all by going to an ever so slightly larger input instance.

% The overall conclusion is that forward checking is useful in solving
% CSP, but is not the ultimate answer.  That has been known to the AI
% community for a long time.  The most effective approach to CSP is to
% use heuristics when choosing the next variable to be assigned and
% also when deciding on the next value to assign.  Specifically, we
% should always choose the most constrained variable (the one that has
% the fewest possible values that are still consistent to the
% constraints) as well as the least constraining value (the value that
% imposes the fewest possible constraints to the variables that are
% yet to be assigned). This approach is able to solve very large
% instances of CSP and so is very likely to accommodate large
% nonograms, possibly as large as 1 million pixels.  This is all
% obviously outside the scope of the course though, so I am not going
% to implement it.

% Another thing worth considering is the formulation of the problem
% itself.  One can choose variables in multiple ways.  It is quite
% possible that a better approach is to consider eash pixel as a
% variable.  The number of variables is polynomially larger but the
% domain of each variable is exponentially smaller, so there are
% grounds to believe that this would be a much better implementation.
% However, the forward checking performed after assigning each pixel
% variable is very similar to the forward checking performed in
% nonogramX/3, so despite appearances I believe that this
% representation is not going to help much.  I am not going to try it
% out but if you do please let me know.

% For those further interested in CSP there is a Prolog library
% dedicated to that and named CLP(FD).  Check out
% https://www.swi-prolog.org/man/clpfd.html for more details and note
% that this library already comes with SWI Prolog.