Optimizing a Prolog algorithm

Question

I'm trying to learn more advanced logical programming by doing problems I've already solved in Java. I'm currently working on a Mancala-type of problem, and my code does produce the right answer, for the most part at least... Some inputs take arduous amounts of time to solve, and in some cases, the computer runs out of stack (for example start([111,111,111,111,111,45,45,111,45,111,111,111]).

I wonder how I can optimize my program so that it works for all inputs of length 12, and solves them reasonably fast at least.

I tried inserting some cuts where I thought they made sense in the minimizing algorithm, which seemed to have some positive effects. Perhaps there are other things I can do to speed things up that I'm not aware of? Any and all help is greatly appreciated.

% Facts.

empty(45).    % "-"

occupied(111).  % "o"

% Executes a move and updates the board.

executeMove([_, _, _ | R], 0, 1, 2, X, Y, Z, [X, Y, Z | R]).

executeMove([A, B, C | R], I, J, K, X, Y, Z, [A | T]) :- K1 is K - 1,
                                                 J1 is J - 1,
                                                 I1 is I - 1,
                                                 executeMove([B, C | R], I1, J1, K1, X, Y, Z, T).

% Tests if a move to the left can be made,
% i.e. there exists a substring "-oo". 

tryLeft(L, I, J, K) :- I > 1,          
                        nth0(I, L, X),
                        occupied(X),
                        nth0(J, L, Y),
                        occupied(Y),                               
                        nth0(K, L, Z),
                        empty(Z).

% Tests if a move to the right can be made,
% i.e. there exists a substring "oo-".                    

tryRight(L, I, J, K) :- I < 10,        
                      nth0(I, L, X),
                      occupied(X),     
                      nth0(J, L, Y),
                      occupied(Y),                              
                      nth0(K, L, Z),
                      empty(Z).

% Calculates the number of stones on the board.

stones([], 0).

stones([111|T], N) :- stones(T, N1),
                 N is N1 + 1, 
                 !.

stones([_|T], N) :- stones(T, N).

% Algorithm for minimizing the number of stones 
% on a board. Currently too inefficient. 

tryMove(L, I) :- (
                 I < 12,               % Iterate over the entire board
                 nth0(I, L, P),        % Get the Ith character
                 (                     % If that character is a stone
                    occupied(P);       % then we might be able to move
                    I1 is I + 1,       % Otherwise, next iteration
                    tryMove(L, I1)
                 ),
                 (
                    J is I + 1,
                    K is J + 1,
                    tryRight(L, I, J, K), % Test if a move can be made
                    executeMove(L, I, J, K, 45, 45, 111, Y), % Update the board
                    tryMove(Y, 0), % Test algorithm using the new board
                    calculate(Y);  % Possibly update the minimum 
                    true
                 ),                % Reset to the previous board
                 (
                    J is I - 1,
                    K is J - 1,
                    tryLeft(L, I, J, K), % Test if a move can be made
                    executeMove(L, K, J, I, 111, 45, 45, Y), % Update the board
                    tryMove(Y, 0), % Test algorithm using the new board
                    calculate(Y);  % Possibly update the minimum 
                    true
                 ),                % Reset to the previous board
                 I2 is I + 1,
                 tryMove(L, I2);   % Iterate
                 true              % Guarantees true output
               ). 

% Reduces code duplication.

calculate(Y) :- stones(Y, F),
          (nb_getval(min, M),
          F < M, 
          nb_setval(min, F),
          ;
          true).

% Game predicate.

start(L) :- stones(L, E), 
        nb_setval(min, E), 
        tryMove(L, 0), 
        nb_getval(min, M), 
        write(M), 
        nl.

Answer 1

in case you're interested, a different approach, more logical solution, working regardless the numbers of stones:

stones :-
    member(Ps, [
        [o,o,o,o,o,-,-,o,-,o,o,o],
        % from doc example
        [-,-,-,o,o,-,-,-,-,-,-,-],
        [-,o,-,-,o,-,o,o,-,-,-,-],
        [-,o,-,-,-,-,o,o,o,-,-,-],
        [o,o,o,o,o,o,o,o,o,o,o,o],
        [o,o,o,o,o,o,o,o,o,o,-,o]
    ]),
    aggregate(min(N, [Last|Steps]), (
        stones([Ps], [Last|Steps]),
        aggregate_all(count, member(o, Last), N)
    ), min(Min, Sol)),
    writeln(Min:Sol).

stones([I|R], Steps) :-
    move(I, T),
    stones([T,I|R], Steps).
stones(Solution, Solution).

move(Ps, Moved) :-
    append(L, [-,o,o|R], Ps),
    append(L, [o,-,-|R], Moved).
move(Ps, Moved) :-
    append(L, [o,o,-|R], Ps),
    append(L, [-,-,o|R], Moved).

yields

?- stones.
3:[[o,-,o,-,-,-,-,-,-,-,-,o],[o,-,-,o,o,-,-,-,-,-,-,o],[o,o,o,-,o,-,-,-,-,-,-,o],[o,o,o,-,-,o,o,-,-,-,-,o],[o,o,o,o,o,-,o,-,-,-,-,o],[o,o,o,o,o,-,-,o,o,-,-,o],[o,o,o,o,o,-,-,o,-,o,o,o]]
true ;
1:[[-,-,o,-,-,-,-,-,-,-,-,-],[-,-,-,o,o,-,-,-,-,-,-,-]]
true ;
2:[[-,o,-,o,-,-,-,-,-,-,-,-],[-,o,-,-,o,o,-,-,-,-,-,-],[-,o,-,-,o,-,o,o,-,-,-,-]]
true ;
3:[[-,o,-,-,-,o,-,-,o,-,-,-],[-,o,-,-,-,-,o,o,o,-,-,-]]
true ;
12:[[o,o,o,o,o,o,o,o,o,o,o,o]]
true ;
1:[[-,o,-,-,-,-,-,-,-,-,-,-],[-,-,o,o,-,-,-,-,-,-,-,-],[o,o,-,o,-,-,-,-,-,-,-,-],[o,o,-,-,o,o,-,-,-,-,-,-],[o,o,o,o,-,o,-,-,-,-,-,-],[o,o,o,o,-,-,o,o,-,-,-,-],[o,o,o,o,o,o,-,o,-,-,-,-],[o,o,o,o,o,o,-,-,o,o,-,-],[o,o,o,o,o,o,o,o,-,o,-,-],[o,o,o,o,o,o,o,o,-,-,o,o],[o,o,o,o,o,o,o,o,o,o,-,o]]
true.