summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--sources/thibaut/globals.ml8
-rw-r--r--sources/thibaut/graph.ml48
-rw-r--r--sources/thibaut/mesh.ml28
-rw-r--r--sources/thibaut/simulator.ml18
-rw-r--r--sources/thibaut/trace.ml4
5 files changed, 81 insertions, 25 deletions
diff --git a/sources/thibaut/globals.ml b/sources/thibaut/globals.ml
index fe45e48..5dfa722 100644
--- a/sources/thibaut/globals.ml
+++ b/sources/thibaut/globals.ml
@@ -261,6 +261,12 @@ type peer = {
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 history : (int * (int HashMap.t list)) RoundMap.t; (* seed, branch *)
+ mutable distance : int
}
and slot = peer SlotArray.slot
+
+let disconnect peer =
+ SlotArray.clear peer.slots;
+ peer.con_state <- OFF;
+ peer.distance <- -1;
diff --git a/sources/thibaut/graph.ml b/sources/thibaut/graph.ml
new file mode 100644
index 0000000..28cd19d
--- /dev/null
+++ b/sources/thibaut/graph.ml
@@ -0,0 +1,48 @@
+open Globals
+
+exception Found of peer
+
+let find_peer id peers =
+ 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
+ with
+ Found p -> p
+
+(* compute distances from root *)
+let distances peers =
+ 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 = find_peer id peers in
+ let aux p =
+ if not visited.(p.id) then begin
+ visited.(p.id) <- true;
+ p.distance <- peer.distance + 1;
+ Queue.push p.id queue
+ end
+ in
+ SlotArray.iter (fun (SlotArray.Peer p) -> aux p) peer.slots
+ done
+
+let repart peers =
+ let n = Array.length peers in
+ let result = Array.make 20 0 in
+ for i = 0 to n-1 do
+ let peer = peers.(i) in
+ if peer.distance < 19 && peer.con_state = ON then
+ result.(peer.distance + 1 ) <- result.(peer.distance + 1 ) +1
+ done;
+ result
+
+
+
diff --git a/sources/thibaut/mesh.ml b/sources/thibaut/mesh.ml
index e62553d..4060b91 100644
--- a/sources/thibaut/mesh.ml
+++ b/sources/thibaut/mesh.ml
@@ -1,5 +1,5 @@
open Globals
-open Globals.SlotArray
+open SlotArray
let ask = ref 0
let askroot = ref 0
@@ -12,7 +12,9 @@ let equal a b = match a with
(* p is asking n slots to root *)
let ask_root root p =
incr askroot;
- if not (SlotArray.full root.slots) then begin
+ 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
@@ -27,25 +29,23 @@ let ask_peer peer p =
AskRoot
else if p.con_state <> ON then
AskRoot
- else begin
- if SlotArray.test (equal (Peer peer)) p.slots then begin
- match SlotArray.random_peer_avoid (equal (Peer peer)) p.slots with
- | Peer x -> Ask x
- | AskRoot -> AskRoot
- | _ -> failwith "Something is very wrong."
- end
- 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
+ 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."
let is_active slot = match slot with
| Peer p -> p.con_state = ON
| _ -> failwith "Big problem"
+
let do_peer root peer =
diff --git a/sources/thibaut/simulator.ml b/sources/thibaut/simulator.ml
index 425de91..c59b939 100644
--- a/sources/thibaut/simulator.ml
+++ b/sources/thibaut/simulator.ml
@@ -3,7 +3,7 @@ open Globals
open Mesh
open Graph
-let degree = ref 1000
+let degree = ref 10
let tpm = ref 3
let accuracy = ref 60
let duration = ref 24
@@ -47,7 +47,8 @@ let peers = Array.init npeers (fun i -> {
slots = SlotArray.make !degree;
rounds_data = RoundMap.empty;
messages = Queue.create();
- history = RoundMap.empty
+ history = RoundMap.empty;
+ distance = -1
})
let do_trace_round = Trace.read ic peers
@@ -58,7 +59,7 @@ let connected = ref 0
let _ =
for i = 0 to (nticks-1) do
- connected := 0;
+ connected := 1;
Pacemaker.messages := 0;
if i mod !accuracy = 0 then begin
incr round;
@@ -95,20 +96,21 @@ let _ =
Printf.printf "Askroots: %d" !Mesh.askroot;
print_newline ();
- let rep = repart (distances peers) in
+ distances peers;
+ let rep = repart peers in
for i = 0 to Array.length rep - 1 do
Printf.printf "%d, " rep.(i)
done;
print_newline ();
-
- for i = 0 to (npeers-1) do
+ (*for i = 0 to (npeers-1) do
let p = peers.(i) in
if p.con_state = ON then begin
- Printf.printf "%d: " p.id;
+ Printf.printf "%d: %d | " p.id distance.(p.id);
SlotArray.iter (fun (SlotArray.Peer p) -> Printf.printf "%d, " p.id ) p.slots;
print_newline ()
end
- done;
+ done;*)
+
Mesh.ask := 0;
Mesh.askroot := 0;
end
diff --git a/sources/thibaut/trace.ml b/sources/thibaut/trace.ml
index 627cbe3..fb139ea 100644
--- a/sources/thibaut/trace.ml
+++ b/sources/thibaut/trace.ml
@@ -70,8 +70,8 @@ let read ic peers =
match !event with
| Round n -> if n = round then next round
| On i -> peers.(i).con_state <- ON; next round
- | Off i -> SlotArray.clear peers.(i).slots;
- peers.(i).con_state <- OFF; next round
+ | Off i -> disconnect peers.(i);
+ next round
| _ -> ()
and next round = get_event(); read_round round in
generated by cgit v1.2.3-70-g09d2 (git 2.52.0) at 2025-12-21 16:49:57 +0000