# C[omp]ute

Welcome to my blog, which was once a mailing list of the same name and is still generated by mail. Please reply via the "comment" links.

Always interested in offers/projects/new ideas. Eclectic experience in fields like: numerical computing; Python web; Java enterprise; functional languages; GPGPU; SQL databases; etc. Based in Santiago, Chile; telecommute worldwide. CV; email.

© 2006-2015 Andrew Cooke (site) / post authors (content).

## Community Sudoku - A Cooperative Algorithm

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],
ok = wait_to_complete(Cells, Log, 0),
Result = result(Cells),
Result.

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

% quiescent state, allowing for clean shutdown and consistent reporting.
sleeping(Cell, Value, Investment) ->
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) ->
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
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) ->
Cell#cell.comp)).

random_neighbour(Cell) ->
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) ->
{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
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 ->
{_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) ->
{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]) ->
{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)]).

### No Emergence

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

Date: Sat, 19 May 2007 13:13:20 -0400 (CLT)

Jerry Fodor on Strawson in the LRB - http://lrb.co.uk/v29/n10/fodo01_.html

Relevant?

Andrew

### Still doesn't work...

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

Date: Sun, 27 May 2007 09:35:05 -0400 (CLT)

Datacompboy on the Erlang mailing list pointed out that this still doesn't
work.  The problem is that it incorrectly detects convergence and so stops
when in an incorrect state (and you need to check more carefully - I know,
I should automate that - since it the invariant makes it look OK).  When
fixed, this fails to converge.

I am about to post a new version with additional logic suggested by
Jonathan Sillito.  However, the new version doesn't converge either (but
the code is nicer - see the new thread).

Andrew