Final touch to the simulator. Time to start the real implementation !

git-svn-id: https://scm.gforge.inria.fr/svn/pacemaker@38 30fcff6e-8de6-41c7-acce-77ff6d1dd07b

9 files changed, 86 insertions, 579 deletions

diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile
index 37cc7e5..6eb3c92 100644
--- a/sources/thibaut/Makefile
+++ b/sources/thibaut/Makefile
@@ -3,9 +3,11 @@ OCAMLOPT=ocamlopt
 OCAMLDEP=ocamldep
 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
+SRCS=simulator.ml trace.ml gentrace.ml pacemaker.ml globals.ml compattrace.ml tracestats.ml mesh.ml graph.ml
 BUILDDIR=build
 DEPEND=.depend
+LIBS=str unix
+LIBSOPT=$(addsuffix .cmxa, $(LIBS))
 
 .PHONY: gentrace.opt simulator.opt tracestats.opt all clean
 all: gentrace.opt simulator.opt tracestats.opt
@@ -16,17 +18,17 @@ $(BUILDDIR):
 tracestats.opt: $(BUILDDIR) $(BUILDDIR)/tracestats
 
 $(BUILDDIR)/tracestats: tracestats.cmx
-	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa str.cmxa compattrace.cmx tracestats.cmx
+	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) $(LIBSOPT) compattrace.cmx tracestats.cmx
 
 gentrace.opt: $(BUILDDIR) $(BUILDDIR)/gentrace
 
 $(BUILDDIR)/gentrace: gentrace.cmx
-	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa str.cmxa map2.cmx globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
+	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) $(LIBSOPT) globals.cmx pacemaker.cmx trace.cmx gentrace.cmx
 
 simulator.opt : $(BUILDDIR) $(BUILDDIR)/simulator
 
 $(BUILDDIR)/simulator: simulator.cmx
-	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) unix.cmxa  str.cmxa map2.cmx globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx
+	$(OCAMLOPT) -o $@ $(OCAMLFLAGS) $(LIBSOPT) globals.cmx graph.cmx pacemaker.cmx trace.cmx mesh.cmx simulator.cmx
 
 clean:
 	rm -f *.cm? *.cmx? *.o *~ *.annot
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index 450c1c8..f798a08 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -17,7 +17,7 @@ module PeerId = struct
   let compare = Pervasives.compare
 end
 
-module HashMap = Map2.Make(PeerId)
+module HashMap = Map.Make(PeerId)
 
 module RoundMap : sig
   type 'a t
@@ -249,28 +249,6 @@ type peer = {
 }
 and slot = peer SlotArray.slot
 
-let winners = ref 0
-let nsessions = ref 0 
-let test = ref 0
-
-let disconnect oc round peer =
-  SlotArray.clear peer.slots;
-  let duration = round - peer.connection_time in
-  if duration > 0 then begin
-    Printf.fprintf oc "%d %d %d\n%!" peer.id
-      duration peer.nproofs;
-    if duration > 20 then begin
-      incr nsessions;
-      if peer.nproofs >= duration/10 - 1 then
-	incr winners;
-      if (float_of_int duration)/.10. -. (float_of_int peer.nproofs) >= 0.5 then
-	incr test
-    end
-  end;
-  peer.con_state <- OFF;
-  peer.distance <- -1;
-  peer.nproofs <- 0
-    
 let swap a pos1 pos2 =
   let temp = a.(pos1) in
     a.(pos1) <- a.(pos2);
@@ -282,7 +260,7 @@ let swap_track tracking_array real_array pos1 pos2 =
     swap tracking_array id1 id2;
     swap real_array pos1 pos2
     
-let random_iter f a tracking = 
+let random_iter f a tracking =
   let rec aux n = match n with
     | 1 -> ()
     | n -> let pos = 1+ Random.int (n-1) in
