## Reduced Range Sudoku Solver

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

Date: Sun, 27 May 2007 09:37:38 -0400 (CLT)

As noted in the previous threads -
http://www.acooke.org/cute/CommunityS0.html
http://www.acooke.org/cute/ParallelSu0.html - this still doesn't converge
(in a reasonable amount of time).  However, for those that are interested
the code is now much cleaner and includes "range narrowing" as suggested
by Jonathan Sillito.

-module(light).

-export([start/0, starting/3]).

-define(CELL_TIMEOUT_MIN, 1).
-define(CELL_TIMEOUT_MAX, 10).
-define(DISPLAY_COUNT, 100).
-define(CONTROL_TIMEOUT, 10000).
-define(RANGE, lists:seq(1, 9)).
-define(GREEDINESS, 0.9).
-define(INTEREST, 1).

-record(cell, {locn, comp, cmty, rnge=?RANGE}).

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

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

list_to_atom(lists:flatten(io_lib:format("~p", [Locn]))).

new_cell(Puzzle, Locn, Log) ->
{Value, Weight} = initialise(Puzzle, Locn),
io:fwrite(Log, "~p.~n", [{Locn, Value, Weight}]),
Community = community(Locn),
Cell = #cell{locn = Locn,
comp = competitors(Locn, Community),
cmty = Community},
proc_lib:spawn(light, starting, [Cell, Value, Weight])).

initialise(Puzzle, Locn) ->
case gb_trees:is_defined(Locn, Puzzle) of
true -> {gb_trees:get(Locn, Puzzle), certain};
false -> {unknown(Locn, Puzzle), 0}
end.

unknown(Locn, Puzzle) ->
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).

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

