C[omp]ute

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

Date: Fri, 18 May 2007 21:27:07 -0400 (CLT)

For earlier attempts, see http://www.acooke.org/cute/ParallelSu0.html


% a parallel sudoku solver.  each cell on the grid is a separate
% process, aware of - and negotiating with - other cells.

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

% the negotiation protocols are 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).

% in very general terms, cells that may conflict (those in the same
% row or column, for example) challenge each other.  if both have the
% same value then one must change (the one with a smaller investment).
% in this way we hope to converge on a solution to the sudoku problem
% (values given in the problem always "win" a challenge and so never
% change).

% so this is a quasi-random exploration of the available solutions.
% the "investment" is an attempt at optimising the process so that
% cells with more "support" remain.  for the "community" market (see
% below) this optimisation is not needed (it seems to lower the number
% of exchanges by perhaps 25%)

% there are two approaches (selected by MARKET below) to picking a new
% value when a cell "loses" a challenge.  in the "individual" approach
% the cell simply picks a new value at random.  in the "community"
% approach the cell swaps with another cell in the same block - this
% guarantees that each block always contains one each of the 9
% digits).

% the "individual" market is terribly, terribly brain-dead and
% inefficient -with a panic doubt of 0.1 it failed to converge in
% 8450000 exchanges ("doubt" helps avoid "incorrect" structures from
% becoming too permanent).

% the "community" market is much more efficient (convergence in a few
% hundred exchanges), but requires a significantly more complex
% protocol.  swapping values consistently is quite difficult to
% achieve - several initial versions of the code would deadlock.  this
% is because a cell is effectively paralysed during the swap - it
% cannot participate in another change or it may end up in a different
% swap, leading to inconsistencies.  to compare the two approaches look
% at all occurrences of "swap" related messages in the code (swap,
% reject_swap and accept_swap).


-module(sudoku).

-export([solve/2, empty/2, starting/3, norvig/0, norvig/2, norvig/3]).
-export([ascii/1, community/1, competitors/3]).

-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]
-define(NULL, "/dev/null").
-define(DOUBT, none).             % none, panic or doubt
-define(INTEREST, 0).             % investment ignored when 0
-define(MARKET, community).       % individual or community

-record(cell, {locn, comp, cmty, dbt, send=0, recv=0, chng=0}).



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

solve(Puzzle, Doubt) -> solve(Puzzle, Doubt, ?NULL).

solve(Puzzle, Doubt, File) ->
    {ok, Log} = file:open(File, [write]),
    Cells = [{X, Y} || Y <- ?RANGE, X <- ?RANGE],
    application:start(sasl),     % debug info for failed processes
    register(ctrl, self()),
    [new_cell(Doubt, Puzzle, Cell, Log) || Cell <- Cells],
    broadcast(Cells, start),
    ok = wait_to_complete(Cells, Log, 0),
    broadcast(Cells, sleep),
    Result = result(Cells),
    broadcast(Cells, stop),
    Result.

broadcast(Cells, Message) ->
    io:fwrite("~p~n", [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, Log) ->
    {Value, Investment} = initialise(Puzzle, Locn),
    io:fwrite(Log, "~p.~n", [{Locn, Value, Investment}]),
    Community = community(Locn),
    Cell = #cell{locn = Locn,
                 comp = competitors(Locn, Community, ?MARKET),
                 cmty = Community,
                 dbt = Doubt},
    % create the process and register its name
    register(address(Locn),
             proc_lib:spawn(sudoku, starting,
                            [Cell, Value, Investment])).

% 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), monopoly};
        false -> {unknown(Locn, Puzzle, ?MARKET), 0}
    end.

% for the individual market we can assign initial values at random
unknown(_Locn, _Puzzle, individual) -> random:uniform(9);

