Permalink
Browse files

Implementation of new algorithm

Ignore-this: 200970c724abc1ab6734c03b43d557a

darcs-hash:20100902142042-b18dd-f37775272bd52d625e376c0fc49ba0a5af6093c5.gz
  • Loading branch information...
1 parent a0b05b4 commit 90d5e64fdab4d4ccdf5b9a638eba301979f08c4b @jamii committed Sep 2, 2010
Showing with 82 additions and 125 deletions.
  1. +19 −21 src/ctmc.erl
  2. +63 −88 src/poppi.erl
  3. +0 −16 src/stats.erl
View
@@ -1,6 +1,6 @@
-module(ctmc).
--export([start/2, interrupt/2, get_state/1, with_state/2, poll_state/3]).
+-export([start/2, call/2]).
-export([behaviour_info/1]).
-behaviour(gen_server).
@@ -10,7 +10,7 @@
-define(SERVER, ?MODULE).
behaviour_info(callbacks) ->
- [{init,1},{events,1},{handle_event,2},{handle_interrupt,2}];
+ [{init,1},{events,1},{handle_event,2},{handle_call,2}];
behaviour_info(_Other) ->
undefined.
@@ -20,17 +20,12 @@ behaviour_info(_Other) ->
start(Module, Args) ->
gen_server:start(?MODULE, [Module, Args], []).
-interrupt(Ctmc, Interrupt) ->
- gen_server:cast(Ctmc, {interrupt, Interrupt}).
-
-get_state(Ctmc) ->
- gen_server:call(Ctmc, get_state).
-
-with_state(Ctmc, F) ->
- F(get_state(Ctmc)).
-
-poll_state(Ctmc, Interval, F) ->
- timer:apply_interval(Interval, ctmc, with_state, [Ctmc, F]).
+call(Ctmc, Call) ->
+ try
+ {ok, gen_server:call(Ctmc, Call, 1000)}
+ catch
+ _:{timeout,_} -> timeout
+ end.
% gen_server callbacks
@@ -40,19 +35,22 @@ init([Module, Args]) ->
{Next_event, Timeout} = next_event(Module, State),
{ok, #ctmc{module=Module, state=State, next_event=Next_event}, Timeout}.
-handle_call(get_state, _From, #ctmc{module=Module, state=State}=Ctmc) ->
- {Next_event, Timeout} = next_event(Module, State),
- {reply, State, Ctmc#ctmc{next_event=Next_event}, Timeout}.
-
-handle_cast({interrupt, Interrupt}, #ctmc{module=Module, state=State}=Ctmc) ->
- State2 = Module:handle_interrupt(State, Interrupt),
+handle_call(Call, _From, #ctmc{module=Module, state=State}=Ctmc) ->
+ {State2, Reply} = Module:handle_call(State, Call),
{Next_event, Timeout} = next_event(Module, State2),
- {noreply, Ctmc#ctmc{state=State2, next_event=Next_event}, Timeout}.
+ {reply, Reply, Ctmc#ctmc{state=State2, next_event=Next_event}, Timeout}.
+
+handle_cast(_Cast, _Ctmc) ->
+ ok.
handle_info(timeout, #ctmc{module=Module, state=State, next_event=Next_event}=Ctmc) ->
State2 = Module:handle_event(State, Next_event),
{Next_event2, Timeout} = next_event(Module, State2),
- {noreply, Ctmc#ctmc{state=State2, next_event=Next_event2}, Timeout}.
+ {noreply, Ctmc#ctmc{state=State2, next_event=Next_event2}, Timeout};
+
+handle_info(_, #ctmc{module=Module, state=State}=Ctmc) ->
+ {Next_event, Timeout} = next_event(Module, State),
+ {noreply, Ctmc#ctmc{next_event=Next_event}, Timeout}.
terminate(_Reason, _State) ->
ok.
View
@@ -1,117 +1,92 @@
-module(poppi).
--export([default/1, start/0, start/1, start_many/2, start_star/1]).
+-export([start/0, start/1, start_experiment/2]).
-behaviour(ctmc).
--export([init/1, events/1, handle_event/2, handle_interrupt/2]).
+-export([init/1, events/1, handle_event/2, handle_call/2]).
--include(poppi).
+-record(poppi, {node,root,known_roots,log}).
% event constants
--define(FORGET, 0.01).
--define(BUMP, 0.01).
--define(PULL, 0.01).
--define(PUSH, 0.01).
--define(CACHE, 0.01).
+-define(LAMBDA, 0.1).
+-define(MU, 0.001).
% api
-default_rates() ->
- #rates{forget=0.01,
- pull=0.01,
- push=0.01,
- cache=0.01}.
-
start() ->
- start(#poppi{peers=[], rates=default_rates()}).
+ start([]).
-start(Poppi) ->
- true = lists:all(fun is_pid/1, Poppi),
- ctmc:start(?MODULE, [Poppi]).
+start(KnownRoots) ->
+ start(KnownRoots, fun (_) -> ok end).
-start_many(N, Poppi) ->
- Nodes = [start(Poppi) || _ <- lists:seq(1,N)],
- {ok, [Node || {ok, Node} <- Nodes]}.
+start(KnownRoots, Log) ->
+ Poppi = #poppi{node=none, root=none, known_roots=KnownRoots, log=Log},
+ ctmc:start(?MODULE, [Poppi]).
-start_star(N, Rates) ->
- {ok, Hub} = start(#poppi{peers=[], rates=Rates}),
- Spoke = #poppi{peers=[Hub], rates=Rates},
- {ok, Spokes} = start_many(N, Spoke),
- {ok, Hub, Spokes}.
+start_experiment(N, K) ->
+ KnownRoots = [Root || {ok, Root} <- [start() || _ <- lists:seq(1,K)]],
+ _Nodes = [Node || {ok, Node} <- [start(KnownRoots) || _ <- lists:seq(1,N-1)]],
+ {ok, _ExperimentNode} = start(KnownRoots, fun log_sample/1).
% ctmc callbacks
-init(#poppi{}=Poppi) ->
- Poppi.
-
-events(#poppi{peers=Peers,
- rates=#rates{forget=Forget,
- pull=Pull,
- push=Push,
- cache=Cache}}) ->
- lists:flatten([
- [{{forget, Peer}, Forget} || Peer <- Peers],
- {cache, Cache},
- [{{bump, Peer}, Bump} || Peer <- Peers],
- [{{pull, Peer}, Pull} || Peer <- Peers],
- [{{push, Peer}, Push} || Peer <- Peers]]).
-
-handle_event(#poppi{peers=Peers}=Poppi, {forget, Peer}) when is_pid(Peer) ->
- log("Forgetting ~w from ~w~n", [Peer, self()]),
- Poppi#poppi{peers=lists:delete(Peer,Peers)};
-
-handle_event(Poppi, cache) ->
- log("Cache not implemented yet~n", []),
- Poppi;
-
-handle_event(Poppi, {bump, Peer}) when is_pid(Peer) ->
- log("Sending bump from ~w to ~w~n", [self(), Peer]),
- ctmc:interrupt(Peer, {bump, self()}),
- Poppi;
-
-handle_event(Poppi, {pull, Peer}) when is_pid(Peer) ->
- log("Sending pull from ~w to ~w~n", [self(), Peer]),
- ctmc:interrupt(Peer, {pull, self()}),
- Poppi;
-
-handle_event(#poppi{peers=Peers}=Poppi, {push, Peer1}) when is_pid(Peer1) ->
- case choice(lists:delete(Peer1,Peers)) of
- none ->
- log("No candidate for push from ~w to ~w~n", [Peer1, self()]);
- {choice, Peer2} ->
- log("Sending push from ~w to ~w with ~w~n", [self(), Peer1, Peer2]),
- ctmc:interrupt(Peer1, {push, Peer2})
- end,
- Poppi.
-
-handle_interrupt(#poppi{peers=Peers}=Poppi, {bump, Peer}) when is_pid(Peer) ->
- log("Receiving bump from ~w to ~w~n", [Peer, self()]),
- Poppi#poppi{peers=[Peer | lists:delete(Peer, Peers)]};
-
-handle_interrupt(#poppi{peers=Peers}=Poppi, {pull, Peer1}) when is_pid(Peer1) ->
- log("Receiving pull from ~w to ~w~n", [Peer1, self()]),
- case choice(Peers) of
- none ->
- log("No candidate for pull from ~w to ~w~n", [Peer1, self()]);
- {choice, Peer2} ->
- log("Sending push from ~w to ~w with ~w~n in response to pull", [self(), Peer1, Peer2]),
- ctmc:interrupt(Peer1, {push, Peer2})
- end,
- Poppi;
-
-handle_interrupt(#poppi{peers=Peers}=Poppi, {push, Peer}) when is_pid(Peer) ->
- log("Receiving push from ~w to ~w~n", [Peer, self()]),
- Poppi#poppi{peers=[Peer | lists:delete(Peer, Peers)]}.
-
+init([#poppi{known_roots=KnownRoots}=Poppi]) ->
+ Node = choose_root(KnownRoots),
+ Root = choose_root(KnownRoots),
+ Poppi#poppi{node=Node, root=Root}.
+
+events(#poppi{}) ->
+ lists:flatten([{msg_root, ?LAMBDA}, {msg_known_root, ?MU}]).
+
+handle_event(#poppi{node=Node}=Poppi, msg_root) ->
+ %log("Messaging root ~w from ~w~n", [Node, self()]),
+ sample(Poppi, Node);
+
+handle_event(#poppi{known_roots=KnownRoots}=Poppi, msg_known_root) ->
+ Root= choose_root(KnownRoots),
+ %log("Messaging known root ~w from ~w~n", [Root, self()]),
+ sample(Poppi, Root).
+
+handle_call(#poppi{root=Root}=Poppi, {sample, Node}) ->
+ %log("Sending sample to ~w from ~w~n", [Node, self()]),
+ {Poppi#poppi{root=Node}, Root}.
+
% internal functions
+sample(#poppi{root=Root, known_roots=KnownRoots, log=Log}=Poppi, Target) ->
+ if
+ Target == self() ->
+ Log(Root),
+ Poppi#poppi{node=Root, root=self()};
+ true ->
+ case ctmc:call(Target, {sample, self()}) of
+ {ok, Node2} ->
+ Log(Node2),
+ Poppi#poppi{node=Node2};
+ timeout ->
+ log("Timeout at ~w~n", [self()]),
+ Node2 = choose_root(KnownRoots),
+ Log(Node2),
+ Poppi#poppi{node=Node2}
+ end
+ end.
+
log(Format, Args) ->
io:format(Format, Args).
+log_sample(Sample) ->
+ log("Sample ~w~n", [Sample]).
+
choice(List) ->
case length(List) of
0 -> none;
N -> {choice, lists:nth(random:uniform(N),List)}
end.
+
+choose_root(Roots) ->
+ case choice(Roots) of
+ none -> self();
+ {choice, Root} -> Root
+ end.
View
@@ -1,16 +0,0 @@
--module(stats).
-
--export([]).
-
-% write results to file
-% separate creation from sampling so can run multiple loggers
-
-view_size(File, N, Rates) ->
- {ok, Hub, Spokes} = poppi:start_star(N, Rates),
- Spoke = lists:nth(random:uniform(N), Spokes),
- Sample = fun (#poppi{peers=Peers}) ->
- io:format(File, "~B~n", [lists:length(Peers)])
- end,
- ctmc:poll_state(Spoke, 1000, Sample).
-
-

0 comments on commit 90d5e64

Please sign in to comment.