test: add a -seed option to gg to get reproducible GM tests

lib/algo/algo.mli

-(* Time-stamp: <modified the 31/08/2021 (at 15:43) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/09/2021 (at 16:12) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface}
 
     A SASA process is an instance of an algorithm defined via this
@@ -160,6 +160,10 @@ val get_graph_attribute : string -> string
 (** Get the value of a graph attribute. Returns None if the attribute doesn't exist. *)
 val get_graph_attribute_opt : string -> string option
 
+(** {3 Finding bad initial state } *)
+type num = F of float | I of int | B of bool
+type 's state_of_nums : num list -> 's
+
 (** {2 Code Registration}
 
 The [register: 's to_register -> unit] function must be called once in
@@ -177,9 +181,11 @@ type 's to_register = {
     state_of_string: (string -> 's) option;
     copy_state: 's -> 's;
     actions   : action list (** Mandatory in custom daemon mode, or to use oracles *);
-    potential_function: 's potential_fun option (** Mandatory with Evil daemons *);
     legitimate_function : 's legitimate_fun option;
+    potential_function: 's potential_fun option (** Mandatory with Evil daemons *);
     fault_function : 's fault_fun option (** called at legitimate configuration *)
+        
+    state_of_nums : 's state_of_nums option;
   }
 (** -  For the [state_to_string] field,  the idea is to  print the raw
    values contained in ['s].  If a  value is omitted, one won't see it

lib/sasacore/worstInit.ml

+(* Time-stamp: <modified the 01/10/2021 (at 11:58) by Erwan Jahier> *)
+
+open Register
+
+type 's node = { st : 's ; d : int }
+type point = num Array.t
+
+let debug = false
+
+type succ_heuristic = (* Various heuristic to choose the neighbor *)
+  | OneDim (* only move one value at a time *)
+  | RanDim (* move a value or not at random *)
+  | AllDim (* move all values *)
+      
+let succ_heuristic_nb = 3
+let int_of_succ_heuristic = function OneDim -> 0 | RanDim -> 1 | AllDim -> 2
+let succ_heuristic_of_int = function 0 -> OneDim | 1 -> RanDim | 2 -> AllDim
+                              | _  -> assert false
+
+let mutate_num = function
+  | F f -> F(f+.(Random.float 2.0) -. 1.0)
+  | I i -> if Random.bool () then I(i+1) else I(i-1)
+  | B b -> B (not b)
+                                
+                                
+let (one_dim_succ : point -> point) = fun p ->
+  let j = Random.int (Array.length p) in
+  p.(j) <- mutate_num p.(j);
+  p
+
+let ran_dim_succ p =
+  for j=0 to Array.length p - 1 do
+    if Random.bool () then p.(j) <- mutate_num p.(j)
+  done;
+  p
+let all_dim_succ  p =
+  for j=0 to Array.length p - 1 do
+    p.(j) <- mutate_num p.(j)
+  done;
+  p
+    
+let succ_heuristic_to_succ = function
+    OneDim -> one_dim_succ | RanDim -> ran_dim_succ | AllDim -> all_dim_succ
+
+(* each succ_heuristic has a weight between 1 and 100, initialized at 50 *)
+let hw = Array.make succ_heuristic_nb 50
+let decr_w log i =
+  Printf.fprintf log "Decrementing heuristic %d\n%!" i;
+  try hw.(i) <- max 1 (hw.(i)-1) with _ -> assert false
+let incr_w log i =
+  Printf.fprintf log "Incrementing heuristic %d\n%!" i;
+  try hw.(i) <- min 100 (hw.(i)+1) with _ -> assert false
+      
+let tf = float_of_int 
+
+let (choose_succ_heuristic : unit -> succ_heuristic) =
+  fun () -> (* Choose one succ_heuristic with a probability defined by their weights in hw *)
+  let sum = tf(Array.fold_left (+) 0 hw) in
+  let r = ref (sum *. Random.float 1.0) in
+  let ri = ref (-1) in
+  assert(sum>0.0);
+  assert(!r>0.0);
+  while !r>0.0 do
+    incr ri;
+    assert (!ri<Array.length hw);
+    r := !r -. (tf hw.(!ri));
+  done;
+  if debug then Printf.printf "choose heuristics %d, %!" !ri; 
+  succ_heuristic_of_int !ri
+
+let h = ref (choose_succ_heuristic ()) 
+let choose_succ s =
+  let s_st = Array.copy s.st in
+  let ns = (succ_heuristic_to_succ !h) s_st in
+  (* update heuristic weights depending on their success at the previous step *)
+  (*if ns = pre_s then decr_w else incr_w) (int_of_succ_heuristic !h*)
+  h := choose_succ_heuristic ();
+  { st = ns ; d = s.d+1 }
+
+
+let print_stat log = 
+  Printf.fprintf log "     ===> heuristic array: [|%s|]\n%!"
+    (Array.fold_left (fun acc d -> Printf.sprintf "%s,%d" acc d) "" hw);
+  
+  
+(*****************************************************************************)
+(* XXX a ranger ailleurs !!! *)
+
+open Process
+    
+let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) =
+  fun point ss ->
+  
+  let (state_to_nums, nums_to_state :
+                         ('v -> Register.num list) * (Register.num list -> 'v -> 'v )) =
+    match Register.get_for_init_search () with
+    | None -> assert false
+    | Some (f, g) -> f, g
+  in
+  let state_size =
+    assert (ss.network <> []);
+    let p0 = List.hd ss.network in
+    let s0 = state_to_nums p0.init in
+    List.length s0
+  in
+  let make_num l i j =
+    if debug then
+      Printf.printf "make_num  i=%d j=%d size=%dx%d \n%!"
+        i j (Array.length point) state_size;
+    let rec f l i j =
+      if i=0 then l else f (point.(i+j-1)::l) (i-1) j
+    in
+    f l i j
+  in
+  let new_config, _ = 
+    List.fold_left 
+    (fun (e,j) p ->
+       let num = make_num [] state_size (j*state_size) in
+       let st = nums_to_state num (Env.get e p.pid) in
+       let e = Env.set e p.pid st in
+       e, j+1
+    )
+    (ss.config, 0)
+    ss.network
+  in
+  if debug then Printf.printf "point_to_ss  ok\n%!";
+  { ss with config = new_config }
+
+    
+let (ss_to_point : 'v SimuState.t -> point) =
+  fun ss ->
+  let (state_to_nums : ('v -> Register.num list) ) =
+    match Register.get_for_init_search () with
+      | None ->
+        failwith "the Algo.for_init_search registration field should provide state_to_nums functions"
+      | Some (f, _) -> f
+  in
+    let size =
+      assert (ss.network <> []);
+      let p0 = List.hd ss.network in
+      let s0 = state_to_nums p0.init in
+      (List.length s0) * (List.length ss.network)
+    in
+  let point = Array.make size (I 0) in
+    let i = ref 0 in
+    List.iter
+    (fun p ->
+       let nums = state_to_nums p.init in
+       List.iter (fun num ->
+           assert (!i<Array.length point);
+           point.(!i) <- num; incr i) nums
+    )
+    ss.network;
+  point
+(*****************************************************************************)
+    
+open LocalSearch
+
+
+
+(* First Choice Hill Climbing: a  successor is chosen at random (using
+   some  heuristics), and  became  the  current state  if  its cost  is
+   better.
+
+   The heuristic to choose the succ is chosen at random in an array of
+   heuristics.   The probability  of  each heuristic  evolves, but  is
+   never null.  *)
+let (fchc : out_channel -> ('v SimuState.t -> int) -> 'v SimuState.t -> int -> 'v SimuState.t) =
+  fun log run ss_init dmax ->
+  let cost p = run (point_to_ss p ss_init) in
+
+  let g =
+    { 
+      init = ({ st = ss_to_point ss_init ; d = 0 }, None, ());
+      succ = (fun n -> [choose_succ n]);
+      stop = (fun _ _n -> false);
+      is_goal = (fun _n -> true);
+      push = (fun _tv n -> Some n);
+      pop = (fun tv -> Some(Option.get tv, None));
+      visiting = (fun _ x -> x);
+      visited  = (fun _ _ -> false);
+      cut  = (fun _ _ -> false);
+    }
+  in
+  let cpt = ref 0 in
+  let av_cost = ref 0 in  
+  let rec run_more pcost psol more =
+    print_stat log;
+    incr cpt;
+    if !cpt < dmax then
+      ( match more (Some psol) with
+        | LocalSearch.Stopped -> assert false (* SNO *)
+        | LocalSearch.NoMore-> assert false (* SNO *)
+        | LocalSearch.Sol (nsol, more) ->
+          av_cost := (!av_cost * (!cpt-1) + pcost) / !cpt;
+          let ncost = cost nsol.st in
+            Printf.fprintf log "%d > %d? " ncost pcost;
+            if ncost > pcost then 
+              incr_w log (int_of_succ_heuristic !h)
+            else 
+              decr_w log (int_of_succ_heuristic !h);
+            if ncost > pcost then (
+              run_more ncost nsol more
+            ) else (
+              run_more pcost psol more            
+            )
+      )
+    else (
+      Printf.printf "The worst initial configuration, which costs %d, is " pcost;
+      point_to_ss psol.st ss_init
+      (* XXX generate a dot file using this initialisation *)
+    
+    )
+  in
+  
+  match LocalSearch.run g None with
+  | LocalSearch.Stopped -> assert false (* SNO *)
+  | LocalSearch.NoMore-> assert false (* SNO *)
+  | LocalSearch.Sol (sol, more) -> run_more (cost sol.st) sol more

src/sasaMain.ml

 open Sasacore
 
-let (print_step : int -> int -> string -> string -> SasArg.t -> 'v Env.t ->
-                  'v Process.t list -> string -> bool list list -> unit) =
-  fun n i legitimate pot args e pl activate_val enab_ll ->
+let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> string -> SasArg.t ->
+      'v Env.t -> 'v Process.t list -> string -> bool list list -> unit) =
+  fun log st n i legitimate pot args e pl activate_val enab_ll ->
   let enable_val =
     String.concat " " (List.map (fun b -> if b then "t" else "f")
                          (List.flatten enab_ll))
   in
+  if st.sasarg.init_search_max_trials <> None then (
+    (*     Printf.fprintf log "\n#step %s\n%!" (string_of_int (n-i)); *)
+    (*     Printf.fprintf log "%s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val legitimate pot; *)
+  ) else  
   if args.no_data_file then (
     Printf.printf "\n#step %s\n%!" (string_of_int (n-i))
   ) else (
@@ -22,7 +26,8 @@ let (print_step : int -> int -> string -> string -> SasArg.t -> 'v Env.t ->
     ) else (
       (* rif mode, internal daemons *)
       if args.rif then
-        Printf.printf " %s %s %s %s %s\n%!" (StringOf.env_rif e pl) enable_val activate_val legitimate pot
+        Printf.printf " %s %s %s %s %s\n%!"
+          (StringOf.env_rif e pl) enable_val activate_val legitimate pot
       else (
         Printf.printf "\n#step %s\n" (string_of_int (n-i));
         Printf.printf "%s%s %s %s %s %s\n%!"
@@ -89,11 +94,11 @@ let (compute_potentiel: 'v SimuState.t -> string) =
     string_of_float p
 
        
-let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
-  fun n i activate_val st ->
+let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =
+  fun log n i activate_val st ->
   (* 1: Get enable processes *)
   let verb = !Register.verbose_level > 0 in
-  if verb then Printf.eprintf "==> SasaSimuState.simustep :1: Get enable processes\n%!";
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep :1: Get enable processes\n%!";
   let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
   let pot = compute_potentiel st in
   let pl = st.network in
@@ -105,15 +110,15 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
     then (
       match Register.get_fault () with
       | None ->
-        print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+        print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
         incr rounds;
         raise (Silent (n-i))
       | Some ff ->
-        print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+        print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
         let str = if st.sasarg.rif then "#" else "" in
-        Printf.eprintf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
+        Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n"
           str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
-        Printf.eprintf "%s==> Inject a fault\n%!" str;
+        Printf.fprintf log "%s==> Inject a fault\n%!" str;
         let st = inject_fault ff st in
         let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
         st, all, enab_ll
@@ -121,15 +126,15 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
     else if leg then (
       match Register.get_fault () with
       | None ->
-        print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+        print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
         raise (Legitimate (n-i))
       | Some ff ->
-        print_step n i "t" pot st.sasarg st.config pl activate_val enab_ll;
+        print_step log st n i "t" pot st.sasarg st.config pl activate_val enab_ll;
         let str = if st.sasarg.rif then "#" else "#" in
-        Printf.eprintf
+        Printf.fprintf log
           "\n%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n"
           str !moves (plur !moves) (n-i) (plur (n-i)) !rounds (plur !rounds);
-        Printf.eprintf "%s==> Inject a fault\n%!" str;
+        Printf.fprintf log "%s==> Inject a fault\n%!" str;
         let st = inject_fault ff st in
         let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
         st, all, enab_ll
@@ -139,9 +144,9 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
   in
   let leg_str = if leg then "t" else "f" in
   if st.sasarg.daemon = DaemonType.Custom then
-    print_step n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
+    print_step log st n i leg_str pot st.sasarg st.config pl activate_val enab_ll;
   (* 2: read the actions *)
-  if verb then Printf.eprintf "==> SasaSimuState.simustep : 2: read the actions\n%!";
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep : 2: read the actions\n%!";
   let get_action_value = RifRead.bool (st.sasarg.verbose > 1) in
   let next_activate_val, pnal = Daemon.f st.sasarg.dummy_input
       (st.sasarg.verbose >= 1) st.sasarg.daemon st.network SimuState.neigbors_of_pid
@@ -151,44 +156,79 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
   update_round next_activate_val enab_ll;
   let next_activate_val = bool_ll_to_string next_activate_val in
   (* 3: Do the steps *)
-  if verb then Printf.eprintf "==> SasaSimuState.simustep : 3: Do the steps\n%!";
+  if verb then Printf.fprintf log "==> SasaSimuState.simustep : 3: Do the steps\n%!";
   if st.sasarg.daemon <> DaemonType.Custom then
-    print_step n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
+    print_step log st n i leg_str pot st.sasarg st.config pl next_activate_val enab_ll;
   let st = Sasacore.Step.f pnal st in
   st, next_activate_val
 
-let rec (simuloop: int -> int -> string -> 'v SimuState.t -> unit) =
-  fun n i activate_val st ->
-  if !Register.verbose_level > 0 then Printf.eprintf "==> SasaSimuState.simuloop %d/%d \n%!" i n;
-  let st, next_activate_val = simustep n i activate_val st in
-  if i > 0 then simuloop n (i-1) next_activate_val st else (
-    print_string "#q\n"; flush_all ()
-  )
-
-let () =
-  let st = Sasacore.SimuState.make true Sys.argv in
-  try
-    let n = st.sasarg.length in
-    simuloop n n "" st
+let rec (simuloop: out_channel -> int -> int -> string -> 'v SimuState.t -> int) =
+  fun log n i activate_val st ->
+  let rec loop i activate_val st =
+    if !Register.verbose_level > 0 then
+      Printf.fprintf log "==> SasaSimuState.simuloop %d/%d \n%!" i n;
+    let st, next_activate_val = simustep log n i activate_val st in
+    if i > 0 then loop (i-1) next_activate_val st else (
+      print_string "#q\n"; flush_all ()
+    )
+  in
+  try (loop i activate_val st); n
   with
   | Silent i ->
     let str = if st.sasarg.rif then "#" else "" in
-    Printf.printf "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
+    Printf.fprintf log "\n%sThis algo is silent after %i move%s, %i step%s, %i round%s.\n%!"
       str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
     print_string "\nq\n#quit\n%!"; 
-    flush_all()
+    flush_all();
+    i  
     
   | Legitimate i ->
     let str = if st.sasarg.rif then "#" else "" in
-    Printf.printf
+    Printf.fprintf log
       "\n%s%sThis algo reached a legitimate configuration after %i move%s, %i step%s, %i round%s.\n%!"
       (if st.sasarg.rif then "#" else "#")
       str !moves (plur !moves) i (plur i) !rounds (plur !rounds);
-    print_string "\n#quit\n"; 
-    flush_all()
+    Printf.fprintf log "\n#quit\n"; 
+    flush_all();
+    i
+
+
+
+
+let () =
+  let st = Sasacore.SimuState.make true Sys.argv in
+  let log = open_out (st.sasarg.topo ^ ".log") in
+  let newdot_fn = (Filename.chop_extension st.sasarg.topo) ^ "_wi.dot" in 
+  let newdot = open_out newdot_fn in
+  let n = st.sasarg.length in
+  try
+    match st.sasarg.init_search_max_trials with
+    | None ->
+      ignore (simuloop stdout n n "" st)
+    | Some maxt ->
+      let i = ref 1 in
+      let run s =
+        moves :=  0;
+        rounds :=  0;
+        round_mask := [];
+        Printf.fprintf log "-------------------------- New simu (%d) \n%!" !i;
+        let s = SimuState.update_config s.config s in
+        let res = simuloop log n n "" s in
+        Printf.fprintf log "initial conf=(%s)\n%!" (StringOf.env_rif s.config s.network);
+        incr i;
+        res
+      in
+      let st = (WorstInit.fchc log run st maxt) in
+      Printf.printf  " (%s)\n%!" (StringOf.env_rif st.config st.network);
+      Printf.fprintf newdot "%s\n" (SimuState.to_dot st);
+      Printf.printf "%s and %s have been generated\n"  (st.sasarg.topo ^ ".log") newdot_fn;
+      flush_all();
+      close_out newdot;
+      close_out log
+  with
   | e ->
      Printf.printf "%s%s\n%!" (if st.sasarg.rif then "#" else "") (Printexc.to_string e);
      print_string "\nq\n#quit\n%!";
      flush_all();
      exit 2
-           
+

test/Makefile.dot

-# Time-stamp: <modified the 27/07/2021 (at 10:44) by Erwan Jahier>
+# Time-stamp: <modified the 02/09/2021 (at 10:38) by Erwan Jahier>
 
 # Rules to generate various dot files.
 # The DECO_PATTERN variable should be defined
 
 grid%.dot:
-	gg grid -w $* -he $* -o $@
+	gg grid -w $* -he $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 clique%.dot:
-	gg clique -n $* -o $@
+	gg clique -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 er%.dot:
-	gg ER --connected -p 0.1 -n $* -o $@
+	gg ER --connected -p 0.1 -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 
 ba%.dot:
-	gg BA -n $* -o $@
+	gg BA -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 udg%.dot:
-	gg UDG -n $* -w 10 -o $@
+	gg UDG -n $* -w 10 -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 qudg%.dot:
-	gg QUDG -n $* -w 10 -o $@
+	gg QUDG -n $* -w 10 -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 ring%.dot:
-	gg ring -n $* -o $@
+	gg ring -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 diring%.dot:
-	gg ring -dir -n $* -o $@
+	gg ring -dir -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 tree%.dot:
-	gg tree -n $* -o $@
+	gg tree -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 intree%.dot:
-	gg tree --in-tree -n $* -o $@
+	gg tree --in-tree -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 outtree%.dot:
-	gg tree --out-tree -n $* -o $@
+	gg tree --out-tree -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 inouttree%.dot:
-	gg tree --in-out-tree -n $* -o $@
+	gg tree --in-out-tree -n $* -o $@ $(SEED)
 	gg-deco $(DECO_PATTERN) $@ -o $@
 
 

test/Makefile.inc

-# Time-stamp: <modified the 01/09/2021 (at 10:26) by Erwan Jahier>
+# Time-stamp: <modified the 02/09/2021 (at 10:34) by Erwan Jahier>
 #
 # Define some default rules that ought to work most of the time
 #
@@ -72,7 +72,11 @@ $(EXPDIR):
 
 # update the reference
 %.ugm_test: %.rif $(EXPDIR)
-	cp $*.rif $(EXPDIR)/$*.rif.exp 
+	cp $*.rif $(EXPDIR)/$*.rif.exp
+
+# fix the seed (in Makefile.dot) for the non-regression tests
+SEED=--seed 42
+
 ############################################################################################
 
 

test/dijkstra-ring/config.ml

@@ -10,22 +10,25 @@ open State
   * 2 2 2 3 0 1 3 -> convex
   * 2 4 5 3 0 1 3 -> convex
   * 2 2 2 3 0 2 3 -> not convex
-  *)
+*)
+module IntSet = Set.Make(Int)
+    
 let compute_Z root root_st (get: Algo.pid -> State.t * (State.t Algo.neighbor * Algo.pid) list) = 
   let v = root_st.v in
-  let used = Array.make (card () + 1) false in
+  let used = ref IntSet.empty in
   let rec convex pid encountered res =
     (* Printf.eprintf (if encountered then "<" else "|"); *)
     (* Printf.eprintf (if res then ">" else "|"); *)
     let next_st, next = 
       match get pid with 
-      (_, [s,n]) -> state s, n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
+        (_, [s,n]) -> state s, n | _ ->
+                failwith "Can't compute the cost of a topology that is not a directed ring"
     in
     if next = root then res
     else
     let next_v = next_st.v in
     (* Printf.eprintf "%s %d" next next_v; *)
-    used.(next_v) <- true;
+    used := IntSet.add next_v !used;
     convex next (encountered || next_v = v) (res && (not encountered || next_v = v))
   in
   if convex root false true
@@ -33,7 +36,7 @@ let compute_Z root root_st (get: Algo.pid -> State.t * (State.t Algo.neighbor *
   else
     let rec get_min_free cur_val dist =
       if cur_val = v then assert false;
-      if not used.(cur_val) then dist
+      if not (IntSet.mem cur_val !used) then dist
       else
         get_min_free ((cur_val + 1) mod (card () + 1)) (dist + 1)
     in
@@ -48,14 +51,16 @@ let compute_sd (root: pid) (get: Algo.pid -> State.t * (State.t Algo.neighbor *
     else
     let st, ((n_state, neighbor): 's * pid) = 
       match get pid with 
-      (st, [n]) -> st, n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
+        (st, [n]) -> st, n | _ ->
+                failwith "Can't compute the cost of a topology that is not a directed ring"
     in
     let total = if (P.enable_f st [n_state]) <> [] then total + rang else total in
     compute neighbor total (rang+1)
   in
   let succ: pid = 
     match get root with 
-    (_, [_, n]) -> n | _ -> failwith "Can't compute the cost of a topology that is not a directed ring"
+      (_, [_, n]) -> n | _ ->
+            failwith "Can't compute the cost of a topology that is not a directed ring"
   in
   compute succ 0 1
 ;;
@@ -101,3 +106,11 @@ let (legitimate: pid list -> (pid -> t * (t neighbor * pid) list) -> bool) =
   token_nb = 1
 
 let legitimate = Some legitimate
+
+let s2n s = [I s.v]
+let n2s nl s =
+  match nl with
+  | [I i] ->  { s with v = i }
+  | _ -> assert false
+    
+let for_init_search = Some (s2n, n2s)

test/dijkstra-ring/ring.dot

 digraph ring7 {
  graph [k=3]  
 
- root [algo="root.ml" init="{root=1;v=1}" ]
- p2   [algo="p.ml" init="{root=0;v=3}" ]
- p3   [algo="p.ml" init="{root=0;v=3}" ]
- p4   [algo="p.ml" init="{root=0;v=2}" ]
- p5   [algo="p.ml" init="{root=0;v=2}" ]
- p6   [algo="p.ml" init="{root=0;v=1}" ]
- p7   [algo="p.ml" init="{root=0;v=1}" ]
+ root [algo="root.ml" init="{root=1;v=0}" ]
+ p2   [algo="p.ml" init="{root=0;v=0}" ]
+ p3   [algo="p.ml" init="{root=0;v=0}" ]
+ p4   [algo="p.ml" init="{root=0;v=0}" ]
+ p5   [algo="p.ml" init="{root=0;v=0}" ]
+ p6   [algo="p.ml" init="{root=0;v=0}" ]
+ p7   [algo="p.ml" init="{root=0;v=0}" ]
  p8   [algo="p.ml" init="{root=0;v=0}" ]
 
  root -> p2 -> p3 -> p4 -> p5 -> p6 -> p7 -> p8 -> root 

test/dijkstra-ring/state.ml

@@ -2,8 +2,23 @@
 
 type t = { root: bool ; v : int } (* semi-anonymous network: we know who is the root! *)
 let to_string s = Printf.sprintf "c=%i" s.v
+let first = ref true
 let (of_string: (string -> t) option) =
-  Some (fun s ->
-    Scanf.sscanf s "{root=%d;v=%d}" (fun i1 i2 -> { root = i1<>0; v = i2 } ))
+    Some (fun s ->
+        try (* if the root node is not explicitly set in the dot file, we
+               consider the first one to be the root *)
+          Scanf.sscanf s "{root=%d;v=%d}" (fun i1 i2 -> { root = i1<>0; v = i2 } )
+        with
+          _  ->
+          try
+            let res = Scanf.sscanf s "c=%d" (fun i -> { root = !first; v = i } ) in
+            first := false;
+            res
+          with
+            _  ->
+              Printf.printf "state.m: Unable to parse the initial state in the .dot: '%s'\n%!" s;
+              assert false
+    )
+    
 let copy x = x
 let actions = ["T"]

tools/gg/graphGen.ml

@@ -279,7 +279,11 @@ let () = (
          exit 2
       | Some g -> g
     in
+    (match t.seed with
+     | None ->  Random.self_init ()
+     | Some i ->     Random.init i
+    );
     make_dot g t.outputFile (all_attr t.rooted t.diameter g);
     if (t.outputFile <> "" && not t.silent)
     then Printf.printf "Done.\nOutput file : '%s'\n" t.outputFile
-  )
+)

tools/gg/graphGen_arg.ml

-let () = Random.self_init ();
 
 type action = string
 
@@ -32,6 +31,7 @@ type t = {
   mutable ba : ba_m;
   mutable qudg : qudg_arg;
 
+  mutable seed : int option;
   mutable silent : bool;
   mutable connected : bool;
   mutable directed : bool;
@@ -83,8 +83,8 @@ let (make_args : unit -> t) =
       r1 = 2.;
       p = 0.5;
     };
-
-
+  
+    seed = None;  
     silent = false;
     connected = false;
     directed = false;
@@ -301,6 +301,10 @@ let (mkoptab : string array -> t -> unit) =
         "Same as the option '-du', but with the two radiuses being ";
            "also displayed.\n"],"QUDG")];
 
+    mkopt args  ["--seed";"-seed"]
+      (Arg.Int(fun i -> args.seed <- Some i))
+      [(["Set the pseudo-random generator seed"],"void")];
+
     mkopt args ["--silent";"-s"]
       (Arg.Unit (fun () -> args.silent <- true))
       [(["be quiet"],"void")];

tools/gg/graphGen_arg.mli

@@ -30,6 +30,7 @@ type t = {
   mutable ba : ba_m;
   mutable qudg : qudg_arg;
 
+  mutable seed : int option;
   mutable silent : bool;
   mutable connected : bool;
   mutable directed : bool;