Contact Graph Routing for time-varying satellite networks
cgr: Fix record field shadowing in extract_route
+144
-72
+35
cgr.opam
+35
cgr.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Contact Graph Routing for time-varying satellite networks"
4
+
description: """
5
+
CGR computes routes through scheduled communication contacts in DTN
6
+
(Delay-Tolerant Networking) environments. It implements the CCSDS
7
+
Schedule-Aware Bundle Routing (SABR) algorithm using Dijkstra over
8
+
time-varying graphs where edges (contacts) have temporal validity windows."""
9
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
10
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
11
+
license: "ISC"
12
+
homepage: "https://tangled.org/samoht.me/ocaml-cgr"
13
+
bug-reports: "https://tangled.org/samoht.me/ocaml-cgr/issues"
14
+
depends: [
15
+
"dune" {>= "3.0"}
16
+
"ocaml" {>= "5.1"}
17
+
"fmt" {>= "0.9"}
18
+
"alcotest" {with-test}
19
+
"crowbar" {with-test}
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
+6
-4
fuzz/fuzz_cgr.ml
+6
-4
fuzz/fuzz_cgr.ml
···
17
17
let gen_rate = map [ range 1000 ] (fun r -> float_of_int (r + 1))
18
18
19
19
let gen_contact =
20
-
map [ gen_node; gen_node; gen_time; range 100; gen_rate ] (fun from to_ start duration rate ->
21
-
let stop = start +. float_of_int (duration + 1) in
22
-
Contact.v ~from ~to_ ~start ~stop ~rate ())
20
+
map
21
+
[ gen_node; gen_node; gen_time; range 100; gen_rate ]
22
+
(fun from to_ start duration rate ->
23
+
let stop = start +. float_of_int (duration + 1) in
24
+
Contact.v ~from ~to_ ~start ~stop ~rate ())
23
25
24
26
let gen_contact_list = list gen_contact
25
27
···
88
90
(* Check all first hops are distinct (by physical identity) *)
89
91
let rec all_distinct = function
90
92
| [] -> true
91
-
| x :: xs -> not (List.exists (fun y -> x == y) xs) && all_distinct xs
93
+
| x :: xs -> (not (List.exists (fun y -> x == y) xs)) && all_distinct xs
92
94
in
93
95
check (all_distinct first_hops)
94
96
+26
-11
lib/cgr.ml
+26
-11
lib/cgr.ml
···
57
57
by_to : Contact.t list Node_map.t;
58
58
}
59
59
60
-
let empty = { contacts = []; by_from = Node_map.empty; by_to = Node_map.empty }
60
+
let empty =
61
+
{ contacts = []; by_from = Node_map.empty; by_to = Node_map.empty }
61
62
62
63
let add contact t =
63
64
let add_to_map key contact map =
···
92
93
in
93
94
Node_set.elements set
94
95
95
-
let active_at t ~time = List.filter (fun c -> Contact.is_active c ~time) t.contacts
96
+
let active_at t ~time =
97
+
List.filter (fun c -> Contact.is_active c ~time) t.contacts
96
98
97
99
let pp ppf t =
98
100
Fmt.pf ppf "@[<v>%a@]" (Fmt.list ~sep:Fmt.cut Contact.pp) t.contacts
···
125
127
let capacity t =
126
128
match t.hops with
127
129
| [] -> infinity
128
-
| hops -> List.fold_left (fun acc c -> Float.min acc (Contact.capacity c)) infinity hops
130
+
| hops ->
131
+
List.fold_left
132
+
(fun acc c -> Float.min acc (Contact.capacity c))
133
+
infinity hops
129
134
130
135
let latency t = arrival_time t -. departure_time t
131
136
···
159
164
Contact_plan.nodes plan
160
165
|> List.fold_left
161
166
(fun map node ->
162
-
let arrival_time = if Node.equal node src then time else infinity in
163
-
let state = { arrival_time; predecessor = None; visited = false } in
167
+
let arrival_time =
168
+
if Node.equal node src then time else infinity
169
+
in
170
+
let state =
171
+
{ arrival_time; predecessor = None; visited = false }
172
+
in
164
173
Node_map.add node state map)
165
174
Node_map.empty
166
175
in
···
194
203
let step state =
195
204
match find_min_unvisited state with
196
205
| None -> None
197
-
| Some current when not (Float.is_finite (get_node_state state current).arrival_time) ->
206
+
| Some current
207
+
when not (Float.is_finite (get_node_state state current).arrival_time) ->
198
208
(* All remaining nodes are unreachable *)
199
209
None
200
210
| Some current ->
···
212
222
|> List.fold_left
213
223
(fun nodes contact ->
214
224
let neighbor = Contact.to_ contact in
215
-
let neighbor_state = get_node_state { state with nodes } neighbor in
225
+
let neighbor_state =
226
+
get_node_state { state with nodes } neighbor
227
+
in
216
228
217
229
if neighbor_state.visited then nodes
218
230
else
219
231
(* Can we use this contact? *)
220
232
(* We need to arrive before the contact ends *)
221
-
let contact_usable = current_arrival < Contact.stop contact in
233
+
let contact_usable =
234
+
current_arrival < Contact.stop contact
235
+
in
222
236
if not contact_usable then nodes
223
237
else
224
238
(* Compute arrival time at neighbor via this contact *)
···
231
245
232
246
if new_arrival < neighbor_state.arrival_time then
233
247
Node_map.add neighbor
234
-
{ neighbor_state with
248
+
{
249
+
neighbor_state with
235
250
arrival_time = new_arrival;
236
251
predecessor = Some contact;
237
252
}
···
256
271
| None -> acc (* Should not happen if arrival_time is finite *)
257
272
| Some contact -> build_path (Contact.from contact) (contact :: acc)
258
273
in
259
-
let hops = build_path dst [] in
260
-
Some Route.{ hops; src = state.src; dst }
274
+
let path = build_path dst [] in
275
+
Some { Route.hops = path; src = state.src; dst }
261
276
end
262
277
263
278
(* High-level routing *)
+32
-27
lib/cgr.mli
+32
-27
lib/cgr.mli
···
6
6
(** Contact Graph Routing for time-varying networks.
7
7
8
8
CGR computes routes through scheduled communication contacts in DTN
9
-
(Delay-Tolerant Networking) environments. Unlike traditional routing
10
-
where links are persistent, CGR handles networks where connectivity
11
-
is intermittent but predictable - such as satellite constellations,
12
-
deep space networks, and scheduled terrestrial links.
9
+
(Delay-Tolerant Networking) environments. Unlike traditional routing where
10
+
links are persistent, CGR handles networks where connectivity is
11
+
intermittent but predictable - such as satellite constellations, deep space
12
+
networks, and scheduled terrestrial links.
13
13
14
14
{2 Overview}
15
15
16
-
A {e contact} is a scheduled window during which one node can transmit
17
-
to another. The {e contact plan} is the complete schedule of all contacts.
18
-
CGR uses Dijkstra's algorithm over this time-varying graph to find routes
19
-
that minimize delivery time while respecting contact windows.
16
+
A {e contact} is a scheduled window during which one node can transmit to
17
+
another. The {e contact plan} is the complete schedule of all contacts. CGR
18
+
uses Dijkstra's algorithm over this time-varying graph to find routes that
19
+
minimize delivery time while respecting contact windows.
20
20
21
21
{2 Example}
22
22
···
29
29
let relay = Node.v "RELAY"
30
30
31
31
(* Define contacts (start_time, end_time, rate in bytes/sec) *)
32
-
let contacts = [
33
-
Contact.v ~from:earth ~to_:relay ~start:0. ~stop:100. ~rate:1_000_000.;
34
-
Contact.v ~from:relay ~to_:mars ~start:50. ~stop:150. ~rate:500_000.;
35
-
]
32
+
let contacts =
33
+
[
34
+
Contact.v ~from:earth ~to_:relay ~start:0. ~stop:100. ~rate:1_000_000.;
35
+
Contact.v ~from:relay ~to_:mars ~start:50. ~stop:150. ~rate:500_000.;
36
+
]
36
37
37
38
(* Create contact plan and find route *)
38
39
let plan = Contact_plan.of_list contacts
···
41
42
42
43
{2 References}
43
44
44
-
- {{:https://datatracker.ietf.org/doc/html/draft-burleigh-dtnrg-cgr}
45
-
IETF Contact Graph Routing draft}
46
-
- {{:https://public.ccsds.org/Pubs/734x2b1.pdf}
47
-
CCSDS Schedule-Aware Bundle Routing (SABR)}
48
-
- {{:https://hal.science/hal-03494106/file/2020-JNCA-CGR-Tutorial.pdf}
49
-
CGR Tutorial (Fraire et al., 2020)} *)
45
+
- {{:https://datatracker.ietf.org/doc/html/draft-burleigh-dtnrg-cgr} IETF
46
+
Contact Graph Routing draft}
47
+
- {{:https://public.ccsds.org/Pubs/734x2b1.pdf} CCSDS Schedule-Aware Bundle
48
+
Routing (SABR)}
49
+
- {{:https://hal.science/hal-03494106/file/2020-JNCA-CGR-Tutorial.pdf} CGR
50
+
Tutorial (Fraire et al., 2020)} *)
50
51
51
52
(** {1 Nodes} *)
52
53
···
76
77
type t
77
78
(** A scheduled communication window between two nodes.
78
79
79
-
A contact represents a period during which the transmitting node
80
-
can send data to the receiving node at a specified rate. *)
80
+
A contact represents a period during which the transmitting node can send
81
+
data to the receiving node at a specified rate. *)
81
82
82
83
val v :
83
84
from:Node.t ->
···
95
96
@param start Contact start time (seconds since epoch)
96
97
@param stop Contact end time (seconds since epoch)
97
98
@param rate Transmission rate in bytes per second
98
-
@param owlt One-way light time (propagation delay) in seconds.
99
-
Defaults to [0.] for terrestrial links. *)
99
+
@param owlt
100
+
One-way light time (propagation delay) in seconds. Defaults to [0.] for
101
+
terrestrial links. *)
100
102
101
103
val from : t -> Node.t
102
104
(** [from c] is the transmitting node. *)
···
120
122
(** [duration c] is [stop c -. start c]. *)
121
123
122
124
val capacity : t -> float
123
-
(** [capacity c] is [duration c *. rate c], the maximum bytes transmittable. *)
125
+
(** [capacity c] is [duration c *. rate c], the maximum bytes transmittable.
126
+
*)
124
127
125
128
val is_active : t -> time:float -> bool
126
129
(** [is_active c ~time] is [true] if [start c <= time < stop c]. *)
···
148
151
(** [contacts plan] returns all contacts. *)
149
152
150
153
val contacts_from : t -> Node.t -> Contact.t list
151
-
(** [contacts_from plan node] returns contacts where [node] is transmitting. *)
154
+
(** [contacts_from plan node] returns contacts where [node] is transmitting.
155
+
*)
152
156
153
157
val contacts_to : t -> Node.t -> Contact.t list
154
158
(** [contacts_to plan node] returns contacts where [node] is receiving. *)
···
224
228
module Dijkstra : sig
225
229
(** Low-level access to the Dijkstra computation.
226
230
227
-
Most users should use {!find_route} instead. This module exposes
228
-
internals for debugging, visualization, or custom routing strategies. *)
231
+
Most users should use {!find_route} instead. This module exposes internals
232
+
for debugging, visualization, or custom routing strategies. *)
229
233
230
234
type state
231
235
(** Internal state of a Dijkstra computation. *)
···
237
241
(** [step state] performs one iteration. Returns [None] when complete. *)
238
242
239
243
val arrival_time : state -> Node.t -> float option
240
-
(** [arrival_time state node] returns the best known arrival time at [node]. *)
244
+
(** [arrival_time state node] returns the best known arrival time at [node].
245
+
*)
241
246
242
247
val predecessor : state -> Node.t -> Contact.t option
243
248
(** [predecessor state node] returns the contact used to reach [node]. *)
+45
-30
test/test_cgr.ml
+45
-30
test/test_cgr.ml
···
16
16
Float.abs (Route.arrival_time a -. Route.arrival_time b) < 0.001)
17
17
18
18
let some_route = Alcotest.option route_arrival
19
-
20
19
let float_eq ?(eps = 0.001) a b = Float.abs (a -. b) < eps
21
20
22
21
(* Test nodes *)
···
39
38
Alcotest.(check node) "src" earth (Route.src route);
40
39
Alcotest.(check node) "dst" mars (Route.dst route);
41
40
Alcotest.(check int) "hops" 1 (List.length (Route.hops route));
42
-
Alcotest.(check bool) "arrival at 0" true (float_eq 0. (Route.arrival_time route))
41
+
Alcotest.(check bool)
42
+
"arrival at 0" true
43
+
(float_eq 0. (Route.arrival_time route))
43
44
44
45
(* Test: Two-hop route *)
45
46
···
56
57
let route = Option.get route in
57
58
Alcotest.(check int) "hops" 2 (List.length (Route.hops route));
58
59
(* Arrive at relay at t=0, wait until contact c2 starts at t=50 *)
59
-
Alcotest.(check bool) "arrival at 50" true (float_eq 50. (Route.arrival_time route))
60
+
Alcotest.(check bool)
61
+
"arrival at 50" true
62
+
(float_eq 50. (Route.arrival_time route))
60
63
61
64
(* Test: No route available *)
62
65
···
76
79
Contact.v ~from:earth ~to_:mars ~start:100. ~stop:200. ~rate:1000. ()
77
80
in
78
81
(* Fast path via relay *)
79
-
let c1 = Contact.v ~from:earth ~to_:relay ~start:0. ~stop:50. ~rate:1000. () in
82
+
let c1 =
83
+
Contact.v ~from:earth ~to_:relay ~start:0. ~stop:50. ~rate:1000. ()
84
+
in
80
85
let c2 =
81
86
Contact.v ~from:relay ~to_:mars ~start:10. ~stop:60. ~rate:1000. ()
82
87
in
···
85
90
Alcotest.(check bool) "route exists" true (Option.is_some route);
86
91
let route = Option.get route in
87
92
(* Fast path arrives at t=10 (via relay), slow path at t=100 *)
88
-
Alcotest.(check bool) "chose fast path" true (float_eq 10. (Route.arrival_time route));
93
+
Alcotest.(check bool)
94
+
"chose fast path" true
95
+
(float_eq 10. (Route.arrival_time route));
89
96
Alcotest.(check int) "via relay (2 hops)" 2 (List.length (Route.hops route))
90
97
91
98
(* Test: Must wait for contact window *)
···
100
107
Alcotest.(check bool) "route exists" true (Option.is_some route);
101
108
let route = Option.get route in
102
109
(* Must wait until t=50 to transmit *)
103
-
Alcotest.(check bool) "arrival at 50" true (float_eq 50. (Route.arrival_time route))
110
+
Alcotest.(check bool)
111
+
"arrival at 50" true
112
+
(float_eq 50. (Route.arrival_time route))
104
113
105
114
(* Test: Propagation delay (one-way light time) *)
106
115
···
115
124
Alcotest.(check bool) "route exists" true (Option.is_some route);
116
125
let route = Option.get route in
117
126
(* Arrival = transmit time + OWLT = 0 + 600 *)
118
-
Alcotest.(check bool) "arrival includes owlt" true
127
+
Alcotest.(check bool)
128
+
"arrival includes owlt" true
119
129
(float_eq owlt (Route.arrival_time route))
120
130
121
131
(* Test: Contact expires before we arrive *)
···
126
136
Contact.v ~from:earth ~to_:relay ~start:0. ~stop:100. ~rate:1000. ()
127
137
in
128
138
(* But the mars contact ends before we could use it *)
129
-
let c2 =
130
-
Contact.v ~from:relay ~to_:mars ~start:0. ~stop:1. ~rate:1000. ()
131
-
in
139
+
let c2 = Contact.v ~from:relay ~to_:mars ~start:0. ~stop:1. ~rate:1000. () in
132
140
let plan = Contact_plan.of_list [ c1; c2 ] in
133
141
let route = find_route plan ~src:earth ~dst:mars ~time:0. in
134
142
(* We arrive at relay at t=0, but c2 ends at t=1 - should still work
···
156
164
Alcotest.(check int) "found 2 routes" 2 (List.length routes);
157
165
(* First route should be fastest (via relay, arrives at 10) *)
158
166
let first = List.hd routes in
159
-
Alcotest.(check bool) "first is fastest" true
167
+
Alcotest.(check bool)
168
+
"first is fastest" true
160
169
(float_eq 10. (Route.arrival_time first))
161
170
162
171
(* Test: Contact plan operations *)
163
172
164
173
let test_contact_plan () =
165
-
let c1 = Contact.v ~from:earth ~to_:mars ~start:0. ~stop:100. ~rate:1000. () in
166
-
let c2 = Contact.v ~from:earth ~to_:relay ~start:50. ~stop:150. ~rate:500. () in
167
-
let c3 = Contact.v ~from:relay ~to_:mars ~start:100. ~stop:200. ~rate:800. () in
174
+
let c1 =
175
+
Contact.v ~from:earth ~to_:mars ~start:0. ~stop:100. ~rate:1000. ()
176
+
in
177
+
let c2 =
178
+
Contact.v ~from:earth ~to_:relay ~start:50. ~stop:150. ~rate:500. ()
179
+
in
180
+
let c3 =
181
+
Contact.v ~from:relay ~to_:mars ~start:100. ~stop:200. ~rate:800. ()
182
+
in
168
183
let plan = Contact_plan.of_list [ c1; c2; c3 ] in
169
-
Alcotest.(check int) "all contacts" 3 (List.length (Contact_plan.contacts plan));
170
-
Alcotest.(check int) "contacts from earth" 2
184
+
Alcotest.(check int)
185
+
"all contacts" 3
186
+
(List.length (Contact_plan.contacts plan));
187
+
Alcotest.(check int)
188
+
"contacts from earth" 2
171
189
(List.length (Contact_plan.contacts_from plan earth));
172
-
Alcotest.(check int) "contacts to mars" 2
190
+
Alcotest.(check int)
191
+
"contacts to mars" 2
173
192
(List.length (Contact_plan.contacts_to plan mars));
174
-
Alcotest.(check int) "contacts earth->mars" 1
193
+
Alcotest.(check int)
194
+
"contacts earth->mars" 1
175
195
(List.length (Contact_plan.contacts_between plan earth mars));
176
196
Alcotest.(check int) "nodes" 3 (List.length (Contact_plan.nodes plan));
177
-
Alcotest.(check int) "active at 75" 2
197
+
Alcotest.(check int)
198
+
"active at 75" 2
178
199
(List.length (Contact_plan.active_at plan ~time:75.))
179
200
180
201
(* Test: Route capacity is bottleneck *)
···
183
204
let c1 =
184
205
Contact.v ~from:earth ~to_:relay ~start:0. ~stop:100. ~rate:1000. ()
185
206
in
186
-
let c2 =
187
-
Contact.v ~from:relay ~to_:mars ~start:0. ~stop:50. ~rate:500. ()
188
-
in
207
+
let c2 = Contact.v ~from:relay ~to_:mars ~start:0. ~stop:50. ~rate:500. () in
189
208
let plan = Contact_plan.of_list [ c1; c2 ] in
190
209
let route = find_route plan ~src:earth ~dst:mars ~time:0. in
191
210
let route = Option.get route in
192
211
(* Capacity is min of: c1 (100*1000=100000) and c2 (50*500=25000) *)
193
-
Alcotest.(check bool) "capacity is bottleneck" true
212
+
Alcotest.(check bool)
213
+
"capacity is bottleneck" true
194
214
(float_eq 25000. (Route.capacity route))
195
215
196
216
(* Suite *)
···
209
229
Alcotest.test_case "find routes" `Quick test_find_routes;
210
230
] );
211
231
( "contact plan",
212
-
[
213
-
Alcotest.test_case "operations" `Quick test_contact_plan;
214
-
] );
215
-
( "route",
216
-
[
217
-
Alcotest.test_case "capacity" `Quick test_route_capacity;
218
-
] );
232
+
[ Alcotest.test_case "operations" `Quick test_contact_plan ] );
233
+
("route", [ Alcotest.test_case "capacity" `Quick test_route_capacity ]);
219
234
]