C[omp]ute

From: "andrew cooke" <andrew@...>

Date: Wed, 16 May 2007 20:00:24 -0400 (CLT)

% a parallel sudoku solver.  each cell on the grid is a separate
% process, aware of - and negotiating with - its "neighbours" (those
% cells it must not conflict with).

% a cell is very simple - it contains just two integer values as
% "mutable" state: the current digit and a "confidence" in that value.

% the negotiation protocol is defined below.  cells "ping" the
% controller when the exchange results in a change of value.  the
% controller stops the system when there has been no change in any
% value for CONTROL_TIMEOUT (currently 1s).

% this is terribly, terribly brain-dead and inefficient (takes several
% - sometimes tens of - minutes to solve the test case on my newish
% linux box).  tuning the doubt parameter may help slightly (a value
% of 0.1 seem to work).


% i think some very interesting graphics could be generated from this
% code - think of the solution as a kind of crystallisation, with
% competing centres of nucleation.  please contact me
% (andrew@...) if interested...


-module(sudoku).

-export([solve/2, empty/1, starting/3, norvig/2]).
-export([neighbours/1, format/2]).


-define(CELL_TIMEOUT, 1).         % see comments below
-define(CONTROL_TIMEOUT, 1000).   % shutdown if no changes after this
-define(RANGE, lists:seq(1, 9)).  % [1 ... 9]

-record(cell, {locn, nbrs, dbt}). % configuration data for a cell



% negotiation between cells is described below but first we need to
% get everything up and running.

solve(Puzzle, Doubt) ->
    Cells = [{X, Y} || Y <- ?RANGE, X <- ?RANGE],
    %application:start(sasl),     % debug info for failed processes
    register(ctrl, self()),
    [new_cell(Doubt, Puzzle, Cell) || Cell <- Cells],
    broadcast(Cells, start),
    ok = wait_to_complete(),
    Result = [report(Cell) || Cell <- Cells],
    broadcast(Cells, stop),
    % i don't understand why flatten is needed here
    {Result, lists:flatten(lists:foldl(fun format/2, "", Result))}.

broadcast(Cells, Message) -> [address(Cell) ! Message || Cell <- Cells].

% for easy identification we use the string {X,Y}, converted to an
% atom, as the name for each process.
address(Locn) ->
    list_to_atom(lists:flatten(io_lib:format("~p", [Locn]))).

new_cell(Doubt, Puzzle, Locn) ->
    {Value, Confidence} = initialise(Puzzle, Locn),
    Cell = #cell{locn = Locn,
                 nbrs = named_neighbours(Locn),
                 dbt = Doubt},
    % create the process and register its name
    register(address(Locn),
             proc_lib:spawn(sudoku, starting,
                            [Cell, Value, Confidence])).

% a puzzle is represented as a map (implemented in gb_trees) from the
% location to the value.  only cells with initial values appear in the
% map.
initialise(Puzzle, Locn) ->
    case gb_trees:is_defined(Locn, Puzzle) of
        true -> {gb_trees:get(Locn, Puzzle), certain};
        false -> {random:uniform(9), 0}
    end.

named_neighbours(Locn) -> [address(N) || N <- neighbours(Locn)].

% cells that can potentially conflict with this cell
neighbours({X, Y}) ->
    CornerX = 3 * ((X - 1) div 3),
    CornerY = 3 * ((Y - 1) div 3),
    [{XX, YY} || XX <- [CornerX + P || P <- [1, 2, 3]],
                 YY <- [CornerY + Q || Q <- [1, 2, 3]],
                 {XX, YY} /= {X, Y}]
        ++ [{XX, YY} || XX <- [roll(X + P) || P <- [0, 3, 6]],
                        YY <- [roll(Y + Q) || Q <- [0, 3, 6]],
                        {XX, YY} /= {X, Y}].

roll(N) when N > 9 -> N - 9;
roll(N) when N < 1 -> N + 9;
roll(N) -> N.



