From 707855e847874baaf9fa6ec5f5259a1768967363 Mon Sep 17 00:00:00 2001 From: thibauth Date: Mon, 6 Jun 2011 07:23:36 +0000 Subject: Code cleanup, add makefile. git-svn-id: https://scm.gforge.inria.fr/svn/pacemaker@19 30fcff6e-8de6-41c7-acce-77ff6d1dd07b --- sources/thibaut/Makefile | 27 +++++ sources/thibaut/gentrace.ml | 73 ++++++++++++++ sources/thibaut/pacemaker.ml | 180 +++++++++++++++++++++++++++++++++ sources/thibaut/simul.ml | 233 ------------------------------------------- sources/thibaut/simulator.ml | 54 ++++++++++ sources/thibaut/trace.ml | 93 +++++------------ 6 files changed, 360 insertions(+), 300 deletions(-) create mode 100644 sources/thibaut/Makefile create mode 100644 sources/thibaut/gentrace.ml create mode 100644 sources/thibaut/pacemaker.ml delete mode 100644 sources/thibaut/simul.ml create mode 100644 sources/thibaut/simulator.ml diff --git a/sources/thibaut/Makefile b/sources/thibaut/Makefile new file mode 100644 index 0000000..79583d1 --- /dev/null +++ b/sources/thibaut/Makefile @@ -0,0 +1,27 @@ +OCAMLC=ocamlc +OCAMLOPT=ocamlopt +OCAMLDEP=ocamldep +INCLUDES= +OCAMLFLAGS=$(INCLUDES) +SRCS=map.ml simulator.ml trace.ml gentrace.ml pacemaker.ml + + +simulator.opt : simulator.cmx + $(OCAMLOPT) -o simulator $(OCAMLFLAGS) map.cmx pacemaker.cmx simulator.cmx + +clean: + rm -f *.cm? *.cmx? *.o *~ + +depend: $(SRCS) + $(OCAMLDEP) $(OCAMLFLAGS) $(SRCS) > .depend + +.SUFFIXES: .mli .ml .cmo .cmi .cmx + +%.cmo : %.ml + $(OCAMLC) -c $(OCAMLFLAGS) $< +%.cmi : %.mli + $(OCAMLC) -c $(OCAMLFLAGS) $< +%.cmx : %.ml + $(OCAMLOPT) -c $(OCAMLFLAGS) $< + +-include .depend \ No newline at end of file diff --git a/sources/thibaut/gentrace.ml b/sources/thibaut/gentrace.ml new file mode 100644 index 0000000..ea12bf5 --- /dev/null +++ b/sources/thibaut/gentrace.ml @@ -0,0 +1,73 @@ +open Trace + +let ndays = ref 0 +let npeers = ref 0 +let filename = ref "" +let seed = ref 0 + +let anon = + 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") + +let usage = "usage: gentrace [OPTIONS] " +let arg_list = [ + "--seed", Arg.Set_int seed, " 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 + +let oc = open_out !filename + +let _ = + output oc (Peers !npeers); + output oc (Days !ndays) + +let peers = Array.init !npeers (fun i -> + let avail = 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 = 1./. (float_of_int session_length) in + let lambda = mu*.(1.-.avail)/.avail in + output oc (Peer (i, avail, state)); + { + id = i; + 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.state = OFF && r < p.lambda then begin + p.state <- ON; + output oc (On p.id) + end else if p.state = ON && r < p.mu then begin + p.state <- OFF; + output oc (Off p.id) + end + in + Array.iter aux peers + done; + output oc End diff --git a/sources/thibaut/pacemaker.ml b/sources/thibaut/pacemaker.ml new file mode 100644 index 0000000..7a26a47 --- /dev/null +++ b/sources/thibaut/pacemaker.ml @@ -0,0 +1,180 @@ +type phase = SEEDING | IDLE +type state = ON | OFF +type peer_id = int + +module PeerId = struct + type t = peer_id + let compare = Pervasives.compare +end + +module Int = struct + type t = int + let compare a b = - (Pervasives.compare a b) +end + +module HashMap = Map.Make(PeerId) + +module RoundMap = Map.Make(Int) + +type message_content = + | 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 +} + +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 +} + +type peer = { + id : peer_id; + mutable con_state : state; + neighbours : node array; + mutable rounds_data : round_data RoundMap.t; + messages : message Queue.t; + mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *) +} and + +node = None | Some of peer + +let find_reply hash replies = + let rec aux n replies = match replies with + | [] -> raise Not_found + | h::t -> let (a,b) = h in + if a = hash then n,b + else aux (n+1) t + in + aux 1 replies + +let peer_init_round peer round seed duration = + let data = { + phase = SEEDING; + duration = duration; + seed = seed; + hmap = HashMap.add peer.id (Hashtbl.hash seed) HashMap.empty; + included = 0; + replies = [] + } in + peer.rounds_data <- RoundMap.add round data peer.rounds_data + +let send_message message receiver = match receiver with + | None -> () + | Some peer -> Queue.push message peer.messages + +let server_init_seed peer round duration = + let data = { + phase = SEEDING; + duration = duration; + seed = Random.int (1 lsl 29); + hmap = HashMap.empty; + included = 0; + replies = [] + } in + peer.rounds_data <- RoundMap.add round data peer.rounds_data; + let message = { + sender = peer.id; + round = round; + content = Seed (data.seed, data.duration) + } in + Array.iter (send_message message) peer.neighbours + +let server_init_pulse peer round = + let data = RoundMap.find round peer.rounds_data in + data.phase <- IDLE; + let message = { + sender = peer.id; + round = round; + content = Pulse (data.seed, [data.hmap]) + } in + Array.iter (send_message message) peer.neighbours + +let rec verify_branch branch = match branch with + | [] -> true + | [h] -> true + | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t) + +let process_message peer m = match m.content with + | Seed(seed,duration) -> + if not (RoundMap.mem m.round peer.rounds_data) then + peer_init_round peer m.round seed duration; + let message = { + sender = peer.id; + round = m.round; + content = Seed(seed, duration) + } in + Array.iter (send_message message) peer.neighbours + | SeedReply(hash) -> + begin try + let data = RoundMap.find m.round peer.rounds_data in + if data.phase = SEEDING then + 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 + match branch with + | [] -> () + | h::t -> try + let hash = HashMap.find peer.id h in + let n,hmap = find_reply hash data.replies in + if data.included > n && verify_branch branch + then begin + let branch2 = hmap::branch in + data.included <- n; + data.phase <- IDLE; + let message = { + sender = peer.id; + round = m.round; + content = Pulse(seed, branch2) + } in + Array.iter (send_message message) peer.neighbours; + peer.history <- RoundMap.add m.round + (seed, branch2) + peer.history + end + with + | Not_found -> () + with + Not_found -> () + end + +let do_peer peer = + Queue.iter (process_message peer) peer.messages; + Queue.clear peer.messages; + try + let aux round data = + if data.phase = SEEDING then begin + let hash = Hashtbl.hash data.hmap in + data.replies <- (hash, data.hmap)::data.replies; + let message = { + sender = peer.id; + round = round; + content = SeedReply(Hashtbl.hash data.hmap) + } in + Array.iter (send_message message) peer.neighbours; + end else + failwith "not seeding" + in + RoundMap.iter aux peer.rounds_data + with + Failure _ -> () + +let do_server peer = + let aux m = match m.content with + | SeedReply _ -> process_message peer m + | _ -> () + in + Queue.iter aux peer.messages; + Queue.clear peer.messages \ No newline at end of file diff --git a/sources/thibaut/simul.ml b/sources/thibaut/simul.ml deleted file mode 100644 index cd6ae54..0000000 --- a/sources/thibaut/simul.ml +++ /dev/null @@ -1,233 +0,0 @@ -type phase = SEEDING | IDLE -type state = ON | OFF -type peer_id = int - -module PeerId = struct - type t = peer_id - let compare = Pervasives.compare -end - -module Int = struct - type t = int - let compare a b = - (Pervasives.compare a b) -end - -module HashMap = Map.Make(PeerId) - -module RoundMap = Map.Make(Int) - -type message_content = - | 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 -} - -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 -} - -type peer = { - id : peer_id; - mutable con_state : state; - neighbours : node array; - mutable rounds_data : round_data RoundMap.t; - messages : message Queue.t; - mutable history : (int * (int HashMap.t list)) RoundMap.t (* seed, branch *) -} and - -node = None | Some of peer - -let find_reply hash replies = - let rec aux n replies = match replies with - | [] -> raise Not_found - | h::t -> let (a,b) = h in - if a = hash then n,b - else aux (n+1) t - in - aux 1 replies - -let peer_init_round peer round seed duration = - let data = { - phase = SEEDING; - duration = duration; - seed = seed; - hmap = HashMap.add peer.id (Hashtbl.hash seed) HashMap.empty; - included = 0; - replies = [] - } in - peer.rounds_data <- RoundMap.add round data peer.rounds_data - -let send_message message receiver = match receiver with - | None -> () - | Some peer -> Queue.push message peer.messages - -let server_init_seed peer round duration = - let data = { - phase = SEEDING; - duration = duration; - seed = Random.int (1 lsl 29); - hmap = HashMap.empty; - included = 0; - replies = [] - } in - peer.rounds_data <- RoundMap.add round data peer.rounds_data; - let message = { - sender = peer.id; - round = round; - content = Seed (data.seed, data.duration) - } in - Array.iter (send_message message) peer.neighbours - -let server_init_pulse peer round = - let data = RoundMap.find round peer.rounds_data in - data.phase <- IDLE; - let message = { - sender = peer.id; - round = round; - content = Pulse (data.seed, [data.hmap]) - } in - Array.iter (send_message message) peer.neighbours - -let rec verify_branch branch = match branch with - | [] -> true - | [h] -> true - | h1::h2::t -> (HashMap.mem (Hashtbl.hash h1) h2 && verify_branch t) - -let process_message peer m = match m.content with - | Seed(seed,duration) -> - if not (RoundMap.mem m.round peer.rounds_data) then - peer_init_round peer m.round seed duration; - let message = { - sender = peer.id; - round = m.round; - content = Seed(seed, duration) - } in - Array.iter (send_message message) peer.neighbours - | SeedReply(hash) -> - begin try - let data = RoundMap.find m.round peer.rounds_data in - if data.phase = SEEDING then - 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 - match branch with - | [] -> () - | h::t -> try - let hash = HashMap.find peer.id h in - let n,hmap = find_reply hash data.replies in - if data.included > n && verify_branch branch - then begin - let branch2 = hmap::branch in - data.included <- n; - data.phase <- IDLE; - let message = { - sender = peer.id; - round = m.round; - content = Pulse(seed, branch2) - } in - Array.iter (send_message message) peer.neighbours; - peer.history <- RoundMap.add m.round - (seed, branch2) - peer.history - end - with - | Not_found -> () - with - Not_found -> () - end - -let do_peer peer = - Queue.iter (process_message peer) peer.messages; - Queue.clear peer.messages; - try - let aux round data = - if data.phase = SEEDING then begin - let hash = Hashtbl.hash data.hmap in - data.replies <- (hash, data.hmap)::data.replies; - let message = { - sender = peer.id; - round = round; - content = SeedReply(Hashtbl.hash data.hmap) - } in - Array.iter (send_message message) peer.neighbours; - end else - failwith "not seeding" - in - RoundMap.iter aux peer.rounds_data - with - Failure _ -> () - -let do_server peer = - let aux m = match m.content with - | SeedReply _ -> process_message peer m - | _ -> () - in - Queue.iter aux peer.messages; - Queue.clear peer.messages - -let npeers = ref 0 -let degree = ref 0 -let days = ref 0 -let tpm = ref 0 -let accuracy = ref 0 -let duration = ref 0 -let seed = ref 0 - -let arg_list = [ - "--degree", Arg.Set_int degree, " maximum number of neighbours"; - "--tpm", Arg.Set_int tpm, " number of ticks per minute"; - "--accuracy", Arg.Set_int accuracy, " number of ticks between rounds"; - "--duration", Arg.Set_int duration, " number of ticks during seeding"; - "--seed", Arg.Set_int seed, " random seed" -] - -let usage = "simul [OPTIONS] " - - -let _ = - Arg.parse (Arg.align arg_list) (fun s -> ()) usage; - Random.init !seed - -let peers = Array.init !npeers (fun i -> { - id = i; - con_state = OFF; - neighbours = Array.make !degree None; - rounds_data = RoundMap.empty; - messages = Queue.create(); - history = RoundMap.empty -}) - -let nticks = (!days)*24*60*(!tpm) -let round = ref 0 - -let _ = - for i = 0 to (nticks-1) do - if i mod !accuracy = 0 then begin - incr round; - server_init_seed peers.(0) !round !duration - end - else if i mod !accuracy = !duration then - server_init_pulse peers.(0) !round; - - do_server peers.(0); - for i = 1 to (!npeers-1) do - let peer = peers.(i) in - if peer.con_state = ON then - do_peer peer - done - done - diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml new file mode 100644 index 0000000..e097d4d --- /dev/null +++ b/sources/thibaut/simulator.ml @@ -0,0 +1,54 @@ +open Pacemaker + +let npeers = ref 0 +let degree = ref 0 +let days = ref 0 +let tpm = ref 0 +let accuracy = ref 0 +let duration = ref 0 +let seed = ref 0 + +let arg_list = [ + "--degree", Arg.Set_int degree, " maximum number of neighbours"; + "--tpm", Arg.Set_int tpm, " number of ticks per minute"; + "--accuracy", Arg.Set_int accuracy, " number of ticks between rounds"; + "--duration", Arg.Set_int duration, " number of ticks during seeding"; + "--seed", Arg.Set_int seed, " random seed" +] + +let usage = "usage: simul [OPTIONS] " + +let _ = + Arg.parse (Arg.align arg_list) (fun s -> ()) usage; + Random.init !seed + +let peers = Array.init !npeers (fun i -> { + id = i; + con_state = OFF; + neighbours = Array.make !degree None; + rounds_data = RoundMap.empty; + messages = Queue.create(); + history = RoundMap.empty +}) + +let nticks = (!days)*24*60*(!tpm) +let round = ref 0 + +let _ = + for i = 0 to (nticks-1) do + if i mod !accuracy = 0 then begin + incr round; + server_init_seed peers.(0) !round !duration + end + else if i mod !accuracy = !duration then + server_init_pulse peers.(0) !round; + + do_server peers.(0); + for i = 1 to (!npeers-1) do + let peer = peers.(i) in + if peer.con_state = ON then + do_peer peer + done + done + + diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml index 3a3ac44..2ee7c2a 100644 --- a/sources/thibaut/trace.ml +++ b/sources/thibaut/trace.ml @@ -29,13 +29,13 @@ let output oc trace_event = 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 + | 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" - | Exponential -> print "Exponential\n" + | _ -> failwith "Invalid event" let input ic = let line = input_line ic in @@ -49,70 +49,29 @@ let input ic = | ["Off"; i] -> Off (int_of_string i) | _ -> failwith (Printf.sprintf "Bad line [%s]" (String.escaped line)) -let ndays = ref 0 -let npeers = ref 0 -let filename = ref "" -let seed = ref 0 - -let anon = - 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") - -let usage = "gentrace [OPTIONS] " -let arg_list = [ - "--seed", Arg.Set_int seed, " random seed" -] - -let _ = - 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) - -let peers = Array.init !npeers (fun i -> - let avail = 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 = 1./. (float_of_int session_length) in - let lambda = mu*.(1.-.avail)/.avail in - output oc (Peer (i, avail, state)); - { - id = i; - 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.state = OFF && r < p.lambda then begin - p.state <- ON; - output oc (On p.id) - end else if p.state = ON && r < p.mu then begin - p.state <- OFF; - output oc (Off p.id) - end - in - Array.iter aux peers +let read 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 + for i = 0 to npeers do + match input ic with + | Peer (i, avail, state) -> () + | _ -> failwith "Not enough peers" done; - output oc End + let event = ref (input ic) in + let get_event () = event := (input ic) in + let rec read_round round peers = + match !event with + | Round n -> if n = round then next round peers + | On i -> peers.(i).Pacemaker.state <- ON; next round peers + | Off i -> peers.(i).Pacemaker.state <- OFF; next round peers + | _ -> () + + and next round peers = get_event(); read_round round peers in + npeers, ndays, read_round -- cgit v1.2.3-70-g09d2