% for the community market we need to take care that all cells in one
% block are distinct
unknown(Locn, Puzzle, community) ->
    Known = [gb_trees:get(L, Puzzle) ||
                L <- community(Locn), gb_trees:is_defined(L, Puzzle)],
    Rest = lists:subtract(?RANGE, Known),
    Index = 1 + length([L || L <- community(Locn), L < Locn,
                             not gb_trees:is_defined(L, Puzzle)]),
    lists:nth(Index, Rest).


% cells that can potentially conflict with this cell
competitors(Locn, Community, individual) ->
    Community ++ other_row_col(Locn, Community);
competitors(Locn, Community, community) ->
    other_row_col(Locn, Community).

community({X,Y}) ->
    CornerX = 3 * ((X - 1) div 3),
    CornerY = 3 * ((Y - 1) div 3),
    lists:usort([{XX, YY} || XX <- [CornerX + P || P <- [1, 2, 3]],
                             YY <- [CornerY + Q || Q <- [1, 2, 3]],
                             {XX, YY} /= {X, Y}]).

other_row_col({X, Y}, Community) ->
    [{XX, Y} || XX <- ?RANGE,
                XX /= X, not contains(Community, {XX,Y})]
        ++ [{X, YY} || YY <- ?RANGE,
                       YY /= Y, not contains(Community, {X,YY})].

contains([], _Value) -> false;
contains([Value|_Tail], Value) -> true;
contains([_Value|Tail], Value) -> contains(Tail, Value).



% 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, Investment) ->
    receive
        start -> searching(Cell, Value, Investment)
    end.

% quiescent state, allowing for clean shutdown and consistent reporting.
sleeping(Cell, Value, Investment) ->
    receive
        stop -> ok;
        {swap, From, _Other} ->
            From ! reject_swap,
            sleeping(Cell, Value, Investment);
        report ->
            report(Cell, Value, Investment),
            sleeping(Cell, Value, Investment);
        status ->
            status(Cell, Value, Investment),
            sleeping(Cell, Value, Investment)
    end.

% the intermediate state (repeated)
searching(Cell, Value, Investment) ->
    receive
        sleep -> sleeping(Cell, Value, Investment);
        Message -> negotiate(Cell, Value, Investment, Message)
    after
        ?CELL_TIMEOUT -> assert(Cell, Value, Investment)
    end.



% next is our negotiate 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
% Investment).

% note that we *never* change the Value if we are already consistent.
% 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 Investment value (together with the "doubt" parameter for the
% run) is an optimisation to help guide us to a solution more quickly.


% if we are monopoly, and our competitor is in conflict, deny them.
negotiate(Cell, Value, monopoly, {assert, From, Value, _Test}) ->
    Cell2 = deny(Cell, From, Value),
    searching(Cell2, Value, monopoly);

% if our competitor is monopoly, and we are conflict, change.
negotiate(Cell, Value, Investment, {assert, From, Value, monopoly}) ->
    Cell2 = yield(Cell, From, Value),
    new_value(Cell2, Value, Investment, ?MARKET);

% otherwise, conflict is resolved according to relevant investment
% levels.  in this case, the competitor is wealthier than we are, so
% we yield and change.
negotiate(Cell, Value, Investment, {assert, From, Value, Test})
  when Investment < Test ->
    Cell2 = yield(Cell, From, Value),
    new_value(Cell2, Value, Investment, ?MARKET);

% alternatively, if we are wealthier, we deny them the value.  this is
% where doubt comes into play....
negotiate(Cell, Value, Investment, {assert, From, Value, _Test}) ->
    Cell2 = deny(Cell, From, Value),
    doubt(Cell2, Value, Investment);

% if our competitor claims a different value from our own then we agree
% - this should also increase our investment slightly.
negotiate(Cell, Value, Investment, {assert, From, Other, _Test}) ->
    Cell2 = yield(Cell, From, Other),
    searching(Cell2, Value, earn(Investment));

% if our competitor has denied us a value (they were wealthier than us
% on the receipt of our assertion), then we must change...
negotiate(Cell, Value, Investment, {deny, Value}) ->
    new_value(Cell, Value, Investment, ?MARKET);

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

