package gsl

  1. Overview
  2. Docs

Source file wavelet.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
type t
type ws

let () = Error.init ()

type kind =
  | DAUBECHIES
  | DAUBECHIES_CENTERED
  | HAAR
  | HAAR_CENTERED
  | BSPLINE
  | BSPLINE_CENTERED

type direction =
  | FORWARD
  | BACKWARD

external _alloc : kind -> int -> t = "ml_gsl_wavelet_alloc"
external _free : t -> unit = "ml_gsl_wavelet_free"
let make kind size =
  let w = _alloc kind size in
  Gc.finalise _free w ;
  w

external name : t -> string = "ml_gsl_wavelet_name"

external _workspace_alloc : int -> ws = "ml_gsl_wavelet_workspace_alloc"
external _workspace_free  : ws -> unit = "ml_gsl_wavelet_workspace_free"
let workspace_make size =
  let ws = _workspace_alloc size in
  Gc.finalise _workspace_free ws ;
  ws
external workspace_size : ws -> int = "ml_gsl_wavelet_workspace_size"

external _transform : 
  t -> direction -> Vector_flat.vector -> ws -> unit 
  = "ml_gsl_wavelet_transform"
external _transform_bigarray : 
  t -> direction -> Vector.vector -> ws -> unit 
  = "ml_gsl_wavelet_transform_bigarray"

let with_workspace ws length f arg =
  let workspace = 
    match ws with 
    | Some ws -> ws
    | None -> _workspace_alloc (length arg) in
  try 
    f arg workspace ;
    if ws = None then _workspace_free workspace
  with exn ->
    if ws = None then _workspace_free workspace ;
    raise exn

let transform_vector_flat w dir ?ws =
  with_workspace ws 
    Vector_flat.length
    (_transform w dir)

let transform_vector w dir ?ws =
  with_workspace ws 
    Vector.length
    (_transform_bigarray w dir)

let transform_gen w dir ?ws = function
  | `V v  -> transform_vector      w dir ?ws v
  | `VF v -> transform_vector_flat w dir ?ws v

let transform_array w dir ?ws ?stride ?off ?len arr =
  transform_vector_flat w dir ?ws
    (Vector_flat.view_array ?stride ?off ?len arr)

let transform_forward w = transform_array w FORWARD
let transform_inverse w = transform_array w BACKWARD

type ordering =
  | STANDARD
  | NON_STANDARD

external _transform_2d :
  t -> ordering -> direction -> Matrix_flat.matrix -> ws -> unit
  = "ml_gsl_wavelet2d_transform_matrix"
external _transform_2d_bigarray :
  t -> ordering -> direction -> Matrix.matrix -> ws -> unit
  = "ml_gsl_wavelet2d_transform_matrix"
external _transform_2d_gen :
  t -> ordering -> direction -> [< Vectmat.mat] -> ws -> unit
  = "ml_gsl_wavelet2d_transform_matrix"

let transform_matrix_flat w order dir ?ws =
  with_workspace ws
    (fun m -> fst (Matrix_flat.dims m))
    (_transform_2d w order dir)

let transform_matrix w order dir ?ws =
  with_workspace ws
    (fun m -> fst (Matrix.dims m))
    (_transform_2d_bigarray w order dir)

let transform_matrix_gen w order dir ?ws =
  with_workspace ws
    (fun m -> fst (Vectmat.dims m))
    (_transform_2d_gen w order dir)