competitors({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).

init_random(Cell) ->
{X, Y} = Cell#cell.locn,
{_, _, T} = now(),
random:seed(X, Y, T).

random_pause() ->
?CELL_TIMEOUT_MIN
+ trunc(random:uniform() * (?CELL_TIMEOUT_MAX - ?CELL_TIMEOUT_MIN)).

% states

starting(Cell, Value, Weight) ->
report_state(Cell, starting),
init_random(Cell),
start -> direct(fun searching/3, Cell, Value, Weight)
end.

sleeping(Cell, Value, Weight) ->
report_state(Cell, sleeping),
stop -> ok;
{swap, _} = Swap ->
reject_swap(fun sleeping/3, Cell, Value, Weight, Swap);
{assert, _} = Assert ->
reject_assert(fun sleeping/3, Cell, Value, Weight, Assert);
report ->
report(fun sleeping/3, Cell, Value, Weight);
status ->
status(fun sleeping/3, Cell, Value, Weight)
end.

searching(Cell, Value, Weight) ->
report_state(Cell, searching),
sleep ->
direct(fun sleeping/3, Cell, Value, Weight);
report ->
report(fun searching/3, Cell, Value, Weight);
status ->
status(fun searching/3, Cell, Value, Weight);

% if we are certain, and our competitor is in conflict, deny them.
{assert, {_From, Value, _Test}} = Assert when Weight == certain ->
deny_assert(fun searching/3, Cell, Value, Weight, Assert);
% if our competitor is certain reduce the available range and change
{assert, {_From, Value, certain}} = Assert ->
accept_assert(reduce_range(Cell, Value), Value, Weight, Assert);
% decide on weights, but add flexibility
{assert, {_From, Value, Test}} = Assert ->
case you_win_anyway(Weight, Test) of
true ->
accept_assert(Cell, Value, Weight, Assert);
false ->
deny_assert(fun searching/3, Cell, Value, Weight, Assert)
end;
% consistent, so increase our weight
{assert, {_From, Other, _Test}} = Assert when Value =/= Other ->
accept_assert(Cell, Value, earn(Weight), Assert);

% refuse to swap if our value is certain
{swap, _} = Swap when Weight == certain ->
reject_swap(fun searching/3, Cell, Value, Weight, Swap);
% otherwise, accept the swap if weights ok, or flexible
{swap, {_From, New, YourWeight, Range}} = Swap ->
case do_swap(Cell, Value, Weight, New, YourWeight, Range) of
true ->
accept_swap(Cell, Value, Swap);
false ->
reject_swap(fun searching/3, Cell, Value, Weight, Swap)
end;

% discard responses to an assert interrupted by swap
reject_assert ->
direct(fun searching/3, Cell, Value, Weight);
{accept_assert, _} ->
direct(fun searching/3, Cell, Value, Weight);
{deny_assert, _} ->
direct(fun searching/3, Cell, Value, Weight);

% fail on other
Message ->
erlang:error("Unexpected message", [Message])
after
random_pause() ->
assert(Cell, Value, Weight)
end.

swapping(Cell, Old, Weight) ->
report_state(Cell, swapping),
report ->
report(fun swapping/3, Cell, Old, Weight);
status ->
status(fun swapping/3, Cell, Old, Weight);
{assert, _} = Assert ->
reject_assert(fun swapping/3, Cell, Old, Weight, Assert);
{accept_swap, New} ->
new_value(Cell, Old, New);
{swap, _} = Swap ->
reject_swap(fun swapping/3, Cell, Old, Weight, Swap);
% this used to restart a new swap, but the system would lock after
% trying to swap, we leave to a later assertion.
reject_swap ->
direct(fun searching/3, Cell, Old, Weight);
% discard responses to an assert interrupted by swap
reject_assert ->
direct(fun swapping/3, Cell, Old, Weight);
{accept_assert, _} ->
direct(fun swapping/3, Cell, Old, Weight);
{deny_assert, _} ->
direct(fun swapping/3, Cell, Old, Weight);
% this would be dangerous if not for the fact that sleep
sleep ->
direct(fun sleeping/3, Cell, Old, Weight);
Message ->
erlang:error("Unexpected message", [Message])
end.

asserting(Cell, Value, Weight) ->
report_state(Cell, asserting),
% refuse to swap if our value is certain
{swap, _} = Swap when Weight == certain ->
reject_swap(fun asserting/3, Cell, Value, Weight, Swap);
% swap takes priority over assertion
{swap, {_From, New, YourWeight, Range}} = Swap ->
case do_swap(Cell, Value, Weight, New, YourWeight, Range) of
true ->
accept_swap(Cell, Value, Swap);
false ->
reject_swap(fun asserting/3, Cell, Value, Weight, Swap)
end;
sleep ->
direct(fun sleeping/3, Cell, Value, Weight);
report ->
report(fun asserting/3, Cell, Value, Weight);
status ->
status(fun asserting/3, Cell, Value, Weight);
reject_assert ->
direct(fun searching/3, Cell, Value, Weight);
% have to change value by swapping with someone else
{deny_assert, Value} ->
swap(Cell, Value, Weight);
% ...but not if they were denying some old value
{deny_assert, Other} when Other =/= Value ->
direct(fun asserting/3, Cell, Value, Weight);
% yield increases weight if it matches our value
{accept_assert, Value}->
direct(fun searching/3, Cell, Value, earn(Weight));
% ..but otherwise discard and keep waiting
{accept_assert, Other} when Other =/= Value->
direct(fun asserting/3, Cell, Value, Weight);
{assert, _} = Assert ->
reject_assert(fun asserting/3, Cell, Value, Weight, Assert);
Message ->
erlang:error("Unexpected message", [Message])
end.

do_swap(Cell, Old, MyWeight, New, YourWeight, Range) ->
contains(Range, Old) and
contains(Cell#cell.rnge, New) and
you_win_anyway(MyWeight, YourWeight).

you_win_anyway(MyWeight, YourWeight) when YourWeight > MyWeight -> true;
you_win_anyway(_MyWeight, _YourWeight) -> random:uniform() > ?GREEDINESS.

% transitions

direct(Next, Cell, Value, Weight) -> Next(Cell, Value, Weight).

report(Next, Cell, Value, Weight) ->
ctrl ! {result, {Value, Weight}},
Next(Cell, Value, Weight).

status(Next, Cell, Value, Weight) ->
error_logger:info_msg("~p = ~p (~p)",
[Cell#cell.locn, Value, Weight]),
Next(Cell, Value, Weight).

% reject is when we're otherwise busy
reject_assert(Next, Cell, Value, Weight, {assert, {From, _Other, _Test}}) ->
From ! reject_assert,
Next(Cell, Value, Weight).

% deny is when it's wrong (distinction important to sender)
deny_assert(Next, Cell, Value, Weight, {assert, {From, Value, _Test}}) ->
From ! {deny_assert, Value},
Next(Cell, Value, Weight).

% second clause when values don't match
accept_assert(Cell, Value, Weight, {assert, {From, Value, _Test}}) ->
From ! {accept_assert, Value},
swap(Cell, Value, Weight);
accept_assert(Cell, Value, Weight, {assert, {From, Other, _Test}}) ->
From ! {accept_assert, Other},
searching(Cell, Value, Weight).

accept_swap(Cell, Old, {swap, {From, New, _Weight, _Range}}) ->
debug("~p accept swap from ~p~n", [Cell#cell.locn, From]),
ctrl ! {new_value, {Cell#cell.locn, Old, New}},
From ! {accept_swap, Old},
new_value(Cell, Old, New).

reject_swap(Next, Cell, Value, Weight,
{swap, {From, _Other, _Weight, _Range}}) ->
debug("~p no swap to ~p~n", [Cell#cell.locn, From]),
ctrl ! {conflict, Cell#cell.locn},
From ! reject_swap,
Next(Cell, Value, Weight).

new_value(Cell, Old, New) ->
debug("~p ~p -> ~p~n", [Cell#cell.locn, Old, New]),
searching(Cell, New, 0).

swap(Cell, Value, Weight) ->
Partner = random_neighbour(Cell),
debug("~p swap ~p with ~p?~n", [Cell#cell.locn, Value, Partner]),
Partner ! {swap, {self(), Value, Weight, Cell#cell.rnge}},
swapping(Cell, Value, Weight).

assert(Cell, Value, Weight) ->
Competitor = random_competitor(Cell),
debug("~p assert ~p to ~p~n", [Cell#cell.locn, Value, Competitor]),
Competitor ! {assert, {self(), Value, Weight}},
asserting(Cell, Value, Weight).

% weight 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(certain) -> certain;
earn(Weight) -> Weight + ?INTEREST.

% sometimes we can exclude a value from those open to us.
reduce_range(Cell, Value) ->
Cell#cell{rnge = [V || V <- Cell#cell.rnge, V =/= Value]}.

random_competitor(Cell) ->
Cell#cell.comp)).

random_neighbour(Cell) ->
Cell#cell.cmty)).

report_state(Cell, State) ->
debug("~p -> ~p~n", [Cell#cell.locn, State]).

debug(_Format, _Values) ->
%    io:fwrite(Format, Values).
ok.

% shutdown and reporting

wait_to_complete(Cells, Log, Start, Swap, Cycles, ?DISPLAY_COUNT,
CycleFail) ->
NewCycles = Cycles + 1,
Attempts = NewCycles * ?DISPLAY_COUNT,
{_Values, Puzzle} = result(Cells),
TotalSuccess = 100 * Swap / Attempts,
CycleSuccess = 100 * (?DISPLAY_COUNT - CycleFail) / ?DISPLAY_COUNT,
Secs = trunc(timer:now_diff(now(), Start) / 1000000),
error_logger:info_msg("~nreport ~p after ~ps "
"(greediness: ~4.2f; interest: ~p)~n"
"total of ~p swaps in ~p attempts~n"
"average swap success rate: ~4.1f%~n"
"success rate in last ~p attempts: ~4.1f%~n"
"~n~s~n(snapshot is not instantaneous)~n~n",
[NewCycles, Secs,
?GREEDINESS, ?INTEREST,
Swap, Attempts,
TotalSuccess,
?DISPLAY_COUNT, CycleSuccess,
ascii(Puzzle)]),
wait_for_tick(Cells, Log, Start, Swap, NewCycles, 0, 0);
wait_to_complete(Cells, Log, Start, Swap, Cycles, CycleTotal, CycleFail) ->
wait_for_tick(Cells, Log, Start, Swap, Cycles, CycleTotal, CycleFail).

wait_for_tick(Cells, Log, Start, Swap, Cycles, CycleTotal, CycleFail) ->
{new_value, {Locn, _Old, New}} ->
io:fwrite(Log, "~p.~n", [{Locn, New}]),
wait_to_complete(Cells, Log, Start, Swap + 1,
Cycles, CycleTotal + 1, CycleFail);
{conflict, _Locn} ->
wait_to_complete(Cells, Log, Start, Swap,
Cycles, CycleTotal + 1, CycleFail + 1)
after
?CONTROL_TIMEOUT ->
file:close(Log),
ok
end.

result(Cells) ->
io:fwrite("collecting result~n"),
Values = [],
Puzzle = gb_trees:empty(),
collect_reports(Values, Puzzle, Cells).

collect_reports(Values, Puzzle, []) -> {Values, Puzzle};
collect_reports(Values, Puzzle, [Cell|Cells]) ->
{result, {Value, Weight}} ->
collect_reports([{Cell, Value, Weight}|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"). % format used at http://norvig.com/sudoku.html norvig(List, 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, 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).

start() ->
{_R, P} = norvig("4.. ... 8.5"
".3. ... ..."
"... 7.. ..."
".2. ... .6."
"... .8. 4.."
"... .1. ..."
"... 6.3 .7."
"5.. 2.. ..."
"1.4 ... ...", "light.txt"),
io:fwrite("~s", [ascii(P)]).

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

% lessons learned
% - tag messages
% - use {tag, payload} to allow easy matching
% - keep clear priority in protocol
% - match failures
% - avoid insisting on a response (tight loops)

### Typical Report

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

Date: Sun, 27 May 2007 09:41:07 -0400 (CLT)

=INFO REPORT==== 27-May-2007::09:40:52 ===

report 1283 after 888s (greediness: 0.90; interest: 1)
total of 12246 swaps in 128300 attempts
average swap success rate:  9.5%
success rate in last 100 attempts: 10.0%

497 126 835
631 895 742
258 734 916

829 457 163
316 982 457
745 316 298

982 643 571
573 291 684
164 578 329

(snapshot is not instantaneous)

### Hot Damn Fuck Me Backwards Woot!

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

Date: Sun, 27 May 2007 12:34:47 -0400 (CLT)

It just converged!

=INFO REPORT==== 27-May-2007::11:37:25 ===

report 9327 after 7880s (greediness: 0.90; interest: 1)
total of 86858 swaps in 932700 attempts
average swap success rate:  9.3%
success rate in last 100 attempts:  2.0%

417 369 825
632 158 947
958 724 316

825 437 168
791 586 432
346 912 759

289 643 571
573 291 684
164 875 293

(snapshot is not instantaneous)

collecting result
417 369 825
632 158 947
958 724 316

825 437 169
791 586 432
346 912 758

289 643 571
573 291 684
164 875 293

Ahem.  Excuse the language.

Andrew

### Aborted Output with Greediness=0.5

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

Date: Sun, 27 May 2007 18:07:16 -0400 (CLT)

Going to try 0.99 instead.  Already longer in time and may more swaps than
0.9.

report 59282 after 16456s (greediness: 0.50; interest: 1)
total of 1209866 swaps in 5928200 attempts
average swap success rate: 20.4%
success rate in last 100 attempts: 29.0%

472 169 835
831 825 796
956 734 124

825 497 563
691 382 412
743 516 789

289 643 571
573 291 648
164 875 392

(snapshot is not instantaneous)

Andrew

### Greediness 0.75

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

Date: Sun, 27 May 2007 22:04:10 -0400 (CLT)

Killed at:

report 35899 after 13594s (greediness: 0.75; interest: 1)
total of 522184 swaps in 3589900 attempts
average swap success rate: 14.5%
success rate in last 100 attempts: 15.0%

467 921 835
239 468 217
815 735 946

928 974 163
371 386 452
645 512 798

982 643 971
573 291 684
164 857 523

(snapshot is not instantaneous)

Andrew

### Convergence with Greediness 0.95

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

Date: Mon, 28 May 2007 06:22:10 -0400 (CLT)

This was running longer than the 0.5 and 0.75 cases, so doesn't say much
(and that's ignoring the small number stats...).  Still, it's nice to have
another convergence.

report 14263 after 22069s (greediness: 0.95; interest: 1)
total of 83859 swaps in 1426300 attempts
average swap success rate:  5.9%
success rate in last 100 attempts:  2.0%

417 369 825
238 158 947
956 724 316

825 437 169
791 586 432
346 912 758

289 643 571
573 291 684
164 875 293

(snapshot is not instantaneous)

collecting result
417 369 825
632 158 947
958 724 316

825 437 169
791 586 432
346 912 758

289 643 571
573 291 684
164 875 293

### Timing Data

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

Date: Mon, 4 Jun 2007 06:32:18 -0400 (CLT)

Here are some results for different values of the Greediness.  I've seen
convergence from 0.81 to 0.95.  There's a lot of scatter but the minimum
time seems to be around 0.87.  Note that some "no convergence" are for
very short times and there's very little testing of small (less than 0.8)
values.

[not converged]
report 32827 after 73477s (greediness: 0.99; interest: 1)
total of 98289 swaps in 3282700 attempts
average swap success rate:  3.0%
success rate in last 100 attempts:  9.0%

[not converged]
report 38185 after 71706s (greediness: 0.97; interest: 1)
total of 172440 swaps in 3818500 attempts
average swap success rate:  4.5%
success rate in last 100 attempts:  7.0%

[converged]
report 14263 after 22069s (greediness: 0.95; interest: 1)
total of 83859 swaps in 1426300 attempts
average swap success rate:  5.9%
success rate in last 100 attempts:  2.0%

[converged]
report 77110 after 90562s (greediness: 0.93; interest: 1)
total of 591911 swaps in 7711000 attempts
average swap success rate:  7.7%
success rate in last 100 attempts: 15.0%

[converged]
report 47199 after 49666s (greediness: 0.91; interest: 1)
total of 380760 swaps in 4719900 attempts
average swap success rate:  8.1%
success rate in last 100 attempts: 10.0%

[converged]
report 9327 after 7880s (greediness: 0.90; interest: 1)
total of 86858 swaps in 932700 attempts
average swap success rate:  9.3%
success rate in last 100 attempts:  2.0%

[converged]
report 32218 after 25576s (greediness: 0.89; interest: 1)
total of 307132 swaps in 3221800 attempts
average swap success rate:  9.5%
success rate in last 100 attempts:  9.0%

[converged]
report 24497 after 16786s (greediness: 0.87; interest: 1)
total of 256732 swaps in 2449700 attempts
average swap success rate: 10.5%
success rate in last 100 attempts: 12.0%

[not converged]
report 56168 after 32334s (greediness: 0.85; interest: 1)
total of 640289 swaps in 5616800 attempts
average swap success rate: 11.4%
success rate in last 100 attempts:  6.0%

[converged]
report 37874 after 19319s (greediness: 0.83; interest: 1)
total of 451522 swaps in 3787400 attempts
average swap success rate: 11.9%
success rate in last 100 attempts: 13.0%

[converged]
report 124689 after 58531s (greediness: 0.81; interest: 1)
total of 1587776 swaps in 12468900 attempts
average swap success rate: 12.7%
success rate in last 100 attempts: 15.0%

[not converged]
report 226865 after 100423s (greediness: 0.80; interest: 1)
total of 2952758 swaps in 22686500 attempts
average swap success rate: 13.0%
success rate in last 100 attempts:  9.0%

[not converged]
report 35899 after 13594s (greediness: 0.75; interest: 1)
total of 522184 swaps in 3589900 attempts
average swap success rate: 14.5%
success rate in last 100 attempts: 15.0%

[not converged]
report 59282 after 16456s (greediness: 0.50; interest: 1)
total of 1209866 swaps in 5928200 attempts
average swap success rate: 20.4%
success rate in last 100 attempts: 29.0%

Andrew