% if our competitor acquiesces with our assertion we can increase our
% investment a little...
negotiate(Cell, Value, Investment, {yield, Value}) ->
    searching(Cell, Value, earn(Investment));

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

% refuse to swap if the value is certain
negotiate(Cell, Value, Investment, {swap, From, _New})
  when Investment == monopoly ->
    From ! refuse_swap,
    searching(Cell, Value, Investment);

% otherwise, accept the swap
negotiate(Cell, Value, _Investment, {swap, From, New}) ->
    From ! {accept_swap, Value},
    ctrl ! {tick, Cell#cell.locn, Value, New},
    searching(Cell#cell{chng = Cell#cell.chng + 1}, New, 0);

% diagnostics to logger (not used here)
negotiate(Cell, Value, Investment, report) ->
    report(Cell, Value, Investment),
    searching(Cell, Value, Investment);

% diagnostics to central control (for periodic display of solution)
negotiate(Cell, Value, Investment, status) ->
    status(Cell, Value, Investment),
    searching(Cell, Value, Investment).


% the various actions used above

deny(Cell, From, Value) ->
    From ! {deny, Value},
    Cell#cell{recv = Cell#cell.recv + 1}.

yield(Cell, From, Value) ->
    From ! {yield, Value},
    Cell#cell{recv = Cell#cell.recv + 1}.

assert(Cell, Value, Investment) ->
    random_competitor(Cell) ! {assert, self(), Value, Investment},
    searching(Cell#cell{send = Cell#cell.send + 1}, Value, Investment).

random_competitor(Cell) ->
    address(lists:nth(random:uniform(length(Cell#cell.comp)),
                      Cell#cell.comp)).

random_neighbour(Cell) ->
    address(lists:nth(random:uniform(length(Cell#cell.cmty)),
                      Cell#cell.cmty)).

new_value(Cell, Old, _Investment, individual) ->
    random_value(Cell, Old);
new_value(Cell, Old, Investment, community) ->
    swap_value(Cell, Old, Investment).

% in an individual-based market the "losing" cell tries a new value
random_value(Cell, Old) ->
    case random:uniform(9) of
        Old -> random_value(Cell, Old);
        New ->
            ctrl ! {tick, Cell#cell.locn, Old, New},
            searching(Cell#cell{chng = Cell#cell.chng + 1}, New, 0)
    end.

% in a community-based market, values are swapped rather than
% generated at random.  this makes no sense for the individuals, since
% two cells lose their investment (instead of one as in the individual
% case), but the community gains the guarantee of remaining consistent
% (one of each of the digits 1-9 is in use).
swap_value(Cell, Old, Investment) ->
    random_neighbour(Cell) ! {swap, self(), Old},
    wait_for_swap_response(Cell#cell{send = Cell#cell.send + 1},
                           Old, Investment).

% to guarantee consistency we block while waiting for a swap reply.
% however, to avoid deadlock we also have to refuse further swaps and
% handle refusal ourselves.
wait_for_swap_response(Cell, Old, Investment) ->
    receive
        {accept_swap, New} ->
            ctrl ! {tick, Cell#cell.locn, Old, New},
            searching(Cell#cell{chng = Cell#cell.chng + 1}, New, 0);
        {swap, From, _Other} ->
            From ! reject_swap,
            wait_for_swap_response(Cell, Old, Investment);
        reject_swap -> swap_value(Cell, Old, Investment);
        % this would be dangerous if not for the fact that sleep
        % cannot return to searching.
        sleep -> sleeping(Cell, Old, Investment)
    end.

% doubt weakens a cell even when it "wins" a challenge.  the aim is to
% weaken frequently challenged cells so that they change more
% frequently.  this helps avoid a self-consistent, but incorrect, set
% of cells from "freezing".
doubt(Cell, Value, monopoly) -> searching(Cell, Value, monopoly);
doubt(Cell, Value, Investment) ->
    case ?DOUBT of
        % doubt has no effect
        none ->
            searching(Cell, Value, Investment);
        % doubt forces a new value directly in some fraction of cases
        panic ->
            case random:uniform() > Cell#cell.dbt of
                true -> searching(Cell, Value, Investment);
                false -> new_value(Cell, Value, Investment, ?MARKET)
            end;
        % doubt lowers the cell's investment, making it weaker
        doubt ->
            searching(Cell, Value,
                      lists:max([0, trunc(Investment * Cell#cell.dbt)]))
    end.

% investment increases when a cell's value is confirmed by other
% cells.  the aim is to encourage the growth of a set of mutually
% consistent values.
earn(monopoly) -> monopoly;
earn(Investment) -> Investment + ?INTEREST.

report(_Cell, Value, Investment) ->
    ctrl ! {result, Value, Investment}.

status(Cell, Value, Investment) ->
    error_logger:info_msg("~p = ~p (~p) send:~p recv:~p chng:~p",
                          [Cell#cell.locn, Value, Investment,
                          Cell#cell.send, Cell#cell.recv, Cell#cell.chng]).


% shutdown and reporting

wait_to_complete(Cells, Log, Count) when Count rem 10000 == 0 ->
    % broadcast(Cells, status),
    {_Values, Puzzle} = result(Cells),
    error_logger:info_msg("status at ~p~n~n~s~n", [Count, ascii(Puzzle)]),
    wait_for_tick(Cells, Log, Count);
wait_to_complete(Cells, Log, Count) -> wait_for_tick(Cells, Log, Count).

wait_for_tick(Cells, Log, Count) ->
    receive
        {tick, Locn, _Old, New} ->
            io:fwrite(Log, "~p.~n", [{Locn, New}]),
            wait_to_complete(Cells, Log, Count + 1)
    after
        ?CONTROL_TIMEOUT ->
            file:close(Log),
            ok
    end.

result(Cells) ->
    Values = [],
    Puzzle = gb_trees:empty(),
    collect_reports(Values, Puzzle, Cells).

collect_reports(Values, Puzzle, []) -> {Values, Puzzle};
collect_reports(Values, Puzzle, [Cell|Cells]) ->
    address(Cell) ! report,
    receive
        {result, Value, Investment} ->
            collect_reports([{Cell, Value, Investment}|Values],
                            gb_trees:insert(Cell, Value, Puzzle), Cells)
    end.


% formatting

value(Puzzle, Locn) -> integer_to_list(gb_trees:get(Locn, Puzzle)).

values(N, Puzzle, X, Y) ->
    lists:flatten([value(Puzzle, {XX,Y}) || XX <- lists:seq(X, X + N - 1)]).

line(Puzzle, Y) ->
    util:join_with([values(3, Puzzle, X, Y) || X <- [1, 4, 7]], " ").

lines(N, Puzzle, Y) ->
    util:join_with([line(Puzzle, YY) || YY <- lists:seq(Y, Y + N - 1)],
                   "\n") ++ "\n".

ascii(Puzzle) ->
    util:join_with([lines(3, Puzzle, Y) || Y <- [1, 4, 7]],
                   lists:duplicate(11, $\ ) ++ "\n").


% testing

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

% format used at http://norvig.com/sudoku.html
norvig(List, Doubt) -> norvig(List, Doubt, ?NULL).

norvig(List, Doubt, File) ->
    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, File).

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).

norvig() -> norvig("4.. ... 8.5"
                   ".3. ... ..."
                   "... 7.. ..."
                   ".2. ... .6."
                   "... .8. 4.."
                   "... .1. ..."
                   "... 6.3 .7."
                   "5.. 2.. ..."
                   "1.4 ... ...", 0.0, "community-none.txt").

% c(sudoku), {R,P} = sudoku:norvig(), io:fwrite("~s", [sudoku:ascii(P)]).