| Andrew Cooke | Contents | Latest | RSS | Twitter | Previous | Next

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.

Personal Projects

Lepl parser for Python.

Colorless Green.

Photography around Santiago.

SVG experiment.

Professional Portfolio

Calibration of seismometers.

Data access via web services.

Cache rewrite.

Extending OpenSSH.

Last 100 entries

Retiring Essentialism; Poorest in UK, Poorest in N Europe; I Want To Be A Redneck!; Reverse Racism; The Lost Art Of Nomography; IBM Data Center (Photo); Interesting Account Of Gamma Hack; The Most Interesting Audiophile In The World; How did the first world war actually end?; Ky - Restaurant Santiago; The Black Dork Lives!; The UN Requires Unaninmous Decisions; LPIR - Steganography in Practice; How I Am 6; Clear Explanation of Verizon / Level 3 / Netflix; Teenage Girls; Formalising NSA Attacks; Switching Brakes (Tektro Hydraulic); Naim NAP 100 (Power Amp); AKG 550 First Impressions; Facebook manipulates emotions (no really); Map Reduce "No Longer Used" At Google; Removing RAID metadata; New Bike (Good Bike Shop, Santiago Chile); Removing APE Tags in Linux; Compiling Python 3.0 With GCC 4.8; Maven is Amazing; Generating Docs from a GitHub Wiki; Modular Shelves; Bash Best Practices; Good Emergency Gasfiter (Santiago, Chile); Readings in Recent Architecture; Roger Casement; Integrated Information Theory (Or Not); Possibly undefined macro AC_ENABLE_SHARED; Update on Charges; Sunburst Visualisation; Spectral Embeddings (Distances -> Coordinates); Introduction to Causality; Filtering To Help Colour-Blindness; ASUS 1015E-DS02 Too; Ready Player One; Writing Clear, Fast Julia Code; List of LatAm Novels; Running (for women); Building a Jenkins Plugin and a Jar (for Command Line use); Headphone Test Recordings; Causal Consistency; The Quest for Randomness; Chat Wars; Real-life Financial Co Without ACID Database...; Flexible Muscle-Based Locomotion for Bipedal Creatures; SQL Performance Explained; The Little Manual of API Design; Multiple Word Sizes; CRC - Next Steps; FizzBuzz; Update on CRCs; Decent Links / Discussion Community; Automated Reasoning About LLVM Optimizations and Undefined Behavior; A Painless Guide To CRC Error Detection Algorithms; Tests in Julia; Dave Eggers: what's so funny about peace, love and Starship?; Cello - High Level C Programming; autoreconf needs tar; Will Self Goes To Heathrow; Top 5 BioInformatics Papers; Vasovagal Response; Good Food in Vina; Chilean Drug Criminals Use Subsitution Cipher; Adrenaline; Stiglitz on the Impact of Technology; Why Not; How I Am 5; Lenovo X240 OpenSuse 13.1; NSA and GCHQ - Psychological Trolls; Finite Fields in Julia (Defining Your Own Number Type); Julian Assange; Starting Qemu on OpenSuse; Noisy GAs/TMs; Venezuela; Reinstalling GRUB with EFI; Instructions For Disabling KDE Indexing; Evolving Speakers; Changing Salt Size in Simple Crypt 3.0.0; Logarithmic Map (Moved); More Info; Words Found in Voynich Manuscript; An Inventory Of 3D Space-Filling Curves; Foxes Using Magnetic Fields To Hunt; 5 Rounds RC5 No Rotation; JP Morgan and Madoff; Ori - Secure, Distributed File System; Physical Unclonable Functions (PUFs); Prejudice on Reddit; Recursion OK; Optimizing Julia Code; Cash Handouts in Brazil; Couple Nice Music Videos; It Also Works!; Adaptive Plaintext

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

Parallel Sudoku Solver in Erlang :o)

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.

Optimisation and Measurement

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

Date: Thu, 17 May 2007 08:59:17 -0400 (CLT)

The above was not intended to be efficient - it was motivated largely by a
(no doubt naive) desire to explore how very simple negotiation between
individuals could find a global solution.

As I've mentioned here before, I am reading "Machine Dreams" at the
moment, so ideas from economics are constantly at the back of mind.

However, the code above is not my initial attempt, but a revision that
removed some "premature optimisation".  Originally I had a limit to
confidence, above which cells would stop sending assertions.  The idea was
to reduce "useless" messages (since extremely confident cells will not
change), but this (wrongly) assumed that assertions help only the cell
doing the assertion - in retrospect it seems likely that continued
assertions from "fixed" cells help force the change incorrect values.

And the "doubt" parameter, while it seems to help, is not clearly justified.

My problem is, of course, that I don't understand what is happening in
detail.  Adding "print" statements gives some guidance, but there are so
many messages exchanges that it tends to help fix only bugs in the
protocol logic (ie when you can focus on a small set of messages, avoiding
the "big picture").

I need a "higher level" way of showing what is happening as the program
proceeds.  Some kind of statistic (ie a global number plotted against
time) or graphic (ie a way of representing the relationship between cells
as timeslice images of the grid, or as a movie).

