Skip to content
Snippets Groups Projects
p.ml 1.91 KiB
Newer Older
(* Time-stamp: <modified the 21/06/2019 (at 17:58) by Erwan Jahier> *)

(* This is algo 5.4 in the book *)

open Algo


type state = {
  d:int;
  par:int;
}
let (state_to_string: ('v -> string)) =
  fun s ->
    Printf.sprintf "d=%d par=%d" s.d s.par

let (parse_state: string -> state) =
  fun s ->
    Printf.eprintf "Calling parse_state!\n";flush stderr;
    Scanf.sscanf s "{d=%d;par=%d}" (fun d par -> {d = d; par = par})

let (copy_state : ('v -> 'v)) = fun x -> x


let (init_state: int -> 'v) =
  fun i ->
    {
      d = Random.int d;
      par = Random.int i;
    }   

let (dist: 'v neighbor list -> int) = fun nl -> 
  let dl = List.map (fun n -> n.state.d) nl in
  1+(List.fold_left min (d-1) dl)

let (dist_ok: 'v neighbor list -> 'v -> bool) =
    let dl = List.map (fun n -> n.state.d) nl in
    let md = List.fold_left min (List.hd dl) (List.tl dl) in
    e.d - 1 = md
let (get_parent: 'v neighbor list -> 'v -> 'v neighbor) =
  fun nl e ->
    try List.nth nl canal
    with Failure _ ->
      failwith (Printf.sprintf "Canal %i does not exist (canal in [0..%i])\n"
                  canal ((List.length nl)-1)) 
let (enable_f:'v neighbor list -> 'v -> action list) =
  fun nl e -> 
    let par = get_parent nl e in
    let par_st = par.state in
    (if  (e.d) <> dist nl then ["CD"] else []) @
    (if (dist_ok nl e) && ( par_st.d <> e.d - 1) then ["CP"] else [])


let (index_of_first_true : bool list -> int) = fun bl -> 
  let rec f i = 
  function
  | [] -> assert false
  | false::tail -> f (i+1) tail
  | true::_ -> i
 in
 f 0 bl
   
let (step_f : 'v neighbor list -> 'v -> action -> 'v) =
  fun nl e -> 
    function
    | "CD" -> { e with d = dist nl } 
    | "CP" ->
      let ok_l = List.map (fun n ->  n.state.d = e.d-1) nl in
      let q = index_of_first_true ok_l in
    | _ -> assert false