oceanbox/Tzar
6
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 3 Wiki Activity

feat: compress and write to tzar format

Browse Source
This commit is contained in:
Jonas Juselius
2025-07-11 15:24:03 +02:00
parent 4658c1900b
commit 48ac7b7769
6 changed files with 163 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@@ -21,4 +21,5 @@ _*.yaml
NuGet.Config
*.sif
*.nc
*.out
*.out
_*

28
src/Copy.fs
View File

@@ -1,11 +1,14 @@
module Tzar.Copy
open System
open System.IO
open FSharpPlus.Control
open Serilog
open FSharp.Compression
open Oceanbox.FvcomKit
open Types
open Tzar.Cli
open Tzar.Tzar
open Fvcom
let private witherZfp tol x =
@@ -79,7 +82,12 @@ let private writeToDest (dst: Uri) (transform: single[] -> single[]) (source: (i
elif dst.LocalPath.EndsWith ".zarr" then
notImplemented "file/zarr"
else
notImplemented "file/r3"
if not (Directory.Exists dst.LocalPath) then
Directory.CreateDirectory dst.LocalPath |> ignore
source
|> Seq.iter (fun (t, p) ->
let data = toZarData transform p
writeTzar dst.LocalPath Guid.Empty t data)
| "s3" ->
let bucket, key = S3.getBucketAndKey dst.LocalPath
if dst.LocalPath.EndsWith ".nc" then
@@ -130,8 +138,24 @@ let copyAction (a: CopyArgs) =
let tol = 1e-4
witherZfp tol
elif a.Compress then
failwith "not implemented"
match a.Sz3 with
| Some tol ->
if a.Rel then
Sz3.Single.sz3CompressRelToSingle tol
else
Sz3.Single.sz3CompressToSingle tol
| None ->
match a.Zfp with
| Some tol -> Zfp.Single.zfpCompressToSingle tol
| None ->
let tol = 1e-4
Zfp.Single.zfpCompressToSingle tol
elif a.Decompress then
// match a.Sz3 with
// | Some tol ->
// Sz3.Single.sz3Decompress x.Length
// | None ->
// Zfp.Single.zfpDecompress
failwith "not implemented"
else
id

50
src/Sz3.fs
View File

@@ -115,6 +115,31 @@ module Single =
Marshal.FreeHGlobal p
compressed
let sz3CompressToSingle (tol: double) (data: single[]) : single[] =
use dp = fixed data
let n = uint64 data.Length
let mutable size = 0UL
let p =
Native.SZ_compress_args (
Native.SZ3_FLOAT,
NativePtr.toNativeInt dp,
&size,
Native.SZ3_ABS,
tol,
0,
0,
0UL,
0UL,
0UL,
0UL,
n
)
// printfn $"sz3 size: {data.Length * 4} -> {size}"
let compressed: single[] = Array.zeroCreate (int size / 4)
Marshal.Copy (p, compressed, 0, int size / 4)
Marshal.FreeHGlobal p
compressed
let sz3CompressRel (tol: double) (data: single[]) : byte[] =
use dp = fixed data
let n = uint64 data.Length
@@ -140,6 +165,31 @@ module Single =
Marshal.FreeHGlobal p
compressed
let sz3CompressRelToSingle (tol: double) (data: single[]) : single[] =
use dp = fixed data
let n = uint64 data.Length
let mutable size = 0UL
let p =
Native.SZ_compress_args (
Native.SZ3_FLOAT,
NativePtr.toNativeInt dp,
&size,
Native.SZ3_REL,
0,
tol,
0,
0UL,
0UL,
0UL,
0UL,
n
)
// printfn $"sz3 size: {data.Length * 4} -> {size}"
let compressed: single[] = Array.zeroCreate (int size / 4)
Marshal.Copy (p, compressed, 0, int size)
Marshal.FreeHGlobal p
compressed
let sz3Decompress (n: int) (data: byte[]) : single[] =
use dp = fixed data
let size = uint64 data.Length

65
src/Tzar.fs Normal file
View File

@@ -0,0 +1,65 @@
module Tzar.Tzar
open System
open System.IO
open Serilog
open Types
type TzarData = {
s: single[][]
t: single[][]
u: single[][]
v: single[][]
w: single[][]
z: single[]
} with
static member empty = {
s = Array.zeroCreate 0
t = Array.zeroCreate 0
z = Array.zeroCreate 0
u = Array.zeroCreate 0
v = Array.zeroCreate 0
w = Array.zeroCreate 0
}
let private writeTzarData (path: string) (aid: Guid) (prop: string) (t: int) (l: int) (data: single[]) =
let fname = Path.Join [| path; $"{aid}.{prop}.{t}.{l}.0" |]
let buf: byte[] = Array.zeroCreate (data.Length * 4)
for i = 0 to data.Length - 1 do
let bytes = BitConverter.GetBytes data[i]
let i' = i * 4
buf[i' .. i' + 3] <- bytes
File.WriteAllBytes (fname, buf)
let toZarData (f: single[] -> single[]) (ps: AsyncProp seq) : TzarData =
let to2D (aa: Async<single[]>) = aa |> Async.RunSynchronously |> f
let to3D (aa: Async<single[][]>) = aa |> Async.RunSynchronously |> Array.map f
ps
|> Seq.fold
(fun a x ->
match x with
| U y -> { a with u = to3D y }
| V y -> { a with v = to3D y }
| W y -> { a with w = to3D y }
| S y -> { a with s = to3D y }
| T y -> { a with t = to3D y }
| Z y -> { a with z = to2D y }
| _ -> a)
TzarData.empty
let writeTzar (path: string) (aid: Guid) (t: int) (data: TzarData) =
let layers = data.t.Length
try
for l = 0 to layers - 1 do
writeTzarData path aid "s" t l data.s[l]
writeTzarData path aid "t" t l data.t[l]
writeTzarData path aid "u" t l data.u[l]
writeTzarData path aid "v" t l data.v[l]
writeTzarData path aid "w" t l data.w[l]
writeTzarData path aid "z" t 0 data.z
with e ->
Log.Fatal e.Message
exit 1

1
src/Tzar.fsproj
View File

@@ -17,6 +17,7 @@
<Compile Include="Types.fs" />
<Compile Include="Cli.fs" />
<Compile Include="Fvcom.fs" />
<Compile Include="Tzar.fs" />
<Compile Include="R3.fs" />
<Compile Include="S3.fs" />
<Compile Include="Zarr.fs" />

25
src/Zfp.fs
View File

@@ -109,7 +109,7 @@ module private Native =
extern void zfp_stream_close(IntPtr zfp)
[<DllImport(libzfp, CallingConvention = CallingConvention.Cdecl)>]
extern IntPtr stream_open(byte[] buf, uint size)
extern IntPtr stream_open(IntPtr, uint size)
[<DllImport(libzfp, CallingConvention = CallingConvention.Cdecl)>]
extern void stream_close(IntPtr stream)
@@ -133,13 +133,14 @@ module private Native =
extern bool zfp_stream_set_omp_chunk_size(IntPtr stream, uint threads)
module private Internal =
let compress (tol: double) (field: ZfpField) : byte[] =
let compress<'T when 'T: unmanaged> (tol: double) (field: ZfpField) : 'T[] =
let zstream = Native.zfp_stream_open 0
Native.zfp_stream_set_accuracy (zstream, tol)
// Native.zfp_stream_set_precision(zstream, 16u)
let bufsize = Native.zfp_stream_maximum_size (zstream, field)
let compressed: byte[] = Array.zeroCreate (int bufsize)
let stream = Native.stream_open (compressed, uint bufsize)
let compressed: 'T[] = Array.zeroCreate (int bufsize)
use compressed' = fixed compressed
let stream = Native.stream_open (NativePtr.toNativeInt compressed', uint bufsize)
Native.zfp_stream_set_bit_stream (zstream, stream)
Native.zfp_stream_rewind zstream
@@ -154,7 +155,8 @@ module private Internal =
compressed[0 .. size - 1]
let readHeader (compressed: byte[]) : ZfpField =
let stream = Native.stream_open (compressed, uint compressed.Length)
use compressed' = fixed compressed
let stream = Native.stream_open (NativePtr.toNativeInt compressed', uint compressed.Length)
let zstream = Native.zfp_stream_open 0
Native.zfp_stream_set_bit_stream (zstream, stream)
@@ -166,7 +168,8 @@ module private Internal =
field
let decompress<'T when 'T: unmanaged> (compressed: byte[]) : 'T[] =
let stream = Native.stream_open (compressed, uint compressed.Length)
use compressed' = fixed compressed
let stream = Native.stream_open (NativePtr.toNativeInt compressed', uint compressed.Length)
let zstream = Native.zfp_stream_open 0
Native.zfp_stream_set_bit_stream (zstream, stream)
@@ -198,6 +201,16 @@ module Single =
}
Internal.compress tol field
let zfpCompressToSingle (tol: double) (data: single[]) : single[] =
use data' = fixed data
let field = {
ZfpField.empty with
_type = ZfpType.Float
nx = uint64 data.Length
data = NativePtr.toNativeInt data'
}
Internal.compress tol field
let zfpDecompress (data: byte[]) : single[] = Internal.decompress<single> data
module Double =