mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-30 16:23:41 +02:00
Sparse vectors
This commit is contained in:
parent
1bff2c9fcc
commit
9a46fe36a4
@ -134,7 +134,7 @@ let test_case () =
|
|||||||
let det =
|
let det =
|
||||||
let open Spin in
|
let open Spin in
|
||||||
creation Alfa 1 @@ creation Alfa 3 @@ creation Alfa 2 @@ creation Alfa 5 @@
|
creation Alfa 1 @@ creation Alfa 3 @@ creation Alfa 2 @@ creation Alfa 5 @@
|
||||||
creation Beta 1 @@ creation Beta 3 @@ creation Beta 4 @@ creation Beta 5 @@ vac
|
creation Beta 1 @@ creation Beta 3 @@ creation Beta 4 @@ creation Beta 5 @@ vac
|
||||||
in
|
in
|
||||||
Alcotest.(check bool) "creation 1" true
|
Alcotest.(check bool) "creation 1" true
|
||||||
(det = of_lists [ 1 ; 3 ; 2 ; 5 ] [1 ; 3 ; 4 ; 5 ] );
|
(det = of_lists [ 1 ; 3 ; 2 ; 5 ] [1 ; 3 ; 4 ; 5 ] );
|
||||||
|
@ -1,10 +1,18 @@
|
|||||||
open Util
|
open Util
|
||||||
|
|
||||||
let make ?guess simulation =
|
let make
|
||||||
if Electrons.multiplicity @@ Simulation.electrons simulation = 1 then
|
?guess:(guess=`Huckel)
|
||||||
RHF.make ?guess simulation
|
?max_scf:(max_scf=64)
|
||||||
else
|
?level_shift:(level_shift=0.1)
|
||||||
ROHF.make ?guess simulation
|
?threshold_SCF:(threshold_SCF=1.e-8)
|
||||||
|
simulation =
|
||||||
|
|
||||||
|
let f =
|
||||||
|
if Electrons.multiplicity @@ Simulation.electrons simulation = 1 then
|
||||||
|
RHF.make
|
||||||
|
else
|
||||||
|
ROHF.make
|
||||||
|
in f ~guess ~max_scf ~level_shift ~threshold_SCF simulation
|
||||||
|
|
||||||
|
|
||||||
let to_string = HartreeFock_type.to_string
|
let to_string = HartreeFock_type.to_string
|
||||||
|
@ -7,9 +7,7 @@ module El = Electrons
|
|||||||
module Ao = AOBasis
|
module Ao = AOBasis
|
||||||
module Ov = Overlap
|
module Ov = Overlap
|
||||||
|
|
||||||
let make ?guess:(guess=`Huckel) ?max_scf:(max_scf=64) ?level_shift:(level_shift=0.1)
|
let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
||||||
?threshold_SCF:(threshold_SCF=1.e-5) simulation =
|
|
||||||
|
|
||||||
(* Number of occupied MOs *)
|
(* Number of occupied MOs *)
|
||||||
let nocc =
|
let nocc =
|
||||||
El.n_alfa @@ Si.electrons simulation
|
El.n_alfa @@ Si.electrons simulation
|
||||||
|
@ -7,8 +7,7 @@ module El = Electrons
|
|||||||
module Ao = AOBasis
|
module Ao = AOBasis
|
||||||
module Ov = Overlap
|
module Ov = Overlap
|
||||||
|
|
||||||
let make ?guess:(guess=`Huckel) ?max_scf:(max_scf=64) ?level_shift:(level_shift=0.1)
|
let make ~guess ~max_scf ~level_shift ~threshold_SCF simulation =
|
||||||
?threshold_SCF:(threshold_SCF=1.e-5) simulation =
|
|
||||||
|
|
||||||
(* Number of occupied MOs *)
|
(* Number of occupied MOs *)
|
||||||
let n_alfa =
|
let n_alfa =
|
||||||
|
@ -6,7 +6,7 @@ let make
|
|||||||
?guess
|
?guess
|
||||||
?(n_states=8)
|
?(n_states=8)
|
||||||
?(n_iter=10)
|
?(n_iter=10)
|
||||||
?(threshold=1.e-10)
|
?(threshold=1.e-8)
|
||||||
diagonal
|
diagonal
|
||||||
matrix_vector
|
matrix_vector
|
||||||
=
|
=
|
||||||
|
197
Utils/Matrix.ml
Normal file
197
Utils/Matrix.ml
Normal file
@ -0,0 +1,197 @@
|
|||||||
|
open Lacaml.D
|
||||||
|
|
||||||
|
type sparse_matrix =
|
||||||
|
{
|
||||||
|
m: int;
|
||||||
|
n: int;
|
||||||
|
v: Vector.t array;
|
||||||
|
}
|
||||||
|
|
||||||
|
type t =
|
||||||
|
| Dense of Mat.t
|
||||||
|
| Sparse of sparse_matrix
|
||||||
|
|
||||||
|
let epsilon = Constants.epsilon
|
||||||
|
|
||||||
|
let is_sparse = function
|
||||||
|
| Sparse _ -> true
|
||||||
|
| Dense _ -> false
|
||||||
|
|
||||||
|
|
||||||
|
let is_dense = function
|
||||||
|
| Sparse _ -> false
|
||||||
|
| Dense _ -> true
|
||||||
|
|
||||||
|
|
||||||
|
let dim1 = function
|
||||||
|
| Dense m -> Mat.dim1 m
|
||||||
|
| Sparse {m ; n ; v} -> m
|
||||||
|
|
||||||
|
|
||||||
|
let dim2 = function
|
||||||
|
| Dense m -> Mat.dim2 m
|
||||||
|
| Sparse {m ; n ; v} -> n
|
||||||
|
|
||||||
|
|
||||||
|
let get = function
|
||||||
|
| Dense m -> (fun i j -> m.{i,j})
|
||||||
|
| Sparse {m ; n ; v } -> (fun i j -> Vector.get v.(i-1) j)
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_dense ?(threshold=epsilon) = function
|
||||||
|
| Sparse _ -> invalid_arg "Expected a dense matrix"
|
||||||
|
| Dense m' ->
|
||||||
|
let m = Mat.dim1 m'
|
||||||
|
and n = Mat.dim2 m'
|
||||||
|
and v =
|
||||||
|
Mat.to_col_vecs m'
|
||||||
|
|> Array.map (fun v -> Vector.sparse_of_vec ~threshold v)
|
||||||
|
in Sparse {m ; n ; v}
|
||||||
|
|
||||||
|
|
||||||
|
let dense_of_sparse = function
|
||||||
|
| Dense _ -> invalid_arg "Expected a sparse matrix"
|
||||||
|
| Sparse {m ; n ; v} ->
|
||||||
|
let m' =
|
||||||
|
Array.map (fun v -> Vector.to_vec v) v
|
||||||
|
|> Mat.of_col_vecs
|
||||||
|
in Dense m'
|
||||||
|
|
||||||
|
|
||||||
|
let dense_of_mat m = Dense m
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_mat ?(threshold=epsilon) m =
|
||||||
|
dense_of_mat m
|
||||||
|
|> sparse_of_dense ~threshold
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_vector_array v =
|
||||||
|
let m =
|
||||||
|
Array.fold_left (fun accu v' ->
|
||||||
|
if Vector.dim v' <> accu then
|
||||||
|
invalid_arg "Inconsistent dimension"
|
||||||
|
else accu) (Vector.dim v.(0)) v
|
||||||
|
and n = Array.length v
|
||||||
|
in
|
||||||
|
Sparse {m ; n ; v}
|
||||||
|
|
||||||
|
|
||||||
|
let rec to_mat = function
|
||||||
|
| Dense m -> m
|
||||||
|
| Sparse m ->
|
||||||
|
dense_of_sparse (Sparse m)
|
||||||
|
|> to_mat
|
||||||
|
|
||||||
|
let transpose = function
|
||||||
|
| Dense m -> Dense (Mat.transpose_copy m)
|
||||||
|
| Sparse {m ; n ; v} ->
|
||||||
|
begin
|
||||||
|
let v' = Array.init m (fun i -> ref []) in
|
||||||
|
Array.iteri (fun j v_j ->
|
||||||
|
Vector.to_assoc_list v_j
|
||||||
|
|> List.iter (fun (i, v_ij) ->
|
||||||
|
v'.(i-1) := (j+1, v_ij) :: !(v'.(i-1))
|
||||||
|
)
|
||||||
|
) v;
|
||||||
|
let v' =
|
||||||
|
Array.map (fun x -> Vector.sparse_of_assoc_list n (List.rev !x) ) v'
|
||||||
|
in
|
||||||
|
Sparse {m=n ; n=m ; v=v'}
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
let outer_product ?(threshold=epsilon) v1 v2 =
|
||||||
|
let v =
|
||||||
|
Array.init (Vector.dim v1) (fun i ->
|
||||||
|
Vector.scale (Vector.get v1 i)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
let mm ?(threshold=epsilon) a b =
|
||||||
|
|
||||||
|
if dim2 a <> dim1 b then
|
||||||
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
|
||||||
|
let spmm {m ; n ; v} b =
|
||||||
|
let n = Mat.dim2 b in
|
||||||
|
let b =
|
||||||
|
Mat.to_col_vecs b
|
||||||
|
|> Array.map (fun v -> Vector.dense_of_vec v)
|
||||||
|
in
|
||||||
|
let v' =
|
||||||
|
Array.map (fun a_i ->
|
||||||
|
Vec.init n (fun j ->
|
||||||
|
Vector.dot a_i b.(j-1))
|
||||||
|
|> Vector.sparse_of_vec ~threshold
|
||||||
|
) v
|
||||||
|
in
|
||||||
|
Sparse {m ; n ; v=v'}
|
||||||
|
in
|
||||||
|
|
||||||
|
let mmsp a {m ; n ; v} =
|
||||||
|
|
||||||
|
|
||||||
|
match a, b with
|
||||||
|
| (Dense a), (Dense b) -> Dense (gemm a b)
|
||||||
|
| (Sparse a), (Dense b) -> spmm a b
|
||||||
|
| (Dense a), (Sparse b) -> mmsp a b
|
||||||
|
| (Sparse a), (Sparse b) -> mmspmm a b
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
let rec pp_matrix ppf = function
|
||||||
|
| Dense m -> Util.pp_matrix ppf m
|
||||||
|
| Sparse m -> pp_matrix ppf @@ dense_of_sparse (Sparse m)
|
||||||
|
|
||||||
|
|
||||||
|
let test_case () =
|
||||||
|
|
||||||
|
let x1 = Mat.map (fun x -> if abs_float x < 0.6 then 0. else x) (Mat.random 3 4)
|
||||||
|
and x2 = Mat.map (fun x -> if abs_float x < 0.3 then 0. else x) (Mat.random 4 5)
|
||||||
|
in
|
||||||
|
|
||||||
|
let m1 = dense_of_mat x1
|
||||||
|
and m2 = dense_of_mat x2
|
||||||
|
in
|
||||||
|
|
||||||
|
let m1_s = sparse_of_mat x1
|
||||||
|
and m2_s = sparse_of_mat x2
|
||||||
|
in
|
||||||
|
|
||||||
|
let test_dimensions () =
|
||||||
|
Alcotest.(check int) "dim1 1" 3 (dim1 m1 );
|
||||||
|
Alcotest.(check int) "dim1 2" 3 (dim1 m1_s);
|
||||||
|
Alcotest.(check int) "dim2 3" 4 (dim2 m1 );
|
||||||
|
Alcotest.(check int) "dim2 4" 4 (dim2 m1_s);
|
||||||
|
Alcotest.(check int) "dim1 5" 4 (dim1 m2 );
|
||||||
|
Alcotest.(check int) "dim1 6" 4 (dim1 m2_s);
|
||||||
|
Alcotest.(check int) "dim2 7" 5 (dim2 m2 );
|
||||||
|
Alcotest.(check int) "dim2 8" 5 (dim2 m2_s);
|
||||||
|
in
|
||||||
|
|
||||||
|
let test_conversion () =
|
||||||
|
Alcotest.(check bool) "sparse -> dense 1" true (dense_of_sparse m1_s = m1 );
|
||||||
|
Alcotest.(check bool) "sparse -> dense 2" true (dense_of_sparse m2_s = m2 );
|
||||||
|
Alcotest.(check bool) "dense -> sparse 1" true (sparse_of_dense m1 = m1_s);
|
||||||
|
Alcotest.(check bool) "dense -> sparse 3" true (sparse_of_dense m2 = m2_s);
|
||||||
|
in
|
||||||
|
|
||||||
|
let test_transpose () =
|
||||||
|
let m1t = Mat.transpose_copy x1 |> dense_of_mat
|
||||||
|
and m2t = Mat.transpose_copy x2 |> dense_of_mat
|
||||||
|
in
|
||||||
|
Alcotest.(check bool) "dense 1" true (transpose m1 = m1t);
|
||||||
|
Alcotest.(check bool) "dense 2" true (transpose m2 = m2t);
|
||||||
|
Alcotest.(check bool) "sparse 1" true (transpose m1_s = sparse_of_dense m1t);
|
||||||
|
Alcotest.(check bool) "sparse 2" true (transpose m2_s = sparse_of_dense m2t);
|
||||||
|
in
|
||||||
|
[
|
||||||
|
"Conversion", `Quick, test_conversion;
|
||||||
|
"Dimensions", `Quick, test_dimensions;
|
||||||
|
"Transposition", `Quick, test_transpose;
|
||||||
|
]
|
||||||
|
|
336
Utils/Vector.ml
Normal file
336
Utils/Vector.ml
Normal file
@ -0,0 +1,336 @@
|
|||||||
|
open Lacaml.D
|
||||||
|
|
||||||
|
let epsilon = Constants.epsilon
|
||||||
|
|
||||||
|
type sparse_vector =
|
||||||
|
{
|
||||||
|
n: int;
|
||||||
|
v: (int*float) list
|
||||||
|
}
|
||||||
|
|
||||||
|
type t =
|
||||||
|
| Dense of Vec.t
|
||||||
|
| Sparse of sparse_vector
|
||||||
|
|
||||||
|
|
||||||
|
let is_sparse = function
|
||||||
|
| Sparse _ -> true
|
||||||
|
| Dense _ -> false
|
||||||
|
|
||||||
|
|
||||||
|
let is_dense = function
|
||||||
|
| Sparse _ -> false
|
||||||
|
| Dense _ -> true
|
||||||
|
|
||||||
|
|
||||||
|
let get = function
|
||||||
|
| Dense v -> (fun i -> v.{i})
|
||||||
|
| Sparse { n ; v } -> (fun i ->
|
||||||
|
if i < 1 || i > n then invalid_arg "index out of bounds";
|
||||||
|
match List.assoc_opt i v with
|
||||||
|
| Some x -> x
|
||||||
|
| None -> 0. )
|
||||||
|
|
||||||
|
|
||||||
|
let dim = function
|
||||||
|
| Dense v -> Vec.dim v
|
||||||
|
| Sparse {n ; v} -> n
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_dense ?(threshold=epsilon) = function
|
||||||
|
| Sparse _ -> invalid_arg "Expected a dense vector"
|
||||||
|
| Dense v ->
|
||||||
|
let rec aux accu = function
|
||||||
|
| 0 -> accu
|
||||||
|
| i ->
|
||||||
|
let x = v.{i} in
|
||||||
|
if abs_float x < threshold then
|
||||||
|
aux accu (i-1)
|
||||||
|
else
|
||||||
|
aux ((i, x)::accu) (i-1)
|
||||||
|
in
|
||||||
|
let n = Vec.dim v in
|
||||||
|
Sparse { n ; v=aux [] n }
|
||||||
|
|
||||||
|
|
||||||
|
let rec to_assoc_list ?(threshold=epsilon) = function
|
||||||
|
| Sparse {n ; v} -> v
|
||||||
|
| Dense v -> to_assoc_list @@ sparse_of_dense ~threshold (Dense v)
|
||||||
|
|
||||||
|
|
||||||
|
let dense_of_sparse = function
|
||||||
|
| Dense _ -> invalid_arg "Expected a sparse vector"
|
||||||
|
| Sparse {n ; v} ->
|
||||||
|
let v' = Vec.make0 n in
|
||||||
|
List.iter (fun (i, x) -> v'.{i} <- x) v;
|
||||||
|
Dense v'
|
||||||
|
|
||||||
|
|
||||||
|
let dense_of_vec v = Dense v
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_vec ?(threshold=epsilon) v =
|
||||||
|
dense_of_vec v
|
||||||
|
|> sparse_of_dense ~threshold
|
||||||
|
|
||||||
|
|
||||||
|
let sparse_of_assoc_list n v = Sparse { n ; v }
|
||||||
|
|
||||||
|
|
||||||
|
let rec to_vec = function
|
||||||
|
| Dense v -> v
|
||||||
|
| Sparse v -> dense_of_sparse (Sparse v) |> to_vec
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let scale ?(threshold=epsilon) x = function
|
||||||
|
| Dense v -> let v' = copy v in (scal x v'; Dense v')
|
||||||
|
| Sparse {n ; v} -> Sparse {n ; v=List.map (fun (i,y) -> let z = x *. y in
|
||||||
|
if abs_float z > threshold then Some (i, z) else None ) v |> Util.list_some }
|
||||||
|
|
||||||
|
|
||||||
|
let rec neg = function
|
||||||
|
| Dense v -> Dense (Vec.neg v)
|
||||||
|
| Sparse {n ; v} -> Sparse {n ; v=List.map (fun (i,y) -> (i, -. y)) v}
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
let rec add ?(threshold=epsilon) x y =
|
||||||
|
if dim x <> dim y then
|
||||||
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
|
||||||
|
match x, y with
|
||||||
|
| Dense x , Dense y -> Dense (Vec.add x y)
|
||||||
|
| Sparse {n ; v}, Dense y ->
|
||||||
|
let v' = copy y in
|
||||||
|
List.iter (fun (i, x) -> v'.{i} <- v'.{i} +. x) v;
|
||||||
|
sparse_of_vec ~threshold v'
|
||||||
|
| Sparse {n ; v}, Sparse {n=n' ; v=v'} ->
|
||||||
|
begin
|
||||||
|
let rec aux accu v1 v2 =
|
||||||
|
match v1, v2 with
|
||||||
|
| [], [] -> {n ; v=List.rev accu}
|
||||||
|
| ((i, x)::v1), [] ->
|
||||||
|
aux ((i, x)::accu) v1 []
|
||||||
|
| [], ((j, y)::v2) ->
|
||||||
|
aux ((j, y)::accu) [] v2
|
||||||
|
| ((i, x)::v1), ((j, y)::v2) ->
|
||||||
|
if i = j then
|
||||||
|
begin
|
||||||
|
let z = x +. y in
|
||||||
|
if abs_float z > threshold then
|
||||||
|
aux ((i, (x +. y))::accu) v1 v2
|
||||||
|
else
|
||||||
|
aux accu v1 v2
|
||||||
|
end
|
||||||
|
else if i < j then
|
||||||
|
begin
|
||||||
|
if abs_float x > threshold then
|
||||||
|
aux ((i, x)::accu) v1 ((j, y)::v2)
|
||||||
|
else
|
||||||
|
aux accu v1 ((j, y)::v2)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if abs_float y > threshold then
|
||||||
|
aux ((j, y)::accu) ((i, x)::v1) v2
|
||||||
|
else
|
||||||
|
aux accu ((i, x)::v1) v2
|
||||||
|
end
|
||||||
|
in
|
||||||
|
Sparse (aux [] v v')
|
||||||
|
end
|
||||||
|
| x, y -> add ~threshold y x
|
||||||
|
|
||||||
|
|
||||||
|
let sub ?(threshold=epsilon) x y = add ~threshold x (neg y)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
|
||||||
|
if dim x <> dim y then
|
||||||
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
|
||||||
|
match x, y with
|
||||||
|
| Dense x , Dense y -> Dense (let y = copy y in axpy ~alpha x y ; y)
|
||||||
|
| Sparse {n ; v}, Dense y ->
|
||||||
|
begin
|
||||||
|
let v' = copy y in
|
||||||
|
List.iter (fun (i, x) -> v'.{i} <- v'.{i} +. alpha *. x) v;
|
||||||
|
sparse_of_vec ~threshold v'
|
||||||
|
end
|
||||||
|
| Dense x , Sparse {n ; v} ->
|
||||||
|
begin
|
||||||
|
let v' = copy x in
|
||||||
|
scal alpha v';
|
||||||
|
List.iter (fun (i, y) -> v'.{i} <- v'.{i} +. y) v;
|
||||||
|
sparse_of_vec ~threshold v'
|
||||||
|
end
|
||||||
|
| Sparse {n ; v}, Sparse {n=n' ; v=v'} ->
|
||||||
|
begin
|
||||||
|
let rec aux accu v1 v2 =
|
||||||
|
match v1, v2 with
|
||||||
|
| [] , [] -> {n ; v=List.rev accu}
|
||||||
|
| ((i, x)::v1), [] -> aux ((i, x)::accu) v1 []
|
||||||
|
| [] , ((j, y)::v2) -> aux ((j, y)::accu) [] v2
|
||||||
|
| ((i, x)::v1), ((j, y)::v2) ->
|
||||||
|
if i = j then
|
||||||
|
begin
|
||||||
|
let z = alpha *. x +. y in
|
||||||
|
if abs_float z > threshold then
|
||||||
|
aux ((i, z)::accu) v1 v2
|
||||||
|
else
|
||||||
|
aux accu v1 v2
|
||||||
|
end
|
||||||
|
else if i < j then
|
||||||
|
let z = alpha *. x in
|
||||||
|
begin
|
||||||
|
if abs_float z > threshold then
|
||||||
|
aux ((i, z)::accu) v1 ((j, y)::v2)
|
||||||
|
else
|
||||||
|
aux accu v1 ((j, y)::v2)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if abs_float y > threshold then
|
||||||
|
aux ((j, y)::accu) ((i, x)::v1) v2
|
||||||
|
else
|
||||||
|
aux accu ((i, x)::v1) v2
|
||||||
|
end
|
||||||
|
in
|
||||||
|
Sparse (aux [] v v')
|
||||||
|
end
|
||||||
|
|
||||||
|
let add = axpy ~alpha:1.
|
||||||
|
|
||||||
|
let sub ?(threshold=epsilon) x y = add ~threshold x @@ neg y
|
||||||
|
|
||||||
|
let pp_vector ppf = function
|
||||||
|
| Dense m -> Util.pp_float_array ppf @@ Vec.to_array m
|
||||||
|
| Sparse {n ; v} ->
|
||||||
|
begin
|
||||||
|
Format.fprintf ppf "@[[ %d | " n;
|
||||||
|
List.iter (fun (i,x) -> Format.fprintf ppf "@[(%d, %f); @]" i x) v;
|
||||||
|
Format.fprintf ppf "]@]"
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let dot v v' =
|
||||||
|
|
||||||
|
let d_d v v' =
|
||||||
|
dot v v'
|
||||||
|
in
|
||||||
|
|
||||||
|
let d_sp v' {n ; v} =
|
||||||
|
if n <> Vec.dim v' then
|
||||||
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
List.fold_left (fun accu (i, v_i) -> accu +. v_i *. v'.{i}) 0. v
|
||||||
|
in
|
||||||
|
|
||||||
|
let sp_sp {n ; v} {n=n' ; v=v'} =
|
||||||
|
if n <> n' then
|
||||||
|
invalid_arg "Inconsistent dimensions";
|
||||||
|
|
||||||
|
List.fold_left (fun accu (i, v_i) ->
|
||||||
|
match List.assoc_opt i v' with
|
||||||
|
| Some w_i -> accu +. v_i *. w_i
|
||||||
|
| None -> accu
|
||||||
|
) 0. v
|
||||||
|
in
|
||||||
|
|
||||||
|
match v, v' with
|
||||||
|
| (Dense v), (Dense v') -> d_d v v'
|
||||||
|
| (Sparse v), (Sparse v') -> sp_sp v v'
|
||||||
|
| (Dense v), (Sparse v') -> d_sp v v'
|
||||||
|
| (Sparse v), (Dense v') -> d_sp v' v
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let test_case () =
|
||||||
|
|
||||||
|
let x1 = Vec.map (fun x -> if abs_float x < 0.6 then 0. else x) (Vec.random 100)
|
||||||
|
and x2 = Vec.map (fun x -> if abs_float x < 0.3 then 0. else x) (Vec.random 100)
|
||||||
|
in
|
||||||
|
let x3 = Vec.map (fun x -> 2. *. x) x1
|
||||||
|
and x4 = Vec.add x1 x2
|
||||||
|
and x5 = Vec.sub x1 x2
|
||||||
|
and x6 =
|
||||||
|
let v = copy x2 in
|
||||||
|
Lacaml.D.axpy ~alpha:3. x1 v;
|
||||||
|
v
|
||||||
|
in
|
||||||
|
|
||||||
|
let v1 = dense_of_vec x1
|
||||||
|
and v2 = dense_of_vec x2
|
||||||
|
and v3 = dense_of_vec x3
|
||||||
|
and v4 = dense_of_vec x4
|
||||||
|
and v5 = dense_of_vec x5
|
||||||
|
and v6 = dense_of_vec x6
|
||||||
|
in
|
||||||
|
|
||||||
|
let v1_s = sparse_of_vec x1
|
||||||
|
and v2_s = sparse_of_vec x2
|
||||||
|
and v3_s = sparse_of_vec x3
|
||||||
|
and v4_s = sparse_of_vec x4
|
||||||
|
and v5_s = sparse_of_vec x5
|
||||||
|
and v6_s = sparse_of_vec x6
|
||||||
|
in
|
||||||
|
|
||||||
|
let zero = dense_of_vec (Vec.make0 100)
|
||||||
|
and zero_s = sparse_of_vec (Vec.make0 100)
|
||||||
|
in
|
||||||
|
|
||||||
|
let test_conversion () =
|
||||||
|
Alcotest.(check bool) "sparse -> dense 1" true (dense_of_sparse v1_s = v1 );
|
||||||
|
Alcotest.(check bool) "sparse -> dense 2" true (dense_of_sparse v2_s = v2 );
|
||||||
|
Alcotest.(check bool) "dense -> sparse 1" true (sparse_of_dense v1 = v1_s);
|
||||||
|
Alcotest.(check bool) "dense -> sparse 2" true (sparse_of_dense v2 = v2_s);
|
||||||
|
in
|
||||||
|
let test_operations () =
|
||||||
|
Alcotest.(check bool) "dense scale" true (scale 2. v1 = v3);
|
||||||
|
Alcotest.(check bool) "sparse scale" true (scale 2. v1_s = v3_s);
|
||||||
|
|
||||||
|
Alcotest.(check bool) "dense dense add" true (add v1 v2 = v4);
|
||||||
|
Alcotest.(check bool) "dense sparse add" true (add v1 v2_s = v4_s);
|
||||||
|
Alcotest.(check bool) "sparse dense add" true (add v1_s v2 = v4_s);
|
||||||
|
Alcotest.(check bool) "sparse dense add" true (add v1 v2_s = v4_s);
|
||||||
|
Alcotest.(check bool) "sparse sparse add" true (add v1_s v2_s = v4_s);
|
||||||
|
|
||||||
|
Alcotest.(check bool) "dense dense sub" true (sub v1 v2 = v5);
|
||||||
|
Alcotest.(check bool) "dense sparse sub" true (sub v1 v2_s = v5_s);
|
||||||
|
Alcotest.(check bool) "sparse dense sub" true (sub v1_s v2 = v5_s);
|
||||||
|
Alcotest.(check bool) "sparse dense sub" true (sub v1 v2_s = v5_s);
|
||||||
|
Alcotest.(check bool) "sparse sparse sub" true (sub v1_s v2_s = v5_s);
|
||||||
|
|
||||||
|
Alcotest.(check bool) "dense dense sub" true (sub v1 v1 = zero);
|
||||||
|
Alcotest.(check bool) "dense sparse sub" true (sub v1 v1_s = zero_s);
|
||||||
|
Alcotest.(check bool) "sparse dense sub" true (sub v1_s v1 = zero_s);
|
||||||
|
Alcotest.(check bool) "sparse sparse sub" true (sub v1_s v1_s = zero_s);
|
||||||
|
|
||||||
|
Alcotest.(check bool) "dense dense axpy" true (axpy ~alpha:3. v1 v2 = v6);
|
||||||
|
Alcotest.(check bool) "dense sparse axpy" true (sub ~threshold:1.e-12 (axpy ~alpha:3. v1 v2_s) v6_s = zero_s);
|
||||||
|
Alcotest.(check bool) "sparse dense axpy" true (sub ~threshold:1.e-12 (axpy ~alpha:3. v1_s v2) v6_s = zero_s);
|
||||||
|
Alcotest.(check bool) "sparse sparse axpy" true (sub ~threshold:1.e-12 (axpy ~alpha:3. v1_s v2_s) v6_s = zero_s);
|
||||||
|
in
|
||||||
|
let test_dot () =
|
||||||
|
let d1d2 = Lacaml.D.dot x1 x2
|
||||||
|
and d1d1 = Lacaml.D.dot x1 x1
|
||||||
|
and d2d2 = Lacaml.D.dot x2 x2
|
||||||
|
in
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x dense 1" (dot v1_s v2 ) d1d2;
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x dense 2" (dot v1_s v1 ) d1d1;
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x dense 3" (dot v2_s v2 ) d2d2;
|
||||||
|
Alcotest.(check (float 1.e-10)) "dense x sparse 1" (dot v1 v2_s) d1d2;
|
||||||
|
Alcotest.(check (float 1.e-10)) "dense x sparse 2" (dot v1 v1_s) d1d1;
|
||||||
|
Alcotest.(check (float 1.e-10)) "dense x sparse 3" (dot v2 v2_s) d2d2;
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x sparse 1" (dot v1_s v2_s) d1d2;
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x sparse 2" (dot v1_s v1_s) d1d1;
|
||||||
|
Alcotest.(check (float 1.e-10)) "sparse x sparse 3" (dot v2_s v2_s) d2d2;
|
||||||
|
in
|
||||||
|
[
|
||||||
|
"Conversion", `Quick, test_conversion;
|
||||||
|
"Operations", `Quick, test_operations;
|
||||||
|
"Dot product", `Quick, test_dot;
|
||||||
|
]
|
||||||
|
|
76
Utils/Vector.mli
Normal file
76
Utils/Vector.mli
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
open Lacaml.D
|
||||||
|
|
||||||
|
(* Sparse or dense vectors *)
|
||||||
|
|
||||||
|
type t
|
||||||
|
|
||||||
|
(** {1 Accessors} *)
|
||||||
|
|
||||||
|
val is_sparse : t -> bool
|
||||||
|
(** True is the vector is sparse. *)
|
||||||
|
|
||||||
|
val is_dense : t -> bool
|
||||||
|
(** True is the vector is dense. *)
|
||||||
|
|
||||||
|
val get : t -> int -> float
|
||||||
|
(** [get v i] returns the i-th element of [v]. *)
|
||||||
|
|
||||||
|
val dim : t -> int
|
||||||
|
(** Dimension of the vector *)
|
||||||
|
|
||||||
|
|
||||||
|
(** {1 Converters } *)
|
||||||
|
|
||||||
|
val to_vec : t -> Vec.t
|
||||||
|
(** Convert into a Lacaml Vec. *)
|
||||||
|
|
||||||
|
val to_assoc_list : ?threshold:float -> t -> (int * float) list
|
||||||
|
(** Convert into an association list. *)
|
||||||
|
|
||||||
|
val sparse_of_dense : ?threshold:float -> t -> t
|
||||||
|
(** Creates a sparse vector from a dense vector. Default threshold is {!Constants.epsilon}. *)
|
||||||
|
|
||||||
|
val dense_of_sparse : t -> t
|
||||||
|
(** Creates a dense vector from a sparse vector. *)
|
||||||
|
|
||||||
|
val dense_of_vec : Vec.t -> t
|
||||||
|
(** Create a dense vector from a Lacaml Vec *)
|
||||||
|
|
||||||
|
val sparse_of_vec : ?threshold:float -> Vec.t -> t
|
||||||
|
(** Create a sparse vector from a Lacaml Vec. Default threshold is {!Constants.epsilon}. *)
|
||||||
|
|
||||||
|
val sparse_of_assoc_list : int -> (int * float) list -> t
|
||||||
|
(** Create a sparse vector from an association list [(index,value)]. The first integer is
|
||||||
|
the size of the vector. *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(** {1 Operations} *)
|
||||||
|
|
||||||
|
val neg : t -> t
|
||||||
|
(** Returns the negative of the vector. *)
|
||||||
|
|
||||||
|
val scale : ?threshold:float -> float -> t -> t
|
||||||
|
(** Scale a vector by a constant *)
|
||||||
|
|
||||||
|
val add : ?threshold:float -> t -> t -> t
|
||||||
|
(** Add two vectors *)
|
||||||
|
|
||||||
|
val sub : ?threshold:float -> t -> t -> t
|
||||||
|
(** Subtract two vectors *)
|
||||||
|
|
||||||
|
val axpy : ?threshold:float -> ?alpha:float -> t -> t -> t
|
||||||
|
(** $a \mathfb{x} + \mathfb{y}$ *)
|
||||||
|
|
||||||
|
val dot : t -> t -> float
|
||||||
|
(** Dot product. *)
|
||||||
|
|
||||||
|
|
||||||
|
(** {1 Printers } *)
|
||||||
|
|
||||||
|
val pp_vector : Format.formatter -> t -> unit
|
||||||
|
|
||||||
|
|
||||||
|
(** {1 Unit testing} *)
|
||||||
|
|
||||||
|
val test_case : unit -> (string * [> `Quick ] * (unit -> unit)) list
|
11
run_tests.ml
11
run_tests.ml
@ -12,12 +12,17 @@ let test_water_dz () =
|
|||||||
let ao_basis =
|
let ao_basis =
|
||||||
Simulation.ao_basis simulation_closed_shell
|
Simulation.ao_basis simulation_closed_shell
|
||||||
in
|
in
|
||||||
Alcotest.run "Water, cc-pVDZ" [
|
Alcotest.run "Unit tests" [
|
||||||
"AO_Basis", AOBasis.test_case ao_basis;
|
|
||||||
"Guess", Guess.test_case ao_basis;
|
|
||||||
"Spindeterminant", Spindeterminant.test_case ();
|
"Spindeterminant", Spindeterminant.test_case ();
|
||||||
"Determinant", Determinant.test_case ();
|
"Determinant", Determinant.test_case ();
|
||||||
"Excitation", Excitation.test_case ();
|
"Excitation", Excitation.test_case ();
|
||||||
|
"Sparse vectors", Vector.test_case ();
|
||||||
|
"Sparse matrices", Matrix.test_case ();
|
||||||
|
];
|
||||||
|
|
||||||
|
Alcotest.run "Water, cc-pVDZ" [
|
||||||
|
"AO_Basis", AOBasis.test_case ao_basis;
|
||||||
|
"Guess", Guess.test_case ao_basis;
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user