summaryrefslogtreecommitdiffstats
path: root/sources
diff options
context:
space:
mode:
authorthibauth <thibauth@30fcff6e-8de6-41c7-acce-77ff6d1dd07b>2011-06-27 16:14:43 +0000
committerthibauth <thibauth@30fcff6e-8de6-41c7-acce-77ff6d1dd07b>2011-06-27 16:14:43 +0000
commit1faa64d34bd8357515c72eefd52dafe22cbcf69e (patch)
treedeb6687c458e447581e289e68ec665a6ca11dfe1 /sources
parent53d01038a4f7a22e442c254f60088f647a1d5a92 (diff)
downloadpacemaker-1faa64d34bd8357515c72eefd52dafe22cbcf69e.tar.gz
Some code cleaning. More plots.
git-svn-id: https://scm.gforge.inria.fr/svn/pacemaker@34 30fcff6e-8de6-41c7-acce-77ff6d1dd07b
Diffstat (limited to 'sources')
-rw-r--r--sources/thibaut/Makefile6
-rw-r--r--sources/thibaut/compattrace.ml126
-rw-r--r--sources/thibaut/gentrace.ml99
-rw-r--r--sources/thibaut/globals.ml445
-rw-r--r--sources/thibaut/graph.ml54
-rw-r--r--sources/thibaut/mesh.ml90
-rw-r--r--sources/thibaut/plot.py23
-rw-r--r--sources/thibaut/simulator.ml210
-rw-r--r--sources/thibaut/trace.ml121
-rw-r--r--sources/thibaut/tracestats.ml112
10 files changed, 676 insertions, 610 deletions
diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 6509a09..71c9568 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -2,7 +2,7 @@ OCAMLC=ocamlc
OCAMLOPT=ocamlopt
OCAMLDEP=ocamldep
INCLUDES=
-OCAMLFLAGS=$(INCLUDES)
+OCAMLFLAGS=$(INCLUDES) -annot
SRCS=map2.ml simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattrace.ml tracestats.ml mesh.ml graph.ml
BUILDDIR=build
DEPEND=.depend
@@ -11,10 +11,10 @@ all: gentrace.opt simulator.opt tracestats.opt
$(BUILDDIR):
mkdir -p $(BUILDDIR)
-
+
tracestats.opt: $(BUILDDIR) tracestats.cmx
$(OCAMLOPT) -o $(BUILDDIR)/tracestats $(OCAMLFLAGS) unix.cmxa str.cmxa compattrace.cmx tracestats.cmx
-
+
gentrace.opt: $(BUILDDIR) gentrace.cmx
$(OCAMLOPT) -o $(BUILDDIR)/gentrace $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
diff --git a/sources/thibaut/compattrace.ml b/sources/thibaut/compattrace.ml
index 5617282..d370b33 100644
--- a/sources/thibaut/compattrace.ml
+++ b/sources/thibaut/compattrace.ml
@@ -1,103 +1,98 @@
type trace_event =
- Peers of int
-| Days of int * int
-| Peer of int * float * string
-| Round of int
-| On of int
-| Off of int
-| Dead of int
-| End
-| Exponential
-
+ | Peers of int
+ | Days of int * int
+ | Peer of int * float * string
+ | Round of int
+ | On of int
+ | Off of int
+ | Dead of int
+ | End
+ | Exponential
+
type state = ON | OFF | DEAD
-
+
type peer = {
- i : int;
- descr : string;
- avail : float;
- mutable state : state;
- mutable real_avail : int;
- mutable session : int;
- }
+ i : int;
+ descr : string;
+ avail : float;
+ mutable state : state;
+ mutable real_avail : int;
+ mutable session : int;
+}
let trace_input ic =
let line = input_line ic in
- let space = Str.regexp " " in
+ let space = Str.regexp " " in
match Str.split space line with
- ["Peers"; npeers] -> Peers (int_of_string npeers)
- | ["Days"; ndays] -> Days (int_of_string ndays, 24 * 60)
- | ["Days"; ndays; day] -> Days (int_of_string ndays, int_of_string day)
- | "Peer" :: i :: avail :: tail ->
- Peer (int_of_string i, float_of_string avail, String.concat " " tail)
- | ["End"] -> End
- | ["Exponential"] -> Exponential
- | ["Round"; round] -> Round (int_of_string round)
- | ["On"; i] -> On (int_of_string i)
- | ["Dead"; i] -> Dead (int_of_string i)
- | ["Off"; i] -> Off (int_of_string i)
- | _ -> failwith (Printf.sprintf "Bad line [%s]" (String.escaped line))
-
+ | ["Peers"; npeers] -> Peers (int_of_string npeers)
+ | ["Days"; ndays] -> Days (int_of_string ndays, 24 * 60)
+ | ["Days"; ndays; day] -> Days (int_of_string ndays, int_of_string day)
+ | "Peer" :: i :: avail :: tail ->
+ Peer (int_of_string i, float_of_string avail, String.concat " " tail)
+ | ["End"] -> End
+ | ["Exponential"] -> Exponential
+ | ["Round"; round] -> Round (int_of_string round)
+ | ["On"; i] -> On (int_of_string i)
+ | ["Dead"; i] -> Dead (int_of_string i)
+ | ["Off"; i] -> Off (int_of_string i)
+ | _ -> failwith (Printf.sprintf "Bad line [%s]" (String.escaped line))
+
let trace_read filename =
let exponential = ref false in
let ic = open_in filename in
let npeers = match trace_input ic with
- Peers npeers -> npeers
+ | Peers npeers -> npeers
| _ -> assert false
in
let (ndays, day) = match trace_input ic with
- Days (ndays, day) -> ndays, day
+ | Days (ndays, day) -> ndays, day
| _ -> assert false
in
- let rec read_peer ii =
- match trace_input ic with
- Exponential -> exponential := true;
+ let rec read_peer ii = match trace_input ic with
+ | Exponential ->
+ exponential := true;
read_peer ii
| Peer (i, avail, s) ->
let p = {
- i = i;
- avail = avail;
- descr = s;
- state = OFF;
- real_avail = 0;
- session = 0
- } in
- p
+ i = i;
+ avail = avail;
+ descr = s;
+ state = OFF;
+ real_avail = 0;
+ session = 0
+ } in
+ p
| _ -> assert false
in
let peers = Array.init npeers read_peer in
let event = ref None in
let get_event () =
let ev = trace_input ic in
- event := Some ev
+ event := Some ev
in
-
- let rec iter_round round =
- match !event with
- None ->
- next_event round
- | Some ev ->
- match ev with
- Round rr ->
- if rr = round then next_event round
+
+ let rec iter_round round = match !event with
+ | None -> next_event round
+ | Some ev -> match ev with
+ | Round rr ->
+ if rr = round then next_event round
| On i ->
event := None;
let p = peers.(i) in
- p.state <- ON;
- next_event round
+ p.state <- ON;
+ next_event round
| Off i ->
event := None;
let p = peers.(i) in
- p.state <- OFF;
- next_event round
+ p.state <- OFF;
+ next_event round
| Dead i ->
event := None;
let p = peers.(i) in
- p.state <- DEAD;
- peers.(i) <- {
- p with state = OFF;
- };
- next_event round
+ p.state <- DEAD;
+ peers.(i) <- { p with state = OFF};
+ next_event round
| End -> ()
| _ -> assert false
@@ -105,4 +100,5 @@ let trace_read filename =
get_event ();
iter_round round
in
- peers, ndays * day, iter_round
+ peers, ndays * day, iter_round
+
diff --git a/sources/thibaut/gentrace.ml b/sources/thibaut/gentrace.ml
index 4d45d3f..b956bce 100644
--- a/sources/thibaut/gentrace.ml
+++ b/sources/thibaut/gentrace.ml
@@ -7,68 +7,69 @@ let filename = ref ""
let seed = ref 0
let anon =
- let args = ref 0 in
+ let args = ref 0 in
fun s ->
- incr args;
- if !Arg.current = Array.length Sys.argv -1 && !args < 3 then
- raise (Arg.Bad "Too few arguments");
- match !args with
- | 1 -> ndays := int_of_string s
- | 2 -> npeers := int_of_string s
- | 3 -> filename := s
- | _ -> raise (Arg.Bad "Too many arguments")
+ incr args;
+ if !Arg.current = Array.length Sys.argv -1 && !args < 3 then
+ raise (Arg.Bad "Too few arguments");
+ match !args with
+ | 1 -> ndays := int_of_string s
+ | 2 -> npeers := int_of_string s
+ | 3 -> filename := s
+ | _ -> raise (Arg.Bad "Too many arguments")
let usage = "usage: gentrace [OPTIONS] <days> <peers> <filename>"
let arg_list = [
- "--seed", Arg.Set_int seed, " <n> random seed"
+ "--seed", Arg.Set_int seed, " <n> random seed"
]
let _ =
- if (Array.length Sys.argv) < 4 then begin
- Arg.usage (Arg.align arg_list) usage;
- exit 1
- end
- else
- Arg.parse (Arg.align arg_list) anon usage;
- Random.init !seed
+ if (Array.length Sys.argv) < 4 then begin
+ Arg.usage (Arg.align arg_list) usage;
+ exit 1
+ end
+ else
+ Arg.parse (Arg.align arg_list) anon usage;
+ Random.init !seed
let oc = open_out !filename
let _ =
- output oc (Peers !npeers);
- output oc (Days !ndays)
+ output oc (Peers !npeers);
+ output oc (Days !ndays)
-let peers = Array.init !npeers (fun i ->
- let avail = if i = 0 then 1. else Random.float 1. in
- let init = Random.float 1. in
- let state = if init < avail then ON else OFF in
- let session_length = 10 + Random.int 90 in
- let mu = if i = 0 then 0. else 1./. (float_of_int session_length) in
- let lambda = mu*.(1.-.avail)/.avail in
- output oc (Trace.Peer (i, avail, state));
- {
- id = i;
- Trace.state = state;
- avail = avail;
- lambda = lambda;
- mu = mu
- }
-)
+let peers = Array.init !npeers
+ (fun i ->
+ let avail = if i = 0 then 1. else Random.float 1. in
+ let init = Random.float 1. in
+ let state = if init < avail then ON else OFF in
+ let session_length = 10 + Random.int 90 in
+ let mu = if i = 0 then 0. else 1./. (float_of_int session_length) in
+ let lambda = mu*.(1.-.avail)/.avail in
+ output oc (Trace.Peer (i, avail, state));
+ {
+ id = i;
+ Trace.state = state;
+ avail = avail;
+ lambda = lambda;
+ mu = mu
+ }
+ )
let nrounds = !ndays*24*60
let _ =
- for i = 0 to (nrounds-1) do
- output oc (Round i);
- let aux p =
- let r = Random.float 1. in
- if p.Trace.state = OFF && r < p.lambda then begin
- p.Trace.state <- ON;
- output oc (On p.Trace.id)
- end else if p.state = ON && r < p.mu then begin
- p.Trace.state <- OFF;
+ for i = 0 to (nrounds-1) do
+ output oc (Round i);
+ let aux p =
+ let r = Random.float 1. in
+ if p.Trace.state = OFF && r < p.lambda then begin
+ p.Trace.state <- ON;
+ output oc (On p.Trace.id)
+ end else if p.state = ON && r < p.mu then begin
+ p.Trace.state <- OFF;
output oc (Off p.Trace.id)
- end
- in
- Array.iter aux peers
- done;
- output oc End
+ end
+ in
+ Array.iter aux peers
+ done;
+ output oc End
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index 19a8844..aa54778 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -1,281 +1,276 @@
type state = ON | OFF
let string_of_state state = match state with
- | ON -> "On"
- | OFF -> "Off"
-
+ | ON -> "On"
+ | OFF -> "Off"
+
let state_of_string s = match s with
- | "On" -> ON
- | "Off" -> OFF
- | _ -> failwith (Printf.sprintf "Wrong state:%s" s)
-
+ | "On" -> ON
+ | "Off" -> OFF
+ | _ -> failwith (Printf.sprintf "Wrong state:%s" s)
+
type phase = SEEDING | IDLE | PULSE
type peer_id = int
module PeerId = struct
- type t = peer_id
- let compare = Pervasives.compare
+ type t = peer_id
+ let compare = Pervasives.compare
end
module HashMap = Map2.Make(PeerId)
module RoundMap : sig
- type 'a t
-
- val empty : 'a t
- val add : int -> 'a -> 'a t -> 'a t
- val mem : int -> 'a t -> bool
- val find : int -> 'a t -> 'a
- val iter : (int -> 'a -> unit) -> 'a t -> unit
- val iter_limit : (int -> 'a -> unit) -> int -> 'a t -> unit
- val last_round : 'a t -> int
- val truncate : int -> 'a t -> 'a t
-
+ type 'a t
+
+ val empty : 'a t
+ val add : int -> 'a -> 'a t -> 'a t
+ val mem : int -> 'a t -> bool
+ val find : int -> 'a t -> 'a
+ val iter : (int -> 'a -> unit) -> 'a t -> unit
+ val iter_limit : (int -> 'a -> unit) -> int -> 'a t -> unit
+ val last_round : 'a t -> int
+ val truncate : int -> 'a t -> 'a t
+
end = struct
- type 'a t = (int* 'a) list
-
- let add round data map = (round,data)::map
-
- let last_round map = match map with
- | [] -> 0
- | (a,b)::c -> a
+ type 'a t = (int* 'a) list
+
+ let add round data map = (round,data)::map
+
+ let last_round map = match map with
+ | [] -> 0
+ | (a,b)::c -> a
- let empty = []
+ let empty = []
+
+ let rec mem round map = match map with
+ | [] -> false
+ | (a,b)::c ->
+ if a = round then true
+ else if a < round then false
+ else mem round c
+
+ let rec find round map = match map with
+ | [] -> raise Not_found
+ | (a,b)::c ->
+ if a = round then b
+ else if a < round then raise Not_found
+ else find round c
+
+ let rec iter f map = match map with
+ | [] -> ()
+ | (a,b)::c -> f a b; iter f c
- let rec mem round map = match map with
- | [] -> false
- | (a,b)::c ->
- if a = round then true
- else if a < round then false
- else mem round c
-
- let rec find round map = match map with
- | [] -> raise Not_found
- | (a,b)::c ->
- if a = round then b
- else if a < round then raise Not_found
- else find round c
-
- let rec iter f map = match map with
- | [] -> ()
- | (a,b)::c -> f a b; iter f c
-
- let rec iter_limit f limit map = match map with
- | [] -> ()
- | (a,b)::c ->
- if a >= limit then begin
- f a b;
- iter_limit f limit c
- end
-
- let rec truncate limit map = match map with
- | [] -> []
- | (a,b)::c -> if a < limit then [] else (a,b)::(truncate limit c)
-
-
+ let rec iter_limit f limit map = match map with
+ | [] -> ()
+ | (a,b)::c ->
+ if a >= limit then begin
+ f a b;
+ iter_limit f limit c
+ end
+
+ let rec truncate limit map = match map with
+ | [] -> []
+ | (a,b)::c ->
+ if a < limit then
+ []
+ else
+ (a,b)::(truncate limit c)
end
type message_content =
- | Seed of int * int (* seed, duration *)
- | SeedReply of int (* hash *)
- | Pulse of int * int HashMap.t list (* seed, branch *)
+ | Seed of int * int (* seed, duration *)
+ | SeedReply of int (* hash *)
+ | Pulse of int * int HashMap.t list (* seed, branch *)
type message = {
- sender : peer_id;
- round : int;
- content : message_content
+ sender : peer_id;
+ round : int;
+ content : message_content
}
type round_data = {
- mutable phase : phase;
- duration : int;
- seed : int;
- mutable hmap : int HashMap.t;
- mutable included : int;
- mutable replies : (int * int HashMap.t) list
+ mutable phase : phase;
+ duration : int;
+ seed : int;
+ mutable hmap : int HashMap.t;
+ mutable included : int;
+ mutable replies : (int * int HashMap.t) list
}
module SlotArray : sig
- exception SlotArray of string
- type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
- type 'a t
- val make : int -> 'a t
- val full : 'a t -> bool
- val accept : 'a slot -> 'a t -> unit
- val clear : 'a t -> unit
- val iter : ('a slot -> unit) -> 'a t -> unit
- val ask_list : 'a t -> ('a slot) array
- val test : ('a slot -> bool) -> 'a t -> bool
- val random_peer_avoid : ('a slot -> bool) -> 'a t -> 'a slot
- val random_peer : 'a t -> 'a slot
- val filter_peers : ('a slot -> bool) -> 'a t -> unit
- val iter_asks : ('a slot -> 'a slot) -> 'a t -> unit
- val capacity : 'a t -> int
- val length : 'a t -> int
- val asks : 'a t -> int
- val append_asks : ('a slot array) -> 'a t -> unit
+ exception SlotArray of string
+ type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
+ type 'a t
+ val make : int -> 'a t
+ val full : 'a t -> bool
+ val accept : 'a slot -> 'a t -> unit
+ val clear : 'a t -> unit
+ val iter : ('a slot -> unit) -> 'a t -> unit
+ val ask_list : 'a t -> ('a slot) array
+ val test : ('a slot -> bool) -> 'a t -> bool
+ val random_peer_avoid : ('a slot -> bool) -> 'a t -> 'a slot
+ val random_peer : 'a t -> 'a slot
+ val filter_peers : ('a slot -> bool) -> 'a t -> unit
+ val iter_asks : ('a slot -> 'a slot) -> 'a t -> unit
+ val capacity : 'a t -> int
+ val length : 'a t -> int
+ val asks : 'a t -> int
+ val append_asks : ('a slot array) -> 'a t -> unit
end = struct
- exception SlotArray of string
- type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
+ exception SlotArray of string
+ type 'a slot = Peer of 'a | Ask of 'a | AskRoot | Empty
+
+ type 'a t = {
+ mutable npeers : int;
+ mutable nasks : int;
+ peers: ('a slot) array;
+ capacity: int;
+ asks: ('a slot) array
+ }
+
+ let full sa = ( sa.npeers = sa.capacity )
+
+ let add_peer elem sa =
+ let length = sa.npeers in
+ sa.peers.(length) <- elem;
+ sa.npeers <- (length + 1)
- type 'a t = {
- mutable npeers : int;
- mutable nasks : int;
- peers: ('a slot) array;
- capacity: int;
- asks: ('a slot) array
- }
+ let remove_peer pos sa =
+ let length = sa.npeers -1 in
+ sa.peers.(pos) <- sa.peers.(length);
+ sa.peers.(length) <- Empty;
+ sa.npeers <- length
- let full sa = ( sa.npeers = sa.capacity )
+ let add_ask elem sa =
+ let length = sa.nasks in
+ sa.asks.(length) <- elem;
+ sa.nasks <- (length + 1)
- let add_peer elem sa =
- let length = sa.npeers in
- sa.peers.(length) <- elem;
- sa.npeers <- (length + 1)
+ let remove_ask pos sa =
+ let length = sa.nasks -1 in
+ sa.asks.(pos) <- sa.asks.(length);
+ sa.asks.(length) <- Empty;
+ sa.nasks <- length
- let remove_peer pos sa =
- let length = sa.npeers -1 in
- sa.peers.(pos) <- sa.peers.(length);
- sa.peers.(length) <- Empty;
- sa.npeers <- length
-
- let add_ask elem sa =
- let length = sa.nasks in
- sa.asks.(length) <- elem;
- sa.nasks <- (length + 1)
-
- let remove_ask pos sa =
- let length = sa.nasks -1 in
- sa.asks.(pos) <- sa.asks.(length);
- sa.asks.(length) <- Empty;
- sa.nasks <- length
-
- let iter_asks f sa =
- let rec aux n =
- if n = sa.nasks then ()
- else
- if full sa then ()
- else begin match f sa.asks.(n) with
- | Ask _ as e -> sa.asks.(n) <- e; aux (n+1)
- | AskRoot -> remove_ask n sa; aux n
- | Peer _ as e -> add_peer e sa; remove_ask n sa; aux n
- | _ -> raise (SlotArray "iter_asks")
- end
- in
- aux 0
-
- let filter_peers pred sa =
- let rec aux n =
- if n = sa.npeers then
- ()
- else
- if not (pred sa.peers.(n)) then begin
- remove_peer n sa;
- aux n
- end
- else
- aux (n+1)
- in
- aux 0
-
- let clear sa =
- for i = 0 to sa.npeers - 1 do
- sa.peers.(i) <- Empty
- done;
- sa.npeers <- 0
-
- let make capacity = {
- peers = Array.make capacity Empty;
- asks = Array.make capacity Empty;
- nasks = 0;
- npeers = 0;
- capacity = capacity
- }
-
- let length sa = sa.npeers
- let asks sa = sa.nasks
- let capacity sa = sa.capacity
+ let iter_asks f sa =
+ let rec aux n =
+ if n < sa.nasks && not (full sa) then
+ match f sa.asks.(n) with
+ | Ask _ as e -> sa.asks.(n) <- e; aux (n+1)
+ | AskRoot -> remove_ask n sa; aux n
+ | Peer _ as e -> add_peer e sa; remove_ask n sa; aux n
+ | _ -> raise (SlotArray "iter_asks")
+ in
+ aux 0
- let test pred sa =
- let rec aux n =
- if n = sa.npeers then false
- else (pred sa.peers.(n))||(aux (n+1))
- in
- aux 0
-
- let accept p sa = add_peer p sa
-
- let iter f sa =
- for i = 0 to sa.npeers -1 do
- f sa.peers.(i)
- done
-
- let random_peer sa =
- let n = Random.int sa.npeers in
- sa.peers.(n)
-
- let random_peer_avoid pred sa =
- if sa.npeers <= 1 then AskRoot
- else let n = Random.int sa.npeers in
- if pred sa.peers.(n) then
- if n = sa.npeers - 1 then sa.peers.(n-1)
- else sa.peers.(n+1)
+ let filter_peers pred sa =
+ let rec aux n =
+ if n < sa.npeers then
+ if not (pred sa.peers.(n)) then begin
+ remove_peer n sa;
+ aux n
+ end
else
- sa.peers.(n)
+ aux (n+1)
+ in
+ aux 0
- let ask_list sa =
- sa.peers
+ let clear sa =
+ for i = 0 to sa.npeers - 1 do
+ sa.peers.(i) <- Empty
+ done;
+ sa.npeers <- 0
+
+ let make capacity = {
+ peers = Array.make capacity Empty;
+ asks = Array.make capacity Empty;
+ nasks = 0;
+ npeers = 0;
+ capacity = capacity
+ }
+
+ let length sa = sa.npeers
+ let asks sa = sa.nasks
+ let capacity sa = sa.capacity
+
+ let test pred sa =
+ let rec aux n =
+ if n = sa.npeers then false
+ else (pred sa.peers.(n))||(aux (n+1))
+ in
+ aux 0
+
+ let accept p sa = add_peer p sa
+
+ let iter f sa =
+ for i = 0 to sa.npeers -1 do
+ f sa.peers.(i)
+ done
+
+ let random_peer sa =
+ let n = Random.int sa.npeers in
+ sa.peers.(n)
- let append_asks list sa =
- let rec aux n =
- if sa.nasks = sa.capacity then
- ()
- else
- match list.(n) with
- | Peer p -> add_ask (Ask p) sa; aux (n+1)
- | Empty -> ()
- | _ -> raise (SlotArray "trying to append non peer")
- in
- aux 0
+ let random_peer_avoid pred sa =
+ if sa.npeers <= 1 then AskRoot
+ else let n = Random.int sa.npeers in
+ if pred sa.peers.(n) then
+ if n = sa.npeers - 1 then sa.peers.(n-1)
+ else sa.peers.(n+1)
+ else
+ sa.peers.(n)
+
+ let ask_list sa =
+ sa.peers
+
+ let append_asks list sa =
+ let rec aux n =
+ if sa.nasks < sa.capacity then
+ match list.(n) with
+ | Peer p -> add_ask (Ask p) sa; aux (n+1)
+ | Empty -> ()
+ | _ -> raise (SlotArray "trying to append non peer")
+ in
+ aux 0
end
type peer = {
- id : peer_id;
- mutable con_state : state;
- slots : peer SlotArray.t;
- mutable rounds_data : round_data RoundMap.t;
- messages : message Queue.t;
- mutable history : (int * (int HashMap.t list)) RoundMap.t; (* seed, branch *)
- mutable distance : int;
- mutable connection_time : int
+ id : peer_id;
+ mutable con_state : state;
+ slots : peer SlotArray.t;
+ mutable rounds_data : round_data RoundMap.t;
+ messages : message Queue.t;
+ mutable history : (int * (int HashMap.t list)) RoundMap.t; (* seed, branch *)
+ mutable distance : int;
+ mutable connection_time : int
}
and slot = peer SlotArray.slot
let disconnect peer =
- SlotArray.clear peer.slots;
- peer.con_state <- OFF;
- peer.distance <- -1
+ SlotArray.clear peer.slots;
+ peer.con_state <- OFF;
+ peer.distance <- -1
let swap a pos1 pos2 =
- let temp = a.(pos1) in
+ let temp = a.(pos1) in
a.(pos1) <- a.(pos2);
a.(pos2) <- temp
let swap_track tracking_array real_array pos1 pos2 =
- let id1 = real_array.(pos1).id in
- let id2 = real_array.(pos2).id in
+ let id1 = real_array.(pos1).id in
+ let id2 = real_array.(pos2).id in
swap tracking_array id1 id2;
swap real_array pos1 pos2
let random_iter f a tracking =
- let rec aux n = match n with
- | 1 -> ()
- | n -> let pos = 1+ Random.int (n-1) in
- swap_track tracking a pos (n-1);
- f a.(n-1);
- aux (n-1)
- in
- aux (Array.length a)
+ let rec aux n = match n with
+ | 1 -> ()
+ | n -> let pos = 1+ Random.int (n-1) in
+ swap_track tracking a pos (n-1);
+ f a.(n-1);
+ aux (n-1)
+ in
+ aux (Array.length a)
diff --git a/sources/thibaut/graph.ml b/sources/thibaut/graph.ml
index 5fba67a..0c31532 100644
--- a/sources/thibaut/graph.ml
+++ b/sources/thibaut/graph.ml
@@ -3,48 +3,50 @@ open Globals
exception Found of peer
let find_peer id peers =
- let n = Array.length peers in
+ let n = Array.length peers in
try
- for i = 0 to n-1 do
- if peers.(i).id = id then
- raise (Found peers.(i))
- done;
- raise Not_found
+ for i = 0 to n-1 do
+ if peers.(i).id = id then
+ raise (Found peers.(i))
+ done;
+ raise Not_found
with
Found p -> p
(* compute distances from root *)
let update_distances peers tracking_array =
- let n = Array.length peers in
- let visited = Array.make n false in
- let queue = Queue.create() in
+ let n = Array.length peers in
+ let visited = Array.make n false in
+ let queue = Queue.create() in
visited.(0) <- true;
peers.(0).distance <- 0;
Queue.push 0 queue;
while not (Queue.is_empty queue) do
- let id = Queue.pop queue in
- let peer = peers.(tracking_array.(id)) in
- let aux pe = match pe with
- | SlotArray.Peer p ->
- if not visited.(p.id) then begin
- visited.(p.id) <- true;
- p.distance <- peer.distance + 1;
- Queue.push p.id queue
- end
- | _ -> raise (SlotArray.SlotArray "non peer in slots")
- in
+ let id = Queue.pop queue in
+ let peer = peers.(tracking_array.(id)) in
+ let aux pe = match pe with
+ | SlotArray.Peer p ->
+ if not visited.(p.id) then begin
+ visited.(p.id) <- true;
+ p.distance <- peer.distance + 1;
+ Queue.push p.id queue
+ end
+ | _ -> raise (SlotArray.SlotArray "non peer in slots")
+ in
SlotArray.iter aux peer.slots
done
let repart round peers =
- let n = Array.length peers in
- let result = Array.make 20 0 in
- let old = ref 0 in
+ let n = Array.length peers in
+ let result = Array.make 20 0 in
+ let old = ref 0 in
for i = 0 to n-1 do
- let peer = peers.(i) in
+ let peer = peers.(i) in
if peer.distance < 19 && peer.con_state = ON then
- result.(peer.distance + 1 ) <- result.(peer.distance + 1 ) +1;
- if peer.con_state = ON && peer.connection_time < round -2 && peer.distance = -1 then
+ result.(peer.distance + 1 ) <- result.(peer.distance + 1 ) +1;
+ if peer.con_state = ON
+ && peer.connection_time < round -2
+ && peer.distance = -1 then
incr old
done;
result, !old
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index 7c27ee9..b94a6ac 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -3,70 +3,68 @@ open SlotArray
let ask = ref 0
let askroot = ref 0
-let equal a b = match a with
- | Peer x -> begin match b with
- | Peer y -> x.id = y.id
- | _ -> failwith "Big problem" end
- | _ -> failwith "Big problem"
-
+let equal a b = match a, b with
+ | Peer x, Peer y -> x.id = y.id
+ | _ -> failwith "Trying to compare non peers"
+
(* p is asking n slots to root *)
let ask_root root p =
- incr askroot;
- if SlotArray.test (equal (Peer p)) root.slots then
- false, SlotArray.ask_list root.slots
- else if not (SlotArray.full root.slots) then begin
- SlotArray.accept (Peer p) root.slots;
- true, SlotArray.ask_list root.slots
- end
- else
- false, SlotArray.ask_list root.slots
+ incr askroot;
+ if SlotArray.test (equal (Peer p)) root.slots then
+ false, SlotArray.ask_list root.slots
+ else if not (SlotArray.full root.slots) then begin
+ SlotArray.accept (Peer p) root.slots;
+ true, SlotArray.ask_list root.slots
+ end
+ else
+ false, SlotArray.ask_list root.slots
(* peer is asking to p *)
let ask_peer peer p =
- incr ask;
-
- if p.id = peer.id then
- AskRoot
- else if p.con_state <> ON then
- AskRoot
- else if SlotArray.test (equal (Peer peer)) p.slots then
- match SlotArray.random_peer_avoid (equal (Peer peer)) p.slots with
- | Peer x -> Ask x
- | AskRoot -> AskRoot
- | _ -> failwith "Something is very wrong."
- else if not (SlotArray.full p.slots) then begin
- SlotArray.accept (Peer peer) p.slots;
- Peer p
- end
- else match SlotArray.random_peer p.slots with
- | Peer x -> Ask x
- | _ -> failwith "Something is very wrong."
+ incr ask;
+
+ if p.id = peer.id then
+ AskRoot
+ else if p.con_state <> ON then
+ AskRoot
+ else if SlotArray.test (equal (Peer peer)) p.slots then
+ match SlotArray.random_peer_avoid (equal (Peer peer)) p.slots with
+ | Peer x -> Ask x
+ | AskRoot -> AskRoot
+ | _ -> failwith "Random peer is failing"
+ else if not (SlotArray.full p.slots) then begin
+ SlotArray.accept (Peer peer) p.slots;
+ Peer p
+ end
+ else match SlotArray.random_peer p.slots with
+ | Peer x -> Ask x
+ | _ -> failwith "Random peer is failing"
-let is_active slot = match slot with
- | Peer p -> p.con_state = ON
- | _ -> failwith "Big problem"
+let is_active = function
+ | Peer p -> p.con_state = ON
+ | _ -> failwith "Big problem"
let do_peer root peer =
- let aux a = match a with
- | Ask p -> ask_peer peer p
- | _ -> failwith "Big problem"
- in
+ let aux = function
+ | Ask p -> ask_peer peer p
+ | _ -> failwith "Big problem"
+ in
SlotArray.filter_peers is_active peer.slots;
SlotArray.iter_asks aux peer.slots;
let free_slots = SlotArray.capacity peer.slots - SlotArray.length peer.slots
- - SlotArray.asks peer.slots in
+ - SlotArray.asks peer.slots in
if free_slots > 2 then
- let (a,b) = ask_root root peer in
+ let (a,b) = ask_root root peer in
if a then begin
- SlotArray.accept (Peer root) peer.slots;
- SlotArray.append_asks b peer.slots
+ SlotArray.accept (Peer root) peer.slots;
+ SlotArray.append_asks b peer.slots
end
else
- SlotArray.append_asks b peer.slots
+ SlotArray.append_asks b peer.slots
let do_server root =
- SlotArray.filter_peers is_active root.slots
+ SlotArray.filter_peers is_active root.slots
diff --git a/sources/thibaut/plot.py b/sources/thibaut/plot.py
index 3a30ad4..f00a0ab 100644
--- a/sources/thibaut/plot.py
+++ b/sources/thibaut/plot.py
@@ -1,7 +1,26 @@
import numpy as np
import matplotlib.pyplot as plt
import sys
-filename = sys.argv[1]
-a = np.loadtxt(filename, unpack=True, usecols=(1,))
+import os
+
+dirname = sys.argv[1]
+
+rounds = os.path.join(dirname, "rounds.data")
+a = np.loadtxt(rounds, unpack=True, usecols=(1,))
+plt.plot(a)
+plt.savefig(os.path.join(dirname, "rounds.png"))
+
+plt.cla()
+sessions = os.path.join(dirname, "trace.data")
+a = np.loadtxt(sessions)
+plt.plot(a)
+plt.show()
+plt.savefig(os.path.join(dirname, "sessions.png"))
+
+plt.cla()
+sessions = os.path.join(dirname, "avail.data")
+a = np.loadtxt(sessions)
plt.plot(a)
plt.show()
+plt.savefig(os.path.join(dirname, "avail.png"))
+
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 9c4a3a5..5e4dfa8 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -12,126 +12,140 @@ let tracename = ref ""
let datadir = ref "data"
let outputdir = ref ""
-let arg_list = [
- "--degree", Arg.Set_int degree, " <n> maximum number of neighbours";
- "--tpm", Arg.Set_int tpm, " <n> number of ticks per minute";
- "--accuracy", Arg.Set_int accuracy, " <n> number of ticks between rounds";
- "--duration", Arg.Set_int duration, " <n> number of ticks during seeding";
- "--seed", Arg.Set_int seed, " <n> random seed";
- "--datadir", Arg.Set_string datadir, " <path> the directory where the simulation data will be stored"
+let arg_list = Arg.align [
+ "--degree", Arg.Set_int degree, " <n> maximum number of neighbours";
+ "--tpm", Arg.Set_int tpm, " <n> number of ticks per minute";
+ "--accuracy", Arg.Set_int accuracy, " <n> number of ticks between rounds";
+ "--duration", Arg.Set_int duration, " <n> number of ticks during seeding";
+ "--seed", Arg.Set_int seed, " <n> random seed";
+ "--datadir", Arg.Set_string datadir, " <path> the directory where the simulation data will be stored"
]
let anon =
- let args = ref 0 in
+ let args = ref 0 in
fun s ->
- incr args;
- match !args with
- | 1 -> tracename := s
- | _ -> raise (Arg.Bad "Too many arguments")
+ incr args;
+ match !args with
+ | 1 -> tracename := s
+ | _ -> raise (Arg.Bad "Too many arguments")
let usage = "usage: simul [OPTIONS] <tracefile>"
let _ =
- Printf.printf "Pacemaker simulator\n";
- if Array.length Sys.argv < 2 then begin
- Arg.usage (Arg.align arg_list) usage;
- exit 1
- end else begin
- Arg.parse (Arg.align arg_list) anon usage;
- Random.init !seed;
- outputdir := Filename.concat !datadir (Filename.chop_extension (Filename.basename !tracename));
- if not (Sys.file_exists !datadir) then
- try
- Unix.mkdir !datadir 0o755
- with
- Unix.Unix_error (e,_,_) -> failwith (Printf.sprintf "%s: Couldn't create data directory %s" (Unix.error_message e) !datadir)
- else if not (Sys.is_directory !datadir) then
- failwith (Printf.sprintf "%s is not a directory" !datadir);
- if not (Sys.file_exists !outputdir) then
- try
- Unix.mkdir !outputdir 0o755
- with
- Unix.Unix_error (e,_,_) -> failwith (Printf.sprintf "%s: Couldn't create output directory %s" (Unix.error_message e) !outputdir)
- end
+ Printf.printf "Pacemaker simulator\n";
+ if Array.length Sys.argv < 2 then begin
+ Printf.eprintf "Error: Too few arguments\n";
+ Arg.usage arg_list usage;
+ exit 1
+ end
+ else begin
+ Arg.parse arg_list anon usage;
+ Random.init !seed;
+ outputdir := Filename.concat !datadir
+ (Filename.chop_extension (Filename.basename !tracename));
+ try
+ if not (Sys.file_exists !datadir) then
+ Unix.mkdir !datadir 0o755
+ else if not (Sys.is_directory !datadir) then begin
+ Printf.eprintf "%s is not a directory\n" !datadir;
+ exit 1
+ end
+ else if not (Sys.file_exists !outputdir) then
+ Unix.mkdir !outputdir 0o755
+ else if not (Sys.is_directory !outputdir) then begin
+ Printf.eprintf "%s is not a directory\n" !outputdir;
+ exit 1
+ end
+ with
+ | Unix.Unix_error (e,_,s) ->
+ Printf.eprintf "%s: Couldn't create output directory '%s'\n"
+ (Unix.error_message e) s;
+ exit 1
+ end
let ic = open_in !tracename
let oc = open_out (Filename.concat !outputdir "rounds.data")
let npeers, days = Trace.read_info ic
-let peers = Array.init npeers (fun i ->
- let p = {
- id = i;
- con_state = OFF;
- slots = SlotArray.make (if i> 0 then !degree else 2*(!degree));
- rounds_data = RoundMap.empty;
- messages = Queue.create();
- history = RoundMap.empty;
- distance = -1;
- connection_time = 0
- } in
- p)
+let peers = Array.init npeers
+ (fun i ->
+ let p = {
+ id = i;
+ con_state = OFF;
+ slots = SlotArray.make (if i> 0 then !degree else 2*(!degree));
+ rounds_data = RoundMap.empty;
+ messages = Queue.create();
+ history = RoundMap.empty;
+ distance = -1;
+ connection_time = 0
+ } in
+ p )
+(* tracking array keeps track of the position of peer i in the peers array *)
let tracking_array = Array.init npeers (fun i -> i)
-
let do_trace_round = Trace.read ic peers
-
let nticks = (days)*24*60*(!tpm)
let round = ref 0
let connected = ref 0
let _ =
- Printf.fprintf oc "#minute connected messages asks askroots olds\n%!";
- for i = 0 to (nticks-1) do
- connected := 1;
- Pacemaker.messages := 0;
- if i mod !accuracy = 0 then begin
- incr round;
- server_init_seed peers.(0) !round !duration
- end;
-
- if i mod !accuracy = !duration then
- server_init_pulse peers.(0) !round;
-
- if i mod !tpm = 0 then begin
- do_trace_round (i/(!tpm));
- end;
-
- let do_server root =
- Mesh.do_server root;
- Pacemaker.do_server !round root
- in
- do_server peers.(0);
-
- let do_peer p =
- if p.con_state = ON then begin
- Mesh.do_peer peers.(0) p;
- Pacemaker.do_peer !round p;
- incr connected
- end
- in
- random_iter do_peer peers tracking_array;
+ Printf.fprintf oc "#minute connected messages asks askroots olds\n%!";
+ for i = 0 to (nticks-1) do
+ connected := 1;
+ Pacemaker.messages := 0;
+ if i mod !accuracy = 0 then begin
+ incr round;
+ server_init_seed peers.(0) !round !duration
+ end;
+
+ if i mod !accuracy = !duration then
+ server_init_pulse peers.(0) !round;
+
+ if i mod !tpm = 0 then begin
+ do_trace_round (i/(!tpm));
+ end;
+
+ let do_server root =
+ Mesh.do_server root;
+ Pacemaker.do_server !round root
+ in
+ let do_peer p =
+ if p.con_state = ON then begin
+ Mesh.do_peer peers.(0) p;
+ Pacemaker.do_peer !round p;
+ incr connected
+ end
+ in
+ do_server peers.(0);
+ random_iter do_peer peers tracking_array;
- if i mod !tpm = 0 then begin
- Printf.fprintf oc "%d %d %d %d %d " (i/(!tpm)) !connected !Pacemaker.messages !Mesh.ask !Mesh.askroot;
- update_distances peers tracking_array;
- let rep, old = repart (i/(!tpm)) peers in
- Printf.fprintf oc "%d\n%!" old;
- for i = 0 to Array.length rep - 1 do
- Printf.printf "%d, " rep.(i)
- done;
- print_newline ();
- (*for i = 0 to (npeers-1) do
- let p = peers.(i) in
- if p.con_state = ON then begin
- Printf.printf "%d: %d | " p.id p.distance;
- SlotArray.iter (fun (SlotArray.Peer p) -> Printf.printf "%d, " p.id ) p.slots;
- print_newline ()
- end
- done;*)
+ if i mod !tpm = 0 then begin
+ Printf.fprintf oc "%d %d %d %d %d "
+ (i/(!tpm))
+ !connected
+ !Pacemaker.messages
+ !Mesh.ask
+ !Mesh.askroot;
+ update_distances peers tracking_array;
+ let rep, old = repart (i/(!tpm)) peers in
+ Printf.fprintf oc "%d\n%!" old;
+ for i = 0 to Array.length rep - 1 do
+ Printf.printf "%d, " rep.(i)
+ done;
+ print_newline ();
+ (*for i = 0 to (npeers-1) do
+ let p = peers.(i) in
+ if p.con_state = ON then begin
+ Printf.printf "%d: %d | " p.id p.distance;
+ SlotArray.iter (fun (SlotArray.Peer p) ->
+ Printf.printf "%d, " p.id ) p.slots;
+ print_newline ()
+ end
+ done;*)
- Mesh.ask := 0;
- Mesh.askroot := 0;
- end
- done
+ Mesh.ask := 0;
+ Mesh.askroot := 0;
+ end
+ done
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index 360e3b6..a340edc 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -2,78 +2,85 @@ open Globals
open Pacemaker
type event =
- | Peers of int
- | Days of int
- | Peer of int * float * state
- | Round of int
- | On of int
- | Off of int
- | End
+ | Peers of int
+ | Days of int
+ | Peer of int * float * state
+ | Round of int
+ | On of int
+ | Off of int
+ | End
type peer = {
- id : int;
- mutable state : state;
- avail : float;
- lambda : float;
- mu : float
+ id : int;
+ mutable state : state;
+ avail : float;
+ lambda : float;
+ mu : float
}
-
+
let output oc trace_event =
- let print s = Printf.fprintf oc s in
+ let print s = Printf.fprintf oc s in
match trace_event with
- | Peers npeers -> print "Peers %d\n" npeers
- | Days ndays -> print "Days %d\n" ndays
- | Peer (i, avail, state) -> print "Peer %d %.3f %s\n" i avail
- (string_of_state state)
- | Round round -> print "Round %d\n" round
- | On i -> print "On %d\n" i
- | Off i -> print "Off %d\n" i
- | End -> print "End\n"
-
+ | Peers npeers -> print "Peers %d\n" npeers
+ | Days ndays -> print "Days %d\n" ndays
+ | Peer (i, avail, state) ->
+ print "Peer %d %.3f %s\n" i avail (string_of_state state)
+ | Round round -> print "Round %d\n" round
+ | On i -> print "On %d\n" i
+ | Off i -> print "Off %d\n" i
+ | End -> print "End\n"
+
let input ic =
- let line = input_line ic in
- let space = Str.regexp " " in
+ let line = input_line ic in
+ let space = Str.regexp " " in
match Str.split space line with
- | ["Peers"; npeers] -> Peers (int_of_string npeers)
- | ["Peer"; id; avail; state] ->
- Peer (int_of_string id, float_of_string avail,
- state_of_string state)
- | ["Days"; ndays] -> Days (int_of_string ndays)
- | ["End"] -> End
- | ["Round"; round] -> Round (int_of_string round)
- | ["On"; i] -> On (int_of_string i)
- | ["Off"; i] -> Off (int_of_string i)
- | _ -> failwith (Printf.sprintf "Bad line [%s]" (String.escaped line))
-
+ | ["Peers"; npeers] -> Peers (int_of_string npeers)
+ | ["Peer"; id; avail; state] ->
+ Peer (int_of_string id, float_of_string avail, state_of_string state)
+ | ["Days"; ndays] -> Days (int_of_string ndays)
+ | ["End"] -> End
+ | ["Round"; round] -> Round (int_of_string round)
+ | ["On"; i] -> On (int_of_string i)
+ | ["Off"; i] -> Off (int_of_string i)
+ | _ -> failwith (Printf.sprintf "Bad line [%s]" (String.escaped line))
+
let read_info ic =
- let npeers = match input ic with
- | Peers n -> n
- | _ -> failwith "Bad trace"
- in
- let ndays = match input ic with
- | Days n -> n
- | _ -> failwith "Bad trace"
- in
+ let npeers = match input ic with
+ | Peers n -> n
+ | _ -> failwith "Bad trace"
+ in
+ let ndays = match input ic with
+ | Days n -> n
+ | _ -> failwith "Bad trace"
+ in
npeers, ndays
let read ic peers =
- let npeers = Array.length peers in
- for i = 0 to (npeers-1) do
- match input ic with
- | Peer (i, avail, state) -> peers.(i).con_state <- state
- | _ -> failwith "Not enough peers"
+ let npeers = Array.length peers in
+ for i = 0 to (npeers-1) do
+ match input ic with
+ | Peer (i, avail, state) -> peers.(i).con_state <- state
+ | _ -> failwith "Not enough peers"
done;
let event = ref (input ic) in
let get_event () = event := (input ic) in
+
let rec read_round round =
- match !event with
- | Round n -> if n = round then next round
- | On i -> peers.(i).con_state <- ON; peers.(i).connection_time <- round; next round
- | Off i -> disconnect peers.(i);
- next round
- | _ -> ()
+ match !event with
+ | Round n -> if n = round then next round
+ | On i ->
+ peers.(i).con_state <- ON;
+ peers.(i).connection_time <- round;
+ next round
+ | Off i ->
+ disconnect peers.(i);
+ next round
+ | _ -> ()
- and next round = get_event(); read_round round in
- read_round
+ and next round =
+ get_event();
+ read_round round
+ in
+ read_round
diff --git a/sources/thibaut/tracestats.ml b/sources/thibaut/tracestats.ml
index 94f254d..5f952a6 100644
--- a/sources/thibaut/tracestats.ml
+++ b/sources/thibaut/tracestats.ml
@@ -1,48 +1,82 @@
open Compattrace
-let usage = "tracestats <input> <output>"
+let usage = "tracestats <input>"
let inputfile = ref ""
let outputfile = ref ""
+let datadir = ref "data"
+let outputdir = ref ""
+
+let arg_list = Arg.align [
+ "--datadir", Arg.Set_string datadir, " <path> Directory where the data will be stored"
+]
let anon =
- let args = ref 0 in
+ let args = ref 0 in
fun s ->
- incr args;
- match !args with
- | 1 -> inputfile := s
- | 2 -> outputfile := s
- | _ -> raise (Arg.Bad "Too many arguments")
+ incr args;
+ match !args with
+ | 1 -> inputfile := s
+ | _ -> raise (Arg.Bad "Too many arguments")
let _ =
- if (Array.length Sys.argv) < 3 then begin
- Printf.printf "Missing arguments.\n";
- Arg.usage [] usage;
- exit 1
- end
- else begin
- Arg.parse [] anon usage
- end;
- let oc = open_out !outputfile in
- let peers, nrounds, iter_round = Compattrace.trace_read !inputfile in
- let npeers = Array.length peers in
- let sessions = Array.make 100000 0 in
- for i = 0 to (nrounds-1) do
- iter_round i;
- let nconnected = ref 0 in
- for i = 0 to (npeers-1) do
- let p = peers.(i) in
- if p.state = ON then begin
- p.real_avail <- p.real_avail + 1;
- p.session <- p.session + 1;
- incr nconnected
- end
- else if p.state = OFF then begin
- if p.session > 0 then begin
- sessions.(p.session) <- sessions.(p.session) + 1;
- p.session <- 0;
- end
- end
- done
- done;
- Array.iter (Printf.fprintf oc "%d\n") sessions
-
+ if (Array.length Sys.argv) < 2 then begin
+ Printf.eprintf "Error: Too many arguments.\n";
+ Arg.usage arg_list usage;
+ exit 1
+ end
+ else begin
+ Arg.parse arg_list anon usage;
+ outputdir := Filename.concat !datadir
+ (Filename.chop_extension (Filename.basename !inputfile));
+
+ try
+ if not (Sys.file_exists !datadir) then
+ Unix.mkdir !datadir 0o755
+ else if not (Sys.is_directory !datadir) then begin
+ Printf.eprintf "%s is not a directory\n" !datadir;
+ exit 1
+ end
+ else if not (Sys.file_exists !outputdir) then
+ Unix.mkdir !outputdir 0o755
+ else if not (Sys.is_directory !outputdir) then begin
+ Printf.eprintf "%s is not a directory\n" !outputdir;
+ exit 1
+ end
+ with
+ | Unix.Unix_error (e,_,s) ->
+ Printf.eprintf "%s: Couldn't create directory '%s'.\n"
+ (Unix.error_message e) s;
+ exit 1
+ end;
+ let sessions_oc = open_out (Filename.concat !outputdir "sessions.data") in
+ let avail_oc = open_out (Filename.concat !outputdir "avail.data") in
+ let peers, nrounds, iter_round = Compattrace.trace_read !inputfile in
+ let npeers = Array.length peers in
+ let sessions = Array.make 1000 0 in
+ for i = 0 to (nrounds-1) do
+ iter_round i;
+ let nconnected = ref 0 in
+ for i = 0 to (npeers-1) do
+ let p = peers.(i) in
+ if p.state = ON then begin
+ p.real_avail <- p.real_avail + 1;
+ p.session <- p.session + 1;
+ incr nconnected
+ end
+ else if p.state = OFF then begin
+ if p.session > 0 && p.session < 1000 then begin
+ sessions.(p.session) <- sessions.(p.session) + 1;
+ p.session <- 0;
+ end
+ end
+ done
+ done;
+ Array.iter (Printf.fprintf sessions_oc "%d\n") sessions;
+ let avail = Array.make 101 0 in
+ Array.iter
+ (fun p ->
+ let a = p.real_avail*100/nrounds in
+ avail.(a) <- avail.(a) + 1
+ )
+ peers;
+ Array.iter (Printf.fprintf avail_oc "%d\n") avail