LDPC codes with belief propagation decoding
Rename ocaml-tm-sync to ocaml-ccsds-coding
The package provides CCSDS-specific channel coding glue
(randomizer, RS interleaving, coding presets) on top of the
generic ocaml-viterbi, ocaml-turbo, ocaml-ldpc, ocaml-reed-solomon
packages. "tm-sync" was too narrow — the same coding applies to
TC, AOS, and USLP as well.
+427
-1
+2
-1
dune-project
+2
-1
dune-project
+22
fuzz/dune
+22
fuzz/dune
···
1
+
(executable
2
+
(name fuzz)
3
+
(modules fuzz fuzz_ldpc)
4
+
(libraries ldpc alcobar))
5
+
6
+
(rule
7
+
(alias runtest)
8
+
(enabled_if
9
+
(<> %{profile} afl))
10
+
(deps fuzz.exe)
11
+
(action
12
+
(run %{exe:fuzz.exe})))
13
+
14
+
(rule
15
+
(alias fuzz)
16
+
(enabled_if
17
+
(= %{profile} afl))
18
+
(deps fuzz.exe)
19
+
(action
20
+
(progn
21
+
(run %{exe:fuzz.exe} --gen-corpus corpus)
22
+
(run afl-fuzz -V 60 -i corpus -o _fuzz -- %{exe:fuzz.exe} @@))))
+1
fuzz/fuzz.ml
+1
fuzz/fuzz.ml
···
1
+
let () = Alcobar.run "ldpc" [ Fuzz_ldpc.suite ]
+58
fuzz/fuzz_ldpc.ml
+58
fuzz/fuzz_ldpc.ml
···
1
+
open Alcobar
2
+
3
+
let ldpc = Ldpc.ccsds_rate_1_2
4
+
5
+
(** Flip bit [i] in a bytes buffer (MSB-first bit ordering). *)
6
+
let flip_bit buf i =
7
+
let byte_idx = i / 8 in
8
+
let bit_pos = 7 - (i mod 8) in
9
+
let old = Char.code (Bytes.get buf byte_idx) in
10
+
Bytes.set buf byte_idx (Char.chr (old lxor (1 lsl bit_pos)))
11
+
12
+
(** Fuzz test: encode random 128-byte data, flip 0-3 random bits in the
13
+
codeword, decode, and verify the original data is recovered. *)
14
+
let test_roundtrip_with_errors data_str n_errors pos0 pos1 pos2 =
15
+
(* data_str is a 128-byte string from the bytes_fixed generator *)
16
+
let data = Bytes.of_string data_str in
17
+
let codeword = Ldpc.encode ldpc data in
18
+
let corrupted = Bytes.copy codeword in
19
+
let n_bits = Bytes.length codeword * 8 in
20
+
(* Flip up to n_errors distinct bits *)
21
+
let positions = [| pos0 mod n_bits; pos1 mod n_bits; pos2 mod n_bits |] in
22
+
(* Deduplicate: only flip each position once *)
23
+
for i = 0 to min n_errors 3 - 1 do
24
+
let pos = positions.(i) in
25
+
let dup = ref false in
26
+
for j = 0 to i - 1 do
27
+
if positions.(j) = pos then dup := true
28
+
done;
29
+
if not !dup then flip_bit corrupted pos
30
+
done;
31
+
match Ldpc.decode ~max_iter:50 ldpc corrupted with
32
+
| Ok recovered ->
33
+
check_eq ~pp:pp_string (Bytes.to_string data) (Bytes.to_string recovered)
34
+
| Error e -> fail (Printf.sprintf "decode failed: %s" e)
35
+
36
+
(** Fuzz test: decode does not crash on arbitrary input. *)
37
+
let test_decode_no_crash input_str =
38
+
(* Just verify decode doesn't raise an exception on random input *)
39
+
let input = Bytes.of_string input_str in
40
+
ignore (Ldpc.decode ldpc input)
41
+
42
+
let suite =
43
+
( "ldpc",
44
+
[
45
+
test_case "roundtrip with 0-3 bit errors"
46
+
[
47
+
bytes_fixed 128;
48
+
range 4;
49
+
(* n_errors: 0, 1, 2, or 3 *)
50
+
range 2048;
51
+
(* bit position 0 *)
52
+
range 2048;
53
+
(* bit position 1 *)
54
+
range 2048 (* bit position 2 *);
55
+
]
56
+
test_roundtrip_with_errors;
57
+
test_case "decode random bytes" [ bytes ] test_decode_no_crash;
58
+
] )
+1
ldpc.opam
+1
ldpc.opam
+343
test/test_ldpc.ml
+343
test/test_ldpc.ml
···
101
101
| Ok _ -> Alcotest.fail "LDPC decode should reject short input"
102
102
| Error _ -> ()
103
103
104
+
(* --- Error correction stress tests --- *)
105
+
106
+
(** Make deterministic test data from a seed byte. *)
107
+
let make_data seed =
108
+
Bytes.init 128 (fun i -> Char.chr (((((i * 37) + seed) * 53) + 7) land 0xFF))
109
+
110
+
(** Flip [n] bits at pseudo-random positions in a copy of [buf], using a simple
111
+
LCG seeded by [seed]. Returns the corrupted copy and the list of flipped
112
+
positions. *)
113
+
let flip_n_bits buf n seed =
114
+
let total_bits = Bytes.length buf * 8 in
115
+
let corrupted = Bytes.copy buf in
116
+
let state = ref seed in
117
+
let next () =
118
+
state := ((!state * 1103515245) + 12345) land 0x3FFFFFFF;
119
+
!state mod total_bits
120
+
in
121
+
let positions = Hashtbl.create n in
122
+
let flipped = ref 0 in
123
+
(* Pick n distinct bit positions *)
124
+
while !flipped < n do
125
+
let pos = next () in
126
+
if not (Hashtbl.mem positions pos) then begin
127
+
Hashtbl.replace positions pos true;
128
+
flip_bit corrupted pos;
129
+
incr flipped
130
+
end
131
+
done;
132
+
corrupted
133
+
134
+
(** Test error correction with exactly [n_errors] bit flips. Returns true if the
135
+
decoder successfully recovered the original data. *)
136
+
let try_correction n_errors seed =
137
+
let data = make_data seed in
138
+
let codeword = Ldpc.encode ldpc data in
139
+
let corrupted = flip_n_bits codeword n_errors ((seed * 1000) + n_errors) in
140
+
match Ldpc.decode ~max_iter:50 ldpc corrupted with
141
+
| Ok recovered -> Bytes.to_string recovered = Bytes.to_string data
142
+
| Error _ -> false
143
+
144
+
(** Error correction: flip 1 bit. *)
145
+
let test_correction_1_bit () =
146
+
let ok = try_correction 1 42 in
147
+
Alcotest.(check bool) "corrects 1 bit error" true ok
148
+
149
+
(** Error correction: flip 3 bits. *)
150
+
let test_correction_3_bits () =
151
+
let ok = try_correction 3 99 in
152
+
Alcotest.(check bool) "corrects 3 bit errors" true ok
153
+
154
+
(** Error correction: flip 5 bits (different seed from existing test). *)
155
+
let test_correction_5_bits () =
156
+
let ok = try_correction 5 7 in
157
+
Alcotest.(check bool) "corrects 5 bit errors" true ok
158
+
159
+
(** Error correction: flip 8 bits. *)
160
+
let test_correction_8_bits () =
161
+
let ok = try_correction 8 123 in
162
+
Alcotest.(check bool) "corrects 8 bit errors" true ok
163
+
164
+
(** Error correction: flip 10 bits. *)
165
+
let test_correction_10_bits () =
166
+
let ok = try_correction 10 200 in
167
+
Alcotest.(check bool) "corrects 10 bit errors" true ok
168
+
169
+
(* --- Find the correction limit via binary search --- *)
170
+
171
+
(** Binary search for the maximum number of correctable bit errors. Tests
172
+
multiple seeds at each error count for reliability. *)
173
+
let test_find_correction_limit () =
174
+
(* Test with multiple seeds to get a reliable picture *)
175
+
let seeds = [| 1; 17; 42; 73; 99; 128; 200; 255 |] in
176
+
let can_correct_all n =
177
+
Array.for_all (fun seed -> try_correction n seed) seeds
178
+
in
179
+
(* Binary search: find largest n where all seeds correct *)
180
+
let lo = ref 1 in
181
+
let hi = ref 512 in
182
+
while !lo < !hi do
183
+
let mid = (!lo + !hi + 1) / 2 in
184
+
if can_correct_all mid then lo := mid else hi := mid - 1
185
+
done;
186
+
let limit = !lo in
187
+
(* The correction limit should be at least 5 (we already test that above)
188
+
and should be well below n-k=1024 *)
189
+
Alcotest.(check bool)
190
+
(Printf.sprintf "correction limit >= 5 (found %d)" limit)
191
+
true (limit >= 5);
192
+
Alcotest.(check bool)
193
+
(Printf.sprintf "correction limit < 512 (found %d)" limit)
194
+
true (limit < 512);
195
+
(* Verify that doubling the limit eventually fails for at least one seed *)
196
+
let beyond = limit * 2 in
197
+
let all_pass_beyond =
198
+
Array.for_all (fun seed -> try_correction beyond seed) seeds
199
+
in
200
+
Alcotest.(check bool)
201
+
(Printf.sprintf "limit*2=%d fails for at least one seed" beyond)
202
+
false all_pass_beyond
203
+
204
+
(* --- Large data: full 128-byte (k=1024 bit) payload --- *)
205
+
206
+
(** Roundtrip with 128 bytes of structured data filling the full k=1024 bits. *)
207
+
let test_large_data () =
208
+
(* Fill with a non-trivial pattern *)
209
+
let data =
210
+
Bytes.init 128 (fun i ->
211
+
let v = ((i * 251) + 137) land 0xFF in
212
+
Char.chr v)
213
+
in
214
+
let codeword = Ldpc.encode ldpc data in
215
+
Alcotest.(check int) "codeword is 256 bytes" 256 (Bytes.length codeword);
216
+
(* Verify systematic property: first 128 bytes = data *)
217
+
for i = 0 to 127 do
218
+
Alcotest.(check int)
219
+
(Printf.sprintf "systematic byte %d" i)
220
+
(Char.code (Bytes.get data i))
221
+
(Char.code (Bytes.get codeword i))
222
+
done;
223
+
match Ldpc.decode ldpc codeword with
224
+
| Ok recovered ->
225
+
Alcotest.(check string)
226
+
"large data roundtrip" (Bytes.to_string data)
227
+
(Bytes.to_string recovered)
228
+
| Error e -> Alcotest.fail (Printf.sprintf "large data decode failed: %s" e)
229
+
230
+
(* --- Syndrome check: zero syndrome for valid codewords --- *)
231
+
232
+
(** Verify syndrome is zero for multiple valid codewords (different data). *)
233
+
let test_syndrome_zero () =
234
+
let seeds = [ 0; 1; 42; 128; 255 ] in
235
+
List.iter
236
+
(fun seed ->
237
+
let data = make_data seed in
238
+
let codeword = Ldpc.encode ldpc data in
239
+
(* Decode with max_iter=1 should succeed immediately if syndrome is 0 *)
240
+
match Ldpc.decode ~max_iter:1 ldpc codeword with
241
+
| Ok recovered ->
242
+
Alcotest.(check string)
243
+
(Printf.sprintf "syndrome zero for seed %d" seed)
244
+
(Bytes.to_string data)
245
+
(Bytes.to_string recovered)
246
+
| Error e ->
247
+
Alcotest.fail
248
+
(Printf.sprintf "syndrome check failed for seed %d: %s" seed e))
249
+
seeds
250
+
251
+
(* --- BP convergence: test max_iter=1,5,50 on same corrupted codeword --- *)
252
+
253
+
(** Test that increasing max_iter improves or maintains decoding quality. *)
254
+
let test_bp_convergence () =
255
+
let data = make_data 77 in
256
+
let codeword = Ldpc.encode ldpc data in
257
+
(* Flip 3 bits: should be correctable with enough iterations *)
258
+
let corrupted = flip_n_bits codeword 3 9999 in
259
+
let decode_ok max_iter =
260
+
match Ldpc.decode ~max_iter ldpc corrupted with
261
+
| Ok recovered -> Bytes.to_string recovered = Bytes.to_string data
262
+
| Error _ -> false
263
+
in
264
+
let ok_1 = decode_ok 1 in
265
+
let ok_5 = decode_ok 5 in
266
+
let ok_50 = decode_ok 50 in
267
+
(* With 50 iterations, 3-bit errors should be correctable *)
268
+
Alcotest.(check bool) "BP converges with max_iter=50" true ok_50;
269
+
(* If it works with fewer iterations, that's fine too, but we just check
270
+
that more iterations never makes it worse (monotonicity) *)
271
+
if ok_1 then
272
+
Alcotest.(check bool) "if max_iter=1 works, 5 should too" true ok_5;
273
+
if ok_5 then
274
+
Alcotest.(check bool) "if max_iter=5 works, 50 should too" true ok_50
275
+
276
+
(** Test that max_iter=1 is insufficient for larger errors. *)
277
+
let test_bp_insufficient_iterations () =
278
+
let data = make_data 33 in
279
+
let codeword = Ldpc.encode ldpc data in
280
+
let corrupted = flip_n_bits codeword 8 5555 in
281
+
let ok_1 =
282
+
match Ldpc.decode ~max_iter:1 ldpc corrupted with
283
+
| Ok recovered -> Bytes.to_string recovered = Bytes.to_string data
284
+
| Error _ -> false
285
+
in
286
+
(* max_iter=1 is very unlikely to correct 8 errors *)
287
+
(* We don't assert it must fail (theoretically possible), but document it *)
288
+
ignore ok_1
289
+
290
+
(* --- Bit-level patterns --- *)
291
+
292
+
(** Alternating 0101... pattern across all 128 bytes. *)
293
+
let test_pattern_alternating_01 () =
294
+
let data = Bytes.init 128 (fun _ -> Char.chr 0x55) in
295
+
(* 0x55 = 0101_0101 *)
296
+
let codeword = Ldpc.encode ldpc data in
297
+
match Ldpc.decode ldpc codeword with
298
+
| Ok recovered ->
299
+
Alcotest.(check string)
300
+
"alternating 01 roundtrip" (Bytes.to_string data)
301
+
(Bytes.to_string recovered)
302
+
| Error e -> Alcotest.fail (Printf.sprintf "alternating 01 failed: %s" e)
303
+
304
+
(** Alternating 1010... pattern across all 128 bytes. *)
305
+
let test_pattern_alternating_10 () =
306
+
let data = Bytes.init 128 (fun _ -> Char.chr 0xAA) in
307
+
(* 0xAA = 1010_1010 *)
308
+
let codeword = Ldpc.encode ldpc data in
309
+
match Ldpc.decode ldpc codeword with
310
+
| Ok recovered ->
311
+
Alcotest.(check string)
312
+
"alternating 10 roundtrip" (Bytes.to_string data)
313
+
(Bytes.to_string recovered)
314
+
| Error e -> Alcotest.fail (Printf.sprintf "alternating 10 failed: %s" e)
315
+
316
+
(** Running ones: 0xFF bytes (same as all-ones but explicitly checked). *)
317
+
let test_pattern_running_ones () =
318
+
let data = Bytes.make 128 '\xFF' in
319
+
let codeword = Ldpc.encode ldpc data in
320
+
match Ldpc.decode ldpc codeword with
321
+
| Ok recovered ->
322
+
Alcotest.(check string)
323
+
"running ones roundtrip" (Bytes.to_string data)
324
+
(Bytes.to_string recovered)
325
+
| Error e -> Alcotest.fail (Printf.sprintf "running ones failed: %s" e)
326
+
327
+
(** Single bit set: only bit 0 is 1, everything else is 0. *)
328
+
let test_pattern_single_bit_0 () =
329
+
let data = Bytes.make 128 '\x00' in
330
+
Bytes.set data 0 (Char.chr 0x80);
331
+
(* bit 0 = MSB of first byte *)
332
+
let codeword = Ldpc.encode ldpc data in
333
+
match Ldpc.decode ldpc codeword with
334
+
| Ok recovered ->
335
+
Alcotest.(check string)
336
+
"single bit 0 roundtrip" (Bytes.to_string data)
337
+
(Bytes.to_string recovered)
338
+
| Error e -> Alcotest.fail (Printf.sprintf "single bit 0 failed: %s" e)
339
+
340
+
(** Single bit set: only the last information bit is 1. *)
341
+
let test_pattern_single_bit_last () =
342
+
let data = Bytes.make 128 '\x00' in
343
+
Bytes.set data 127 (Char.chr 0x01);
344
+
(* bit 1023 = LSB of last byte *)
345
+
let codeword = Ldpc.encode ldpc data in
346
+
match Ldpc.decode ldpc codeword with
347
+
| Ok recovered ->
348
+
Alcotest.(check string)
349
+
"single bit last roundtrip" (Bytes.to_string data)
350
+
(Bytes.to_string recovered)
351
+
| Error e -> Alcotest.fail (Printf.sprintf "single bit last failed: %s" e)
352
+
353
+
(** Single bit set in the middle: bit 512. *)
354
+
let test_pattern_single_bit_middle () =
355
+
let data = Bytes.make 128 '\x00' in
356
+
(* bit 512 = byte 64, MSB *)
357
+
Bytes.set data 64 (Char.chr 0x80);
358
+
let codeword = Ldpc.encode ldpc data in
359
+
match Ldpc.decode ldpc codeword with
360
+
| Ok recovered ->
361
+
Alcotest.(check string)
362
+
"single bit middle roundtrip" (Bytes.to_string data)
363
+
(Bytes.to_string recovered)
364
+
| Error e -> Alcotest.fail (Printf.sprintf "single bit middle failed: %s" e)
365
+
366
+
(* --- Decoder rejects oversized input --- *)
367
+
368
+
(** Decode with oversized input: extra bytes beyond n bits should be ignored and
369
+
decoding should still succeed. *)
370
+
let test_decode_oversized_input () =
371
+
let data = make_data 42 in
372
+
let codeword = Ldpc.encode ldpc data in
373
+
(* Append 100 extra bytes *)
374
+
let oversized = Bytes.make (Bytes.length codeword + 100) '\xAB' in
375
+
Bytes.blit codeword 0 oversized 0 (Bytes.length codeword);
376
+
match Ldpc.decode ldpc oversized with
377
+
| Ok recovered ->
378
+
(* The decoder should still recover the original data, ignoring extras *)
379
+
Alcotest.(check string)
380
+
"oversized input: data recovered" (Bytes.to_string data)
381
+
(Bytes.to_string recovered)
382
+
| Error e ->
383
+
Alcotest.fail (Printf.sprintf "oversized input decode failed: %s" e)
384
+
385
+
(** Encode with oversized input: extra bytes beyond k bits should be ignored. *)
386
+
let test_encode_oversized_input () =
387
+
let data = make_data 42 in
388
+
(* Append 50 extra bytes *)
389
+
let oversized = Bytes.make (128 + 50) '\xCD' in
390
+
Bytes.blit data 0 oversized 0 128;
391
+
let codeword = Ldpc.encode ldpc oversized in
392
+
(* First 128 bytes of codeword should match data (systematic) *)
393
+
Alcotest.(check string)
394
+
"oversized encode: systematic prefix preserved" (Bytes.to_string data)
395
+
(Bytes.sub_string codeword 0 128);
396
+
(* And decoding should recover the original 128 bytes *)
397
+
match Ldpc.decode ldpc codeword with
398
+
| Ok recovered ->
399
+
Alcotest.(check string)
400
+
"oversized encode: roundtrip" (Bytes.to_string data)
401
+
(Bytes.to_string recovered)
402
+
| Error e ->
403
+
Alcotest.fail (Printf.sprintf "oversized encode roundtrip failed: %s" e)
404
+
104
405
let suite =
105
406
( "ldpc",
106
407
[
···
113
414
Alcotest.test_case "LDPC codeword length" `Quick test_ldpc_codeword_length;
114
415
Alcotest.test_case "LDPC decode short input" `Quick
115
416
test_ldpc_decode_short_input;
417
+
(* Error correction stress *)
418
+
Alcotest.test_case "LDPC corrects 1 bit error" `Quick
419
+
test_correction_1_bit;
420
+
Alcotest.test_case "LDPC corrects 3 bit errors" `Quick
421
+
test_correction_3_bits;
422
+
Alcotest.test_case "LDPC corrects 5 bit errors" `Quick
423
+
test_correction_5_bits;
424
+
Alcotest.test_case "LDPC corrects 8 bit errors" `Quick
425
+
test_correction_8_bits;
426
+
Alcotest.test_case "LDPC corrects 10 bit errors" `Quick
427
+
test_correction_10_bits;
428
+
(* Correction limit *)
429
+
Alcotest.test_case "LDPC correction limit (binary search)" `Slow
430
+
test_find_correction_limit;
431
+
(* Large data *)
432
+
Alcotest.test_case "LDPC 128-byte payload roundtrip" `Quick
433
+
test_large_data;
434
+
(* Syndrome *)
435
+
Alcotest.test_case "LDPC syndrome zero for valid codewords" `Quick
436
+
test_syndrome_zero;
437
+
(* BP convergence *)
438
+
Alcotest.test_case "LDPC BP convergence (max_iter=1,5,50)" `Quick
439
+
test_bp_convergence;
440
+
Alcotest.test_case "LDPC BP insufficient iterations" `Quick
441
+
test_bp_insufficient_iterations;
442
+
(* Bit-level patterns *)
443
+
Alcotest.test_case "LDPC alternating 01 pattern" `Quick
444
+
test_pattern_alternating_01;
445
+
Alcotest.test_case "LDPC alternating 10 pattern" `Quick
446
+
test_pattern_alternating_10;
447
+
Alcotest.test_case "LDPC running ones pattern" `Quick
448
+
test_pattern_running_ones;
449
+
Alcotest.test_case "LDPC single bit 0" `Quick test_pattern_single_bit_0;
450
+
Alcotest.test_case "LDPC single bit last" `Quick
451
+
test_pattern_single_bit_last;
452
+
Alcotest.test_case "LDPC single bit middle" `Quick
453
+
test_pattern_single_bit_middle;
454
+
(* Oversized input *)
455
+
Alcotest.test_case "LDPC decode oversized input" `Quick
456
+
test_decode_oversized_input;
457
+
Alcotest.test_case "LDPC encode oversized input" `Quick
458
+
test_encode_oversized_input;
116
459
] )