mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-22 20:33:36 +01:00
Added org-mode files in common
This commit is contained in:
parent
4146264c2e
commit
ebd753d48e
79
common/README.org
Normal file
79
common/README.org
Normal file
@ -0,0 +1,79 @@
|
||||
#+TITLE: Common
|
||||
|
||||
[[elisp:(org-babel-tangle)]]
|
||||
|
||||
This directory contains many utility functions used by all the other directories.
|
||||
|
||||
- [[./angular_momentum.org][Angular Momentum]]
|
||||
- [[./bitstring.org][Bit string]]
|
||||
|
||||
* Dune files
|
||||
:PROPERTIES:
|
||||
:dune: lib/dune
|
||||
:dune-test: test/dune
|
||||
:header-args: :noweb yes
|
||||
:END:
|
||||
|
||||
** Headers
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune" t)
|
||||
(library
|
||||
#+end_src
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
|
||||
(library
|
||||
#+end_src
|
||||
|
||||
** Library
|
||||
|
||||
*** General information
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune" t)
|
||||
(name common)
|
||||
(public_name qcaml.common)
|
||||
(synopsis "General utilities used in all QCaml libraries.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
|
||||
(name test_common)
|
||||
(synopsis "Test for common library")
|
||||
#+end_src
|
||||
|
||||
*** Dependencies
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune" t)
|
||||
(libraries
|
||||
str
|
||||
zarith
|
||||
getopt
|
||||
)
|
||||
#+end_src
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
|
||||
(libraries
|
||||
alcotest
|
||||
qcaml.common
|
||||
)
|
||||
#+end_src
|
||||
*** Extra C files
|
||||
|
||||
The ~math_functions~ file contains small C snippets to add missing
|
||||
functionalities to OCaml, such as support for the ~popcnt~ instruction.
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune" t)
|
||||
(c_names
|
||||
math_functions
|
||||
)
|
||||
(c_flags (:standard)
|
||||
-Ofast -march=native -fPIC
|
||||
)
|
||||
#+end_src
|
||||
|
||||
** Footers
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune" t)
|
||||
)
|
||||
#+end_src
|
||||
|
||||
#+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
|
||||
)
|
||||
#+end_src
|
||||
|
||||
|
||||
330
common/angular_momentum.org
Normal file
330
common/angular_momentum.org
Normal file
@ -0,0 +1,330 @@
|
||||
#+TITLE: Angular Momentum
|
||||
|
||||
[[elisp:(org-babel-tangle)]]
|
||||
|
||||
* Angular Momentum
|
||||
:PROPERTIES:
|
||||
:ml: lib/angular_momentum.ml
|
||||
:mli: lib/angular_momentum.mli
|
||||
:header-args: :noweb yes :comments both
|
||||
:END:
|
||||
|
||||
Azimuthal quantum number, repsesented as $s,p,d,...$.
|
||||
|
||||
** Type
|
||||
|
||||
#+NAME: types
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
type t =
|
||||
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
||||
| Int of int
|
||||
|
||||
exception Angular_momentum_error of string
|
||||
|
||||
type kind =
|
||||
Singlet of t
|
||||
| Doublet of (t * t)
|
||||
| Triplet of (t * t * t)
|
||||
| Quartet of (t * t * t * t)
|
||||
|
||||
#+end_src
|
||||
|
||||
An exception is raised when the ~Angular_momentum.t~ element can't
|
||||
be created.
|
||||
|
||||
The ~kind~ is used to build shells, shell doublets, triplets or
|
||||
quartets, use in the two-electron operators.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
<<types>>
|
||||
open Powers
|
||||
#+end_src
|
||||
|
||||
|
||||
** Conversions
|
||||
|
||||
|
||||
*** ~of_char~
|
||||
|
||||
Returns an ~Angular_momentum.t~ when a shell is given as a character
|
||||
(case insensitive):
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.of_char 'p' -> Angular_momentum.P
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val of_char : char -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let of_char = function
|
||||
| 's' | 'S' -> S | 'p' | 'P' -> P
|
||||
| 'd' | 'D' -> D | 'f' | 'F' -> F
|
||||
| 'g' | 'G' -> G | 'h' | 'H' -> H
|
||||
| 'i' | 'I' -> I | 'j' | 'J' -> J
|
||||
| 'k' | 'K' -> K | 'l' | 'L' -> L
|
||||
| 'm' | 'M' -> M | 'n' | 'N' -> N
|
||||
| 'o' | 'O' -> O
|
||||
| c -> raise (Angular_momentum_error (String.make 1 c))
|
||||
#+end_src
|
||||
|
||||
*** ~to_string~
|
||||
|
||||
Converts the angular momentum into a string:
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.(to_string D) -> "D"
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val to_string : t -> string
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let to_string = function
|
||||
| S -> "S" | P -> "P"
|
||||
| D -> "D" | F -> "F"
|
||||
| G -> "G" | H -> "H"
|
||||
| I -> "I" | J -> "J"
|
||||
| K -> "K" | L -> "L"
|
||||
| M -> "M" | N -> "N"
|
||||
| O -> "O" | Int i -> string_of_int i
|
||||
#+end_src
|
||||
|
||||
*** ~to_char~
|
||||
|
||||
Converts the angular momentum into a char:
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.(to_char D) -> 'D'
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val to_char : t -> char
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let to_char = function
|
||||
| S -> 'S' | P -> 'P'
|
||||
| D -> 'D' | F -> 'F'
|
||||
| G -> 'G' | H -> 'H'
|
||||
| I -> 'I' | J -> 'J'
|
||||
| K -> 'K' | L -> 'L'
|
||||
| M -> 'M' | N -> 'N'
|
||||
| O -> 'O' | Int _ -> '_'
|
||||
#+end_src
|
||||
|
||||
*** ~to_int~
|
||||
|
||||
Returns the $l_{max}$ value of the shell:
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.(to_char D) -> 2
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val to_int : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let to_int = function
|
||||
| S -> 0 | P -> 1
|
||||
| D -> 2 | F -> 3
|
||||
| G -> 4 | H -> 5
|
||||
| I -> 6 | J -> 7
|
||||
| K -> 8 | L -> 9
|
||||
| M -> 10 | N -> 11
|
||||
| O -> 12 | Int i -> i
|
||||
#+end_src
|
||||
|
||||
*** ~of_int~
|
||||
|
||||
Returns a shell given an $l$ value.
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.of_int 3 -> Angular_momentum.F
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val of_int : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let of_int = function
|
||||
| 0 -> S | 1 -> P
|
||||
| 2 -> D | 3 -> F
|
||||
| 4 -> G | 5 -> H
|
||||
| 6 -> I | 7 -> J
|
||||
| 8 -> K | 9 -> L
|
||||
| 10 -> M | 11 -> N
|
||||
| 12 -> O | i -> Int i
|
||||
#+end_src
|
||||
|
||||
|
||||
** Shell functions
|
||||
|
||||
|
||||
*** ~n_functions~
|
||||
|
||||
Returns the number of cartesian functions in a shell.
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.n_functions D -> 6
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val n_functions : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let n_functions a =
|
||||
let a =
|
||||
to_int a
|
||||
in
|
||||
(a*a + 3*a + 2)/2
|
||||
#+end_src
|
||||
|
||||
|
||||
*** ~zkey_array~
|
||||
|
||||
Array of ~Zkey.t~, where each element is a a key associated with the
|
||||
the powers of $x,y,z$.
|
||||
|
||||
#+begin_example
|
||||
Angular_momentum.( zkey_array Doublet (P,S) ) ->
|
||||
[| {Zkey.left = 0; right = 1125899906842624} ;
|
||||
{Zkey.left = 0; right = 1099511627776} ;
|
||||
{Zkey.left = 0; right = 1073741824} |]
|
||||
=
|
||||
|
||||
let s,x,y,z =
|
||||
Powers.( of_int_tuple (0,0,0),
|
||||
of_int_tuple (1,0,0),
|
||||
of_int_tuple (0,1,0),
|
||||
of_int_tuple (0,0,1) )
|
||||
in
|
||||
Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
|
||||
[| (x,s) ; (y,s) ; (z,s) |]
|
||||
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val zkey_array : kind -> Zkey.t array
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
|
||||
Hashtbl.create 13
|
||||
|
||||
let zkey_array a =
|
||||
|
||||
let keys_1d l =
|
||||
let create_z { x ; y ; _ } =
|
||||
Powers.of_int_tuple (x,y,l-(x+y))
|
||||
in
|
||||
let rec create_y accu xyz =
|
||||
let { x ; y ; z ;_ } = xyz in
|
||||
match y with
|
||||
| 0 -> (create_z xyz)::accu
|
||||
| _ -> let ynew = y-1 in
|
||||
(create_y [@tailcall]) ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
|
||||
in
|
||||
let rec create_x accu xyz =
|
||||
let { x ; z ;_ } = xyz in
|
||||
match x with
|
||||
| 0 -> (create_y [] xyz)@accu
|
||||
| _ -> let xnew = x-1 in
|
||||
let ynew = l-xnew in
|
||||
(create_x [@tailcall]) ((create_y [] xyz)@accu) (Powers.of_int_tuple (xnew, ynew, z))
|
||||
in
|
||||
create_x [] (Powers.of_int_tuple (l,0,0))
|
||||
|> List.rev
|
||||
in
|
||||
|
||||
try
|
||||
Hashtbl.find zkey_array_memo a
|
||||
|
||||
with Not_found ->
|
||||
|
||||
let result =
|
||||
begin
|
||||
match a with
|
||||
| Singlet l1 ->
|
||||
List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
|
||||
|
||||
| Doublet (l1, l2) ->
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b -> Zkey.of_powers_six a b) (keys_1d @@ to_int l2)
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
|
||||
| Triplet (l1, l2, l3) ->
|
||||
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b ->
|
||||
List.rev_map (fun c ->
|
||||
Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
|
||||
| Quartet (l1, l2, l3, l4) ->
|
||||
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b ->
|
||||
List.rev_map (fun c ->
|
||||
List.rev_map (fun d ->
|
||||
Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
|
||||
) (keys_1d @@ to_int l3)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
end
|
||||
|> List.rev
|
||||
|> Array.of_list
|
||||
in
|
||||
Hashtbl.add zkey_array_memo a result;
|
||||
result
|
||||
#+end_src
|
||||
|
||||
|
||||
** Arithmetic
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val ( + ) : t -> t -> t
|
||||
val ( - ) : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let ( + ) a b =
|
||||
of_int ( (to_int a) + (to_int b) )
|
||||
|
||||
let ( - ) a b =
|
||||
of_int ( (to_int a) - (to_int b) )
|
||||
#+end_src
|
||||
|
||||
|
||||
** Printers
|
||||
|
||||
Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val pp_string : Format.formatter -> t -> unit
|
||||
val pp_int : Format.formatter -> t -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let pp_string ppf x =
|
||||
Format.fprintf ppf "@[%s@]" (to_string x)
|
||||
|
||||
let pp_int ppf x =
|
||||
Format.fprintf ppf "@[%d@]" (to_int x)
|
||||
#+end_src
|
||||
|
||||
|
||||
|
||||
** TODO Tests
|
||||
559
common/bitstring.org
Normal file
559
common/bitstring.org
Normal file
@ -0,0 +1,559 @@
|
||||
#+TITLE: Bit string
|
||||
|
||||
[[elisp:(org-babel-tangle)]]
|
||||
|
||||
* Bit string
|
||||
:PROPERTIES:
|
||||
:ml: lib/bitstring.ml
|
||||
:mli: lib/bitstring.mli
|
||||
:test-ml: test/bitstring.ml
|
||||
:header-args: :noweb yes :comments both
|
||||
:END:
|
||||
|
||||
We define here a data type to handle bit strings efficiently.
|
||||
When the bit string contains less than 64 bits, it is stored
|
||||
internally in a 63-bit integer and uses bitwise instructions.
|
||||
When more than 63 bits are required, the =zarith= library is used to
|
||||
consider the bit string as a multi-precision integer.
|
||||
|
||||
|
||||
** Single-integer implementation
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
module One = struct
|
||||
|
||||
let of_int x =
|
||||
assert (x > 0); x
|
||||
|
||||
let numbits _ = 63
|
||||
let zero = 0
|
||||
let is_zero x = x = 0
|
||||
let shift_left x i = x lsl i
|
||||
let shift_right x i = x lsr i
|
||||
let shift_left_one i = 1 lsl i
|
||||
let testbit x i = ( (x lsr i) land 1 ) = 1
|
||||
let logor a b = a lor b
|
||||
let neg a = - a
|
||||
let logxor a b = a lxor b
|
||||
let logand a b = a land b
|
||||
let lognot a = lnot a
|
||||
let minus_one a = a - 1
|
||||
let plus_one a = a + 1
|
||||
|
||||
let popcount = function
|
||||
| 0 -> 0
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
|
||||
let hamdist a b =
|
||||
a lxor b
|
||||
|> popcount
|
||||
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64)
|
||||
(Z.of_int s)
|
||||
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Zarith implementation
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
module Many = struct
|
||||
|
||||
let of_z x = x
|
||||
let zero = Z.zero
|
||||
let is_zero x = x = Z.zero
|
||||
let shift_left = Z.shift_left
|
||||
let shift_right = Z.shift_right
|
||||
let shift_left_one i = Z.shift_left Z.one i
|
||||
let testbit = Z.testbit
|
||||
let logor = Z.logor
|
||||
let logxor = Z.logxor
|
||||
let logand = Z.logand
|
||||
let lognot = Z.lognot
|
||||
let neg = Z.neg
|
||||
let minus_one = Z.pred
|
||||
let plus_one = Z.succ
|
||||
let trailing_zeros = Z.trailing_zeros
|
||||
let hamdist = Z.hamdist
|
||||
let numbits i = max (Z.numbits i) 64
|
||||
|
||||
let popcount z =
|
||||
if z = Z.zero then 0 else Z.popcount z
|
||||
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s)) s
|
||||
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Type
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
type t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
type t =
|
||||
| One of int
|
||||
| Many of Z.t
|
||||
#+end_src
|
||||
|
||||
** Tests header
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
open Common.Bitstring
|
||||
let check msg x = Alcotest.(check bool) msg true x
|
||||
let test_all () =
|
||||
let x = 8745687 in
|
||||
let one_x = of_int x in
|
||||
let z = Z.shift_left (Z.of_int x) 64 in
|
||||
let many_x = of_z z in
|
||||
#+end_src
|
||||
** General implementation
|
||||
|
||||
*** ~of_int~
|
||||
|
||||
Creates a bit string from an ~int~.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val of_int : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let of_int x =
|
||||
One (One.of_int x)
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "of_x" true (one_x = (of_int x));
|
||||
#+end_src
|
||||
|
||||
*** ~of_z~
|
||||
|
||||
Creates a bit string from an ~Z.t~ multi-precision integer.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val of_z : Z.t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let of_z x =
|
||||
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
|
||||
#+end_src
|
||||
|
||||
*** ~zero~
|
||||
|
||||
~zero n~ creates a zero bit string with ~n~ bits.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val zero : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let zero = function
|
||||
| n when n < 64 -> One (One.zero)
|
||||
| _ -> Many (Many.zero)
|
||||
#+end_src
|
||||
|
||||
*** ~numbits~
|
||||
|
||||
Returns the number of bits used to represent the bit string.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val numbits : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let numbits = function
|
||||
| One x -> One.numbits x
|
||||
| Many x -> Many.numbits x
|
||||
#+end_src
|
||||
|
||||
*** ~is_zero~
|
||||
|
||||
True if all the bits of the bit string are zero.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val is_zero : t -> bool
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let is_zero = function
|
||||
| One x -> One.is_zero x
|
||||
| Many x -> Many.is_zero x
|
||||
#+end_src
|
||||
|
||||
*** ~neg~
|
||||
|
||||
Returns the negative of the integer interpretation of the bit string.
|
||||
|
||||
#+begin_example
|
||||
neg (of_int x) = neg (of_int (-x))
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val neg : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let neg = function
|
||||
| One x -> One (One.neg x)
|
||||
| Many x -> Many (Many.neg x)
|
||||
#+end_src
|
||||
|
||||
*** ~shift_left~
|
||||
|
||||
~shift_left t n~ returns a new bit strings with all the bits
|
||||
shifted ~n~ positions to the left.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val shift_left : t -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let shift_left x i = match x with
|
||||
| One x -> One (One.shift_left x i)
|
||||
| Many x -> Many (Many.shift_left x i)
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 3);
|
||||
Alcotest.(check bool) "shift_left2" true (of_z (Z.shift_left z 3) = shift_left many_x 3);
|
||||
Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
|
||||
#+end_src
|
||||
|
||||
*** ~shift_right~
|
||||
|
||||
~shift_right t n~ returns a new bit strings with all the bits
|
||||
shifted ~n~ positions to the right.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val shift_right : t -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let shift_right x i = match x with
|
||||
| One x -> One (One.shift_right x i)
|
||||
| Many x -> Many (Many.shift_right x i)
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 3);
|
||||
Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
|
||||
#+end_src
|
||||
|
||||
*** ~shift_left_one~
|
||||
|
||||
~shift_left_one size n~ returns a new bit strings with the ~n~-th
|
||||
bit set to one.
|
||||
It is equivalent as shifting ~1~ by ~n~ bits to the left.
|
||||
~size~ is the total number of bits of the bit string.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val shift_left_one : int -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let shift_left_one = function
|
||||
| n when n < 64 -> fun i -> One (One.shift_left_one i)
|
||||
| _ -> fun i -> Many (Many.shift_left_one i)
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 3);
|
||||
Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
|
||||
#+end_src
|
||||
|
||||
*** ~testbit~
|
||||
|
||||
~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
|
||||
set to ~1~.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val testbit : t -> int -> bool
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let testbit = function
|
||||
| One x -> One.testbit x
|
||||
| Many x -> Many.testbit x
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3);
|
||||
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
|
||||
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
|
||||
Alcotest.(check bool) "testbit4" true (testbit (of_z (Z.of_int 8)) 3);
|
||||
Alcotest.(check bool) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
|
||||
Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
|
||||
#+end_src
|
||||
|
||||
*** ~logor~
|
||||
|
||||
Bitwise logical or.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val logor : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let logor a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logor a b)
|
||||
| Many a, Many b -> Many (Many.logor a b)
|
||||
| _ -> invalid_arg "Bitstring.logor"
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2));
|
||||
Alcotest.(check bool) "logor2" true (of_z (Z.of_int (1 lor 2)) = logor (of_z Z.one) (of_z (Z.of_int 2)));
|
||||
#+end_src
|
||||
|
||||
*** ~logxor~
|
||||
|
||||
Bitwise logical exclusive or.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val logxor : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let logxor a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logxor a b)
|
||||
| Many a, Many b -> Many (Many.logxor a b)
|
||||
| _ -> invalid_arg "Bitstring.logxor"
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2));
|
||||
Alcotest.(check bool) "logxor2" true (of_z (Z.of_int (1 lxor 2)) = logxor (of_z Z.one) (of_z (Z.of_int 2)));
|
||||
#+end_src
|
||||
|
||||
*** ~logand~
|
||||
|
||||
Bitwise logical and.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val logand : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let logand a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logand a b)
|
||||
| Many a, Many b -> Many (Many.logand a b)
|
||||
| _ -> invalid_arg "Bitstring.logand"
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 3));
|
||||
Alcotest.(check bool) "logand2" true (of_z (Z.of_int (1 land 3)) = logand (of_z Z.one) (of_z (Z.of_int 3)));
|
||||
#+end_src
|
||||
|
||||
*** ~lognot~
|
||||
|
||||
Bitwise logical negation.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val lognot : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let lognot = function
|
||||
| One x -> One (One.lognot x)
|
||||
| Many x -> Many (Many.lognot x)
|
||||
#+end_src
|
||||
|
||||
*** ~minus_one~
|
||||
|
||||
Takes the integer representation of the bit string and removes one.
|
||||
|
||||
#+begin_example
|
||||
minus_one (of_int 10) = of_int 9
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val minus_one : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let minus_one = function
|
||||
| One x -> One (One.minus_one x)
|
||||
| Many x -> Many (Many.minus_one x)
|
||||
#+end_src
|
||||
|
||||
*** ~plus_one~
|
||||
|
||||
Takes the integer representation of the bit string and adds one.
|
||||
|
||||
#+begin_example
|
||||
plus_one (of_int 10) = of_int 11
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val plus_one : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let plus_one = function
|
||||
| One x -> One (One.plus_one x)
|
||||
| Many x -> Many (Many.plus_one x)
|
||||
#+end_src
|
||||
|
||||
*** ~trailing_zeros~
|
||||
|
||||
Returns the number of trailing zeros in the bit string.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val trailing_zeros : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let trailing_zeros = function
|
||||
| One x -> One.trailing_zeros x
|
||||
| Many x -> Many.trailing_zeros x
|
||||
#+end_src
|
||||
|
||||
*** ~hamdist~
|
||||
|
||||
Returns the Hamming distance, i.e. the number of bits differing
|
||||
between two bit strings.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val hamdist : t -> t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let hamdist a b = match a, b with
|
||||
| One a, One b -> One.hamdist a b
|
||||
| Many a, Many b -> Many.hamdist a b
|
||||
| _ -> invalid_arg "Bitstring.hamdist"
|
||||
#+end_src
|
||||
|
||||
*** ~popcount~
|
||||
|
||||
Returns the number of bits set to one in the bit string.
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val popcount : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let popcount = function
|
||||
| One x -> One.popcount x
|
||||
| Many x -> Many.popcount x
|
||||
#+end_src
|
||||
|
||||
*** ~to_list~
|
||||
|
||||
Converts a bit string into a list of integers indicating the
|
||||
positions where the bits are set to ~1~. The first value for the
|
||||
position is not ~0~ but ~1~.
|
||||
|
||||
#+begin_example
|
||||
Bitstring.to_list (of_int 5);;
|
||||
- : int list = [1; 3]
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val to_list : ?accu:(int list) -> t -> int list
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let rec to_list ?(accu=[]) = function
|
||||
| t when (is_zero t) -> List.rev accu
|
||||
| t -> let newlist =
|
||||
(trailing_zeros t + 1)::accu
|
||||
in
|
||||
logand t @@ minus_one t
|
||||
|> (to_list [@tailcall]) ~accu:newlist
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
|
||||
#+end_src
|
||||
|
||||
*** ~permtutations~
|
||||
|
||||
~permtutations m n~ generates the list of all possible ~n~-bit
|
||||
strings with ~m~ bits set to ~1~.
|
||||
Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]].
|
||||
|
||||
#+begin_example
|
||||
Bitstring.permtutations 2 4 |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
|> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
- : string list =
|
||||
["++--------------------------------------------------------------";
|
||||
"+-+-------------------------------------------------------------";
|
||||
"-++-------------------------------------------------------------";
|
||||
"+--+------------------------------------------------------------";
|
||||
"-+-+------------------------------------------------------------";
|
||||
"--++------------------------------------------------------------"]
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val permtutations : int -> int -> t list
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let permtutations m n =
|
||||
|
||||
let rec aux k u rest =
|
||||
if k=1 then
|
||||
List.rev (u :: rest)
|
||||
else
|
||||
let t = logor u @@ minus_one u in
|
||||
let t' = plus_one t in
|
||||
let not_t = lognot t in
|
||||
let neg_not_t = neg not_t in
|
||||
let t'' = shift_right (minus_one @@ logand not_t neg_not_t) (trailing_zeros u + 1) in
|
||||
(*
|
||||
let t'' = shift_right (minus_one (logand (lognot t) t')) (trailing_zeros u + 1) in
|
||||
,*)
|
||||
(aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
|
||||
in
|
||||
aux (Util.binom n m) (minus_one (shift_left_one n m)) []
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
check "permutations"
|
||||
(permtutations 2 4 = List.map of_int
|
||||
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
|
||||
#+end_src
|
||||
|
||||
** Printers
|
||||
|
||||
Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "mli" t)
|
||||
val pp : Format.formatter -> t -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "ml" t)
|
||||
let pp ppf = function
|
||||
| One x -> One.pp ppf x
|
||||
| Many x -> Many.pp ppf x
|
||||
#+end_src
|
||||
|
||||
** Tests
|
||||
|
||||
#+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
|
||||
()
|
||||
|
||||
let tests = [
|
||||
"all", `Quick, test_all;
|
||||
]
|
||||
#+end_src
|
||||
|
||||
@ -1,11 +1,29 @@
|
||||
open Powers
|
||||
|
||||
|
||||
(* An exception is raised when the ~Angular_momentum.t~ element can't
|
||||
* be created.
|
||||
*
|
||||
* The ~kind~ is used to build shells, shell doublets, triplets or
|
||||
* quartets, use in the two-electron operators. *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*Type][Type:2]] *)
|
||||
type t =
|
||||
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
||||
| Int of int
|
||||
|
||||
exception Angular_momentum_error of string
|
||||
|
||||
type t =
|
||||
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
||||
| Int of int
|
||||
type kind =
|
||||
Singlet of t
|
||||
| Doublet of (t * t)
|
||||
| Triplet of (t * t * t)
|
||||
| Quartet of (t * t * t * t)
|
||||
|
||||
open Powers
|
||||
(* Type:2 ends here *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*~of_char~][~of_char~:2]] *)
|
||||
let of_char = function
|
||||
| 's' | 'S' -> S | 'p' | 'P' -> P
|
||||
| 'd' | 'D' -> D | 'f' | 'F' -> F
|
||||
@ -15,7 +33,9 @@ let of_char = function
|
||||
| 'm' | 'M' -> M | 'n' | 'N' -> N
|
||||
| 'o' | 'O' -> O
|
||||
| c -> raise (Angular_momentum_error (String.make 1 c))
|
||||
(* ~of_char~:2 ends here *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_string~][~to_string~:2]] *)
|
||||
let to_string = function
|
||||
| S -> "S" | P -> "P"
|
||||
| D -> "D" | F -> "F"
|
||||
@ -24,7 +44,9 @@ let to_string = function
|
||||
| K -> "K" | L -> "L"
|
||||
| M -> "M" | N -> "N"
|
||||
| O -> "O" | Int i -> string_of_int i
|
||||
(* ~to_string~:2 ends here *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_char~][~to_char~:2]] *)
|
||||
let to_char = function
|
||||
| S -> 'S' | P -> 'P'
|
||||
| D -> 'D' | F -> 'F'
|
||||
@ -33,7 +55,9 @@ let to_char = function
|
||||
| K -> 'K' | L -> 'L'
|
||||
| M -> 'M' | N -> 'N'
|
||||
| O -> 'O' | Int _ -> '_'
|
||||
(* ~to_char~:2 ends here *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_int~][~to_int~:2]] *)
|
||||
let to_int = function
|
||||
| S -> 0 | P -> 1
|
||||
| D -> 2 | F -> 3
|
||||
@ -42,8 +66,9 @@ let to_int = function
|
||||
| K -> 8 | L -> 9
|
||||
| M -> 10 | N -> 11
|
||||
| O -> 12 | Int i -> i
|
||||
(* ~to_int~:2 ends here *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~of_int~][~of_int~:2]] *)
|
||||
let of_int = function
|
||||
| 0 -> S | 1 -> P
|
||||
| 2 -> D | 3 -> F
|
||||
@ -52,28 +77,21 @@ let of_int = function
|
||||
| 8 -> K | 9 -> L
|
||||
| 10 -> M | 11 -> N
|
||||
| 12 -> O | i -> Int i
|
||||
(* ~of_int~:2 ends here *)
|
||||
|
||||
|
||||
|
||||
type kind =
|
||||
| Singlet of t
|
||||
| Doublet of (t*t)
|
||||
| Triplet of (t*t*t)
|
||||
| Quartet of (t*t*t*t)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:2]] *)
|
||||
let n_functions a =
|
||||
let a =
|
||||
let a =
|
||||
to_int a
|
||||
in
|
||||
(a*a + 3*a + 2)/2
|
||||
(* ~n_functions~:2 ends here *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:2]] *)
|
||||
let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
|
||||
Hashtbl.create 13
|
||||
Hashtbl.create 13
|
||||
|
||||
(** Returns an array of Zkeys corresponding to all possible angular momenta *)
|
||||
let zkey_array a =
|
||||
let zkey_array a =
|
||||
|
||||
let keys_1d l =
|
||||
let create_z { x ; y ; _ } =
|
||||
@ -84,15 +102,15 @@ let zkey_array a =
|
||||
match y with
|
||||
| 0 -> (create_z xyz)::accu
|
||||
| _ -> let ynew = y-1 in
|
||||
(create_y [@tailcall]) ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
|
||||
(create_y [@tailcall]) ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
|
||||
in
|
||||
let rec create_x accu xyz =
|
||||
let { x ; z ;_ } = xyz in
|
||||
match x with
|
||||
| 0 -> (create_y [] xyz)@accu
|
||||
| _ -> let xnew = x-1 in
|
||||
let ynew = l-xnew in
|
||||
(create_x [@tailcall]) ((create_y [] xyz)@accu) (Powers.of_int_tuple (xnew, ynew, z))
|
||||
let ynew = l-xnew in
|
||||
(create_x [@tailcall]) ((create_y [] xyz)@accu) (Powers.of_int_tuple (xnew, ynew, z))
|
||||
in
|
||||
create_x [] (Powers.of_int_tuple (l,0,0))
|
||||
|> List.rev
|
||||
@ -103,62 +121,62 @@ let zkey_array a =
|
||||
|
||||
with Not_found ->
|
||||
|
||||
let result =
|
||||
let result =
|
||||
begin
|
||||
match a with
|
||||
| Singlet l1 ->
|
||||
List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
|
||||
| Singlet l1 ->
|
||||
List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
|
||||
|
||||
| Doublet (l1, l2) ->
|
||||
List.rev_map (fun a ->
|
||||
| Doublet (l1, l2) ->
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b -> Zkey.of_powers_six a b) (keys_1d @@ to_int l2)
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
|> List.concat
|
||||
|
||||
| Triplet (l1, l2, l3) ->
|
||||
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b ->
|
||||
List.rev_map (fun c ->
|
||||
Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
|
||||
) (keys_1d @@ to_int l2)
|
||||
List.rev_map (fun c ->
|
||||
Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
|> List.concat
|
||||
|
||||
| Quartet (l1, l2, l3, l4) ->
|
||||
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun a ->
|
||||
List.rev_map (fun b ->
|
||||
List.rev_map (fun c ->
|
||||
List.rev_map (fun d ->
|
||||
Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
|
||||
) (keys_1d @@ to_int l3)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l2)
|
||||
List.rev_map (fun c ->
|
||||
List.rev_map (fun d ->
|
||||
Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
|
||||
) (keys_1d @@ to_int l3)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l1)
|
||||
|> List.concat
|
||||
|> List.concat
|
||||
end
|
||||
|> List.rev
|
||||
|> Array.of_list
|
||||
in
|
||||
Hashtbl.add zkey_array_memo a result;
|
||||
result
|
||||
(* ~zkey_array~:2 ends here *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*Arithmetic][Arithmetic:2]] *)
|
||||
let ( + ) a b =
|
||||
of_int ( (to_int a) + (to_int b) )
|
||||
|
||||
let ( - ) a b =
|
||||
of_int ( (to_int a) - (to_int b) )
|
||||
(* Arithmetic:2 ends here *)
|
||||
|
||||
|
||||
(** {2 Printers} *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*Printers][Printers:2]] *)
|
||||
let pp_string ppf x =
|
||||
Format.fprintf ppf "@[%s@]" (to_string x)
|
||||
|
||||
let pp_int ppf x =
|
||||
Format.fprintf ppf "@[%d@]" (to_int x)
|
||||
|
||||
(* Printers:2 ends here *)
|
||||
|
||||
@ -1,115 +1,142 @@
|
||||
(** Azimuthal quantum number, represented as {% $s,p,d,\dots$ %} *)
|
||||
(* Type
|
||||
*
|
||||
* #+NAME: types *)
|
||||
|
||||
(* [[file:../angular_momentum.org::types][types]] *)
|
||||
type t =
|
||||
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
||||
| Int of int
|
||||
| S | P | D | F | G | H | I | J | K | L | M | N | O
|
||||
| Int of int
|
||||
|
||||
exception Angular_momentum_error of string
|
||||
(** Raised when the {!Angular_momentum.t} element can't be created.
|
||||
*)
|
||||
|
||||
|
||||
val of_char : char -> t
|
||||
(** Returns an {!Angular_momentum.t} when a shell is given as a character (case
|
||||
insensitive).
|
||||
|
||||
Example:
|
||||
|
||||
{[
|
||||
Angular_momentum.of_char 'p' -> Angular_momentum.P
|
||||
]}
|
||||
*)
|
||||
|
||||
val to_string : t -> string
|
||||
(**
|
||||
{[
|
||||
Angular_momentum.(to_string D) -> "D"
|
||||
]}
|
||||
*)
|
||||
|
||||
|
||||
val to_char : t -> char
|
||||
(**
|
||||
{[
|
||||
Angular_momentum.(to_char D) -> 'D'
|
||||
]}
|
||||
*)
|
||||
|
||||
|
||||
val to_int : t -> int
|
||||
(**
|
||||
Returns the l{_max} value of the shell.
|
||||
|
||||
Example:
|
||||
|
||||
{[
|
||||
Angular_momentum.to_int D -> 2
|
||||
]}
|
||||
*)
|
||||
|
||||
val of_int : int -> t
|
||||
(**
|
||||
Opposite of {!of_int}.
|
||||
|
||||
Example:
|
||||
|
||||
{[
|
||||
Angular_momentum.of_int 3 -> Angular_momentum.F
|
||||
]}
|
||||
*)
|
||||
|
||||
type kind =
|
||||
Singlet of t
|
||||
| Doublet of (t * t)
|
||||
| Triplet of (t * t * t)
|
||||
| Quartet of (t * t * t * t)
|
||||
(* types ends here *)
|
||||
|
||||
(* ~of_char~
|
||||
*
|
||||
* Returns an ~Angular_momentum.t~ when a shell is given as a character
|
||||
* (case insensitive):
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.of_char 'p' -> Angular_momentum.P
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~of_char~][~of_char~:1]] *)
|
||||
val of_char : char -> t
|
||||
(* ~of_char~:1 ends here *)
|
||||
|
||||
(* ~to_string~
|
||||
*
|
||||
* Converts the angular momentum into a string:
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.(to_string D) -> "D"
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_string~][~to_string~:1]] *)
|
||||
val to_string : t -> string
|
||||
(* ~to_string~:1 ends here *)
|
||||
|
||||
(* ~to_char~
|
||||
*
|
||||
* Converts the angular momentum into a char:
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.(to_char D) -> 'D'
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_char~][~to_char~:1]] *)
|
||||
val to_char : t -> char
|
||||
(* ~to_char~:1 ends here *)
|
||||
|
||||
(* ~to_int~
|
||||
*
|
||||
* Returns the $l_{max}$ value of the shell:
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.(to_char D) -> 2
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~to_int~][~to_int~:1]] *)
|
||||
val to_int : t -> int
|
||||
(* ~to_int~:1 ends here *)
|
||||
|
||||
(* ~of_int~
|
||||
*
|
||||
* Returns a shell given an $l$ value.
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.of_int 3 -> Angular_momentum.F
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~of_int~][~of_int~:1]] *)
|
||||
val of_int : int -> t
|
||||
(* ~of_int~:1 ends here *)
|
||||
|
||||
(* ~n_functions~
|
||||
*
|
||||
* Returns the number of cartesian functions in a shell.
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.n_functions D -> 6
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:1]] *)
|
||||
val n_functions : t -> int
|
||||
(** Number of cartesian functions in shell.
|
||||
(* ~n_functions~:1 ends here *)
|
||||
|
||||
Example:
|
||||
|
||||
{[
|
||||
Angular_momentum.n_functions D -> 6
|
||||
]}
|
||||
*)
|
||||
(* ~zkey_array~
|
||||
*
|
||||
* Array of ~Zkey.t~, where each element is a a key associated with the
|
||||
* the powers of $x,y,z$.
|
||||
*
|
||||
* #+begin_example
|
||||
* Angular_momentum.( zkey_array Doublet (P,S) ) ->
|
||||
* [| {Zkey.left = 0; right = 1125899906842624} ;
|
||||
* {Zkey.left = 0; right = 1099511627776} ;
|
||||
* {Zkey.left = 0; right = 1073741824} |]
|
||||
* =
|
||||
*
|
||||
* let s,x,y,z =
|
||||
* Powers.( of_int_tuple (0,0,0),
|
||||
* of_int_tuple (1,0,0),
|
||||
* of_int_tuple (0,1,0),
|
||||
* of_int_tuple (0,0,1) )
|
||||
* in
|
||||
* Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
|
||||
* [| (x,s) ; (y,s) ; (z,s) |]
|
||||
*
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:1]] *)
|
||||
val zkey_array : kind -> Zkey.t array
|
||||
(** Array of {!Zkey.t}, where each element is a a key associated with the
|
||||
the powers of x,y,z.
|
||||
(* ~zkey_array~:1 ends here *)
|
||||
|
||||
Example:
|
||||
(* Arithmetic *)
|
||||
|
||||
{[
|
||||
Angular_momentum.( zkey_array Doublet (P,S) ) ->
|
||||
[| {Zkey.left = 0; right = 1125899906842624} ;
|
||||
{Zkey.left = 0; right = 1099511627776} ;
|
||||
{Zkey.left = 0; right = 1073741824} |]
|
||||
=
|
||||
|
||||
let s,x,y,z =
|
||||
Powers.( of_int_tuple (0,0,0),
|
||||
of_int_tuple (1,0,0),
|
||||
of_int_tuple (0,1,0),
|
||||
of_int_tuple (0,0,1) )
|
||||
in
|
||||
Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
|
||||
[| (x,s) ; (y,s) ; (z,s) |]
|
||||
]}
|
||||
|
||||
*)
|
||||
|
||||
(* [[file:../angular_momentum.org::*Arithmetic][Arithmetic:1]] *)
|
||||
val ( + ) : t -> t -> t
|
||||
val ( - ) : t -> t -> t
|
||||
(* Arithmetic:1 ends here *)
|
||||
|
||||
(* Printers
|
||||
*
|
||||
* Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
|
||||
|
||||
|
||||
(** {2 Printers} *)
|
||||
|
||||
(* [[file:../angular_momentum.org::*Printers][Printers:1]] *)
|
||||
val pp_string : Format.formatter -> t -> unit
|
||||
(** Prints as a string S, P, D, ... *)
|
||||
|
||||
val pp_int : Format.formatter -> t -> unit
|
||||
(** Prints as an integer 0, 1, 2, ... *)
|
||||
|
||||
(* Printers:1 ends here *)
|
||||
|
||||
@ -1,7 +1,9 @@
|
||||
module One = struct
|
||||
type t = int
|
||||
(* Single-integer implementation *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Single-integer implementation][Single-integer implementation:1]] *)
|
||||
module One = struct
|
||||
|
||||
let of_int x =
|
||||
assert (x > 0); x
|
||||
|
||||
@ -24,30 +26,26 @@ module One = struct
|
||||
| 0 -> 0
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
|
||||
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
|
||||
|
||||
let hamdist a b =
|
||||
a lxor b
|
||||
|> popcount
|
||||
|
||||
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64)
|
||||
(Z.of_int s)
|
||||
|
||||
end
|
||||
(* Single-integer implementation:1 ends here *)
|
||||
|
||||
(* Zarith implementation *)
|
||||
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Zarith implementation][Zarith implementation:1]] *)
|
||||
module Many = struct
|
||||
|
||||
type t = Z.t
|
||||
|
||||
let of_int = Z.of_int
|
||||
let of_z x = x
|
||||
let zero = Z.zero
|
||||
let is_zero x = x = Z.zero
|
||||
@ -73,98 +71,134 @@ module Many = struct
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s)) s
|
||||
|
||||
end
|
||||
(* Zarith implementation:1 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*Type][Type:2]] *)
|
||||
type t =
|
||||
| One of int
|
||||
| Many of Z.t
|
||||
(* Type:2 ends here *)
|
||||
|
||||
type t =
|
||||
| One of int
|
||||
| Many of Z.t
|
||||
|
||||
(* [[file:../bitstring.org::*~of_int~][~of_int~:2]] *)
|
||||
let of_int x =
|
||||
One (One.of_int x)
|
||||
(* ~of_int~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~of_z~][~of_z~:2]] *)
|
||||
let of_z x =
|
||||
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
|
||||
(* ~of_z~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~zero~][~zero~:2]] *)
|
||||
let zero = function
|
||||
| n when n < 64 -> One (One.zero)
|
||||
| _ -> Many (Many.zero)
|
||||
(* ~zero~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~numbits~][~numbits~:2]] *)
|
||||
let numbits = function
|
||||
| One x -> One.numbits x
|
||||
| Many x -> Many.numbits x
|
||||
(* ~numbits~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~is_zero~][~is_zero~:2]] *)
|
||||
let is_zero = function
|
||||
| One x -> One.is_zero x
|
||||
| Many x -> Many.is_zero x
|
||||
| One x -> One.is_zero x
|
||||
| Many x -> Many.is_zero x
|
||||
(* ~is_zero~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~neg~][~neg~:2]] *)
|
||||
let neg = function
|
||||
| One x -> One (One.neg x)
|
||||
| Many x -> Many (Many.neg x)
|
||||
| One x -> One (One.neg x)
|
||||
| Many x -> Many (Many.neg x)
|
||||
(* ~neg~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left~][~shift_left~:2]] *)
|
||||
let shift_left x i = match x with
|
||||
| One x -> One (One.shift_left x i)
|
||||
| Many x -> Many (Many.shift_left x i)
|
||||
(* ~shift_left~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_right~][~shift_right~:2]] *)
|
||||
let shift_right x i = match x with
|
||||
| One x -> One (One.shift_right x i)
|
||||
| Many x -> Many (Many.shift_right x i)
|
||||
(* ~shift_right~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:2]] *)
|
||||
let shift_left_one = function
|
||||
| n when n < 64 -> fun i -> One (One.shift_left_one i)
|
||||
| _ -> fun i -> Many (Many.shift_left_one i)
|
||||
(* ~shift_left_one~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~testbit~][~testbit~:2]] *)
|
||||
let testbit = function
|
||||
| One x -> One.testbit x
|
||||
| Many x -> Many.testbit x
|
||||
(* ~testbit~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logor~][~logor~:2]] *)
|
||||
let logor a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logor a b)
|
||||
| Many a, Many b -> Many (Many.logor a b)
|
||||
| _ -> invalid_arg "Bitstring.logor"
|
||||
(* ~logor~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logxor~][~logxor~:2]] *)
|
||||
let logxor a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logxor a b)
|
||||
| Many a, Many b -> Many (Many.logxor a b)
|
||||
| _ -> invalid_arg "Bitstring.logxor"
|
||||
(* ~logxor~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logand~][~logand~:2]] *)
|
||||
let logand a b =
|
||||
match a,b with
|
||||
| One a, One b -> One (One.logand a b)
|
||||
| Many a, Many b -> Many (Many.logand a b)
|
||||
| _ -> invalid_arg "Bitstring.logand"
|
||||
(* ~logand~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~lognot~][~lognot~:2]] *)
|
||||
let lognot = function
|
||||
| One x -> One (One.lognot x)
|
||||
| Many x -> Many (Many.lognot x)
|
||||
(* ~lognot~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~minus_one~][~minus_one~:2]] *)
|
||||
let minus_one = function
|
||||
| One x -> One (One.minus_one x)
|
||||
| Many x -> Many (Many.minus_one x)
|
||||
(* ~minus_one~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~plus_one~][~plus_one~:2]] *)
|
||||
let plus_one = function
|
||||
| One x -> One (One.plus_one x)
|
||||
| Many x -> Many (Many.plus_one x)
|
||||
(* ~plus_one~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:2]] *)
|
||||
let trailing_zeros = function
|
||||
| One x -> One.trailing_zeros x
|
||||
| Many x -> Many.trailing_zeros x
|
||||
(* ~trailing_zeros~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~hamdist~][~hamdist~:2]] *)
|
||||
let hamdist a b = match a, b with
|
||||
| One a, One b -> One.hamdist a b
|
||||
| Many a, Many b -> Many.hamdist a b
|
||||
| _ -> invalid_arg "Bitstring.hamdist"
|
||||
(* ~hamdist~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~popcount~][~popcount~:2]] *)
|
||||
let popcount = function
|
||||
| One x -> One.popcount x
|
||||
| Many x -> Many.popcount x
|
||||
(* ~popcount~:2 ends here *)
|
||||
|
||||
let pp ppf = function
|
||||
| One x -> One.pp ppf x
|
||||
| Many x -> Many.pp ppf x
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~to_list~][~to_list~:2]] *)
|
||||
let rec to_list ?(accu=[]) = function
|
||||
| t when (is_zero t) -> List.rev accu
|
||||
| t -> let newlist =
|
||||
@ -172,18 +206,9 @@ let rec to_list ?(accu=[]) = function
|
||||
in
|
||||
logand t @@ minus_one t
|
||||
|> (to_list [@tailcall]) ~accu:newlist
|
||||
(* ~to_list~:2 ends here *)
|
||||
|
||||
|
||||
(** [permtutations m n] generates the list of all possible [n]-bit
|
||||
strings with [m] bits set to 1.
|
||||
Algorithm adapted from
|
||||
{{:https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation}
|
||||
Bit twiddling hacks}.
|
||||
Example:
|
||||
{[
|
||||
permtutations 2 4 = [ 0011 ; 0101 ; 0110 ; 1001 ; 1010 ; 1100 ]
|
||||
]}
|
||||
*)
|
||||
(* [[file:../bitstring.org::*~permtutations~][~permtutations~:2]] *)
|
||||
let permtutations m n =
|
||||
|
||||
let rec aux k u rest =
|
||||
@ -201,6 +226,10 @@ let permtutations m n =
|
||||
(aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
|
||||
in
|
||||
aux (Util.binom n m) (minus_one (shift_left_one n m)) []
|
||||
(* ~permtutations~:2 ends here *)
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Printers][Printers:2]] *)
|
||||
let pp ppf = function
|
||||
| One x -> One.pp ppf x
|
||||
| Many x -> Many.pp ppf x
|
||||
(* Printers:2 ends here *)
|
||||
|
||||
244
common/lib/bitstring.mli
Normal file
244
common/lib/bitstring.mli
Normal file
@ -0,0 +1,244 @@
|
||||
(* Type *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Type][Type:1]] *)
|
||||
type t
|
||||
(* Type:1 ends here *)
|
||||
|
||||
(* ~of_int~
|
||||
*
|
||||
* Creates a bit string from an ~int~. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~of_int~][~of_int~:1]] *)
|
||||
val of_int : int -> t
|
||||
(* ~of_int~:1 ends here *)
|
||||
|
||||
(* ~of_z~
|
||||
*
|
||||
* Creates a bit string from an ~Z.t~ multi-precision integer. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~of_z~][~of_z~:1]] *)
|
||||
val of_z : Z.t -> t
|
||||
(* ~of_z~:1 ends here *)
|
||||
|
||||
(* ~zero~
|
||||
*
|
||||
* ~zero n~ creates a zero bit string with ~n~ bits. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~zero~][~zero~:1]] *)
|
||||
val zero : int -> t
|
||||
(* ~zero~:1 ends here *)
|
||||
|
||||
(* ~numbits~
|
||||
*
|
||||
* Returns the number of bits used to represent the bit string. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~numbits~][~numbits~:1]] *)
|
||||
val numbits : t -> int
|
||||
(* ~numbits~:1 ends here *)
|
||||
|
||||
(* ~is_zero~
|
||||
*
|
||||
* True if all the bits of the bit string are zero. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~is_zero~][~is_zero~:1]] *)
|
||||
val is_zero : t -> bool
|
||||
(* ~is_zero~:1 ends here *)
|
||||
|
||||
(* ~neg~
|
||||
*
|
||||
* Returns the negative of the integer interpretation of the bit string.
|
||||
*
|
||||
* #+begin_example
|
||||
* neg (of_int x) = neg (of_int (-x))
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~neg~][~neg~:1]] *)
|
||||
val neg : t -> t
|
||||
(* ~neg~:1 ends here *)
|
||||
|
||||
(* ~shift_left~
|
||||
*
|
||||
* ~shift_left t n~ returns a new bit strings with all the bits
|
||||
* shifted ~n~ positions to the left. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left~][~shift_left~:1]] *)
|
||||
val shift_left : t -> int -> t
|
||||
(* ~shift_left~:1 ends here *)
|
||||
|
||||
(* ~shift_right~
|
||||
*
|
||||
* ~shift_right t n~ returns a new bit strings with all the bits
|
||||
* shifted ~n~ positions to the right. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_right~][~shift_right~:1]] *)
|
||||
val shift_right : t -> int -> t
|
||||
(* ~shift_right~:1 ends here *)
|
||||
|
||||
(* ~shift_left_one~
|
||||
*
|
||||
* ~shift_left_one size n~ returns a new bit strings with the ~n~-th
|
||||
* bit set to one.
|
||||
* It is equivalent as shifting ~1~ by ~n~ bits to the left.
|
||||
* ~size~ is the total number of bits of the bit string. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:1]] *)
|
||||
val shift_left_one : int -> int -> t
|
||||
(* ~shift_left_one~:1 ends here *)
|
||||
|
||||
(* ~testbit~
|
||||
*
|
||||
* ~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
|
||||
* set to ~1~. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~testbit~][~testbit~:1]] *)
|
||||
val testbit : t -> int -> bool
|
||||
(* ~testbit~:1 ends here *)
|
||||
|
||||
(* ~logor~
|
||||
*
|
||||
* Bitwise logical or. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~logor~][~logor~:1]] *)
|
||||
val logor : t -> t -> t
|
||||
(* ~logor~:1 ends here *)
|
||||
|
||||
(* ~logxor~
|
||||
*
|
||||
* Bitwise logical exclusive or. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~logxor~][~logxor~:1]] *)
|
||||
val logxor : t -> t -> t
|
||||
(* ~logxor~:1 ends here *)
|
||||
|
||||
(* ~logand~
|
||||
*
|
||||
* Bitwise logical and. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~logand~][~logand~:1]] *)
|
||||
val logand : t -> t -> t
|
||||
(* ~logand~:1 ends here *)
|
||||
|
||||
(* ~lognot~
|
||||
*
|
||||
* Bitwise logical negation. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~lognot~][~lognot~:1]] *)
|
||||
val lognot : t -> t
|
||||
(* ~lognot~:1 ends here *)
|
||||
|
||||
(* ~minus_one~
|
||||
*
|
||||
* Takes the integer representation of the bit string and removes one.
|
||||
*
|
||||
* #+begin_example
|
||||
* minus_one (of_int 10) = of_int 9
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~minus_one~][~minus_one~:1]] *)
|
||||
val minus_one : t -> t
|
||||
(* ~minus_one~:1 ends here *)
|
||||
|
||||
(* ~plus_one~
|
||||
*
|
||||
* Takes the integer representation of the bit string and adds one.
|
||||
*
|
||||
* #+begin_example
|
||||
* plus_one (of_int 10) = of_int 11
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~plus_one~][~plus_one~:1]] *)
|
||||
val plus_one : t -> t
|
||||
(* ~plus_one~:1 ends here *)
|
||||
|
||||
(* ~trailing_zeros~
|
||||
*
|
||||
* Returns the number of trailing zeros in the bit string. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:1]] *)
|
||||
val trailing_zeros : t -> int
|
||||
(* ~trailing_zeros~:1 ends here *)
|
||||
|
||||
(* ~hamdist~
|
||||
*
|
||||
* Returns the Hamming distance, i.e. the number of bits differing
|
||||
* between two bit strings. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~hamdist~][~hamdist~:1]] *)
|
||||
val hamdist : t -> t -> int
|
||||
(* ~hamdist~:1 ends here *)
|
||||
|
||||
(* ~popcount~
|
||||
*
|
||||
* Returns the number of bits set to one in the bit string. *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~popcount~][~popcount~:1]] *)
|
||||
val popcount : t -> int
|
||||
(* ~popcount~:1 ends here *)
|
||||
|
||||
(* ~to_list~
|
||||
*
|
||||
* Converts a bit string into a list of integers indicating the
|
||||
* positions where the bits are set to ~1~. The first value for the
|
||||
* position is not ~0~ but ~1~.
|
||||
*
|
||||
* #+begin_example
|
||||
* Bitstring.to_list (of_int 5);;
|
||||
* - : int list = [1; 3]
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~to_list~][~to_list~:1]] *)
|
||||
val to_list : ?accu:(int list) -> t -> int list
|
||||
(* ~to_list~:1 ends here *)
|
||||
|
||||
(* ~permtutations~
|
||||
*
|
||||
* ~permtutations m n~ generates the list of all possible ~n~-bit
|
||||
* strings with ~m~ bits set to ~1~.
|
||||
* Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]].
|
||||
*
|
||||
* #+begin_example
|
||||
* Bitstring.permtutations 2 4 |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
* |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
* - : string list =
|
||||
* ["++--------------------------------------------------------------";
|
||||
* "+-+-------------------------------------------------------------";
|
||||
* "-++-------------------------------------------------------------";
|
||||
* "+--+------------------------------------------------------------";
|
||||
* "-+-+------------------------------------------------------------";
|
||||
* "--++------------------------------------------------------------"]
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~permtutations~][~permtutations~:1]] *)
|
||||
val permtutations : int -> int -> t list
|
||||
(* ~permtutations~:1 ends here *)
|
||||
|
||||
(* Printers
|
||||
*
|
||||
* Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Printers][Printers:1]] *)
|
||||
val pp : Format.formatter -> t -> unit
|
||||
(* Printers:1 ends here *)
|
||||
@ -1,18 +1,20 @@
|
||||
; name = name of the supermodule that will wrap all source files as submodules
|
||||
; public_name = name of the library for ocamlfind and opam
|
||||
(library
|
||||
|
||||
(name common)
|
||||
(public_name qcaml.common)
|
||||
(synopsis "General utilities used in all QCaml libraries.")
|
||||
|
||||
(libraries
|
||||
str
|
||||
zarith
|
||||
getopt
|
||||
)
|
||||
|
||||
(c_names
|
||||
math_functions
|
||||
)
|
||||
(c_flags
|
||||
(:standard)
|
||||
(c_flags (:standard)
|
||||
-Ofast -march=native -fPIC
|
||||
)
|
||||
(synopsis "General utilities used in all QCaml libraries."))
|
||||
|
||||
)
|
||||
|
||||
@ -1,49 +1,81 @@
|
||||
(* Tests header *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Tests header][Tests header:1]] *)
|
||||
open Common.Bitstring
|
||||
|
||||
let check msg x = Alcotest.(check bool) msg true x
|
||||
|
||||
let test_one () =
|
||||
let test_all () =
|
||||
let x = 8745687 in
|
||||
let one_x = One x in
|
||||
let one_x = of_int x in
|
||||
let z = Z.shift_left (Z.of_int x) 64 in
|
||||
let many_x = of_z z in
|
||||
(* Tests header:1 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~of_int~][~of_int~:3]] *)
|
||||
Alcotest.(check bool) "of_x" true (one_x = (of_int x));
|
||||
Alcotest.(check bool) "shift_left1" true (One (x lsl 3) = shift_left one_x 3);
|
||||
Alcotest.(check bool) "shift_right1" true (One (x lsr 3) = shift_right one_x 3);
|
||||
Alcotest.(check bool) "shift_left_one1" true (One (1 lsl 3) = shift_left_one 4 3);
|
||||
Alcotest.(check bool) "testbit1" true (testbit (One 8) 3);
|
||||
Alcotest.(check bool) "testbit2" false (testbit (One 8) 2);
|
||||
Alcotest.(check bool) "testbit3" false (testbit (One 8) 4);
|
||||
Alcotest.(check bool) "logor1" true (One (1 lor 2) = logor (One 1) (One 2));
|
||||
Alcotest.(check bool) "logxor1" true (One (1 lxor 2) = logxor (One 1) (One 2));
|
||||
Alcotest.(check bool) "logand1" true (One (1 land 2) = logand (One 1) (One 2));
|
||||
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (One 45)))
|
||||
(* ~of_int~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~of_z~][~of_z~:3]] *)
|
||||
Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
|
||||
(* ~of_z~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left~][~shift_left~:3]] *)
|
||||
Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 3);
|
||||
Alcotest.(check bool) "shift_left2" true (of_z (Z.shift_left z 3) = shift_left many_x 3);
|
||||
Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
|
||||
(* ~shift_left~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_right~][~shift_right~:3]] *)
|
||||
Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 3);
|
||||
Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
|
||||
(* ~shift_right~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:3]] *)
|
||||
Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 3);
|
||||
Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
|
||||
(* ~shift_left_one~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~testbit~][~testbit~:3]] *)
|
||||
Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3);
|
||||
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
|
||||
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
|
||||
Alcotest.(check bool) "testbit4" true (testbit (of_z (Z.of_int 8)) 3);
|
||||
Alcotest.(check bool) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
|
||||
Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
|
||||
(* ~testbit~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logor~][~logor~:3]] *)
|
||||
Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2));
|
||||
Alcotest.(check bool) "logor2" true (of_z (Z.of_int (1 lor 2)) = logor (of_z Z.one) (of_z (Z.of_int 2)));
|
||||
(* ~logor~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logxor~][~logxor~:3]] *)
|
||||
Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2));
|
||||
Alcotest.(check bool) "logxor2" true (of_z (Z.of_int (1 lxor 2)) = logxor (of_z Z.one) (of_z (Z.of_int 2)));
|
||||
(* ~logxor~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logand~][~logand~:3]] *)
|
||||
Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 3));
|
||||
Alcotest.(check bool) "logand2" true (of_z (Z.of_int (1 land 3)) = logand (of_z Z.one) (of_z (Z.of_int 3)));
|
||||
(* ~logand~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~to_list~][~to_list~:3]] *)
|
||||
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
|
||||
(* ~to_list~:3 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~permtutations~][~permtutations~:3]] *)
|
||||
check "permutations"
|
||||
(permtutations 2 4 = List.map of_int
|
||||
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
|
||||
(* ~permtutations~:3 ends here *)
|
||||
|
||||
(* Tests *)
|
||||
|
||||
|
||||
let test_many () =
|
||||
let x = 8745687 in
|
||||
let z = Z.of_int x in
|
||||
let one_x = One x in
|
||||
let many_x = Many z in
|
||||
Alcotest.(check bool) "of_z" true (one_x = (of_z z));
|
||||
Alcotest.(check bool) "shift_left2" true (Many (Z.shift_left z 3) = shift_left many_x 3);
|
||||
Alcotest.(check bool) "shift_left3" true (Many (Z.shift_left z 100) = shift_left many_x 100);
|
||||
Alcotest.(check bool) "shift_right2" true (Many (Z.shift_right z 3) = shift_right many_x 3);
|
||||
Alcotest.(check bool) "shift_left_one2" true (Many (Z.shift_left Z.one 200) = shift_left_one 300 200);
|
||||
Alcotest.(check bool) "testbit4" true (testbit (Many (Z.of_int 8)) 3);
|
||||
Alcotest.(check bool) "testbit5" false (testbit (Many (Z.of_int 8)) 2);
|
||||
Alcotest.(check bool) "testbit6" false (testbit (Many (Z.of_int 8)) 4);
|
||||
Alcotest.(check bool) "logor2" true (Many (Z.of_int (1 lor 2)) = logor (Many Z.one) (Many (Z.of_int 2)));
|
||||
Alcotest.(check bool) "logxor2" true (Many (Z.of_int (1 lxor 2)) = logxor (Many Z.one) (Many (Z.of_int 2)));
|
||||
Alcotest.(check bool) "logand2" true (Many (Z.of_int (1 land 2)) = logand (Many Z.one) (Many (Z.of_int 2)))
|
||||
|
||||
|
||||
let test_permutations () =
|
||||
check "permutations"
|
||||
(permtutations 2 4 = List.map of_int
|
||||
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ])
|
||||
|
||||
(* [[file:../bitstring.org::*Tests][Tests:1]] *)
|
||||
()
|
||||
|
||||
let tests = [
|
||||
"One", `Quick, test_one;
|
||||
"Many", `Quick, test_many;
|
||||
"permutations", `Quick, test_permutations;
|
||||
"all", `Quick, test_all;
|
||||
]
|
||||
|
||||
(* Tests:1 ends here *)
|
||||
|
||||
@ -1,7 +1,11 @@
|
||||
(library
|
||||
|
||||
(name test_common)
|
||||
(synopsis "Test for common library")
|
||||
|
||||
(libraries
|
||||
alcotest
|
||||
qcaml.common
|
||||
)
|
||||
(synopsis "Tests for common library"))
|
||||
|
||||
)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user