How to solve this puzzle in Prolog?

Question

I am trying to solve a puzzle in Prolog that involves taking a square of numbers (a list of a list of numbers) and returning the list of the greatest combination of numbers starting at the top and going down, row by row. Each move must be either down, down to the right, or down to the left.

I've been trying to do this for a while now, does anyone have a place I could begin?

For example, on the board

 [[0, 2, 1, 0],
  [0, 1, 1, 0],
  [0,10,20,30]]

the best move would be [1, 2, 3] for 33 points.

Answer 1

?- best_path_score([[0, 2, 1, 0],[0, 1, 1, 0],[0,10,20,30]], P, S).
P = [1, 2, 3],
S = 33.

with this definition

best_path_score(Rs, BestPath, BestScore) :-
    aggregate_all(max(Score, Path), a_path(Rs, Path, Score), max(BestScore, BestPath)).

a_path([R|Rs], [P|Ps], Score) :-
    nth0(P, R, S0),
    a_path(Rs, P, Ps, S),
    Score is S0 + S.

a_path([], _, [], 0).
a_path([R|Rs], P, [Q|Qs], T) :-
    ( Q is P - 1 ; Q is P ; Q is P + 1 ),
    nth0(Q, R, S0),
    a_path(Rs, Q, Qs, S),
    T is S0 + S.

Answer 2

So here is how you could do it. I know it's kinda wordy, that probably is because I'm not really fluent in Prolog either...

% Lookup a value in a list by it's index.
% this should be built into prolog?
at(0, [H|_], H).
at(N, [_|T], X) :- 
    N > 0,
    N1 is N - 1,
    at(N1, T, X).

% like Haskell's maximumBy; takes a predicate, a 
% list and an initial maximum value, finds the
% maximum value in a list
maxby(_, [], M, M).
maxby(P, [H|T], M0, M) :-
    call(P, H, M0, M1),
    maxby(P, T, M1, M).

% which of two paths has the bigger score?
maxval(path(C,  I), path(C1, _), path(C, I)) :- C >= C1.
maxval(path(C0, _), path(C, I),  path(C, I)) :- C0 < C.

% generate N empty paths as a starting value for
% our search
initpaths(N, Ps) :- 
    findall(path(0, []), 
            between(0, N, _), 
        Ps). 

% given the known best paths to all indexes in the previous
% line and and index I in the current line, select the best
% path leading to I.
select(Ps, I, N, P) :-
    I0 is I-1,
    I1 is I+1,
    select(Ps, I0, N, path(-1, []), P0),
    select(Ps, I,  N, P0, P1),
    select(Ps, I1, N, P1, P).

% given the known best paths to the previous line (Ps),
% an index I and a preliminary choice P0, select the path 
% leading to the index I (in the previous line) if I is within 
% the range 0..N and its score is greater than the preliminary 
% choice. Stay with the latter otherwise.
select(_, I, _, P0, P0) :- I < 0.
select(_, I, N, P0, P0) :- I > N.
select(Ps, I, _, P0, P) :- 
    at(I, Ps, P1),
    maxby(maxval, [P0], P1, P).

% given the known best paths to the previous line (P1),
% and a Row, which is the current line, extend P1 to a 
% new list of paths P indicating the best paths to the
% current line.
update(P1, P, Row, N) :-
    findall(path(C, [X|Is]), 
            ( between(0, N, X)
            , select(P1, X, N, path(C0, Is))
            , at(X, Row, C1)
            , C is C0 + C1),
        P).

% solve the puzzle by starting with a list of empty paths
% and updating it as long as there are still more rows in 
% the square.
solve(Rows, Score, Path) :-
    Rows = [R|_],
    length(R, N0),
    N is N0 - 1,
    initpaths(N, IP),
    solve(N, Rows, IP, Score, Path).
solve(_, [], P, Score, Path) :- 
    maxby(maxval, P, path(-1, []), path(Score, Is0)),
    reverse(Is0, Path).
solve(N, [R|Rows], P0, Score, Path) :-
    update(P0, P1, R, N),
    solve(N, Rows, P1, Score, Path).

Shall we try it out? Here are your examples:

?- solve([[0,2,1,0], [0,1,1,0], [0,10,20,30]], Score, Path).
Score = 33,
Path = [1, 2, 3] ;
false.

?- solve([[0,1,1], [0,2,1], [10,0,0]], Score, Path).
Score = 13,
Path = [1, 1, 0] ;
false.

Answer 3

My prolog is a bit shaky. In fact all I remember about prolog is that it's declarative.

Here is some haskell code to find the value of the max path. Finding the trace should be an easy next step, but a bit more complicated to code up I imagine. I suppose a very elegant solution for the trace would be using monads.

maxValue :: [ [ Int ] ] -> Int
maxValue p = maximum $ maxValueHelper p
maxValueHelper :: [ [ Int ] ] -> [ Int ]
maxValueHelper [ row ] = row
maxValueHelper ( row : restOfRows ) = combine row ( maxValueHelper restOfRows )
combine :: [ Int ] -> [ Int ]-> [ Int ]
combine [ x ] [ y ] = [ x + y ]
combine ( x1 : x2 : lx ) ( y1 : y2 : ly ) =
   let ( z2 : lz ) = combine ( x2 : lx ) ( y2 : ly )
   in
   ( max ( x1 + y1 ) ( x1 + y2 ) : max ( x2 + y1 ) z2 : lz )

main :: IO()
main = print $ maxValue [[0,2,1,0], [0,1,1,0], [0,10,20,30]]