mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-06-14 09:15:19 +02:00
32 KiB
32 KiB
None
<html>
<head>
</head>
</html>
In [1]:
#use "topfind";;
#require "jupyter.notebook";;
#require "lacaml.top" ;;
Sparse Vector module¶
A sparse vector is a structure made of:
- The dimension of the vector space
- The number of non-zeros
- An array of indices
- An array of values
The indices are stored in an int Bigarray and the values are stored in a Lacaml.Vec.t
Types¶
In [2]:
module L = Lacaml.D
type t =
{
dim: int ;
nnz: int ;
indices: (int, Bigarray.int_elt, Bigarray.fortran_layout) Bigarray.Array1.t ; (* Indices *)
values: L.Vec.t
}
Out[2]:
Out[2]:
Printers¶
In [3]:
let pp ppf t =
let pp_data ppf t =
for i=1 to t.nnz do
Format.fprintf ppf "@[(%d,@ %f)@]@;" t.indices.{i} t.values.{i}
done
in
Format.fprintf ppf "@[{@[dim:@ %d@]@;@[%a@]}@]" t.dim pp_data t
Out[3]:
Creators¶
In [4]:
let of_vec ?(threshold=0.) v =
let dim = L.Vec.dim v in
let buffer_idx = Bigarray.(Array1.create int fortran_layout) dim in
let buffer_val = Bigarray.(Array1.create float64 fortran_layout) dim in
let check =
if threshold = 0. then
fun x -> x <> 0.
else
fun x -> (abs_float x) > 0.
in
let rec aux k i =
if i > dim then
k-1
else if check v.{i} then
( buffer_idx.{k} <- i ;
buffer_val.{k} <- v.{i} ;
aux (k+1) (i+1)
)
else
aux k (i+1)
in
let nnz = aux 1 1 in
let indices = Bigarray.(Array1.create int fortran_layout) nnz in
let values = L.Vec.create nnz in
for i=1 to nnz do
indices.{i} <- buffer_idx.{i};
values.{i} <- buffer_val.{i};
done ;
{ dim ; nnz ; indices ; values }
Out[4]:
In [5]:
let make0 dim =
{ dim ;
nnz = 0;
indices = Bigarray.(Array1.create int fortran_layout) 32 ;
values = L.Vec.create 32;
}
Out[5]:
In [77]:
let of_vec ?(threshold=0.) v =
let dim = L.Vec.dim v in
let buffer_idx = Bigarray.(Array1.create int fortran_layout) dim in
let buffer_val = Bigarray.(Array1.create float64 fortran_layout) dim in
let check =
if threshold = 0. then
fun x -> x <> 0.
else
fun x -> (abs_float x) > 0.
in
let rec aux k i =
if i > dim then
k-1
else if check v.{i} then
( buffer_idx.{k} <- i ;
buffer_val.{k} <- v.{i} ;
aux (k+1) (i+1)
)
else
aux k (i+1)
in
let nnz = aux 1 1 in
let indices = Bigarray.(Array1.create int fortran_layout) nnz in
let values = L.Vec.create nnz in
for i=1 to nnz do
indices.{i} <- buffer_idx.{i};
values.{i} <- buffer_val.{i};
done ;
{ dim ; nnz ; indices ; values }
let of_array ?(threshold=0.) a =
L.Vec.of_array a
|> of_vec ~threshold
Out[77]:
Out[77]:
In [78]:
let copy t =
let indices =
Bigarray.(Array1.create int fortran_layout) t.nnz
in
Bigarray.Array1.blit t.indices indices ;
let values = L.copy t.values in
{ dim = t.dim ;
nnz = t.nnz ;
indices ; values }
Out[78]:
Test¶
In [79]:
let x = make0 10
let dense_a =
of_array [| 1. ; -2. ; 0. ; 0. ; 0.5 ; 1.e-8 ; 0. ; 3. ; 0. |]
let sparse_a = of_vec dense_a
let _ =
copy sparse_a = sparse_a
let _ =
copy sparse_a == sparse_a
let () =
Format.printf "@.@[%a@]@." pp sparse_a
Out[79]:
Out[79]:
aX + Y¶
Run along all the entries of X and Y simultaneously with indices k and l. m is the index of the new array.
if k<l, update using a*x[k].
if k>l, update using y[l].
if k=l, update using a*x[k] + y[l].
In [105]:
let axpy ?(threshold=0.) ?(alpha=1.) x y =
if dim x <> dim y then
invalid_arg "Inconsistent dimensions";
let check = (* Test if value should be added wrt threshold *)
if threshold = 0. then
fun x -> x <> 0.
else
fun x -> abs_float x > 0.
in
let f = (* if a=1 in ax+y, then do x+y. If a=0 then do y *)
if alpha = 1. then
fun x y -> x +. y
else if alpha = 0. then
fun _ y -> y
else
fun x y -> alpha *. x +. y
in
let dim = dim x in
let nnz = x.nnz + y.nnz in
let new_indices = Bigarray.(Array1.create int fortran_layout) nnz in
let new_values = L.Vec.create nnz in
let rec aux k l m =
match k <= x.nnz, l <= y.nnz with
| true , true -> (* Both arrays are running *)
begin
if x.indices.{k} < y.indices.{l} then (
let w = f x.values.{k} 0. in
if check w then (
new_indices.{m} <- x.indices.{k};
new_values.{m} <- w
);
(aux [@tailcall]) (k+1) l (m+1)
)
else if x.indices.{k} > y.indices.{l} then (
let w = y.values.{l} in
if check w then (
new_indices.{m} <- y.indices.{l};
new_values.{m} <- w
);
(aux [@tailcall]) k (l+1) (m+1)
)
else (
let w = f x.values.{k} y.values.{l} in
if check w then (
new_indices.{m} <- x.indices.{k};
new_values.{m} <- w
);
(aux [@tailcall]) (k+1) (l+1) (m+1)
)
end
| false, true -> (* Array x is done running *)
begin
let m = ref m in
for i=l to y.nnz do
let w = y.values.{i} in
if check w then (
new_indices.{!m} <- y.indices.{i};
new_values.{!m} <- w;
incr m;
)
done; !m
end
| true, false -> (* Array y is done running *)
begin
let m = ref m in
for i=k to x.nnz do
let w = alpha *. x.values.{i} in
if check w then (
new_indices.{!m} <- x.indices.{i};
new_values.{!m} <- w;
incr m;
)
done; !m
end
| false, false -> (* Both arrays are done *)
m
in
let nnz = (aux 1 1 1) - 1 in
{ dim ; nnz ;
indices = new_indices ; values = new_values }
Out[105]:
Test¶
In [108]:
let m_A = L.Vec.of_array [| 1. ; 2. ; 0. ; 0. ; 0.01 ; -2. ; 0. ; -1.e-3 ; 0. ; 0.|]
let m_B = L.Vec.of_array [| 0. ; 1. ; 2. ; 0. ; 0. ; 0.01 ; -2. ; 0. ; -1.e-3 ; 2. |]
let m_As = of_vec m_A
let m_Bs = of_vec m_B
let m_C = L.copy m_B ;;
L.axpy ~alpha:2. m_A m_C;;
m_C;;
let m_D = L.copy m_A;;
L.axpy ~alpha:2. m_B m_D;;
m_D;;
let m_Cs = axpy ~alpha:2. m_As m_Bs
let _ = of_vec m_C = m_Cs;;
let m_Ds = axpy ~alpha:2. m_Bs m_As
let _ = of_vec m_D = m_Ds;;
L.Vec.iteri (fun i x -> Format.printf "%d %f %f\n%!" i x (get m_Cs i)) m_C;;
L.Vec.iteri (fun i x -> Format.printf "%d %f %f\n%!" i x (get m_Ds i)) m_D;;
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Out[108]:
Accessors¶
In [24]:
let dim t = t.dim
let nnz t = t.nnz
let indices t = t.indices
let values t = t.values
Out[24]:
Out[24]:
Out[24]:
Out[24]:
In [25]:
let get t i =
if i < 1 || i > dim t then invalid_arg "index out of bounds";
let rec binary_search index value low high =
if high = low then
if index.{low} = value then
low
else
raise Not_found
else let mid = (low + high) / 2 in
if index.{mid} > value then
binary_search index value low (mid - 1)
else if index.{mid} < value then
binary_search index value (mid + 1) high
else
mid
in
try
let k =
let id = indices t in
binary_search id i id.{1} (nnz t)
in
t.values.{k}
with Not_found -> 0.
Out[25]:
In [26]:
let iter f t =
for k=1 to nnz t do
f t.indices.{k} t.values.{k}
done
Out[26]:
Test¶
In [28]:
dense_a = L.Vec.init (dim sparse_a) (get sparse_a);;
iter (fun i v -> Printf.printf "%d %f\n%!" i v) sparse_a;;
Out[28]:
Out[28]:
Converters¶
In [30]:
let to_assoc_list t =
let rec aux k accu =
if k = 0 then
accu
else
aux (k-1) ( (t.indices.{k}, t.values.{k})::accu )
in
aux (nnz t) []
let to_vec t =
let result = L.Vec.make0 (dim t) in
iter (fun k v -> result.{k} <- v) t;
result
Out[30]:
Out[30]:
Test¶
In [31]:
to_assoc_list sparse_a;;
to_vec sparse_a = dense_a;;
Out[31]:
Out[31]:
Operations¶
One-vector operations¶
In [64]:
let immutable f t =
let result = copy t in
f result;
result
let scale_mut x t =
L.scal x t.values
let scale x = immutable @@ scale_mut x
let neg t =
{ t with values = L.Vec.neg t.values }
Out[64]:
Out[64]:
Out[64]:
Out[64]:
Test¶
In [67]:
let sparse_b = copy sparse_a;;
scale_mut 0.5 sparse_b;;
let sparse_c = scale 0.5 sparse_a;;
Format.printf "%a@." pp sparse_a;;
Format.printf "%a@." pp sparse_b;;
Format.printf "%a@." pp sparse_c;;
Format.printf "%a@." pp (neg sparse_a);;
let _ =
let n1 = neg sparse_a in
neg n1 = sparse_a
Out[67]:
Out[67]:
Out[67]:
Out[67]:
Out[67]:
Out[67]:
Out[67]:
Out[67]:
In [ ]: