C[omp]ute

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)