% each process is a simple state machine.  this is the starting state,
% waiting on an initial message (so that all the processes can be
% deployed before they try talking to each other).
starting(Cell, Value, Confidence) ->
    receive
        start -> searching(Cell, Value, Confidence)
    end.

% the final state, allowing for clean shutdown.
ending() ->
    receive
        stop -> ok
    end.

% the intermediate state (repeated)
searching(Cell, Value, Confidence) ->
    receive
        % shutdown takes priority over other, pending messages
        report ->
            report(Value, Confidence),
            ending();
        % otherwise, if we have a waiting message, process it
        Message ->
            transition(Cell, Value, Confidence, Message)
    after
        % otherwise, after a short pause, send a message to a
        % random neighbour asserting our current value.
        ?CELL_TIMEOUT ->
            random_nbr(Cell) ! {assert, self(), Value, Confidence},
            searching(Cell, Value, Confidence)
    end.

random_nbr(Cell) ->
    lists:nth(random:uniform(length(Cell#cell.nbrs)),
              Cell#cell.nbrs).


% next is our transition table for the negotiation protocol (the
% protocol is symmetric - our neighbour has the same table).  for each
% message we reply if necessary (we either deny or yield to an
% assertion) and then update our internal state (Value and
% Confidence).

% note that we *never* change the Value if we agree with our
% neighbour.  this ensures that the process is stationary (if we have
% a solution we don't mess it up) which, together with a quasi-random
% exploration of the available parameter space, is pretty much our
% only (weak!) guarantee for convergence.

% the Confidence value (together with the "doubt" parameter for the
% run) is an optimisation to help guide us to a solution more quickly.


% if we are certain, and our neighbour is in conflict, deny them.
transition(Cell, Value, certain, {assert, From, Value, _Test}) ->
    deny(From, Value),
    searching(Cell, Value, certain);

% if our neighbour is certain, and we are conflict, change.  note that
% we initially have no confidence in the new value.
transition(Cell, Value, _Confidence, {assert, From, Value, certain}) ->
    yield(From, Value),
    searching(Cell, new_value(Cell, Value), 0);

% otherwise, conflict is resolved according to relevant confidence
% levels.  in this case, the neighbour is more confident than we are,
% so we yield and change.
transition(Cell, Value, Confidence, {assert, From, Value, Test})
  when Confidence < Test ->
    yield(From, Value),
    searching(Cell, new_value(Cell, Value), 0);

% alternatively, if we are more confident, we deny them the value.
% this is where doubt comes into play....

% on an emotional level, this is simple enough - our confidence should
% decrease if our neighbours continually disagree with us.  but i
% think there is a more technical issue, too.  it is possible for a
% set of cells to be self-consistent and so, by mutual assurances,
% gain a high level of confidence.  for "hard" sudoku games i suspect
% that such a group can exist without conflicting directly with any
% known (initial) value.  in such cases the "self-deluding" set can
% become unbeatable (their confidence is higher than any neighbour),
% blocking a solution.  a sufficiently high level of doubt weakens
% this process and increases our chance of global convergence.
transition(Cell, Value, Confidence, {assert, From, Value, _Test}) ->
    deny(From, Value),
    searching(Cell, Value, doubt(Cell, Confidence));

% if our neighbour claims a different value from our own then we agree
% - this should also increase our confidence slightly.
transition(Cell, Value, Confidence, {assert, From, Other, _Test}) ->
    yield(From, Other),
    searching(Cell, Value, confirm(Confidence));

% if our neighbour has denied us a value (they were more certain than
% us on the receipt of our assertion), then we must change...
transition(Cell, Value, _Confidence, {deny, Value}) ->
    searching(Cell, new_value(Cell, Value), 0);

% ...but not if we already changed and no longer have the value we
% asserted!
transition(Cell, Value, Confidence, {deny, _Other}) ->
    searching(Cell, Value, Confidence);

% if our neighbour acquiesces with our assertion we can increase our
% confidence a little...
transition(Cell, Value, Confidence, {yield, Value}) ->
    searching(Cell, Value, confirm(Confidence));

% ...but if they agreed with a value we no longer have then we can do
% little about it.
transition(Cell, Value, Confidence, {yield, _Other}) ->
    searching(Cell, Value, Confidence).


% the various actions used above

deny(From, Value) -> From ! {deny, Value}.
yield(From, Value) -> From ! {yield, Value}.
report(Value, Confidence) -> ctrl ! {result, Value, Confidence}.

new_value(Cell, Value) ->
    case random:uniform(9) of
        Value -> new_value(Cell, Value);
        Other ->
            ctrl ! {tick, Cell#cell.locn, Value, Other},
            searching(Cell, Other, 0)
    end.

doubt(_Cell, certain) -> certain;
doubt(Cell, Confidence) ->
    lists:max([0, trunc(Confidence * Cell#cell.dbt)]).

confirm(certain) -> certain;
confirm(Confidence) -> Confidence + 1.



% shutdown and reporting

wait_to_complete() ->
    receive
        {tick, _Locn, Value, _Other} ->
            io:fwrite("~p", [Value]),  % print something to show action
            wait_to_complete()
    after
        ?CONTROL_TIMEOUT -> ok
    end.

report(Locn) ->
    address(Locn) ! report,
    receive
        {result, Value, Conf} -> {Locn, Value, Conf}
    end.

% this "ignores" X, Y - assumes ordering as in Cells
format({{X, Y}, Value, _Conf}, Text) ->
    Text ++ io_lib:format("~p", [Value]) ++ decorate(X, Y).

decorate(X, Y) when X == 9, Y rem 3 == 0, Y /= 9 ->
    decorate_x(X) ++ "---------------------\n";
decorate(X, _Y) -> decorate_x(X).

decorate_x(9) -> "\n";
decorate_x(X) when X > 0, X rem 3 == 0 -> " | ";
decorate_x(_) -> " ".


% testing

empty(Doubt) -> solve(Doubt, gb_trees:empty()).

% format used at http://norvig.com/sudoku.html
norvig(List, Doubt) ->
    Cells = [{X, Y} || Y <- ?RANGE, X <- ?RANGE],
    Clean = [L || L <- List,
                  (L == $.) or ((L >= $0) and (L =< $9))],
    Puzzle = lists:foldl(fun set_known/2, gb_trees:empty(),
                         lists:zip(Clean, Cells)),
    solve(Puzzle, Doubt).

set_known({N, _Locn}, Puzzle) when (N < $1) or (N > $9) -> Puzzle;
set_known({CharValue, Locn}, Puzzle) ->
    gb_trees:insert(Locn, list_to_integer([CharValue]), Puzzle).


% to run, start "erl" and then enter:

% > c(sudoku).
% > {Result, Piccy} = sudoku:norvig("4.. ... 8.5"
%                                   ".3. ... ..."
%                                   "... 7.. ..."
%                                   ".2. ... .6."
%                                   "... .8. 4.."
%                                   "... .1. ..."
%                                   "... 6.3 .7."
%                                   "5.. 2.. ..."
%                                   "1.4 ... ...", 0.1).
%  ...
% > io:fwrite("~s", [Piccy]).
% 4 5 1 | 1 4 6 | 8 3 5
% 8 3 7 | 9 2 5 | 7 1 9
% 2 6 9 | 7 8 3 | 6 4 2
% ---------------------
% 9 2 4 | 2 9 7 | 3 6 8
% 6 7 3 | 3 8 4 | 4 5 1
% 8 5 1 | 5 1 6 | 9 2 7
% ---------------------
% 7 8 9 | 6 1 3 | 5 7 2
% 5 6 2 | 2 9 8 | 1 4 6
% 1 3 4 | 4 7 5 | 3 9 8


% (c) andrew cooke, 2007, released under the gpl.
% thanks to j armstrong, the rest of the erlang guys, and p norvig.