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