Contact Graph Routing for time-varying satellite networks
cgr: Add large-scale tests and SGP4 simulation
- Add Cgr_gen module with synthetic contact plan generators:
ring, mesh, random_topology, time_varying, constellation
- Add 6 large-scale tests: 10-100 node rings, meshes, constellation
- Add SGP4-based contact generation from real TLE data
- Include example with 15 Starlink satellites (538 contacts, 100% routability)
+588
-1
+45
example/starlink.tle
+45
example/starlink.tle
···
1
+
STARLINK-1008
2
+
1 44714U 19074B 26034.10858321 -.00000474 00000+0 -36567-5 0 9992
3
+
2 44714 53.1593 339.5849 0001299 80.4695 279.6453 15.31021178343579
4
+
STARLINK-1012
5
+
1 44718U 19074F 26034.13533931 .00000551 00000+0 30742-4 0 9998
6
+
2 44718 53.1596 339.3072 0001402 95.3674 264.7487 15.30198845343577
7
+
STARLINK-1017
8
+
1 44723U 19074L 26034.08160182 .00013033 00000+0 58634-3 0 9990
9
+
2 44723 53.0461 330.7618 0002775 97.7299 262.4012 15.21437281343699
10
+
STARLINK-1019
11
+
1 44724U 19074M 26034.58335647 .00228917 00000+0 17496-2 0 9995
12
+
2 44724 53.0489 306.9433 0011203 82.9458 10.6482 15.70884486 5808
13
+
STARLINK-1020
14
+
1 44725U 19074N 26034.31694539 .00001827 00000+0 14140-3 0 9998
15
+
2 44725 53.0562 0.9240 0001266 96.3425 263.7708 15.06424821343280
16
+
STARLINK-1031
17
+
1 44736U 19074Z 26034.58335647 .00185585 00000+0 11268-2 0 9992
18
+
2 44736 53.0440 292.0843 0007228 112.3235 48.0489 15.76423710 5965
19
+
STARLINK-1036
20
+
1 44741U 19074AE 26034.58335647 .00088670 00000+0 16114-2 0 9990
21
+
2 44741 53.0557 352.7530 0005028 99.2080 70.6580 15.48813597 5861
22
+
STARLINK-1039
23
+
1 44744U 19074AH 26034.22888187 .00053516 00000+0 25435-2 0 9993
24
+
2 44744 53.0527 13.1223 0005877 73.3777 286.7862 15.18701350343112
25
+
STARLINK-1042
26
+
1 44747U 19074AL 26034.32583353 .00022104 00000+0 42316-3 0 9991
27
+
2 44747 53.0433 259.4358 0003715 91.8857 268.2575 15.47997310344749
28
+
STARLINK-1043
29
+
1 44748U 19074AM 26034.28094475 .00034311 00000+0 57946-3 0 9997
30
+
2 44748 53.0551 0.2107 0002444 46.4392 313.6819 15.51323981343302
31
+
STARLINK-1046
32
+
1 44751U 19074AQ 26034.58335647 .00078349 00000+0 18751-2 0 9992
33
+
2 44751 53.0558 12.5987 0006269 68.7514 258.9636 15.40770158 5894
34
+
STARLINK-1047
35
+
1 44752U 19074AR 26034.44587714 .00011599 00000+0 38422-3 0 9994
36
+
2 44752 53.0709 305.8764 0004990 102.8718 257.2840 15.31756090344095
37
+
STARLINK-1048
38
+
1 44753U 19074AS 26034.10081703 .00081651 00000+0 17337-2 0 9992
39
+
2 44753 53.0561 334.9306 0005842 98.7775 261.3893 15.44327836343639
40
+
STARLINK-1053
41
+
1 44758U 19074AX 26034.04342482 .00117446 00000+0 66328-3 0 9991
42
+
2 44758 53.0314 258.4462 0002496 157.8385 202.2743 15.78307627344710
43
+
STARLINK-1060
44
+
1 44765U 19074BE 26034.23360458 .01052951 61983-3 14262-2 0 9993
45
+
2 44765 53.0368 296.0878 0003325 214.0609 146.0210 16.05890245344182
+255
example/tle_contacts.ml
+255
example/tle_contacts.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Generate contact plans from TLE data using SGP4 propagation.
7
+
8
+
This module computes contact windows between satellites by propagating their
9
+
orbits and checking line-of-sight visibility at regular intervals. *)
10
+
11
+
(** Distance between two positions in km *)
12
+
let distance (p1 : Sgp4.position) (p2 : Sgp4.position) =
13
+
let dx = p1.x -. p2.x in
14
+
let dy = p1.y -. p2.y in
15
+
let dz = p1.z -. p2.z in
16
+
Float.sqrt ((dx *. dx) +. (dy *. dy) +. (dz *. dz))
17
+
18
+
(** Check if two satellites can communicate (simplified: just distance check).
19
+
In reality this would involve:
20
+
- Earth obstruction (line-of-sight through Earth)
21
+
- Antenna patterns
22
+
- Link budget calculations
23
+
24
+
For LEO inter-satellite links, max range is typically 2000-5000 km. *)
25
+
let can_communicate ?(max_range = 5000.) (p1 : Sgp4.position)
26
+
(p2 : Sgp4.position) =
27
+
distance p1 p2 <= max_range
28
+
29
+
(** Propagate TLE to get position at Unix timestamp *)
30
+
let propagate_to state tle unix_time = Sgp4.propagate_to state tle unix_time
31
+
32
+
(** Compute light-time delay between two positions *)
33
+
let light_time (p1 : Sgp4.position) (p2 : Sgp4.position) =
34
+
let c = 299792.458 in
35
+
(* km/s *)
36
+
distance p1 p2 /. c
37
+
38
+
type satellite = {
39
+
name : string;
40
+
tle : Sgp4.tle;
41
+
state : Sgp4.state;
42
+
node : Cgr.Node.t;
43
+
}
44
+
45
+
let satellite_of_tle tle =
46
+
match Sgp4.sgp4_init tle with
47
+
| Error _ -> None
48
+
| Ok state -> Some { name = tle.name; tle; state; node = Cgr.Node.v tle.name }
49
+
50
+
type visibility_state = { in_contact : bool; contact_start : float option }
51
+
(** Track visibility state between a pair of satellites *)
52
+
53
+
(** Generate contacts between satellites over a time window.
54
+
55
+
@param sats List of satellites (parsed and initialized)
56
+
@param start_time Unix timestamp for window start
57
+
@param duration Duration of window in seconds
58
+
@param step Time step for propagation in seconds (default: 60)
59
+
@param max_range Maximum communication range in km (default: 5000)
60
+
@param rate Data rate for generated contacts in bytes/sec *)
61
+
let generate_contacts ?(step = 60.) ?(max_range = 5000.) ~rate sats ~start_time
62
+
~duration =
63
+
let n = List.length sats in
64
+
let sats = Array.of_list sats in
65
+
66
+
(* Track visibility state for each pair *)
67
+
let visibility =
68
+
Array.make_matrix n n { in_contact = false; contact_start = None }
69
+
in
70
+
let contacts = ref [] in
71
+
72
+
(* Close a contact and add it to the list *)
73
+
let close_contact i j time =
74
+
match visibility.(i).(j).contact_start with
75
+
| None -> ()
76
+
| Some start ->
77
+
let from = sats.(i).node in
78
+
let to_ = sats.(j).node in
79
+
(* Compute average OWLT (use midpoint) *)
80
+
let mid_time = (start +. time) /. 2. in
81
+
let owlt =
82
+
match
83
+
( propagate_to sats.(i).state sats.(i).tle mid_time,
84
+
propagate_to sats.(j).state sats.(j).tle mid_time )
85
+
with
86
+
| Ok (p1, _), Ok (p2, _) -> light_time p1 p2
87
+
| _ -> 0.
88
+
in
89
+
let contact =
90
+
Cgr.Contact.v ~from ~to_ ~start ~stop:time ~rate ~owlt ()
91
+
in
92
+
contacts := contact :: !contacts;
93
+
visibility.(i).(j) <- { in_contact = false; contact_start = None }
94
+
in
95
+
96
+
(* Step through time *)
97
+
let end_time = start_time +. duration in
98
+
let time = ref start_time in
99
+
while !time <= end_time do
100
+
(* Propagate all satellites to current time *)
101
+
let positions =
102
+
Array.map (fun sat -> propagate_to sat.state sat.tle !time) sats
103
+
in
104
+
105
+
(* Check visibility for each pair *)
106
+
for i = 0 to n - 1 do
107
+
for j = 0 to n - 1 do
108
+
if i <> j then
109
+
match (positions.(i), positions.(j)) with
110
+
| Ok (pi, _), Ok (pj, _) ->
111
+
let visible = can_communicate ~max_range pi pj in
112
+
let state = visibility.(i).(j) in
113
+
if visible && not state.in_contact then
114
+
(* Contact starts *)
115
+
visibility.(i).(j) <-
116
+
{ in_contact = true; contact_start = Some !time }
117
+
else if (not visible) && state.in_contact then
118
+
(* Contact ends *)
119
+
close_contact i j !time
120
+
| _ -> ()
121
+
done
122
+
done;
123
+
124
+
time := !time +. step
125
+
done;
126
+
127
+
(* Close any remaining contacts *)
128
+
for i = 0 to n - 1 do
129
+
for j = 0 to n - 1 do
130
+
if visibility.(i).(j).in_contact then close_contact i j end_time
131
+
done
132
+
done;
133
+
134
+
!contacts
135
+
136
+
(** Parse TLEs from a multi-line string (standard TLE format) *)
137
+
let parse_tles text =
138
+
let lines = String.split_on_char '\n' text in
139
+
let lines = List.filter (fun s -> String.trim s <> "") lines in
140
+
let rec process acc = function
141
+
| [] -> List.rev acc
142
+
| name :: line1 :: line2 :: rest -> (
143
+
match Sgp4.parse_tle [ name; line1; line2 ] with
144
+
| Ok tle -> (
145
+
match satellite_of_tle tle with
146
+
| Some sat -> process (sat :: acc) rest
147
+
| None -> process acc rest)
148
+
| Error _ -> process acc rest)
149
+
| _ -> List.rev acc
150
+
in
151
+
process [] lines
152
+
153
+
(** Load TLE file *)
154
+
let load_tle_file filename =
155
+
let ic = open_in filename in
156
+
let rec read_all acc =
157
+
match input_line ic with
158
+
| line -> read_all (line :: acc)
159
+
| exception End_of_file ->
160
+
close_in ic;
161
+
String.concat "\n" (List.rev acc)
162
+
in
163
+
read_all []
164
+
165
+
(** Example: Generate contacts for real Starlink satellites *)
166
+
let example () =
167
+
(* Load TLEs from file *)
168
+
let tle_file = "ocaml-cgr/example/starlink.tle" in
169
+
let tle_text =
170
+
try load_tle_file tle_file
171
+
with _ ->
172
+
Printf.eprintf "Could not load %s, using embedded TLEs\n" tle_file;
173
+
{|STARLINK-1008
174
+
1 44714U 19074B 26034.10858321 -.00000474 00000+0 -36567-5 0 9992
175
+
2 44714 53.1593 339.5849 0001299 80.4695 279.6453 15.31021178343579
176
+
STARLINK-1012
177
+
1 44718U 19074F 26034.13533931 .00000551 00000+0 30742-4 0 9998
178
+
2 44718 53.1596 339.3072 0001402 95.3674 264.7487 15.30198845343577
179
+
STARLINK-1017
180
+
1 44723U 19074L 26034.08160182 .00013033 00000+0 58634-3 0 9990
181
+
2 44723 53.0461 330.7618 0002775 97.7299 262.4012 15.21437281343699
182
+
STARLINK-1020
183
+
1 44725U 19074N 26034.31694539 .00001827 00000+0 14140-3 0 9998
184
+
2 44725 53.0562 0.9240 0001266 96.3425 263.7708 15.06424821343280
185
+
STARLINK-1042
186
+
1 44747U 19074AL 26034.32583353 .00022104 00000+0 42316-3 0 9991
187
+
2 44747 53.0433 259.4358 0003715 91.8857 268.2575 15.47997310344749|}
188
+
in
189
+
let sats = parse_tles tle_text in
190
+
Printf.printf "Loaded %d Starlink satellites\n" (List.length sats);
191
+
List.iter (fun s -> Printf.printf " - %s\n" s.name) sats;
192
+
193
+
(* Use epoch time from first TLE as reference *)
194
+
let start_time =
195
+
match sats with sat :: _ -> Sgp4.epoch_unix sat.tle | [] -> 1704067200.
196
+
in
197
+
Printf.printf "\nSimulation start: %.0f (Unix time)\n" start_time;
198
+
199
+
(* Generate contacts for 2 orbits (~180 minutes) *)
200
+
let duration = 10800. in
201
+
let rate = 1_000_000_000. in
202
+
(* 1 Gbps ISL *)
203
+
Printf.printf "Generating contacts over %.0f seconds (%.1f hours)...\n"
204
+
duration (duration /. 3600.);
205
+
206
+
let contacts =
207
+
generate_contacts ~step:30. ~max_range:5000. ~rate sats ~start_time
208
+
~duration
209
+
in
210
+
Printf.printf "Generated %d contacts\n" (List.length contacts);
211
+
212
+
(* Create contact plan *)
213
+
let plan = Cgr.Contact_plan.of_list contacts in
214
+
let nodes = Cgr.Contact_plan.nodes plan in
215
+
Printf.printf "Network has %d nodes\n\n" (List.length nodes);
216
+
217
+
(* Show some contact statistics *)
218
+
Printf.printf "Contact plan summary:\n";
219
+
List.iter
220
+
(fun node ->
221
+
let from_count = List.length (Cgr.Contact_plan.contacts_from plan node) in
222
+
let to_count = List.length (Cgr.Contact_plan.contacts_to plan node) in
223
+
Printf.printf " %s: %d outgoing, %d incoming contacts\n"
224
+
(Cgr.Node.name node) from_count to_count)
225
+
nodes;
226
+
227
+
(* Find routes between all pairs *)
228
+
Printf.printf "\nRouting analysis:\n";
229
+
let total_pairs = ref 0 in
230
+
let routable_pairs = ref 0 in
231
+
List.iter
232
+
(fun src ->
233
+
List.iter
234
+
(fun dst ->
235
+
if not (Cgr.Node.equal src dst) then begin
236
+
incr total_pairs;
237
+
match Cgr.find_route plan ~src ~dst ~time:start_time with
238
+
| Some route ->
239
+
incr routable_pairs;
240
+
Printf.printf " %s -> %s: %d hops, latency %.3f s\n"
241
+
(Cgr.Node.name src) (Cgr.Node.name dst)
242
+
(List.length (Cgr.Route.hops route))
243
+
(Cgr.Route.latency route)
244
+
| None ->
245
+
Printf.printf " %s -> %s: NO ROUTE\n" (Cgr.Node.name src)
246
+
(Cgr.Node.name dst)
247
+
end)
248
+
nodes)
249
+
nodes;
250
+
251
+
Printf.printf "\nRoutability: %d/%d pairs (%.1f%%)\n" !routable_pairs
252
+
!total_pairs
253
+
(100. *. Float.of_int !routable_pairs /. Float.of_int !total_pairs)
254
+
255
+
let () = example ()
+125
gen/cgr_gen.ml
+125
gen/cgr_gen.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Synthetic contact plan generation for testing and benchmarking. *)
7
+
8
+
let ring ~nodes ~duration ~rate =
9
+
(* Ring topology: node i connects to node (i+1) mod n *)
10
+
let n = List.length nodes in
11
+
let nodes = Array.of_list nodes in
12
+
List.init n (fun i ->
13
+
let from = nodes.(i) in
14
+
let to_ = nodes.((i + 1) mod n) in
15
+
Cgr.Contact.v ~from ~to_ ~start:0. ~stop:duration ~rate ())
16
+
17
+
let mesh ~nodes ~duration ~rate =
18
+
(* Full mesh: every node connects to every other node *)
19
+
let contacts = ref [] in
20
+
List.iter
21
+
(fun from ->
22
+
List.iter
23
+
(fun to_ ->
24
+
if not (Cgr.Node.equal from to_) then
25
+
contacts :=
26
+
Cgr.Contact.v ~from ~to_ ~start:0. ~stop:duration ~rate ()
27
+
:: !contacts)
28
+
nodes)
29
+
nodes;
30
+
!contacts
31
+
32
+
let random_topology ~nodes ~edge_prob ~duration ~rate ~seed =
33
+
(* Random graph with given edge probability *)
34
+
Random.init seed;
35
+
let contacts = ref [] in
36
+
List.iter
37
+
(fun from ->
38
+
List.iter
39
+
(fun to_ ->
40
+
if (not (Cgr.Node.equal from to_)) && Random.float 1.0 < edge_prob
41
+
then
42
+
contacts :=
43
+
Cgr.Contact.v ~from ~to_ ~start:0. ~stop:duration ~rate ()
44
+
:: !contacts)
45
+
nodes)
46
+
nodes;
47
+
!contacts
48
+
49
+
let time_varying ~nodes ~intervals ~rate ~seed =
50
+
(* Time-varying contacts: each edge appears in random intervals *)
51
+
Random.init seed;
52
+
let contacts = ref [] in
53
+
List.iter
54
+
(fun from ->
55
+
List.iter
56
+
(fun to_ ->
57
+
if not (Cgr.Node.equal from to_) then
58
+
for _ = 1 to 1 + Random.int intervals do
59
+
let start = Random.float 1000. in
60
+
let duration = 10. +. Random.float 90. in
61
+
contacts :=
62
+
Cgr.Contact.v ~from ~to_ ~start ~stop:(start +. duration) ~rate
63
+
()
64
+
:: !contacts
65
+
done)
66
+
nodes)
67
+
nodes;
68
+
!contacts
69
+
70
+
let constellation ~shells ~sat_per_shell ~ground_stations ~duration ~rate ~owlt
71
+
=
72
+
(* LEO constellation with inter-satellite and ground links *)
73
+
let contacts = ref [] in
74
+
(* Create satellite nodes: shell_i_sat_j *)
75
+
let sats =
76
+
List.init shells (fun shell ->
77
+
List.init sat_per_shell (fun sat ->
78
+
Cgr.Node.v (Printf.sprintf "S%d_%d" shell sat)))
79
+
in
80
+
(* Intra-plane links (satellites in same shell) *)
81
+
List.iter
82
+
(fun shell_sats ->
83
+
let n = List.length shell_sats in
84
+
let arr = Array.of_list shell_sats in
85
+
for i = 0 to n - 1 do
86
+
let from = arr.(i) in
87
+
let to_ = arr.((i + 1) mod n) in
88
+
contacts :=
89
+
Cgr.Contact.v ~from ~to_ ~start:0. ~stop:duration ~rate ()
90
+
:: Cgr.Contact.v ~from:to_ ~to_:from ~start:0. ~stop:duration ~rate ()
91
+
:: !contacts
92
+
done)
93
+
sats;
94
+
(* Inter-plane links (between adjacent shells) *)
95
+
for shell = 0 to shells - 2 do
96
+
let shell1 = List.nth sats shell in
97
+
let shell2 = List.nth sats (shell + 1) in
98
+
List.iter2
99
+
(fun s1 s2 ->
100
+
contacts :=
101
+
Cgr.Contact.v ~from:s1 ~to_:s2 ~start:0. ~stop:duration ~rate ()
102
+
:: Cgr.Contact.v ~from:s2 ~to_:s1 ~start:0. ~stop:duration ~rate ()
103
+
:: !contacts)
104
+
shell1 shell2
105
+
done;
106
+
(* Ground station links (each GS connects to first shell satellites) *)
107
+
List.iteri
108
+
(fun gs_idx gs ->
109
+
let first_shell = List.nth sats 0 in
110
+
(* Each GS has periodic contact windows with visible satellites *)
111
+
let visible_sats = gs_idx mod List.length first_shell in
112
+
let sat = List.nth first_shell visible_sats in
113
+
(* Periodic visibility windows *)
114
+
for window = 0 to 9 do
115
+
let start = Float.of_int window *. (duration /. 10.) in
116
+
let stop = start +. (duration /. 20.) in
117
+
contacts :=
118
+
Cgr.Contact.v ~from:gs ~to_:sat ~start ~stop ~rate ~owlt ()
119
+
:: Cgr.Contact.v ~from:sat ~to_:gs ~start ~stop ~rate ~owlt ()
120
+
:: !contacts
121
+
done)
122
+
ground_stations;
123
+
!contacts
124
+
125
+
let make_nodes n = List.init n (fun i -> Cgr.Node.v (Printf.sprintf "N%d" i))
+53
gen/cgr_gen.mli
+53
gen/cgr_gen.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Synthetic contact plan generation for testing and simulation. *)
7
+
8
+
val make_nodes : int -> Cgr.Node.t list
9
+
(** [make_nodes n] creates [n] nodes named "N0", "N1", ..., "N{n-1}". *)
10
+
11
+
val ring :
12
+
nodes:Cgr.Node.t list -> duration:float -> rate:float -> Cgr.Contact.t list
13
+
(** [ring ~nodes ~duration ~rate] creates a ring topology where each node
14
+
connects to the next. All contacts span the full duration. *)
15
+
16
+
val mesh :
17
+
nodes:Cgr.Node.t list -> duration:float -> rate:float -> Cgr.Contact.t list
18
+
(** [mesh ~nodes ~duration ~rate] creates a full mesh where every node connects
19
+
to every other node. *)
20
+
21
+
val random_topology :
22
+
nodes:Cgr.Node.t list ->
23
+
edge_prob:float ->
24
+
duration:float ->
25
+
rate:float ->
26
+
seed:int ->
27
+
Cgr.Contact.t list
28
+
(** [random_topology ~nodes ~edge_prob ~duration ~rate ~seed] creates a random
29
+
graph where each directed edge exists with probability [edge_prob]. *)
30
+
31
+
val time_varying :
32
+
nodes:Cgr.Node.t list ->
33
+
intervals:int ->
34
+
rate:float ->
35
+
seed:int ->
36
+
Cgr.Contact.t list
37
+
(** [time_varying ~nodes ~intervals ~rate ~seed] creates time-varying contacts
38
+
where each edge appears in 1 to [intervals] random time windows. *)
39
+
40
+
val constellation :
41
+
shells:int ->
42
+
sat_per_shell:int ->
43
+
ground_stations:Cgr.Node.t list ->
44
+
duration:float ->
45
+
rate:float ->
46
+
owlt:float ->
47
+
Cgr.Contact.t list
48
+
(** [constellation ~shells ~sat_per_shell ~ground_stations ~duration ~rate
49
+
~owlt] creates a LEO constellation topology with:
50
+
- [shells] orbital planes, each with [sat_per_shell] satellites
51
+
- Intra-plane links (ring within each shell)
52
+
- Inter-plane links (between adjacent shells)
53
+
- Ground station links with periodic visibility windows *)
+1
-1
test/dune
+1
-1
test/dune
+103
test/test_cgr.ml
+103
test/test_cgr.ml
···
370
370
"arrival at 17.0" true
371
371
(float_eq 17. (Route.arrival_time route))
372
372
373
+
(* ==========================================================================
374
+
Large-scale tests using synthetic contact plans
375
+
========================================================================== *)
376
+
377
+
let test_ring_10 () =
378
+
let nodes = Cgr_gen.make_nodes 10 in
379
+
let contacts = Cgr_gen.ring ~nodes ~duration:1000. ~rate:1_000_000. in
380
+
let plan = Contact_plan.of_list contacts in
381
+
Alcotest.(check int) "10 contacts" 10 (List.length contacts);
382
+
(* Route from N0 to N5 should exist (5 hops clockwise) *)
383
+
let n0 = Node.v "N0" and n5 = Node.v "N5" in
384
+
let route = find_route plan ~src:n0 ~dst:n5 ~time:0. in
385
+
Alcotest.(check bool) "route exists" true (Option.is_some route);
386
+
let route = Option.get route in
387
+
Alcotest.(check int) "5 hops" 5 (List.length (Route.hops route))
388
+
389
+
let test_ring_100 () =
390
+
let nodes = Cgr_gen.make_nodes 100 in
391
+
let contacts = Cgr_gen.ring ~nodes ~duration:1000. ~rate:1_000_000. in
392
+
let plan = Contact_plan.of_list contacts in
393
+
Alcotest.(check int) "100 contacts" 100 (List.length contacts);
394
+
(* Route from N0 to N50 should exist (50 hops clockwise) *)
395
+
let n0 = Node.v "N0" and n50 = Node.v "N50" in
396
+
let route = find_route plan ~src:n0 ~dst:n50 ~time:0. in
397
+
Alcotest.(check bool) "route exists" true (Option.is_some route);
398
+
let route = Option.get route in
399
+
Alcotest.(check int) "50 hops" 50 (List.length (Route.hops route))
400
+
401
+
let test_mesh_10 () =
402
+
let nodes = Cgr_gen.make_nodes 10 in
403
+
let contacts = Cgr_gen.mesh ~nodes ~duration:1000. ~rate:1_000_000. in
404
+
let plan = Contact_plan.of_list contacts in
405
+
(* Full mesh: n*(n-1) = 10*9 = 90 directed edges *)
406
+
Alcotest.(check int) "90 contacts" 90 (List.length contacts);
407
+
(* Direct route between any two nodes *)
408
+
let n0 = Node.v "N0" and n9 = Node.v "N9" in
409
+
let route = find_route plan ~src:n0 ~dst:n9 ~time:0. in
410
+
Alcotest.(check bool) "route exists" true (Option.is_some route);
411
+
let route = Option.get route in
412
+
(* In full mesh, shortest path is always 1 hop *)
413
+
Alcotest.(check int) "1 hop" 1 (List.length (Route.hops route))
414
+
415
+
let test_mesh_20 () =
416
+
let nodes = Cgr_gen.make_nodes 20 in
417
+
let contacts = Cgr_gen.mesh ~nodes ~duration:1000. ~rate:1_000_000. in
418
+
let plan = Contact_plan.of_list contacts in
419
+
(* Full mesh: 20*19 = 380 directed edges *)
420
+
Alcotest.(check int) "380 contacts" 380 (List.length contacts);
421
+
let n0 = Node.v "N0" and n19 = Node.v "N19" in
422
+
let route = find_route plan ~src:n0 ~dst:n19 ~time:0. in
423
+
Alcotest.(check bool) "route exists" true (Option.is_some route);
424
+
let route = Option.get route in
425
+
Alcotest.(check int) "1 hop" 1 (List.length (Route.hops route))
426
+
427
+
let test_time_varying () =
428
+
let nodes = Cgr_gen.make_nodes 10 in
429
+
let contacts =
430
+
Cgr_gen.time_varying ~nodes ~intervals:5 ~rate:1_000_000. ~seed:42
431
+
in
432
+
let plan = Contact_plan.of_list contacts in
433
+
(* At least some contacts should exist *)
434
+
Alcotest.(check bool) "has contacts" true (List.length contacts > 0);
435
+
(* Try routing at different times *)
436
+
let n0 = Node.v "N0" and n5 = Node.v "N5" in
437
+
let route_early = find_route plan ~src:n0 ~dst:n5 ~time:0. in
438
+
let route_late = find_route plan ~src:n0 ~dst:n5 ~time:500. in
439
+
(* At least one should succeed *)
440
+
Alcotest.(check bool)
441
+
"at least one route" true
442
+
(Option.is_some route_early || Option.is_some route_late)
443
+
444
+
let test_constellation () =
445
+
let gs1 = Node.v "GS1" and gs2 = Node.v "GS2" in
446
+
let contacts =
447
+
Cgr_gen.constellation ~shells:3 ~sat_per_shell:4
448
+
~ground_stations:[ gs1; gs2 ] ~duration:1000. ~rate:1_000_000_000.
449
+
~owlt:0.003
450
+
in
451
+
let plan = Contact_plan.of_list contacts in
452
+
(* Count contacts:
453
+
- Intra-plane: 3 shells * 4 sats * 2 (bidirectional) = 24
454
+
- Inter-plane: 2 gaps * 4 sats * 2 = 16
455
+
- Ground: 2 GS * 10 windows * 2 = 40
456
+
Total: 80 *)
457
+
Alcotest.(check bool) "many contacts" true (List.length contacts > 50);
458
+
(* Route from GS1 to GS2 should exist (via satellites) *)
459
+
let route = find_route plan ~src:gs1 ~dst:gs2 ~time:0. in
460
+
Alcotest.(check bool) "GS-to-GS route exists" true (Option.is_some route);
461
+
let route = Option.get route in
462
+
(* Route should have multiple hops (GS1 -> sat -> ... -> sat -> GS2) *)
463
+
Alcotest.(check bool)
464
+
"multi-hop route" true
465
+
(List.length (Route.hops route) >= 2)
466
+
373
467
(* Suite *)
374
468
375
469
let suite =
···
398
492
test_hdtn_routing_no_reverse;
399
493
Alcotest.test_case "routing choose faster" `Quick
400
494
test_hdtn_routing_choose_faster;
495
+
] );
496
+
( "large-scale",
497
+
[
498
+
Alcotest.test_case "ring 10 nodes" `Quick test_ring_10;
499
+
Alcotest.test_case "ring 100 nodes" `Slow test_ring_100;
500
+
Alcotest.test_case "mesh 10 nodes" `Quick test_mesh_10;
501
+
Alcotest.test_case "mesh 20 nodes" `Slow test_mesh_20;
502
+
Alcotest.test_case "time varying" `Quick test_time_varying;
503
+
Alcotest.test_case "constellation" `Quick test_constellation;
401
504
] );
402
505
]