But there is a catch-22: it is hard to find a good description without
understanding the system.

In the comments I think I talk about the result "crystallising out".  I
think this is a useful metaphor - there is a phase change from a
disordered state (random values) to an ordered one (consistent solution). 
The ordering involves correlations on all scales (not just local
neighbours) which, if I remember correctly, is also a property of some
phase transitions (I used to have the Landau + Lifshitz book on phase
transitions, but seem to have lost it).

But how does this carry across in detail?  I am starting to believe, for
example, that the idea of "competing centres of nucleation" is incorrect. 
It seems more (or equally?) likely that there is, in some sense, a
"single" structure, but that it slowly drifts "out of phase" so that when
it meets up later, it becomes inconsistent.

I am explaining things poorly.  What I mean is that there may be a large
group of cells which tend to be self-consistent when you move from one to
another along many paths, but which still have some paths that are
inconsistent (path being a series of jumps from neighbour to neighbour in
the sense of "neighbour" defined in the code).

So it would be impossible to identify competing sites for a graphic.

Alternatively (perhaps equivalently) the kind of graphic I was thinking of
seems to be a simplification of some kind of cluster analysis, with
significant clustering at a range of hierarchies.  So it's not clear where
to select a cutoff, or how useful it would be.

Which forces me back to simpler statistics.

Two I can think of are:

- number of points that agree with the final solution

- average of (or any other statistic related to) the number of
  consistent neighbours a cell has

I may modify the code to generate a log file that records cell/value
changes - statistics like that could then be assembled from that log
without having to re-run the (slow) code.

Andrew

Markets and Individuals

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

Date: Thu, 17 May 2007 09:36:12 -0400 (CLT)

Looking at this problem, comparing the parallel solution with a classic
(ie Norvig) constraint propagation/search, you can see support for one the
arguments Mirowski makes in Machine Dreams, I think:  that the individual
is less important than the market.  In other words, "top-down" is often
more efficient than "bottom-up".

This simplifies the issue enormously, of course - and there are no(?)
moral issues involved here (cells do not care about democracy).

But maybe Sudoku can function for economics in a similar way to chess for
searching - as a test case?  Is there some way of having a "slider" that
can be adjusted to move "intelligence" up and down the system?  How much
complexity would you need at each "level" to place the intelligence there?
 What are the levels?

Andrew

I Don't Even Know How To Play Sudoku...

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

Date: Thu, 17 May 2007 20:59:59 -0400 (CLT)

Someone just pointed on Reddit that I've screwed up:
http://programming.reddit.com/info/1rgar/comments/c1rlgd

Here's the correct neighbours function...

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, Y} || XX <- ?RANGE, XX /= X]
        ++ [{X, YY} || YY <- ?RANGE, YY /= Y].

Andrew

Latest Before Bed...

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

Date: Thu, 17 May 2007 22:03:20 -0400 (CLT)

About to go to bed, but the latest news is that this no longer appears to
converge.  The problem is that "my" rules were less local and so "broke
up" self-consistent but incorrect blocks.  Now, even with a doubt factor
of zero, the system is getting stuck in an semi-consistent state.  Here
are some snapshots:

65217:
467 921 835
231 865 749
958 734 126

823 457 961
719 182 453
645 319 287

492 643 578
576 298 314
184 573 692

66629:
467 921 835
231 865 749
958 734 126

823 457 961
719 382 453
645 319 287

192 643 578
576 298 314
154 578 692

96359:
467 921 835
231 865 749
958 734 126

823 457 961
719 382 453
645 319 287

392 643 578
576 298 314
184 578 692

Where the initial value is age.  See how static the system is, even over
30,000 changes in value?

I'll leave it running overnight, but don't expect that to terminate.  Not
sure what to do instead.  :o(

Andrew

Can't Sleep

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

Date: Thu, 17 May 2007 22:38:26 -0400 (CLT)

So, if I don't go running tomorrow morning I can sleep later...

I changed the algorithm to "panic" (paranoid?) - now doubt describes the
likelihood that, even when a cell wins a contest, it changes its value. 
So a value near 1 tends to give a cascade of changes.

Playing with the value, it seems that the results are quite sensitive when
doubt approaches 1 (as you might expect, although the fixed, known values
should also dampen things).  Currently a value of 0.99 seems to give an
apparently useful balance between change and stability.  I'll leave this
for a while to see how it evolves...

Andrew

Bug!

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

Date: Thu, 17 May 2007 23:30:13 -0400 (CLT)

There's a bug.  I don't know what it is, but there is one - at least one
non-certain cell is stuck at a fixed value.

Andrew

New Version

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

Date: Fri, 18 May 2007 08:03:23 -0400 (CLT)

During the day I need to do real work(!), so I'll leave this running.  It
seems to be making a decent exploration of the available space.  Note that
the interface between cells and control is becoming more modular (sleep,
status and report messages) as I modify the code to make it easier to
understand what is happening.  Output to the log is analysed by separate
tools not shown here.

Typical output to the screen at the moment looks like:

=INFO REPORT==== 18-May-2007::08:02:24 ===
status at 150000

472 361 895
635 849 712
851 725 346

428 937 561
913 586 427
756 412 983

589 653 274
567 294 138
124 978 659


% 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/2, starting/3, norvig/0, norvig/2, norvig/3]).
-export([neighbours/1]).


