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],
broadcast(Cells, start),
ok = wait_to_complete(Cells, Log, now(), 0, 0, 0, 0),
broadcast(Cells, sleep),
Result = result(Cells),
broadcast(Cells, stop),
Result.
broadcast(Cells, Message) ->
io:fwrite("broadcast ~p~n", [Message]),
[address(Cell) ! Message || Cell <- Cells].
address(Locn) ->
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},
register(address(Locn),
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),
receive
start -> direct(fun searching/3, Cell, Value, Weight)
end.
sleeping(Cell, Value, Weight) ->
report_state(Cell, sleeping),
receive
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),
receive
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),
receive
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
% around 1 million exchanges. instead, to avoid deadlock (all
% 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
% cannot return to searching.
sleep ->
direct(fun sleeping/3, Cell, Old, Weight);
Message ->
erlang:error("Unexpected message", [Message])
end.
asserting(Cell, Value, Weight) ->
report_state(Cell, asserting),
receive
% 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) ->
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)).
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,
% broadcast(Cells, status),
{_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) ->
receive
{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]) ->
address(Cell) ! report,
receive
{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)