diff --git a/sources/thibaut/map2.ml b/sources/thibaut/map2.ml
deleted file mode 100644
index 3d9597a..0000000
--- a/sources/thibaut/map2.ml
+++ /dev/null
@@ -1,314 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../LICENSE.     *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-module type OrderedType =
-  sig
-    type t
-    val compare: t -> t -> int
-  end
-
-module type S =
-  sig
-    type key
-    type +'a t
-    val empty: 'a t
-    val is_empty: 'a t -> bool
-    val mem:  key -> 'a t -> bool
-    val add: key -> 'a -> 'a t -> 'a t
-    val singleton: key -> 'a -> 'a t
-    val remove: key -> 'a t -> 'a t
-    val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
-    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
-    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-    val iter: (key -> 'a -> unit) -> 'a t -> unit
-    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
-    val for_all: (key -> 'a -> bool) -> 'a t -> bool
-    val exists: (key -> 'a -> bool) -> 'a t -> bool
-    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
-    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
-    val cardinal: 'a t -> int
-    val bindings: 'a t -> (key * 'a) list
-    val min_binding: 'a t -> (key * 'a)
-    val max_binding: 'a t -> (key * 'a)
-    val choose: 'a t -> (key * 'a)
-    val split: key -> 'a t -> 'a t * 'a option * 'a t
-    val find: key -> 'a t -> 'a
-    val map: ('a -> 'b) -> 'a t -> 'b t
-    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
-  end
-
-module Make(Ord: OrderedType) = struct
-
-    type key = Ord.t
-
-    type 'a t =
-        Empty
-      | Node of 'a t * key * 'a * 'a t * int
-
-    let height = function
-        Empty -> 0
-      | Node(_,_,_,_,h) -> h
-
-    let create l x d r =
-      let hl = height l and hr = height r in
-      Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-    let singleton x d = Node(Empty, x, d, Empty, 1)
-
-    let bal l x d r =
-      let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
-      let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
-      if hl > hr + 2 then begin
-        match l with
-          Empty -> invalid_arg "Map.bal"
-        | Node(ll, lv, ld, lr, _) ->
-            if height ll >= height lr then
-              create ll lv ld (create lr x d r)
-            else begin
-              match lr with
-                Empty -> invalid_arg "Map.bal"
-              | Node(lrl, lrv, lrd, lrr, _)->
-                  create (create ll lv ld lrl) lrv lrd (create lrr x d r)
-            end
-      end else if hr > hl + 2 then begin
-        match r with
-          Empty -> invalid_arg "Map.bal"
-        | Node(rl, rv, rd, rr, _) ->
-            if height rr >= height rl then
-              create (create l x d rl) rv rd rr
-            else begin
-              match rl with
-                Empty -> invalid_arg "Map.bal"
-              | Node(rll, rlv, rld, rlr, _) ->
-                  create (create l x d rll) rlv rld (create rlr rv rd rr)
-            end
-      end else
-        Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-    let empty = Empty
-
-    let is_empty = function Empty -> true | _ -> false
-
-    let rec add x data = function
-        Empty ->
-          Node(Empty, x, data, Empty, 1)
-      | Node(l, v, d, r, h) ->
-          let c = Ord.compare x v in
-          if c = 0 then
-            Node(l, x, data, r, h)
-          else if c < 0 then
-            bal (add x data l) v d r
-          else
-            bal l v d (add x data r)
-
-    let rec find x = function
-        Empty ->
-          raise Not_found
-      | Node(l, v, d, r, _) ->
-          let c = Ord.compare x v in
-          if c = 0 then d
-          else find x (if c < 0 then l else r)
-
-    let rec mem x = function
-        Empty ->
-          false
-      | Node(l, v, d, r, _) ->
-          let c = Ord.compare x v in
-          c = 0 || mem x (if c < 0 then l else r)
-
-    let rec min_binding = function
-        Empty -> raise Not_found
-      | Node(Empty, x, d, r, _) -> (x, d)
-      | Node(l, x, d, r, _) -> min_binding l
-
-    let rec max_binding = function
-        Empty -> raise Not_found
-      | Node(l, x, d, Empty, _) -> (x, d)
-      | Node(l, x, d, r, _) -> max_binding r
-
-    let rec remove_min_binding = function
-        Empty -> invalid_arg "Map.remove_min_elt"
-      | Node(Empty, x, d, r, _) -> r
-      | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
-
-    let merge t1 t2 =
-      match (t1, t2) with
-        (Empty, t) -> t
-      | (t, Empty) -> t
-      | (_, _) ->
-          let (x, d) = min_binding t2 in
-          bal t1 x d (remove_min_binding t2)
-
-    let rec remove x = function
-        Empty ->
-          Empty
-      | Node(l, v, d, r, h) ->
-          let c = Ord.compare x v in
-          if c = 0 then
-            merge l r
-          else if c < 0 then
-            bal (remove x l) v d r
-          else
-            bal l v d (remove x r)
-
-    let rec iter f = function
-        Empty -> ()
-      | Node(l, v, d, r, _) ->
-          iter f l; f v d; iter f r
-
-    let rec map f = function
-        Empty ->
-          Empty
-      | Node(l, v, d, r, h) ->
-          let l' = map f l in
-          let d' = f d in
-          let r' = map f r in
-          Node(l', v, d', r', h)
-
-    let rec mapi f = function
-        Empty ->
-          Empty
-      | Node(l, v, d, r, h) ->
-          let l' = mapi f l in
-          let d' = f v d in
-          let r' = mapi f r in
-          Node(l', v, d', r', h)
-
-    let rec fold f m accu =
-      match m with
-        Empty -> accu
-      | Node(l, v, d, r, _) ->
-          fold f r (f v d (fold f l accu))
-
-    let rec for_all p = function
-        Empty -> true
-      | Node(l, v, d, r, _) -> p v d && for_all p l && for_all p r
-
-    let rec exists p = function
-        Empty -> false
-      | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
-
-    let filter p s =
-      let rec filt accu = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            filt (filt (if p v d then add v d accu else accu) l) r in
-      filt Empty s
-
-    let partition p s =
-      let rec part (t, f as accu) = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in
-      part (Empty, Empty) s
-
-    (* Same as create and bal, but no assumptions are made on the
-       relative heights of l and r. *)
-
-    let rec join l v d r =
-      match (l, r) with
-        (Empty, _) -> add v d r
-      | (_, Empty) -> add v d l
-      | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
-          if lh > rh + 2 then bal ll lv ld (join lr v d r) else
-          if rh > lh + 2 then bal (join l v d rl) rv rd rr else
-          create l v d r
-
-    (* Merge two trees l and r into one.
-       All elements of l must precede the elements of r.
-       No assumption on the heights of l and r. *)
-
-    let concat t1 t2 =
-      match (t1, t2) with
-        (Empty, t) -> t
-      | (t, Empty) -> t
-      | (_, _) ->
-          let (x, d) = min_binding t2 in
-          join t1 x d (remove_min_binding t2)
-
-    let concat_or_join t1 v d t2 =
-      match d with
-      | Some d -> join t1 v d t2
-      | None -> concat t1 t2
-
-    let rec split x = function
-        Empty ->
-          (Empty, None, Empty)
-      | Node(l, v, d, r, _) ->
-          let c = Ord.compare x v in
-          if c = 0 then (l, Some d, r)
-          else if c < 0 then
-            let (ll, pres, rl) = split x l in (ll, pres, join rl v d r)
-          else
-            let (lr, pres, rr) = split x r in (join l v d lr, pres, rr)
-
-    let rec merge f s1 s2 =
-      match (s1, s2) with
-        (Empty, Empty) -> Empty
-      | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
-          let (l2, d2, r2) = split v1 s2 in
-          concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
-      | (_, Node (l2, v2, d2, r2, h2)) ->
-          let (l1, d1, r1) = split v2 s1 in
-          concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
-      | _ ->
-          assert false
-
-    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
-
-    let rec cons_enum m e =
-      match m with
-        Empty -> e
-      | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
-
-    let compare cmp m1 m2 =
-      let rec compare_aux e1 e2 =
-          match (e1, e2) with
-          (End, End) -> 0
-        | (End, _)  -> -1
-        | (_, End) -> 1
-        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
-            let c = Ord.compare v1 v2 in
-            if c <> 0 then c else
-            let c = cmp d1 d2 in
-            if c <> 0 then c else
-            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
-      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
-
-    let equal cmp m1 m2 =
-      let rec equal_aux e1 e2 =
-          match (e1, e2) with
-          (End, End) -> true
-        | (End, _)  -> false
-        | (_, End) -> false
-        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
-            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
-            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
-      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
-
-    let rec cardinal = function
-        Empty -> 0
-      | Node(l, _, _, r, _) -> cardinal l + 1 + cardinal r
-
-    let rec bindings_aux accu = function
-        Empty -> accu
-      | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l
-
-    let bindings s =
-      bindings_aux [] s
-
-    let choose = min_binding
-
-end
diff --git a/sources/thibaut/map2.mli b/sources/thibaut/map2.mli
deleted file mode 100644
index b025b8c..0000000
--- a/sources/thibaut/map2.mli
+++ /dev/null
@@ -1,194 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../LICENSE.     *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(** Association tables over ordered types.
-
-   This module implements applicative association tables, also known as
-   finite maps or dictionaries, given a total ordering function
-   over the keys.
-   All operations over maps are purely applicative (no side-effects).
-   The implementation uses balanced binary trees, and therefore searching
-   and insertion take time logarithmic in the size of the map.
-*)
-
-module type OrderedType =
-  sig
-    type t
-      (** The type of the map keys. *)
-    val compare : t -> t -> int
-      (** A total ordering function over the keys.
-          This is a two-argument function [f] such that
-          [f e1 e2] is zero if the keys [e1] and [e2] are equal,
-          [f e1 e2] is strictly negative if [e1] is smaller than [e2],
-          and [f e1 e2] is strictly positive if [e1] is greater than [e2].
-          Example: a suitable ordering function is the generic structural
-          comparison function {!Pervasives.compare}. *)
-  end
-(** Input signature of the functor {!Map.Make}. *)
-
-module type S =
-  sig
-    type key
-    (** The type of the map keys. *)
-
-    type (+'a) t
-    (** The type of maps from type [key] to type ['a]. *)
-
-    val empty: 'a t
-    (** The empty map. *)
-
-    val is_empty: 'a t -> bool
-    (** Test whether a map is empty or not. *)
-
-    val mem: key -> 'a t -> bool
-    (** [mem x m] returns [true] if [m] contains a binding for [x],
-       and [false] otherwise. *)
-
-    val add: key -> 'a -> 'a t -> 'a t
-    (** [add x y m] returns a map containing the same bindings as
-       [m], plus a binding of [x] to [y]. If [x] was already bound
-       in [m], its previous binding disappears. *)
-
-    val singleton: key -> 'a -> 'a t
-    (** [singleton x y] returns the one-element map that contains a binding [y]
-        for [x].
-        @since 3.12.0
-     *)
-
-    val remove: key -> 'a t -> 'a t
-    (** [remove x m] returns a map containing the same bindings as
-       [m], except for [x] which is unbound in the returned map. *)
-
-    val merge:
-         (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
-    (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1]
-        and of [m2]. The presence of each such binding, and the corresponding
-        value, is determined with the function [f].
-        @since 3.12.0
-     *)
-
-    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
-    (** Total ordering between maps.  The first argument is a total ordering
-        used to compare data associated with equal keys in the two maps. *)
-
-    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
-    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
-       equal, that is, contain equal keys and associate them with
-       equal data.  [cmp] is the equality predicate used to compare
-       the data associated with the keys. *)
-
-    val iter: (key -> 'a -> unit) -> 'a t -> unit
-    (** [iter f m] applies [f] to all bindings in map [m].
-       [f] receives the key as first argument, and the associated value
-       as second argument.  The bindings are passed to [f] in increasing
-       order with respect to the ordering over the type of the keys. *)
-
-    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
-    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
-       where [k1 ... kN] are the keys of all bindings in [m]
-       (in increasing order), and [d1 ... dN] are the associated data. *)
-
-    val for_all: (key -> 'a -> bool) -> 'a t -> bool
-    (** [for_all p m] checks if all the bindings of the map
-        satisfy the predicate [p].
-        @since 3.12.0
-     *)
-
-    val exists: (key -> 'a -> bool) -> 'a t -> bool
-    (** [exists p m] checks if at least one binding of the map
-        satisfy the predicate [p].
-        @since 3.12.0
-     *)
-
-    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
-    (** [filter p m] returns the map with all the bindings in [m]
-        that satisfy predicate [p].
-        @since 3.12.0
-     *)
-
-    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
-    (** [partition p m] returns a pair of maps [(m1, m2)], where
-        [m1] contains all the bindings of [s] that satisfy the
-        predicate [p], and [m2] is the map with all the bindings of
-        [s] that do not satisfy [p].
-        @since 3.12.0
-     *)
-
-    val cardinal: 'a t -> int
-    (** Return the number of bindings of a map.
-        @since 3.12.0
-     *)
-
-    val bindings: 'a t -> (key * 'a) list
-    (** Return the list of all bindings of the given map.
-       The returned list is sorted in increasing order with respect
-       to the ordering [Ord.compare], where [Ord] is the argument
-       given to {!Map.Make}.
-        @since 3.12.0
-     *)
-
-    val min_binding: 'a t -> (key * 'a)
-    (** Return the smallest binding of the given map
-       (with respect to the [Ord.compare] ordering), or raise
-       [Not_found] if the map is empty.
-        @since 3.12.0
-     *)
-
-    val max_binding: 'a t -> (key * 'a)
-    (** Same as {!Map.S.min_binding}, but returns the largest binding
-        of the given map.
-        @since 3.12.0
-     *)
-
-    val choose: 'a t -> (key * 'a)
-    (** Return one binding of the given map, or raise [Not_found] if
-       the map is empty. Which binding is chosen is unspecified,
-       but equal bindings will be chosen for equal maps.
-        @since 3.12.0
-     *)
-
-    val split: key -> 'a t -> 'a t * 'a option * 'a t
-    (** [split x m] returns a triple [(l, data, r)], where
-          [l] is the map with all the bindings of [m] whose key
-        is strictly less than [x];
-          [r] is the map with all the bindings of [m] whose key
-        is strictly greater than [x];
-          [data] is [None] if [m] contains no binding for [x],
-          or [Some v] if [m] binds [v] to [x].
-        @since 3.12.0
-     *)
-
-    val find: key -> 'a t -> 'a
-    (** [find x m] returns the current binding of [x] in [m],
-       or raises [Not_found] if no such binding exists. *)
-
-    val map: ('a -> 'b) -> 'a t -> 'b t
-    (** [map f m] returns a map with same domain as [m], where the
-       associated value [a] of all bindings of [m] has been
-       replaced by the result of the application of [f] to [a].
-       The bindings are passed to [f] in increasing order
-       with respect to the ordering over the type of the keys. *)
-
-    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
-    (** Same as {!Map.S.map}, but the function receives as arguments both the
-       key and the associated value for each binding of the map. *)
-
-
-  end
-(** Output signature of the functor {!Map.Make}. *)
-
-module Make (Ord : OrderedType) : S with type key = Ord.t
-(** Functor building an implementation of the map structure
-   given a totally ordered type. *)
diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml
index 32f0047..f634fa8 100644
--- a/sources/thibaut/pacemaker.ml
+++ b/sources/thibaut/pacemaker.ml
@@ -55,13 +55,22 @@ let server_init_pulse peer round =
       content = Pulse (data.seed, [data.hmap])
     } in
       SlotArray.iter (send_message message) peer.slots
-	
+
+exception Found
+
+let exists map elem =
+  let aux _ b = if b = elem then raise Found in
+    try 
+      let _ = HashMap.iter aux map in false
+    with
+      | Found -> true
+    
 let rec verify_branch branch = match branch with
   | [] -> true
   | [h] -> true 
   | h1::h2::t ->
       let hash = Hashtbl.hash h1 in
-	(HashMap.exists (fun _ a -> a = hash) h2) && (verify_branch (h2::t))
+	(exists h2 hash) && (verify_branch (h2::t))
     
 let process_message oc current_round peer m =
   if m.round >= (current_round - 2) then
@@ -77,43 +86,44 @@ let process_message oc current_round peer m =
 	      SlotArray.iter (send_message message) peer.slots
       | SeedReply(hash) ->
           begin try
-          let data = RoundMap.find m.round peer.rounds_data in
+            let data = RoundMap.find m.round peer.rounds_data in
               if data.phase = SEEDING then
-              data.hmap <- HashMap.add m.sender hash data.hmap;
+		data.hmap <- HashMap.add m.sender hash data.hmap;
           with
               Not_found -> ()
           end
       | Pulse(seed, branch) ->
           begin try
             let data = RoundMap.find m.round peer.rounds_data in
-            if data.phase = SEEDING || data.phase = PULSE then
-	      match branch with
-		| [] -> ()
-		| h::t -> 
-		    try
-		      let hash = HashMap.find peer.id h in
-		      let hmap = find_reply hash data.replies in
-			if verify_branch branch then
-			  let branch2 = hmap::branch in
-			  let message = {
-		            sender = peer.id;
-		            round = m.round;
-		            content = Pulse(seed, branch2)
-		          } in		          
-			    if data.phase = SEEDING then begin
-			      data.phase <- PULSE;			      
-			      Printf.fprintf oc "%d %d\n" peer.id current_round;
-			      peer.nproofs <- peer.nproofs + 1
-			    end;
-		            SlotArray.iter (send_message message) peer.slots;
-		            peer.history <- RoundMap.add m.round 
-		              (seed, branch2) peer.history;
-		    with
-		      | Not_found -> ()
+              if data.phase = SEEDING || data.phase = PULSE then
+		match branch with
+		  | [] -> ()
+		  | h::t -> 
+		      try
+			let hash = HashMap.find peer.id h in
+			let hmap = find_reply hash data.replies in
+			  if verify_branch branch then
+			    let branch2 = hmap::branch in
+			    let message = {
+		              sender = peer.id;
+		              round = m.round;
+		              content = Pulse(seed, branch2)
+		            } in		          
+			      if data.phase = SEEDING then begin
+				data.phase <- PULSE;			      
+				Printf.fprintf oc "%d %d\n"
+				  peer.id current_round;
+				peer.nproofs <- peer.nproofs + 1
+			      end;
+		              SlotArray.iter (send_message message) peer.slots;
+		              peer.history <- RoundMap.add m.round 
+				(seed, branch2) peer.history;
+		      with
+			| Not_found -> ()
           with
               Not_found -> ()
           end
-
+	    
 let do_peer oc current_round peer =
   Queue.iter (process_message oc current_round peer) peer.messages;
   Queue.clear peer.messages;
diff --git a/sources/thibaut/plot.py b/sources/thibaut/plot.py
index 3900b65..f696822 100644
--- a/sources/thibaut/plot.py
+++ b/sources/thibaut/plot.py
@@ -2,6 +2,7 @@ import numpy as np
 import matplotlib.pyplot as plt
 import sys
 import os
+import math
 
 dirname = sys.argv[1]
 
@@ -25,10 +26,13 @@ plt.savefig(os.path.join(dirname, "avail.png"))
 plt.cla()
 simul_sessions = os.path.join(dirname, "simul_sessions.data")
 duration, proofs = np.loadtxt(simul_sessions, unpack = True, usecols=(1,2))
-result = np.zeros((len(duration)+1,2))
+nsessions = 0
+result = 0
 for i in range(len(duration)):
-    temp = duration[i]
-    result[temp,0] = result[temp,0] + proofs[i]
-    result[temp,1] = result[temp,1] + 1
-plt.plot(result[:200,0]/result[:200,1])
-plt.show()
+    if duration[i] >= 20:
+        nsessions = nsessions + 1
+        if proofs[i] >= math.floor(duration[i]/10) -1:
+            result = result + 1
+
+print float(result)/nsessions
+
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 12d5bfb..8f1ad44 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -3,7 +3,7 @@ open Globals
 open Mesh
 open Graph
 
-let degree = ref 10
+let degree = ref 4
 let tpm = ref 3
 let accuracy = ref 30
 let duration = ref 12
@@ -18,7 +18,8 @@ let arg_list = Arg.align [
   "--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"
+  "--datadir", Arg.Set_string datadir, " <path> \
+the directory where the simulation data will be stored"
 ]
 
 let anon = 
@@ -87,7 +88,10 @@ let peers = Array.init npeers
      } in
        p )
 
