CCSDS 123.0-B Lossless Multispectral and Hyperspectral Image Compression
hcomp: extract test_hcomp suite, drop test_/get_/create_/make_ prefixes
- Move every test case from test/test.ml into test/test_hcomp.ml,
drop the redundant test_ prefix on each (E325/E331), and reduce the
runner to a single Alcotest.run line (E600).
- Replace Format.fprintf with Fmt.pf in the bytes pretty-printer
(E205) and add fmt to the test dune libraries.
- Rename hcomp.ml's get_sample -> sample and create_entropy_state
-> entropy_state (E331).
- Replace the catch-all (with _ -> ()) handler in the fuzz
decompress safety test with the documented Invalid_argument /
Failure handlers (E311).
- Rename fuzz_compress.{ml,mli} to fuzz_hcomp.{ml,mli} and the suite
name from "compress" to "hcomp" so E710/E720 see a corresponding
library module.
+411
-429
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+1
-1
fuzz/fuzz.ml
+1
-1
fuzz/fuzz.ml
+2
-2
fuzz/fuzz_compress.ml
fuzz/fuzz_hcomp.ml
+2
-2
fuzz/fuzz_compress.ml
fuzz/fuzz_hcomp.ml
···
38
38
Hcomp.decompress ~bands:1 ~width:4 ~height:4 ~bits_per_sample:8 data
39
39
in
40
40
()
41
-
with _ -> ()
41
+
with Invalid_argument _ | Failure _ -> ()
42
42
43
43
(** Compressed output must be deterministic. *)
44
44
let test_deterministic buf =
···
122
122
failf "output length %d <> expected %d" (Bytes.length decompressed) needed
123
123
124
124
let suite =
125
-
( "compress",
125
+
( "hcomp",
126
126
[
127
127
test_case "roundtrip" [ bytes ] test_roundtrip;
128
128
test_case "decompress crash safety" [ bytes ] test_decompress_crash_safety;
fuzz/fuzz_compress.mli
fuzz/fuzz_hcomp.mli
fuzz/fuzz_compress.mli
fuzz/fuzz_hcomp.mli
+16
-20
lib/hcomp.ml
+16
-20
lib/hcomp.ml
···
115
115
(** Image data is stored in band-interleaved-by-pixel (BIP) order with 16-bit
116
116
big-endian samples. *)
117
117
118
-
let get_sample (data : bytes) ~bands ~width ~band ~x ~y =
118
+
let sample (data : bytes) ~bands ~width ~band ~x ~y =
119
119
let idx = ((((y * width) + x) * bands) + band) * 2 in
120
120
let hi = Char.code (Bytes.get data idx) in
121
121
let lo = Char.code (Bytes.get data (idx + 1)) in
···
149
149
if band = 0 then
150
150
(* First band: spatial-only prediction *)
151
151
begin if x = 0 && y = 0 then mid
152
-
else if y = 0 then get_sample data ~bands ~width ~band ~x:(x - 1) ~y
153
-
else if x = 0 then get_sample data ~bands ~width ~band ~x ~y:(y - 1)
152
+
else if y = 0 then sample data ~bands ~width ~band ~x:(x - 1) ~y
153
+
else if x = 0 then sample data ~bands ~width ~band ~x ~y:(y - 1)
154
154
else begin
155
-
let n = get_sample data ~bands ~width ~band ~x ~y:(y - 1) in
156
-
let w = get_sample data ~bands ~width ~band ~x:(x - 1) ~y in
157
-
let nw = get_sample data ~bands ~width ~band ~x:(x - 1) ~y:(y - 1) in
155
+
let n = sample data ~bands ~width ~band ~x ~y:(y - 1) in
156
+
let w = sample data ~bands ~width ~band ~x:(x - 1) ~y in
157
+
let nw = sample data ~bands ~width ~band ~x:(x - 1) ~y:(y - 1) in
158
158
(* Median predictor (same as PNG "Paeth" without abs distance) *)
159
159
let p = n + w - nw in
160
160
let max_val = (1 lsl bits_per_sample) - 1 in
···
163
163
end
164
164
else begin
165
165
(* Subsequent bands: blend spatial prediction with spectral neighbor *)
166
-
let spectral = get_sample data ~bands ~width ~band:(band - 1) ~x ~y in
166
+
let spectral = sample data ~bands ~width ~band:(band - 1) ~x ~y in
167
167
if x = 0 && y = 0 then spectral
168
168
else begin
169
169
let spatial =
170
-
if y = 0 then get_sample data ~bands ~width ~band ~x:(x - 1) ~y
171
-
else if x = 0 then get_sample data ~bands ~width ~band ~x ~y:(y - 1)
170
+
if y = 0 then sample data ~bands ~width ~band ~x:(x - 1) ~y
171
+
else if x = 0 then sample data ~bands ~width ~band ~x ~y:(y - 1)
172
172
else begin
173
-
let n = get_sample data ~bands ~width ~band ~x ~y:(y - 1) in
174
-
let w = get_sample data ~bands ~width ~band ~x:(x - 1) ~y in
175
-
let nw = get_sample data ~bands ~width ~band ~x:(x - 1) ~y:(y - 1) in
173
+
let n = sample data ~bands ~width ~band ~x ~y:(y - 1) in
174
+
let w = sample data ~bands ~width ~band ~x:(x - 1) ~y in
175
+
let nw = sample data ~bands ~width ~band ~x:(x - 1) ~y:(y - 1) in
176
176
let p = n + w - nw in
177
177
let max_val = (1 lsl bits_per_sample) - 1 in
178
178
max 0 (min max_val p)
···
206
206
207
207
type entropy_state = { mutable accum : int; mutable count : int }
208
208
209
-
let create_entropy_state bits_per_sample =
209
+
let entropy_state bits_per_sample =
210
210
(* Initialize accumulator to bias toward middle k values *)
211
211
let initial_k = max 1 (bits_per_sample / 2) in
212
212
{ accum = 1 lsl initial_k; count = 1 }
···
284
284
Bitstream.write_bits bw 16 height;
285
285
Bitstream.write_bits bw 8 bits_per_sample;
286
286
(* One entropy state per band for spectral adaptation *)
287
-
let states =
288
-
Array.init bands (fun _ -> create_entropy_state bits_per_sample)
289
-
in
287
+
let states = Array.init bands (fun _ -> entropy_state bits_per_sample) in
290
288
(* Encode in BIP order: for each pixel, for each band *)
291
289
for y = 0 to height - 1 do
292
290
for x = 0 to width - 1 do
293
291
for band = 0 to bands - 1 do
294
-
let sample = get_sample data ~bands ~width ~band ~x ~y in
292
+
let sample = sample data ~bands ~width ~band ~x ~y in
295
293
let predicted =
296
294
predict ~data ~bands ~width ~height ~band ~x ~y ~bits_per_sample
297
295
in
···
315
313
|| h_bps <> bits_per_sample
316
314
then invalid_arg "Hcomp.decompress: header mismatch";
317
315
let output = Bytes.make (bands * width * height * 2) '\x00' in
318
-
let states =
319
-
Array.init bands (fun _ -> create_entropy_state bits_per_sample)
320
-
in
316
+
let states = Array.init bands (fun _ -> entropy_state bits_per_sample) in
321
317
let max_val = (1 lsl bits_per_sample) - 1 in
322
318
for y = 0 to height - 1 do
323
319
for x = 0 to width - 1 do
+1
-1
test/dune
+1
-1
test/dune
+1
-404
test/test.ml
+1
-404
test/test.ml
···
1
-
(* Copyright (c) 2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
-
3
-
Permission to use, copy, modify, and distribute this software for any
4
-
purpose with or without fee is hereby granted, provided that the above
5
-
copyright notice and this permission notice appear in all copies.
6
-
7
-
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
-
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
-
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
-
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
-
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
-
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
-
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
-
15
-
(** Helper: create multi-band image data in BIP order with 16-bit big-endian
16
-
samples. *)
17
-
let make_image ~bands ~width ~height f =
18
-
let data = Bytes.make (bands * width * height * 2) '\x00' in
19
-
for y = 0 to height - 1 do
20
-
for x = 0 to width - 1 do
21
-
for band = 0 to bands - 1 do
22
-
let v = f ~band ~x ~y in
23
-
let idx = ((((y * width) + x) * bands) + band) * 2 in
24
-
Bytes.set data idx (Char.chr ((v lsr 8) land 0xFF));
25
-
Bytes.set data (idx + 1) (Char.chr (v land 0xFF))
26
-
done
27
-
done
28
-
done;
29
-
data
30
-
31
-
let check_roundtrip ~bands ~width ~height ~bits_per_sample data =
32
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
33
-
let decompressed =
34
-
Hcomp.decompress ~bands ~width ~height ~bits_per_sample compressed
35
-
in
36
-
if data <> decompressed then
37
-
Alcotest.failf
38
-
"roundtrip failed: input and output differ (bands=%d width=%d height=%d \
39
-
bps=%d)"
40
-
bands width height bits_per_sample
41
-
42
-
(* Single band, constant image. *)
43
-
let test_single_band_constant () =
44
-
let bands = 1 and width = 8 and height = 8 and bits_per_sample = 8 in
45
-
let data = make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 128) in
46
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
47
-
48
-
(* Single band, gradient. *)
49
-
let test_single_band_gradient () =
50
-
let bands = 1 and width = 8 and height = 8 and bits_per_sample = 8 in
51
-
let data = make_image ~bands ~width ~height (fun ~band:_ ~x ~y:_ -> x * 32) in
52
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
53
-
54
-
(* Multi-band constant. *)
55
-
let test_multi_band_constant () =
56
-
let bands = 4 and width = 8 and height = 8 and bits_per_sample = 8 in
57
-
let data =
58
-
make_image ~bands ~width ~height (fun ~band ~x:_ ~y:_ -> 50 * (band + 1))
59
-
in
60
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
61
-
62
-
(* Multi-band with spatial gradient. *)
63
-
let test_multi_band_gradient () =
64
-
let bands = 3 and width = 16 and height = 16 and bits_per_sample = 8 in
65
-
let data =
66
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
67
-
(((x + y) * 8) + (band * 20)) mod 256)
68
-
in
69
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
70
-
71
-
(* 16-bit samples. *)
72
-
let test_16bit_samples () =
73
-
let bands = 2 and width = 8 and height = 8 and bits_per_sample = 16 in
74
-
let data =
75
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
76
-
((x * 1000) + (y * 500) + (band * 10000)) mod 65536)
77
-
in
78
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
79
-
80
-
(* All zeros. *)
81
-
let test_all_zeros () =
82
-
let bands = 3 and width = 4 and height = 4 and bits_per_sample = 8 in
83
-
let data = make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 0) in
84
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
85
-
86
-
(* Single pixel image. *)
87
-
let test_single_pixel () =
88
-
let bands = 5 and width = 1 and height = 1 and bits_per_sample = 12 in
89
-
let data =
90
-
make_image ~bands ~width ~height (fun ~band ~x:_ ~y:_ -> band * 100)
91
-
in
92
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
93
-
94
-
(* Spectral correlation: bands are similar with small offsets. *)
95
-
let test_spectral_correlation () =
96
-
let bands = 8 and width = 8 and height = 8 and bits_per_sample = 10 in
97
-
let data =
98
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
99
-
let base = ((x * 30) + (y * 30)) mod 1024 in
100
-
(base + (band * 5)) mod 1024)
101
-
in
102
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
103
-
104
-
(* Checkerboard pattern per band. *)
105
-
let test_checkerboard_multi_band () =
106
-
let bands = 2 and width = 8 and height = 8 and bits_per_sample = 8 in
107
-
let data =
108
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
109
-
if (x + y + band) mod 2 = 0 then 200 else 50)
110
-
in
111
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data
112
-
113
-
(* Verify compression ratio for correlated multi-band data. *)
114
-
let test_compression_ratio () =
115
-
let bands = 4 and width = 16 and height = 16 and bits_per_sample = 8 in
116
-
let data =
117
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
118
-
let base = (x + y) * 255 / 30 in
119
-
(base + (band * 2)) mod 256)
120
-
in
121
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
122
-
let ratio =
123
-
Float.of_int (Bytes.length compressed) /. Float.of_int (Bytes.length data)
124
-
in
125
-
if ratio >= 1.0 then
126
-
Alcotest.failf
127
-
"compression ratio %.3f >= 1.0 for correlated multi-band data \
128
-
(compressed=%d, original=%d)"
129
-
ratio (Bytes.length compressed) (Bytes.length data)
130
-
131
-
(* Invalid input size should raise. *)
132
-
let test_invalid_size () =
133
-
let bands = 2 and width = 4 and height = 4 and bits_per_sample = 8 in
134
-
let data = Bytes.make 10 '\x00' in
135
-
match Hcomp.compress ~bands ~width ~height ~bits_per_sample data with
136
-
| _ -> Alcotest.fail "expected Invalid_argument for wrong data size"
137
-
| exception Invalid_argument _ -> ()
138
-
139
-
(* Invalid bits_per_sample should raise. *)
140
-
let test_invalid_bps () =
141
-
let bands = 1 and width = 2 and height = 2 in
142
-
let data = Bytes.make (1 * 2 * 2 * 2) '\x00' in
143
-
(match Hcomp.compress ~bands ~width ~height ~bits_per_sample:0 data with
144
-
| _ -> Alcotest.fail "expected Invalid_argument for bps=0"
145
-
| exception Invalid_argument _ -> ());
146
-
match Hcomp.compress ~bands ~width ~height ~bits_per_sample:17 data with
147
-
| _ -> Alcotest.fail "expected Invalid_argument for bps=17"
148
-
| exception Invalid_argument _ -> ()
149
-
150
-
(* -- Wire format tests ---------------------------------------------------- *)
151
-
152
-
let bytes_of_list l =
153
-
let b = Bytes.make (List.length l) '\000' in
154
-
List.iteri (fun i v -> Bytes.set_uint8 b i v) l;
155
-
b
156
-
157
-
let pp_bytes fmt b =
158
-
for i = 0 to Bytes.length b - 1 do
159
-
if i > 0 then Format.fprintf fmt " ";
160
-
Format.fprintf fmt "%02x" (Bytes.get_uint8 b i)
161
-
done
162
-
163
-
let bytes_eq = Alcotest.testable pp_bytes Bytes.equal
164
-
165
-
(** Wire format: compress a constant 2-band 2x2 cube and check exact output
166
-
bytes. This catches encoder bugs that a roundtrip would miss. *)
167
-
let test_wire_format_const_2band () =
168
-
let bands = 2 and width = 2 and height = 2 and bits_per_sample = 8 in
169
-
let data =
170
-
make_image ~bands ~width ~height (fun ~band ~x:_ ~y:_ ->
171
-
if band = 0 then 100 else 200)
172
-
in
173
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
174
-
let expected =
175
-
bytes_of_list
176
-
[
177
-
0x00;
178
-
0x02;
179
-
0x00;
180
-
0x02;
181
-
0x00;
182
-
0x02;
183
-
0x08;
184
-
0x17;
185
-
0x00;
186
-
0x0c;
187
-
0x40;
188
-
0x56;
189
-
0x81;
190
-
0x5a;
191
-
0x09;
192
-
0x60;
193
-
]
194
-
in
195
-
Alcotest.(check bytes_eq) "const 2-band wire format" expected compressed
196
-
197
-
(** Wire format: 1-band 2x2 ramp. *)
198
-
let test_wire_format_ramp_1band () =
199
-
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 8 in
200
-
let data =
201
-
make_image ~bands ~width ~height (fun ~band:_ ~x ~y -> (y * 2) + x)
202
-
in
203
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
204
-
let expected =
205
-
bytes_of_list
206
-
[
207
-
0x00;
208
-
0x01;
209
-
0x00;
210
-
0x02;
211
-
0x00;
212
-
0x02;
213
-
0x08;
214
-
0x00;
215
-
0x01;
216
-
0xf8;
217
-
0x28;
218
-
0x90;
219
-
0x00;
220
-
]
221
-
in
222
-
Alcotest.(check bytes_eq) "ramp 1-band wire format" expected compressed
223
-
224
-
(** Wire format: 1-bit checkerboard. *)
225
-
let test_wire_format_1bit () =
226
-
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 1 in
227
-
let data =
228
-
make_image ~bands ~width ~height (fun ~band:_ ~x ~y -> (x + y) mod 2)
229
-
in
230
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
231
-
let expected =
232
-
bytes_of_list [ 0x00; 0x01; 0x00; 0x02; 0x00; 0x02; 0x01; 0xc9; 0x40 ]
233
-
in
234
-
Alcotest.(check bytes_eq) "1-bit checker wire format" expected compressed
235
-
236
-
(** Wire format: 16-bit ramp. *)
237
-
let test_wire_format_16bit () =
238
-
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 16 in
239
-
let data =
240
-
make_image ~bands ~width ~height (fun ~band:_ ~x ~y -> ((y * 2) + x) * 1000)
241
-
in
242
-
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
243
-
let expected =
244
-
bytes_of_list
245
-
[
246
-
0x00;
247
-
0x01;
248
-
0x00;
249
-
0x02;
250
-
0x00;
251
-
0x02;
252
-
0x10;
253
-
0x00;
254
-
0x00;
255
-
0x00;
256
-
0x00;
257
-
0xbf;
258
-
0xff;
259
-
0xe1;
260
-
0xf4;
261
-
0x27;
262
-
0xd0;
263
-
0x40;
264
-
0x00;
265
-
]
266
-
in
267
-
Alcotest.(check bytes_eq) "16-bit ramp wire format" expected compressed
268
-
269
-
(* -- Spectral decorrelation effectiveness --------------------------------- *)
270
-
271
-
(** Spectral decorrelation: correlated multi-band data should compress better
272
-
than uncorrelated (random) multi-band data. *)
273
-
let test_spectral_decorrelation () =
274
-
let bands = 4 and width = 16 and height = 16 and bits_per_sample = 8 in
275
-
(* Correlated: all bands are a base gradient + tiny per-band offset *)
276
-
let correlated =
277
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
278
-
let base = (x + y) * 255 / 30 mod 256 in
279
-
(base + (band * 3)) mod 256)
280
-
in
281
-
let c_corr =
282
-
Hcomp.compress ~bands ~width ~height ~bits_per_sample correlated
283
-
in
284
-
(* Uncorrelated: each band is independent random data (deterministic seed) *)
285
-
let _ = Random.init 12345 in
286
-
let uncorrelated =
287
-
make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> Random.int 256)
288
-
in
289
-
let c_uncorr =
290
-
Hcomp.compress ~bands ~width ~height ~bits_per_sample uncorrelated
291
-
in
292
-
let ratio_corr =
293
-
Float.of_int (Bytes.length c_corr) /. Float.of_int (Bytes.length correlated)
294
-
in
295
-
let ratio_uncorr =
296
-
Float.of_int (Bytes.length c_uncorr)
297
-
/. Float.of_int (Bytes.length uncorrelated)
298
-
in
299
-
if ratio_corr >= ratio_uncorr then
300
-
Alcotest.failf
301
-
"spectral decorrelation ineffective: correlated ratio %.3f >= \
302
-
uncorrelated ratio %.3f"
303
-
ratio_corr ratio_uncorr
304
-
305
-
(* -- Bits per sample boundary tests --------------------------------------- *)
306
-
307
-
(** 1-bit samples: only values 0 and 1 are valid. *)
308
-
let test_1bit_roundtrip () =
309
-
let bands = 1 and width = 4 and height = 4 and bits_per_sample = 1 in
310
-
(* All zeros *)
311
-
let data0 = make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 0) in
312
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data0;
313
-
(* All ones *)
314
-
let data1 = make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 1) in
315
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data1;
316
-
(* Alternating *)
317
-
let data_alt =
318
-
make_image ~bands ~width ~height (fun ~band:_ ~x ~y -> (x + y) mod 2)
319
-
in
320
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data_alt;
321
-
(* Multi-band 1-bit *)
322
-
let bands = 3 and width = 4 and height = 4 in
323
-
let data_mb =
324
-
make_image ~bands ~width ~height (fun ~band ~x ~y -> (x + y + band) mod 2)
325
-
in
326
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data_mb
327
-
328
-
(** 16-bit samples: full range edge values. *)
329
-
let test_16bit_edge_values () =
330
-
let bands = 2 and width = 4 and height = 4 and bits_per_sample = 16 in
331
-
(* Max values *)
332
-
let data_max =
333
-
make_image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 65535)
334
-
in
335
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data_max;
336
-
(* Alternating 0 / 65535 *)
337
-
let data_alt =
338
-
make_image ~bands ~width ~height (fun ~band:_ ~x ~y ->
339
-
if (x + y) mod 2 = 0 then 0 else 65535)
340
-
in
341
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data_alt;
342
-
(* Near-max ramp *)
343
-
let data_ramp =
344
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
345
-
65535 - ((x + y + band) * 100))
346
-
in
347
-
check_roundtrip ~bands ~width ~height ~bits_per_sample data_ramp
348
-
349
-
(** Various bits_per_sample from 2 to 15. *)
350
-
let test_bps_range () =
351
-
List.iter
352
-
(fun bps ->
353
-
let max_val = (1 lsl bps) - 1 in
354
-
let bands = 2 and width = 4 and height = 4 in
355
-
let data =
356
-
make_image ~bands ~width ~height (fun ~band ~x ~y ->
357
-
((x * 31) + (y * 17) + (band * 7)) * max_val / 64 mod (max_val + 1))
358
-
in
359
-
check_roundtrip ~bands ~width ~height ~bits_per_sample:bps data)
360
-
[ 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16 ]
361
-
362
-
(* -- Suite ---------------------------------------------------------------- *)
363
-
364
-
let suite =
365
-
( "hcomp",
366
-
[
367
-
("single band constant roundtrip", `Quick, test_single_band_constant);
368
-
("single band gradient roundtrip", `Quick, test_single_band_gradient);
369
-
("multi-band constant roundtrip", `Quick, test_multi_band_constant);
370
-
("multi-band gradient roundtrip", `Quick, test_multi_band_gradient);
371
-
("16-bit samples roundtrip", `Quick, test_16bit_samples);
372
-
("all zeros roundtrip", `Quick, test_all_zeros);
373
-
("single pixel roundtrip", `Quick, test_single_pixel);
374
-
("spectral correlation roundtrip", `Quick, test_spectral_correlation);
375
-
("checkerboard multi-band roundtrip", `Quick, test_checkerboard_multi_band);
376
-
("compression ratio", `Quick, test_compression_ratio);
377
-
("invalid input size", `Quick, test_invalid_size);
378
-
("invalid bits_per_sample", `Quick, test_invalid_bps);
379
-
] )
380
-
381
-
let wire_format_suite =
382
-
( "wire-format",
383
-
[
384
-
("const 2-band 2x2", `Quick, test_wire_format_const_2band);
385
-
("ramp 1-band 2x2", `Quick, test_wire_format_ramp_1band);
386
-
("1-bit checkerboard", `Quick, test_wire_format_1bit);
387
-
("16-bit ramp", `Quick, test_wire_format_16bit);
388
-
] )
389
-
390
-
let spectral_suite =
391
-
( "spectral",
392
-
[ ("decorrelation effectiveness", `Quick, test_spectral_decorrelation) ] )
393
-
394
-
let boundary_suite =
395
-
( "boundary",
396
-
[
397
-
("1-bit roundtrip", `Quick, test_1bit_roundtrip);
398
-
("16-bit edge values", `Quick, test_16bit_edge_values);
399
-
("bps range 2..16", `Quick, test_bps_range);
400
-
] )
401
-
402
-
let () =
403
-
Alcotest.run "hcomp"
404
-
[ suite; wire_format_suite; spectral_suite; boundary_suite ]
1
+
let () = Alcotest.run "hcomp" [ Test_hcomp.suite ]
+385
test/test_hcomp.ml
+385
test/test_hcomp.ml
···
1
+
(* Copyright (c) 2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
+
3
+
Permission to use, copy, modify, and distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
+
15
+
(** Helper: create multi-band image data in BIP order with 16-bit big-endian
16
+
samples. *)
17
+
let image ~bands ~width ~height f =
18
+
let data = Bytes.make (bands * width * height * 2) '\x00' in
19
+
for y = 0 to height - 1 do
20
+
for x = 0 to width - 1 do
21
+
for band = 0 to bands - 1 do
22
+
let v = f ~band ~x ~y in
23
+
let idx = ((((y * width) + x) * bands) + band) * 2 in
24
+
Bytes.set data idx (Char.chr ((v lsr 8) land 0xFF));
25
+
Bytes.set data (idx + 1) (Char.chr (v land 0xFF))
26
+
done
27
+
done
28
+
done;
29
+
data
30
+
31
+
let check_roundtrip ~bands ~width ~height ~bits_per_sample data =
32
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
33
+
let decompressed =
34
+
Hcomp.decompress ~bands ~width ~height ~bits_per_sample compressed
35
+
in
36
+
if data <> decompressed then
37
+
Alcotest.failf
38
+
"roundtrip failed: input and output differ (bands=%d width=%d height=%d \
39
+
bps=%d)"
40
+
bands width height bits_per_sample
41
+
42
+
(* Single band, constant image. *)
43
+
let single_band_constant () =
44
+
let bands = 1 and width = 8 and height = 8 and bits_per_sample = 8 in
45
+
let data = image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 128) in
46
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
47
+
48
+
(* Single band, gradient. *)
49
+
let single_band_gradient () =
50
+
let bands = 1 and width = 8 and height = 8 and bits_per_sample = 8 in
51
+
let data = image ~bands ~width ~height (fun ~band:_ ~x ~y:_ -> x * 32) in
52
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
53
+
54
+
(* Multi-band constant. *)
55
+
let multi_band_constant () =
56
+
let bands = 4 and width = 8 and height = 8 and bits_per_sample = 8 in
57
+
let data =
58
+
image ~bands ~width ~height (fun ~band ~x:_ ~y:_ -> 50 * (band + 1))
59
+
in
60
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
61
+
62
+
(* Multi-band with spatial gradient. *)
63
+
let multi_band_gradient () =
64
+
let bands = 3 and width = 16 and height = 16 and bits_per_sample = 8 in
65
+
let data =
66
+
image ~bands ~width ~height (fun ~band ~x ~y ->
67
+
(((x + y) * 8) + (band * 20)) mod 256)
68
+
in
69
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
70
+
71
+
(* 16-bit samples. *)
72
+
let samples_16bit () =
73
+
let bands = 2 and width = 8 and height = 8 and bits_per_sample = 16 in
74
+
let data =
75
+
image ~bands ~width ~height (fun ~band ~x ~y ->
76
+
((x * 1000) + (y * 500) + (band * 10000)) mod 65536)
77
+
in
78
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
79
+
80
+
(* All zeros. *)
81
+
let all_zeros () =
82
+
let bands = 3 and width = 4 and height = 4 and bits_per_sample = 8 in
83
+
let data = image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 0) in
84
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
85
+
86
+
(* Single pixel image. *)
87
+
let single_pixel () =
88
+
let bands = 5 and width = 1 and height = 1 and bits_per_sample = 12 in
89
+
let data = image ~bands ~width ~height (fun ~band ~x:_ ~y:_ -> band * 100) in
90
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
91
+
92
+
(* Spectral correlation: bands are similar with small offsets. *)
93
+
let spectral_correlation () =
94
+
let bands = 8 and width = 8 and height = 8 and bits_per_sample = 10 in
95
+
let data =
96
+
image ~bands ~width ~height (fun ~band ~x ~y ->
97
+
let base = ((x * 30) + (y * 30)) mod 1024 in
98
+
(base + (band * 5)) mod 1024)
99
+
in
100
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
101
+
102
+
(* Checkerboard pattern per band. *)
103
+
let checkerboard_multi_band () =
104
+
let bands = 2 and width = 8 and height = 8 and bits_per_sample = 8 in
105
+
let data =
106
+
image ~bands ~width ~height (fun ~band ~x ~y ->
107
+
if (x + y + band) mod 2 = 0 then 200 else 50)
108
+
in
109
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data
110
+
111
+
(* Verify compression ratio for correlated multi-band data. *)
112
+
let compression_ratio () =
113
+
let bands = 4 and width = 16 and height = 16 and bits_per_sample = 8 in
114
+
let data =
115
+
image ~bands ~width ~height (fun ~band ~x ~y ->
116
+
let base = (x + y) * 255 / 30 in
117
+
(base + (band * 2)) mod 256)
118
+
in
119
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
120
+
let ratio =
121
+
Float.of_int (Bytes.length compressed) /. Float.of_int (Bytes.length data)
122
+
in
123
+
if ratio >= 1.0 then
124
+
Alcotest.failf
125
+
"compression ratio %.3f >= 1.0 for correlated multi-band data \
126
+
(compressed=%d, original=%d)"
127
+
ratio (Bytes.length compressed) (Bytes.length data)
128
+
129
+
(* Invalid input size should raise. *)
130
+
let invalid_size () =
131
+
let bands = 2 and width = 4 and height = 4 and bits_per_sample = 8 in
132
+
let data = Bytes.make 10 '\x00' in
133
+
match Hcomp.compress ~bands ~width ~height ~bits_per_sample data with
134
+
| _ -> Alcotest.fail "expected Invalid_argument for wrong data size"
135
+
| exception Invalid_argument _ -> ()
136
+
137
+
(* Invalid bits_per_sample should raise. *)
138
+
let invalid_bps () =
139
+
let bands = 1 and width = 2 and height = 2 in
140
+
let data = Bytes.make (1 * 2 * 2 * 2) '\x00' in
141
+
(match Hcomp.compress ~bands ~width ~height ~bits_per_sample:0 data with
142
+
| _ -> Alcotest.fail "expected Invalid_argument for bps=0"
143
+
| exception Invalid_argument _ -> ());
144
+
match Hcomp.compress ~bands ~width ~height ~bits_per_sample:17 data with
145
+
| _ -> Alcotest.fail "expected Invalid_argument for bps=17"
146
+
| exception Invalid_argument _ -> ()
147
+
148
+
(* -- Wire format tests ---------------------------------------------------- *)
149
+
150
+
let bytes_of_list l =
151
+
let b = Bytes.make (List.length l) '\000' in
152
+
List.iteri (fun i v -> Bytes.set_uint8 b i v) l;
153
+
b
154
+
155
+
let pp_bytes fmt b =
156
+
for i = 0 to Bytes.length b - 1 do
157
+
if i > 0 then Fmt.pf fmt " ";
158
+
Fmt.pf fmt "%02x" (Bytes.get_uint8 b i)
159
+
done
160
+
161
+
let bytes_eq = Alcotest.testable pp_bytes Bytes.equal
162
+
163
+
(** Wire format: compress a constant 2-band 2x2 cube and check exact output
164
+
bytes. This catches encoder bugs that a roundtrip would miss. *)
165
+
let wire_format_const_2band () =
166
+
let bands = 2 and width = 2 and height = 2 and bits_per_sample = 8 in
167
+
let data =
168
+
image ~bands ~width ~height (fun ~band ~x:_ ~y:_ ->
169
+
if band = 0 then 100 else 200)
170
+
in
171
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
172
+
let expected =
173
+
bytes_of_list
174
+
[
175
+
0x00;
176
+
0x02;
177
+
0x00;
178
+
0x02;
179
+
0x00;
180
+
0x02;
181
+
0x08;
182
+
0x17;
183
+
0x00;
184
+
0x0c;
185
+
0x40;
186
+
0x56;
187
+
0x81;
188
+
0x5a;
189
+
0x09;
190
+
0x60;
191
+
]
192
+
in
193
+
Alcotest.(check bytes_eq) "const 2-band wire format" expected compressed
194
+
195
+
(** Wire format: 1-band 2x2 ramp. *)
196
+
let wire_format_ramp_1band () =
197
+
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 8 in
198
+
let data = image ~bands ~width ~height (fun ~band:_ ~x ~y -> (y * 2) + x) in
199
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
200
+
let expected =
201
+
bytes_of_list
202
+
[
203
+
0x00;
204
+
0x01;
205
+
0x00;
206
+
0x02;
207
+
0x00;
208
+
0x02;
209
+
0x08;
210
+
0x00;
211
+
0x01;
212
+
0xf8;
213
+
0x28;
214
+
0x90;
215
+
0x00;
216
+
]
217
+
in
218
+
Alcotest.(check bytes_eq) "ramp 1-band wire format" expected compressed
219
+
220
+
(** Wire format: 1-bit checkerboard. *)
221
+
let wire_format_1bit () =
222
+
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 1 in
223
+
let data = image ~bands ~width ~height (fun ~band:_ ~x ~y -> (x + y) mod 2) in
224
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
225
+
let expected =
226
+
bytes_of_list [ 0x00; 0x01; 0x00; 0x02; 0x00; 0x02; 0x01; 0xc9; 0x40 ]
227
+
in
228
+
Alcotest.(check bytes_eq) "1-bit checker wire format" expected compressed
229
+
230
+
(** Wire format: 16-bit ramp. *)
231
+
let wire_format_16bit () =
232
+
let bands = 1 and width = 2 and height = 2 and bits_per_sample = 16 in
233
+
let data =
234
+
image ~bands ~width ~height (fun ~band:_ ~x ~y -> ((y * 2) + x) * 1000)
235
+
in
236
+
let compressed = Hcomp.compress ~bands ~width ~height ~bits_per_sample data in
237
+
let expected =
238
+
bytes_of_list
239
+
[
240
+
0x00;
241
+
0x01;
242
+
0x00;
243
+
0x02;
244
+
0x00;
245
+
0x02;
246
+
0x10;
247
+
0x00;
248
+
0x00;
249
+
0x00;
250
+
0x00;
251
+
0xbf;
252
+
0xff;
253
+
0xe1;
254
+
0xf4;
255
+
0x27;
256
+
0xd0;
257
+
0x40;
258
+
0x00;
259
+
]
260
+
in
261
+
Alcotest.(check bytes_eq) "16-bit ramp wire format" expected compressed
262
+
263
+
(* -- Spectral decorrelation effectiveness --------------------------------- *)
264
+
265
+
(** Spectral decorrelation: correlated multi-band data should compress better
266
+
than uncorrelated (random) multi-band data. *)
267
+
let spectral_decorrelation () =
268
+
let bands = 4 and width = 16 and height = 16 and bits_per_sample = 8 in
269
+
let correlated =
270
+
image ~bands ~width ~height (fun ~band ~x ~y ->
271
+
let base = (x + y) * 255 / 30 mod 256 in
272
+
(base + (band * 3)) mod 256)
273
+
in
274
+
let c_corr =
275
+
Hcomp.compress ~bands ~width ~height ~bits_per_sample correlated
276
+
in
277
+
let _ = Random.init 12345 in
278
+
let uncorrelated =
279
+
image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> Random.int 256)
280
+
in
281
+
let c_uncorr =
282
+
Hcomp.compress ~bands ~width ~height ~bits_per_sample uncorrelated
283
+
in
284
+
let ratio_corr =
285
+
Float.of_int (Bytes.length c_corr) /. Float.of_int (Bytes.length correlated)
286
+
in
287
+
let ratio_uncorr =
288
+
Float.of_int (Bytes.length c_uncorr)
289
+
/. Float.of_int (Bytes.length uncorrelated)
290
+
in
291
+
if ratio_corr >= ratio_uncorr then
292
+
Alcotest.failf
293
+
"spectral decorrelation ineffective: correlated ratio %.3f >= \
294
+
uncorrelated ratio %.3f"
295
+
ratio_corr ratio_uncorr
296
+
297
+
(* -- Bits per sample boundary tests --------------------------------------- *)
298
+
299
+
(** 1-bit samples: only values 0 and 1 are valid. *)
300
+
let roundtrip_1bit () =
301
+
let bands = 1 and width = 4 and height = 4 and bits_per_sample = 1 in
302
+
let data0 = image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 0) in
303
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data0;
304
+
let data1 = image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 1) in
305
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data1;
306
+
let data_alt =
307
+
image ~bands ~width ~height (fun ~band:_ ~x ~y -> (x + y) mod 2)
308
+
in
309
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data_alt;
310
+
let bands = 3 and width = 4 and height = 4 in
311
+
let data_mb =
312
+
image ~bands ~width ~height (fun ~band ~x ~y -> (x + y + band) mod 2)
313
+
in
314
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data_mb
315
+
316
+
(** 16-bit samples: full range edge values. *)
317
+
let edge_values_16bit () =
318
+
let bands = 2 and width = 4 and height = 4 and bits_per_sample = 16 in
319
+
let data_max = image ~bands ~width ~height (fun ~band:_ ~x:_ ~y:_ -> 65535) in
320
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data_max;
321
+
let data_alt =
322
+
image ~bands ~width ~height (fun ~band:_ ~x ~y ->
323
+
if (x + y) mod 2 = 0 then 0 else 65535)
324
+
in
325
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data_alt;
326
+
let data_ramp =
327
+
image ~bands ~width ~height (fun ~band ~x ~y ->
328
+
65535 - ((x + y + band) * 100))
329
+
in
330
+
check_roundtrip ~bands ~width ~height ~bits_per_sample data_ramp
331
+
332
+
(** Various bits_per_sample from 2 to 15. *)
333
+
let bps_range () =
334
+
List.iter
335
+
(fun bps ->
336
+
let max_val = (1 lsl bps) - 1 in
337
+
let bands = 2 and width = 4 and height = 4 in
338
+
let data =
339
+
image ~bands ~width ~height (fun ~band ~x ~y ->
340
+
((x * 31) + (y * 17) + (band * 7)) * max_val / 64 mod (max_val + 1))
341
+
in
342
+
check_roundtrip ~bands ~width ~height ~bits_per_sample:bps data)
343
+
[ 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16 ]
344
+
345
+
(* -- Suites --------------------------------------------------------------- *)
346
+
347
+
let core_cases =
348
+
[
349
+
("single band constant roundtrip", `Quick, single_band_constant);
350
+
("single band gradient roundtrip", `Quick, single_band_gradient);
351
+
("multi-band constant roundtrip", `Quick, multi_band_constant);
352
+
("multi-band gradient roundtrip", `Quick, multi_band_gradient);
353
+
("16-bit samples roundtrip", `Quick, samples_16bit);
354
+
("all zeros roundtrip", `Quick, all_zeros);
355
+
("single pixel roundtrip", `Quick, single_pixel);
356
+
("spectral correlation roundtrip", `Quick, spectral_correlation);
357
+
("checkerboard multi-band roundtrip", `Quick, checkerboard_multi_band);
358
+
("compression ratio", `Quick, compression_ratio);
359
+
("invalid input size", `Quick, invalid_size);
360
+
("invalid bits_per_sample", `Quick, invalid_bps);
361
+
]
362
+
363
+
let wire_format_cases =
364
+
[
365
+
("const 2-band 2x2", `Quick, wire_format_const_2band);
366
+
("ramp 1-band 2x2", `Quick, wire_format_ramp_1band);
367
+
("1-bit checkerboard", `Quick, wire_format_1bit);
368
+
("16-bit ramp", `Quick, wire_format_16bit);
369
+
]
370
+
371
+
let spectral_cases =
372
+
[ ("decorrelation effectiveness", `Quick, spectral_decorrelation) ]
373
+
374
+
let boundary_cases =
375
+
[
376
+
("1-bit roundtrip", `Quick, roundtrip_1bit);
377
+
("16-bit edge values", `Quick, edge_values_16bit);
378
+
("bps range 2..16", `Quick, bps_range);
379
+
]
380
+
381
+
let suite =
382
+
( "hcomp",
383
+
List.map
384
+
(fun (n, sp, f) -> Alcotest.test_case n sp f)
385
+
(core_cases @ wire_format_cases @ spectral_cases @ boundary_cases) )