-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, panic).            % doubt algorithm

-record(cell, {locn, nbrs, 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) -> [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, Confidence} = initialise(Puzzle, Locn),
    io:fwrite(Log, "~p.~n", [{Locn, Value, Confidence}]),
    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),
    lists:usort([{XX, YY} || XX <- [CornerX + P || P <- [1, 2, 3]],
                             YY <- [CornerY + Q || Q <- [1, 2, 3]],
                             {XX, YY} /= {X, Y}]
                ++ [{XX, Y} || XX <- ?RANGE, XX /= X]
                ++ [{X, YY} || YY <- ?RANGE, YY /= Y]).



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

% quiescent state, allowing for clean shutdown and consistent reporting.
sleeping(Cell, Value, Confidence) ->
    receive
        stop -> ok ;
        report ->
            report(Cell, Value, Confidence),
            sleeping(Cell, Value, Confidence);
        status ->
            status(Cell, Value, Confidence),
            sleeping(Cell, Value, Confidence);
        awake -> searching(Cell, Value, Confidence)
    end.

% the intermediate state (repeated)
searching(Cell, Value, Confidence) ->
    receive
        sleep -> sleeping(Cell, Value, Confidence);
        report ->
            report(Cell, Value, Confidence),
            searching(Cell, Value, Confidence);
        status ->
            status(Cell, Value, Confidence),
            searching(Cell, Value, Confidence);
        Message -> negotiate(Cell, Value, Confidence, Message)
    after
        ?CELL_TIMEOUT -> assert(Cell, Value, Confidence)
    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
% 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.
negotiate(Cell, Value, certain, {assert, From, Value, _Test}) ->
    Cell2 = deny(Cell, From, Value),
    searching(Cell2, Value, certain);

% if our neighbour is certain, and we are conflict, change.
negotiate(Cell, Value, _Confidence, {assert, From, Value, certain}) ->
    Cell2 = yield(Cell, From, Value),
    new_value(Cell2, Value);

% 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.
negotiate(Cell, Value, Confidence, {assert, From, Value, Test})
  when Confidence < Test ->
    Cell2 = yield(Cell, From, Value),
    new_value(Cell2, Value);

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

% if our neighbour claims a different value from our own then we agree
% - this should also increase our confidence slightly.
negotiate(Cell, Value, Confidence, {assert, From, Other, _Test}) ->
    Cell2 = yield(Cell, From, Other),
    searching(Cell2, 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...
negotiate(Cell, Value, _Confidence, {deny, Value}) ->
    new_value(Cell, Value);

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

% if our neighbour acquiesces with our assertion we can increase our
% confidence a little...
negotiate(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.
negotiate(Cell, Value, Confidence, {yield, _Other}) ->
    searching(Cell, Value, Confidence).


% 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, Confidence) ->
    random_nbr(Cell) ! {assert, self(), Value, Confidence},
    searching(Cell#cell{send = Cell#cell.send + 1}, Value, Confidence).

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

new_value(Cell, Old) ->
    case random:uniform(9) of
        Old -> new_value(Cell, Old);
        New ->
            ctrl ! {tick, Cell#cell.locn, Old, New},
            searching(Cell#cell{chng = Cell#cell.chng + 1}, New, 0)
    end.

doubt(Cell, Value, certain) -> searching(Cell, Value, certain);
doubt(Cell, Value, Confidence) ->
    case ?DOUBT of
        panic ->
            case random:uniform() > Cell#cell.dbt of
                true -> searching(Cell, Value, Confidence);
                false -> new_value(Cell, Value)
            end;
        doubt ->
            searching(Cell, Value,
                      lists:max([0, trunc(Confidence * Cell#cell.dbt)]))
    end.

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

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

status(Cell, Value, Confidence) ->
    error_logger:info_msg("~p = ~p (~p) send:~p recv:~p chng:~p",
                          [Cell#cell.locn, Value, Confidence,
                          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, Confidence} ->
            collect_reports([{Cell, Value, Confidence}|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.1, "example-0-1.txt").

% c(sudoku), {R,P} = sudoku:norvig().

Coming Soon - Community Sudoku

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

Date: Fri, 18 May 2007 20:51:18 -0400 (CLT)

I gave up on the pure "1-on-1" negotiation approach.  It's simply too
inefficient - I ran 8450000 exchanges during the day without finding a
solution.

Instead, I've modified the algorithm so that the cells "collaborate" for
the greater good of their "community".  The result just converged in just
148 exchanges:

457 321 865
836 548 497
192 796 213

927 256 163
618 387 452
435 419 789

287 653 873
539 248 215
164 197 694

I'll post more on a new thread once I've cleaned up the code.

Andrew

Comment on this post