-(* tracking array keeps track of the position of peer i in the peers array *)
+(* tracking_array keeps track of the position of peer i in the peers
+   array. That is, peer i is peers.(tracking_array.(i)). Indeed the
+   peers are swapped all the time during random iterations
+ *)
 let tracking_array = Array.init npeers (fun i -> i)
 let do_trace_round = Trace.read sessions_oc ic tracking_array peers
 let nticks = (days)*24*60*(!tpm)
@@ -101,20 +105,27 @@ let _ =
   Printf.fprintf proofs_oc "#id round\n%!";
 
   for i = 0 to (nticks-1) do
+
+    (* print progess percent *)
     for i = 0 to 2 do
       Printf.printf "%c" '\b'
     done;
     Printf.printf "%02d%%%!" ((i+1)*100/nticks);
+    
     connected := 1;
     Pacemaker.messages := 0;
+    
+    (* start server round *)
     if i mod !accuracy = 0 then begin
       incr round;
       server_init_seed peers.(0) !round !duration
     end;
 
+    (* end of seeding phase, broadcast the pulse *)
     if i mod !accuracy = !duration then
       server_init_pulse peers.(0) !round;
     
+    (* every minute, update peers' status from the trace *)
     if i mod !tpm = 0 then begin
       do_trace_round (i/(!tpm));
     end;
@@ -153,6 +164,5 @@ let _ =
       end
   done;
   print_newline ();
-  Printf.printf "%f %f\n" ((float_of_int !winners)/.(float_of_int !nsessions))  
-    ((float_of_int !test)/.(float_of_int !nsessions))  
+ 
  
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index 47fd3c5..1d1cbf3 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -35,8 +35,9 @@ let input ic =
   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)   
+      | ["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)
@@ -55,6 +56,15 @@ let read_info ic =
   in
     npeers, ndays
 
+let disconnect oc round peer =
+  SlotArray.clear peer.Globals.slots;
+  let duration = round - peer.connection_time in
+    if duration > 0 then
+      Printf.fprintf oc "%d %d %d\n%!" peer.Globals.id duration peer.nproofs;
+    peer.con_state <- OFF;
+    peer.distance <- -1;
+    peer.nproofs <- 0
+
 let read oc ic tracking peers = 
   let npeers = Array.length peers in
     for i = 0 to (npeers-1) do
diff --git a/sources/thibaut/tracestats.ml b/sources/thibaut/tracestats.ml
index a769eac..fb7c1a2 100644
--- a/sources/thibaut/tracestats.ml
+++ b/sources/thibaut/tracestats.ml
@@ -7,7 +7,8 @@ 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"
+  "--datadir", Arg.Set_string datadir, " <path> \
+Directory where the data will be stored"
 ]
 
 let anon =