LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-06-02 03:15:19 +02:00
Code Releases Activity

Put description after type

Browse Source
This commit is contained in:
Anthony Scemama 2020-12-27 17:38:04 +01:00
parent c6b48bed35
commit e7c9abd0d3
13 changed files with 579 additions and 489 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
common/angular_momentum.org
View File

@ -46,12 +46,15 @@ type kind =
open Powers open Powers
#+end_src #+end_src
** Conversions ** Conversions
*** ~of_char~ *** ~of_char~
#+begin_src ocaml :tangle (eval mli)
val of_char : char -> t
#+end_src
Returns an ~Angular_momentum.t~ when a shell is given as a character Returns an ~Angular_momentum.t~ when a shell is given as a character
(case insensitive): (case insensitive):
@ -59,10 +62,6 @@ open Powers
Angular_momentum.of_char 'p' -> Angular_momentum.P Angular_momentum.of_char 'p' -> Angular_momentum.P
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val of_char : char -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let of_char = function let of_char = function
| 's' | 'S' -> S | 'p' | 'P' -> P | 's' | 'S' -> S | 'p' | 'P' -> P
@ -77,16 +76,16 @@ let of_char = function
*** ~to_string~ *** ~to_string~
#+begin_src ocaml :tangle (eval mli)
val to_string : t -> string
#+end_src
Converts the angular momentum into a string: Converts the angular momentum into a string:
#+begin_example #+begin_example
Angular_momentum.(to_string D) -> "D" Angular_momentum.(to_string D) -> "D"
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val to_string : t -> string
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let to_string = function let to_string = function
| S -> "S" | P -> "P" | S -> "S" | P -> "P"
@ -100,16 +99,16 @@ let to_string = function
*** ~to_char~ *** ~to_char~
#+begin_src ocaml :tangle (eval mli)
val to_char : t -> char
#+end_src
Converts the angular momentum into a char: Converts the angular momentum into a char:
#+begin_example #+begin_example
Angular_momentum.(to_char D) -> 'D' Angular_momentum.(to_char D) -> 'D'
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val to_char : t -> char
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let to_char = function let to_char = function
| S -> 'S' | P -> 'P' | S -> 'S' | P -> 'P'
@ -123,16 +122,16 @@ let to_char = function
*** ~to_int~ *** ~to_int~
#+begin_src ocaml :tangle (eval mli)
val to_int : t -> int
#+end_src
Returns the $l_{max}$ value of the shell: Returns the $l_{max}$ value of the shell:
#+begin_example #+begin_example
Angular_momentum.(to_char D) -> 2 Angular_momentum.(to_char D) -> 2
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val to_int : t -> int
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let to_int = function let to_int = function
| S -> 0 | P -> 1 | S -> 0 | P -> 1
@ -146,16 +145,16 @@ let to_int = function
*** ~of_int~ *** ~of_int~
#+begin_src ocaml :tangle (eval mli)
val of_int : int -> t
#+end_src
Returns a shell given an $l$ value. Returns a shell given an $l$ value.
#+begin_example #+begin_example
Angular_momentum.of_int 3 -> Angular_momentum.F Angular_momentum.of_int 3 -> Angular_momentum.F
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val of_int : int -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let of_int = function let of_int = function
| 0 -> S | 1 -> P | 0 -> S | 1 -> P
@ -167,22 +166,21 @@ let of_int = function
| 12 -> O | i -> Int i | 12 -> O | i -> Int i
#+end_src #+end_src
** Shell functions ** Shell functions
*** ~n_functions~ *** ~n_functions~
#+begin_src ocaml :tangle (eval mli)
val n_functions : t -> int
#+end_src
Returns the number of cartesian functions in a shell. Returns the number of cartesian functions in a shell.
#+begin_example #+begin_example
Angular_momentum.n_functions D -> 6 Angular_momentum.n_functions D -> 6
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val n_functions : t -> int
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let n_functions a = let n_functions a =
let a = let a =
@ -194,6 +192,10 @@ let n_functions a =
*** ~zkey_array~ *** ~zkey_array~
#+begin_src ocaml :tangle (eval mli)
val zkey_array : kind -> Zkey.t array
#+end_src
Array of ~Zkey.t~, where each element is a a key associated with the Array of ~Zkey.t~, where each element is a a key associated with the
the powers of $x,y,z$. the powers of $x,y,z$.
@ -212,13 +214,8 @@ let n_functions a =
in in
Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b) Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
[| (x,s) ; (y,s) ; (z,s) |] [| (x,s) ; (y,s) ; (z,s) |]
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val zkey_array : kind -> Zkey.t array
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t = let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
Hashtbl.create 13 Hashtbl.create 13
@ -297,7 +294,6 @@ let zkey_array a =
result result
#+end_src #+end_src
** Arithmetic ** Arithmetic
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
@ -313,7 +309,6 @@ let ( - ) a b =
of_int ( (to_int a) - (to_int b) ) of_int ( (to_int a) - (to_int b) )
#+end_src #+end_src
** Printers ** Printers
Printers can print as a string (~pp_string~) or as an integer (~pp_int~). Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
@ -332,5 +327,4 @@ let pp_int ppf x =
#+end_src #+end_src
** TODO Tests ** TODO Tests

241
common/bitstring.org
View File

@ -112,84 +112,84 @@ type t =
open Common.Bitstring open Common.Bitstring
let check msg x = Alcotest.(check bool) msg true x let check msg x = Alcotest.(check bool) msg true x
let test_all () = let test_all () =
let x = 8745687 in let x = 8745687 in
let one_x = of_int x in let one_x = of_int x in
let z = Z.shift_left (Z.of_int x) 64 in let z = Z.shift_left (Z.of_int x) 64 in
let many_x = of_z z in let many_x = of_z z in
#+end_src #+end_src
** General implementation ** General implementation
*** ~of_int~ *** ~of_int~
Creates a bit string from an ~int~.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val of_int : int -> t val of_int : int -> t
#+end_src #+end_src
Creates a bit string from an ~int~.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let of_int x = let of_int x =
One (One.of_int x) One (One.of_int x)
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "of_x" true (one_x = (of_int x)); Alcotest.(check bool) "of_x" true (one_x = (of_int x));
#+end_src #+end_src
*** ~of_z~ *** ~of_z~
Creates a bit string from an ~Z.t~ multi-precision integer.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val of_z : Z.t -> t val of_z : Z.t -> t
#+end_src #+end_src
Creates a bit string from an ~Z.t~ multi-precision integer.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let of_z x = let of_z x =
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x) if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x))); Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
#+end_src #+end_src
*** ~zero~ *** ~zero~
~zero n~ creates a zero bit string with ~n~ bits.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val zero : int -> t val zero : int -> t
#+end_src #+end_src
~zero n~ creates a zero bit string with ~n~ bits.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let zero = function let zero = function
| n when n < 64 -> One (One.zero) | n when n < 64 -> One (One.zero)
| _ -> Many (Many.zero) | _ -> Many (Many.zero)
#+end_src #+end_src
*** ~numbits~ *** ~numbits~
Returns the number of bits used to represent the bit string.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val numbits : t -> int val numbits : t -> int
#+end_src #+end_src
Returns the number of bits used to represent the bit string.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let numbits = function let numbits = function
| One x -> One.numbits x | One x -> One.numbits x
| Many x -> Many.numbits x | Many x -> Many.numbits x
#+end_src #+end_src
*** ~is_zero~ *** ~is_zero~
True if all the bits of the bit string are zero.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val is_zero : t -> bool val is_zero : t -> bool
#+end_src #+end_src
True if all the bits of the bit string are zero.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let is_zero = function let is_zero = function
| One x -> One.is_zero x | One x -> One.is_zero x
@ -198,16 +198,16 @@ let is_zero = function
*** ~neg~ *** ~neg~
#+begin_src ocaml :tangle (eval mli)
val neg : t -> t
#+end_src
Returns the negative of the integer interpretation of the bit string. Returns the negative of the integer interpretation of the bit string.
#+begin_example #+begin_example
neg (of_int x) = neg (of_int (-x)) neg (of_int x) = neg (of_int (-x))
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val neg : t -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let neg = function let neg = function
| One x -> One (One.neg x) | One x -> One (One.neg x)
@ -216,100 +216,100 @@ let neg = function
*** ~shift_left~ *** ~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 (eval mli) #+begin_src ocaml :tangle (eval mli)
val shift_left : t -> int -> t val shift_left : t -> int -> t
#+end_src #+end_src
~shift_left t n~ returns a new bit strings with all the bits
shifted ~n~ positions to the left.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let shift_left x i = match x with let shift_left x i = match x with
| One x -> One (One.shift_left x i) | One x -> One (One.shift_left x i)
| Many x -> Many (Many.shift_left x i) | Many x -> Many (Many.shift_left x i)
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 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_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); Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
#+end_src #+end_src
*** ~shift_right~ *** ~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 (eval mli) #+begin_src ocaml :tangle (eval mli)
val shift_right : t -> int -> t val shift_right : t -> int -> t
#+end_src #+end_src
~shift_right t n~ returns a new bit strings with all the bits
shifted ~n~ positions to the right.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let shift_right x i = match x with let shift_right x i = match x with
| One x -> One (One.shift_right x i) | One x -> One (One.shift_right x i)
| Many x -> Many (Many.shift_right x i) | Many x -> Many (Many.shift_right x i)
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 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); Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
#+end_src #+end_src
*** ~shift_left_one~ *** ~shift_left_one~
#+begin_src ocaml :tangle (eval mli)
val shift_left_one : int -> int -> t
#+end_src
~shift_left_one size n~ returns a new bit strings with the ~n~-th ~shift_left_one size n~ returns a new bit strings with the ~n~-th
bit set to one. bit set to one.
It is equivalent as shifting ~1~ by ~n~ bits to the left. It is equivalent as shifting ~1~ by ~n~ bits to the left.
~size~ is the total number of bits of the bit string. ~size~ is the total number of bits of the bit string.
#+begin_src ocaml :tangle (eval mli)
val shift_left_one : int -> int -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let shift_left_one = function let shift_left_one = function
| n when n < 64 -> fun i -> One (One.shift_left_one i) | n when n < 64 -> fun i -> One (One.shift_left_one i)
| _ -> fun i -> Many (Many.shift_left_one i) | _ -> fun i -> Many (Many.shift_left_one i)
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 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); Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
#+end_src #+end_src
*** ~testbit~ *** ~testbit~
~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
set to ~1~.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val testbit : t -> int -> bool val testbit : t -> int -> bool
#+end_src #+end_src
~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
set to ~1~.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let testbit = function let testbit = function
| One x -> One.testbit x | One x -> One.testbit x
| Many x -> Many.testbit x | Many x -> Many.testbit x
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3); Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3);
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2); Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4); 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) "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) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4); Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
#+end_src #+end_src
*** ~logor~ *** ~logor~
Bitwise logical or.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val logor : t -> t -> t val logor : t -> t -> t
#+end_src #+end_src
Bitwise logical or.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let logor a b = let logor a b =
match a,b with match a,b with
@ -319,40 +319,39 @@ let logor a b =
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2)); 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))); 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 #+end_src
*** ~logxor~ *** ~logxor~
Bitwise logical exclusive or.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val logxor : t -> t -> t val logxor : t -> t -> t
#+end_src #+end_src
Bitwise logical exclusive or.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let logxor a b = let logxor a b =
match a,b with match a,b with
| One a, One b -> One (One.logxor a b) | One a, One b -> One (One.logxor a b)
| Many a, Many b -> Many (Many.logxor a b) | Many a, Many b -> Many (Many.logxor a b)
| _ -> invalid_arg "Bitstring.logxor" | _ -> invalid_arg "Bitstring.logxor"
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2)); 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))); 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 #+end_src
*** ~logand~ *** ~logand~
Bitwise logical and.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val logand : t -> t -> t val logand : t -> t -> t
#+end_src #+end_src
Bitwise logical and.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let logand a b = let logand a b =
match a,b with match a,b with
@ -363,106 +362,110 @@ let logand a b =
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 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))); 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 #+end_src
*** ~lognot~ *** ~lognot~
Bitwise logical negation.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val lognot : t -> t val lognot : t -> t
#+end_src #+end_src
Bitwise logical negation.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let lognot = function let lognot = function
| One x -> One (One.lognot x) | One x -> One (One.lognot x)
| Many x -> Many (Many.lognot x) | Many x -> Many (Many.lognot x)
#+end_src #+end_src
*** ~minus_one~ *** ~minus_one~
#+begin_src ocaml :tangle (eval mli)
val minus_one : t -> t
#+end_src
Takes the integer representation of the bit string and removes one. Takes the integer representation of the bit string and removes one.
#+begin_example #+begin_example
minus_one (of_int 10) = of_int 9 minus_one (of_int 10) = of_int 9
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val minus_one : t -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let minus_one = function let minus_one = function
| One x -> One (One.minus_one x) | One x -> One (One.minus_one x)
| Many x -> Many (Many.minus_one x) | Many x -> Many (Many.minus_one x)
#+end_src #+end_src
*** ~plus_one~ *** ~plus_one~
#+begin_src ocaml :tangle (eval mli)
val plus_one : t -> t
#+end_src
Takes the integer representation of the bit string and adds one. Takes the integer representation of the bit string and adds one.
#+begin_example #+begin_example
plus_one (of_int 10) = of_int 11 plus_one (of_int 10) = of_int 11
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val plus_one : t -> t
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let plus_one = function let plus_one = function
| One x -> One (One.plus_one x) | One x -> One (One.plus_one x)
| Many x -> Many (Many.plus_one x) | Many x -> Many (Many.plus_one x)
#+end_src #+end_src
*** ~trailing_zeros~ *** ~trailing_zeros~
Returns the number of trailing zeros in the bit string.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val trailing_zeros : t -> int val trailing_zeros : t -> int
#+end_src #+end_src
Returns the number of trailing zeros in the bit string.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let trailing_zeros = function let trailing_zeros = function
| One x -> One.trailing_zeros x | One x -> One.trailing_zeros x
| Many x -> Many.trailing_zeros x | Many x -> Many.trailing_zeros x
#+end_src #+end_src
*** ~hamdist~ *** ~hamdist~
Returns the Hamming distance, i.e. the number of bits differing
between two bit strings.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val hamdist : t -> t -> int val hamdist : t -> t -> int
#+end_src #+end_src
Returns the Hamming distance, i.e. the number of bits differing
between two bit strings.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let hamdist a b = match a, b with let hamdist a b = match a, b with
| One a, One b -> One.hamdist a b | One a, One b -> One.hamdist a b
| Many a, Many b -> Many.hamdist a b | Many a, Many b -> Many.hamdist a b
| _ -> invalid_arg "Bitstring.hamdist" | _ -> invalid_arg "Bitstring.hamdist"
#+end_src #+end_src
*** ~popcount~ *** ~popcount~
Returns the number of bits set to one in the bit string.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val popcount : t -> int val popcount : t -> int
#+end_src #+end_src
Returns the number of bits set to one in the bit string.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let popcount = function let popcount = function
| One x -> One.popcount x | One x -> One.popcount x
| Many x -> Many.popcount x | Many x -> Many.popcount x
#+end_src #+end_src
*** ~to_list~ *** ~to_list~
#+begin_src ocaml :tangle (eval mli)
val to_list : ?accu:(int list) -> t -> int list
#+end_src
Converts a bit string into a list of integers indicating the Converts a bit string into a list of integers indicating the
positions where the bits are set to ~1~. The first value for the positions where the bits are set to ~1~. The first value for the
position is not ~0~ but ~1~. position is not ~0~ but ~1~.
@ -472,26 +475,26 @@ Bitstring.to_list (of_int 5);;
- : int list = [1; 3] - : int list = [1; 3]
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val to_list : ?accu:(int list) -> t -> int list
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let rec to_list ?(accu=[]) = function let rec to_list ?(accu=[]) = function
| t when (is_zero t) -> List.rev accu | t when (is_zero t) -> List.rev accu
| t -> let newlist = | t -> let newlist =
(trailing_zeros t + 1)::accu (trailing_zeros t + 1)::accu
in in
logand t @@ minus_one t logand t @@ minus_one t
|> (to_list [@tailcall]) ~accu:newlist |> (to_list [@tailcall]) ~accu:newlist
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45))); Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
#+end_src #+end_src
*** ~permutations~ *** ~permutations~
#+begin_src ocaml :tangle (eval mli)
val permutations : int -> int -> t list
#+end_src
~permutations m n~ generates the list of all possible ~n~-bit ~permutations m n~ generates the list of all possible ~n~-bit
strings with ~m~ bits set to ~1~. strings with ~m~ bits set to ~1~.
Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]]. Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]].
@ -508,10 +511,6 @@ Bitstring.permutations 2 4
"--++------------------------------------------------------------"] "--++------------------------------------------------------------"]
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val permutations : int -> int -> t list
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let permutations m n = let permutations m n =
@ -546,16 +545,16 @@ val pp : Format.formatter -> t -> unit
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let pp ppf = function let pp ppf = function
| One x -> One.pp ppf x | One x -> One.pp ppf x
| Many x -> Many.pp ppf x | Many x -> Many.pp ppf x
#+end_src #+end_src
** Tests :noexport: ** Tests :noexport:
#+begin_src ocaml :tangle (eval test-ml) :exports none #+begin_src ocaml :tangle (eval test-ml) :exports none
() ()
let tests = [ let tests = [
"all", `Quick, test_all; "all", `Quick, test_all;
] ]
#+end_src #+end_src

4
common/charge.org
View File

@ -17,12 +17,12 @@
** Type ** Type
This type should be used for all charges in the program (electrons, nuclei,...).
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
type t type t
#+end_src #+end_src
This type should be used for all charges in the program (electrons, nuclei,...).
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
type t = float type t = float
#+end_src #+end_src

76
common/command_line.org
View File

@ -19,7 +19,7 @@
Here is an example of how to use this module. Here is an example of how to use this module.
First, define the specification: First, define the specification:
#+begin_src ocaml :tangle no #+begin_src ocaml :tangle no
let open Command_line in let open Command_line in
begin begin
set_header_doc (Sys.argv.(0) ^ " - One-line description"); set_header_doc (Sys.argv.(0) ^ " - One-line description");
@ -30,18 +30,18 @@ begin
arg=Without_arg; }; arg=Without_arg; };
{ short='b' ; long="basis" ; opt=Mandatory; { short='b' ; long="basis" ; opt=Mandatory;
arg=With_arg "<string>"; arg=With_arg "<string>";
doc="Name of the file containing the basis set"; } ; doc="Name of the file containing the basis set"; } ;
{ short='m' ; long="multiplicity" ; opt=Optional; { short='m' ; long="multiplicity" ; opt=Optional;
arg=With_arg "<int>"; arg=With_arg "<int>";
doc="Spin multiplicity (2S+1). Default is singlet"; } ; doc="Spin multiplicity (2S+1). Default is singlet"; } ;
] ]
end; end;
#+end_src #+end_src
Then, define what to do with the arguments: Then, define what to do with the arguments:
#+begin_src ocaml :tangle no #+begin_src ocaml :tangle no
let c = let c =
Command_line.get_bool "check" Command_line.get_bool "check"
in in
@ -57,20 +57,10 @@ let multiplicity =
| None -> 1 | None -> 1
| Some n -> int_of_string n | Some n -> int_of_string n
in in
#+end_src #+end_src
** Type ** Type
- Short option: in the command line, a dash with a single character
(ex: =ls -l=)
- Long option: in the command line, two dashes with a word
(ex: =ls --directory=)
- Command-line options can be ~Mandatory~ or ~Optional~
- Documentation of the option is used in the help function
- Some options require an argument (~ls --ignore="*.ml"~ ), some
don't (~ls -l~) and for some arguments the argument is optional
(~git --log[=<n>]~)
#+NAME:type #+NAME:type
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
type short_opt = char type short_opt = char
@ -89,6 +79,16 @@ type description = {
#+end_src #+end_src
- Short option: in the command line, a dash with a single character
(ex: =ls -l=)
- Long option: in the command line, two dashes with a word
(ex: =ls --directory=)
- Command-line options can be ~Mandatory~ or ~Optional~
- Documentation of the option is used in the help function
- Some options require an argument (~ls --ignore="*.ml"~ ), some
don't (~ls -l~) and for some arguments the argument is optional
(~git --log[=<n>]~)
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
<<type>> <<type>>
#+end_src #+end_src
@ -107,27 +107,28 @@ let specs = ref []
let dict = Hashtbl.create 67 let dict = Hashtbl.create 67
#+end_src #+end_src
Functions to set the header, footer and main description of the
documentation provided by the ~help~ function:
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val set_header_doc : string -> unit val set_header_doc : string -> unit
val set_description_doc : string -> unit val set_description_doc : string -> unit
val set_footer_doc : string -> unit val set_footer_doc : string -> unit
#+end_src #+end_src
Functions to set the header, footer and main description of the
documentation provided by the ~help~ function:
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let set_header_doc s = header_doc := s let set_header_doc s = header_doc := s
let set_description_doc s = description_doc := s let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s let set_footer_doc s = footer_doc := s
#+end_src #+end_src
Function to create an anonymous argument:
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val anonymous : long_opt -> optional -> documentation -> description val anonymous : long_opt -> optional -> documentation -> description
#+end_src #+end_src
Function to create an anonymous argument.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let anonymous name opt doc = let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; } { short=' ' ; long=name; opt; doc; arg=Without_arg; }
@ -136,6 +137,7 @@ let anonymous name opt doc =
** Text formatting functions :noexport: ** Text formatting functions :noexport:
Function to print some text such that it fits on the screen Function to print some text such that it fits on the screen
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let output_text t = let output_text t =
Format.printf "@[<v 0>"; Format.printf "@[<v 0>";
@ -160,6 +162,7 @@ let output_text t =
Function to build the short description of the command-line Function to build the short description of the command-line
arguments, such as arguments, such as
#+begin_example #+begin_example
my_program -b <string> [-h] [-u <float>] -x <string> [--] my_program -b <string> [-h] [-u <float>] -x <string> [--]
#+end_example #+end_example
@ -180,6 +183,7 @@ let output_short x =
Function to build the long description of the command-line Function to build the long description of the command-line
arguments, such as arguments, such as
#+begin_example #+begin_example
-x --xyz=<string> Name of the file containing the nuclear -x --xyz=<string> Name of the file containing the nuclear
coordinates in xyz format coordinates in xyz format
@ -195,8 +199,8 @@ let output_long max_width x =
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg | _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
in in
let long = let long =
let l = String.length arg in let l = String.length arg in
arg^(String.make (max_width-l) ' ') arg^(String.make (max_width-l) ' ')
in in
Format.printf "@[<v 0>"; Format.printf "@[<v 0>";
begin begin
@ -212,17 +216,17 @@ let output_long max_width x =
*** ~anon_args~ *** ~anon_args~
Returns the list of anonymous arguments
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val anon_args : unit -> string list val anon_args : unit -> string list
#+end_src #+end_src
Returns the list of anonymous arguments
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let anon_args () = !anon_args_ref let anon_args () = !anon_args_ref
#+end_src #+end_src
*** ~help~ *** ~help~ :noexport:
Prints the documentation of the program. Prints the documentation of the program.
@ -296,12 +300,12 @@ let help () =
*** ~get~ *** ~get~
Returns the argument associated with a long option.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val get : long_opt -> string option val get : long_opt -> string option
#+end_src #+end_src
Returns the argument associated with a long option.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let get x = let get x =
try Some (Hashtbl.find dict x) try Some (Hashtbl.find dict x)
@ -310,26 +314,26 @@ let get x =
*** ~get_bool~ *** ~get_bool~
True if the ~Optional~ argument is present in the command-line
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val get_bool : long_opt -> bool val get_bool : long_opt -> bool
#+end_src #+end_src
True if the ~Optional~ argument is present in the command-line
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let get_bool x = Hashtbl.mem dict x let get_bool x = Hashtbl.mem dict x
#+end_src #+end_src
** Specification ** Specification
Gives the specifications of the current program as a list of #+begin_src ocaml :tangle (eval mli)
val set_specs : description list -> unit
#+end_src
Sets the specifications of the current program from a list of
~descrption~ variables. ~descrption~ variables.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval ml) :exports none
val set_specs : description list -> unit
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none
let set_specs specs_in = let set_specs specs_in =
specs := { short = 'h' ; specs := { short = 'h' ;
long = "help" ; long = "help" ;

20
common/constants.org
View File

@ -1,4 +1,4 @@
#+begin_src elisp tangle: no :results none #+begin_src elisp tangle: no :results none :exports none
(setq pwd (file-name-directory buffer-file-name)) (setq pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -16,37 +16,29 @@
All constants used in the program. All constants used in the program.
#+begin_src ocaml :tangle (eval mli)
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none
#+end_src
** Thresholds ** Thresholds
*** ~epsilon~ *** ~epsilon~
Value below which a float is considered null. Default is
\epsilon = 2.10^{-15}.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val epsilon : float val epsilon : float
#+end_src #+end_src
Value below which a float is considered null. Default is
\epsilon = 2.10^{-15}.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let epsilon = 2.e-15 let epsilon = 2.e-15
#+end_src #+end_src
*** ~integrals_cutoff~ *** ~integrals_cutoff~
Cutoff value for integrals. Default is \epsilon .
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val integrals_cutoff : float val integrals_cutoff : float
#+end_src #+end_src
Cutoff value for integrals. Default is \epsilon .
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let integrals_cutoff = epsilon let integrals_cutoff = epsilon
#+end_src #+end_src

34
common/coordinate.org
View File

@ -1,4 +1,4 @@
#+begin_src elisp tangle: no :results none #+begin_src elisp tangle: no :results none :exports none
(setq pwd (file-name-directory buffer-file-name)) (setq pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -48,36 +48,36 @@ type axis = X | Y | Z
*** ~make~ *** ~make~
Creates a point in atomic units.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val make : 'a point -> t val make : 'a point -> t
#+end_src #+end_src
Creates a point in atomic units.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
external make : 'a point -> t = "%identity" external make : 'a point -> t = "%identity"
#+end_src #+end_src
*** ~make_angstrom~ *** ~make_angstrom~
Creates a point in angstrom.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val make_angstrom : 'a point -> angstrom point val make_angstrom : 'a point -> angstrom point
#+end_src #+end_src
Creates a point in angstrom.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
external make_angstrom : 'a point -> angstrom point = "%identity" external make_angstrom : 'a point -> angstrom point = "%identity"
#+end_src #+end_src
*** ~bohr_to_angstrom~ *** ~bohr_to_angstrom~
Converts a point in bohr to angstrom.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val bohr_to_angstrom : bohr point -> angstrom point val bohr_to_angstrom : bohr point -> angstrom point
#+end_src #+end_src
Converts a point in bohr to angstrom.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let b_to_a b = Constants.a0 *. b let b_to_a b = Constants.a0 *. b
@ -89,12 +89,12 @@ let bohr_to_angstrom { x ; y ; z } =
*** ~angstrom_to_bohr~ *** ~angstrom_to_bohr~
Converts a point in angstrom to bohr.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val angstrom_to_bohr : angstrom point -> bohr point val angstrom_to_bohr : angstrom point -> bohr point
#+end_src #+end_src
Converts a point in angstrom to bohr.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let a_to_b a = Constants.a0_inv *. a let a_to_b a = Constants.a0_inv *. a
@ -106,12 +106,12 @@ let angstrom_to_bohr { x ; y ; z } =
*** ~zero~ *** ~zero~
~zero~ = (0., 0., 0.)
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val zero : bohr point val zero : bohr point
#+end_src #+end_src
~zero~ = (0., 0., 0.)
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let zero = let zero =
make { x = 0. ; y = 0. ; z = 0. } make { x = 0. ; y = 0. ; z = 0. }
@ -119,6 +119,10 @@ let zero =
*** ~get~ *** ~get~
#+begin_src ocaml :tangle (eval mli)
val get : axis -> bohr point -> float
#+end_src
Extracts the projection of the coordinate on an axis. Extracts the projection of the coordinate on an axis.
#+begin_example #+begin_example
@ -126,10 +130,6 @@ Coordinate.(get Y { x=1. ; y=2. ; z=3. }) ;;
- : float = 2. - : float = 2.
#+end_example #+end_example
#+begin_src ocaml :tangle (eval mli)
val get : axis -> bohr point -> float
#+end_src
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
let get axis { x ; y ; z } = let get axis { x ; y ; z } =
match axis with match axis with
@ -250,14 +250,14 @@ let norm u =
** Printers ** Printers
Coordinates can be printed in bohr or angstrom.
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
val pp_bohr: Format.formatter -> t -> unit val pp_bohr: Format.formatter -> t -> unit
val pp_angstrom : Format.formatter -> t -> unit val pp_angstrom : Format.formatter -> t -> unit
#+end_src #+end_src
Coordinates can be printed in bohr or angstrom.
#+begin_src ocaml :tangle (eval ml) :exports none #+begin_src ocaml :tangle (eval ml) :exports none
open Format open Format
let pp ppf c = let pp ppf c =

78
common/lib/angular_momentum.ml
View File

@ -23,6 +23,16 @@ type kind =
open Powers open Powers
(* Type:2 ends here *) (* Type:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~of_char~][~of_char~:2]] *)
let of_char = function let of_char = function
| 's' | 'S' -> S | 'p' | 'P' -> P | 's' | 'S' -> S | 'p' | 'P' -> P
@ -35,6 +45,15 @@ let of_char = function
| c -> raise (Angular_momentum_error (String.make 1 c)) | c -> raise (Angular_momentum_error (String.make 1 c))
(* ~of_char~:2 ends here *) (* ~of_char~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~to_string~][~to_string~:2]] *)
let to_string = function let to_string = function
| S -> "S" | P -> "P" | S -> "S" | P -> "P"
@ -46,6 +65,15 @@ let to_string = function
| O -> "O" | Int i -> string_of_int i | O -> "O" | Int i -> string_of_int i
(* ~to_string~:2 ends here *) (* ~to_string~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~to_char~][~to_char~:2]] *)
let to_char = function let to_char = function
| S -> 'S' | P -> 'P' | S -> 'S' | P -> 'P'
@ -57,6 +85,15 @@ let to_char = function
| O -> 'O' | Int _ -> '_' | O -> 'O' | Int _ -> '_'
(* ~to_char~:2 ends here *) (* ~to_char~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~to_int~][~to_int~:2]] *)
let to_int = function let to_int = function
| S -> 0 | P -> 1 | S -> 0 | P -> 1
@ -68,6 +105,15 @@ let to_int = function
| O -> 12 | Int i -> i | O -> 12 | Int i -> i
(* ~to_int~:2 ends here *) (* ~to_int~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~of_int~][~of_int~:2]] *)
let of_int = function let of_int = function
| 0 -> S | 1 -> P | 0 -> S | 1 -> P
@ -79,6 +125,15 @@ let of_int = function
| 12 -> O | i -> Int i | 12 -> O | i -> Int i
(* ~of_int~:2 ends here *) (* ~of_int~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:2]] *)
let n_functions a = let n_functions a =
let a = let a =
@ -87,6 +142,29 @@ let n_functions a =
(a*a + 3*a + 2)/2 (a*a + 3*a + 2)/2
(* ~n_functions~:2 ends here *) (* ~n_functions~:2 ends here *)
(* 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~:2]] *) (* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:2]] *)
let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t = let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
Hashtbl.create 13 Hashtbl.create 13

72
common/lib/angular_momentum.mli
View File

@ -16,107 +16,49 @@ type kind =
| Quartet of (t * t * t * t) | Quartet of (t * t * t * t)
(* types ends here *) (* types ends here *)
(* ~of_char~ (* ~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]] *) (* [[file:../angular_momentum.org::*~of_char~][~of_char~:1]] *)
val of_char : char -> t val of_char : char -> t
(* ~of_char~:1 ends here *) (* ~of_char~:1 ends here *)
(* ~to_string~ (* ~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]] *) (* [[file:../angular_momentum.org::*~to_string~][~to_string~:1]] *)
val to_string : t -> string val to_string : t -> string
(* ~to_string~:1 ends here *) (* ~to_string~:1 ends here *)
(* ~to_char~ (* ~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]] *) (* [[file:../angular_momentum.org::*~to_char~][~to_char~:1]] *)
val to_char : t -> char val to_char : t -> char
(* ~to_char~:1 ends here *) (* ~to_char~:1 ends here *)
(* ~to_int~ (* ~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]] *) (* [[file:../angular_momentum.org::*~to_int~][~to_int~:1]] *)
val to_int : t -> int val to_int : t -> int
(* ~to_int~:1 ends here *) (* ~to_int~:1 ends here *)
(* ~of_int~ (* ~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]] *) (* [[file:../angular_momentum.org::*~of_int~][~of_int~:1]] *)
val of_int : int -> t val of_int : int -> t
(* ~of_int~:1 ends here *) (* ~of_int~:1 ends here *)
(* ~n_functions~ (* ~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]] *) (* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:1]] *)
val n_functions : t -> int val n_functions : t -> int
(* ~n_functions~:1 ends here *) (* ~n_functions~:1 ends here *)
(* ~zkey_array~ (* ~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]] *) (* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:1]] *)

204
common/lib/bitstring.ml
View File

@ -79,64 +79,129 @@ type t =
| Many of Z.t | Many of Z.t
(* Type:2 ends here *) (* Type:2 ends here *)
(* Creates a bit string from an ~int~. *)
(* [[file:../bitstring.org::*~of_int~][~of_int~:2]] *) (* [[file:../bitstring.org::*~of_int~][~of_int~:2]] *)
let of_int x = let of_int x =
One (One.of_int x) One (One.of_int x)
(* ~of_int~:2 ends here *) (* ~of_int~:2 ends here *)
(* Creates a bit string from an ~Z.t~ multi-precision integer. *)
(* [[file:../bitstring.org::*~of_z~][~of_z~:2]] *) (* [[file:../bitstring.org::*~of_z~][~of_z~:2]] *)
let of_z x = let of_z x =
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.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 *) (* ~of_z~:2 ends here *)
(* ~zero n~ creates a zero bit string with ~n~ bits. *)
(* [[file:../bitstring.org::*~zero~][~zero~:2]] *) (* [[file:../bitstring.org::*~zero~][~zero~:2]] *)
let zero = function let zero = function
| n when n < 64 -> One (One.zero) | n when n < 64 -> One (One.zero)
| _ -> Many (Many.zero) | _ -> Many (Many.zero)
(* ~zero~:2 ends here *) (* ~zero~:2 ends here *)
(* Returns the number of bits used to represent the bit string. *)
(* [[file:../bitstring.org::*~numbits~][~numbits~:2]] *) (* [[file:../bitstring.org::*~numbits~][~numbits~:2]] *)
let numbits = function let numbits = function
| One x -> One.numbits x | One x -> One.numbits x
| Many x -> Many.numbits x | Many x -> Many.numbits x
(* ~numbits~:2 ends here *) (* ~numbits~:2 ends here *)
(* True if all the bits of the bit string are zero. *)
(* [[file:../bitstring.org::*~is_zero~][~is_zero~:2]] *) (* [[file:../bitstring.org::*~is_zero~][~is_zero~:2]] *)
let is_zero = function let is_zero = function
| One x -> One.is_zero x | One x -> One.is_zero x
| Many x -> Many.is_zero x | Many x -> Many.is_zero x
(* ~is_zero~:2 ends here *) (* ~is_zero~:2 ends here *)
(* 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~:2]] *) (* [[file:../bitstring.org::*~neg~][~neg~:2]] *)
let neg = function let neg = function
| One x -> One (One.neg x) | One x -> One (One.neg x)
| Many x -> Many (Many.neg x) | Many x -> Many (Many.neg x)
(* ~neg~:2 ends here *) (* ~neg~:2 ends here *)
(* ~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~:2]] *) (* [[file:../bitstring.org::*~shift_left~][~shift_left~:2]] *)
let shift_left x i = match x with let shift_left x i = match x with
| One x -> One (One.shift_left x i) | One x -> One (One.shift_left x i)
| Many x -> Many (Many.shift_left x i) | Many x -> Many (Many.shift_left x i)
(* ~shift_left~:2 ends here *) (* ~shift_left~:2 ends here *)
(* ~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~:2]] *) (* [[file:../bitstring.org::*~shift_right~][~shift_right~:2]] *)
let shift_right x i = match x with let shift_right x i = match x with
| One x -> One (One.shift_right x i) | One x -> One (One.shift_right x i)
| Many x -> Many (Many.shift_right x i) | Many x -> Many (Many.shift_right x i)
(* ~shift_right~:2 ends here *) (* ~shift_right~:2 ends here *)
(* ~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~:2]] *) (* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:2]] *)
let shift_left_one = function let shift_left_one = function
| n when n < 64 -> fun i -> One (One.shift_left_one i) | n when n < 64 -> fun i -> One (One.shift_left_one i)
| _ -> fun i -> Many (Many.shift_left_one i) | _ -> fun i -> Many (Many.shift_left_one i)
(* ~shift_left_one~:2 ends here *) (* ~shift_left_one~:2 ends here *)
(* ~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
* set to ~1~. *)
(* [[file:../bitstring.org::*~testbit~][~testbit~:2]] *) (* [[file:../bitstring.org::*~testbit~][~testbit~:2]] *)
let testbit = function let testbit = function
| One x -> One.testbit x | One x -> One.testbit x
| Many x -> Many.testbit x | Many x -> Many.testbit x
(* ~testbit~:2 ends here *) (* ~testbit~:2 ends here *)
(* Bitwise logical or. *)
(* [[file:../bitstring.org::*~logor~][~logor~:2]] *) (* [[file:../bitstring.org::*~logor~][~logor~:2]] *)
let logor a b = let logor a b =
match a,b with match a,b with
@ -145,6 +210,11 @@ let logor a b =
| _ -> invalid_arg "Bitstring.logor" | _ -> invalid_arg "Bitstring.logor"
(* ~logor~:2 ends here *) (* ~logor~:2 ends here *)
(* Bitwise logical exclusive or. *)
(* [[file:../bitstring.org::*~logxor~][~logxor~:2]] *) (* [[file:../bitstring.org::*~logxor~][~logxor~:2]] *)
let logxor a b = let logxor a b =
match a,b with match a,b with
@ -153,6 +223,11 @@ let logxor a b =
| _ -> invalid_arg "Bitstring.logxor" | _ -> invalid_arg "Bitstring.logxor"
(* ~logxor~:2 ends here *) (* ~logxor~:2 ends here *)
(* Bitwise logical and. *)
(* [[file:../bitstring.org::*~logand~][~logand~:2]] *) (* [[file:../bitstring.org::*~logand~][~logand~:2]] *)
let logand a b = let logand a b =
match a,b with match a,b with
@ -161,53 +236,122 @@ let logand a b =
| _ -> invalid_arg "Bitstring.logand" | _ -> invalid_arg "Bitstring.logand"
(* ~logand~:2 ends here *) (* ~logand~:2 ends here *)
(* Bitwise logical negation. *)
(* [[file:../bitstring.org::*~lognot~][~lognot~:2]] *) (* [[file:../bitstring.org::*~lognot~][~lognot~:2]] *)
let lognot = function let lognot = function
| One x -> One (One.lognot x) | One x -> One (One.lognot x)
| Many x -> Many (Many.lognot x) | Many x -> Many (Many.lognot x)
(* ~lognot~:2 ends here *) (* ~lognot~:2 ends here *)
(* 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~:2]] *) (* [[file:../bitstring.org::*~minus_one~][~minus_one~:2]] *)
let minus_one = function let minus_one = function
| One x -> One (One.minus_one x) | One x -> One (One.minus_one x)
| Many x -> Many (Many.minus_one x) | Many x -> Many (Many.minus_one x)
(* ~minus_one~:2 ends here *) (* ~minus_one~:2 ends here *)
(* 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~:2]] *) (* [[file:../bitstring.org::*~plus_one~][~plus_one~:2]] *)
let plus_one = function let plus_one = function
| One x -> One (One.plus_one x) | One x -> One (One.plus_one x)
| Many x -> Many (Many.plus_one x) | Many x -> Many (Many.plus_one x)
(* ~plus_one~:2 ends here *) (* ~plus_one~:2 ends here *)
(* Returns the number of trailing zeros in the bit string. *)
(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:2]] *) (* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:2]] *)
let trailing_zeros = function let trailing_zeros = function
| One x -> One.trailing_zeros x | One x -> One.trailing_zeros x
| Many x -> Many.trailing_zeros x | Many x -> Many.trailing_zeros x
(* ~trailing_zeros~:2 ends here *) (* ~trailing_zeros~:2 ends here *)
(* Returns the Hamming distance, i.e. the number of bits differing
* between two bit strings. *)
(* [[file:../bitstring.org::*~hamdist~][~hamdist~:2]] *) (* [[file:../bitstring.org::*~hamdist~][~hamdist~:2]] *)
let hamdist a b = match a, b with let hamdist a b = match a, b with
| One a, One b -> One.hamdist a b | One a, One b -> One.hamdist a b
| Many a, Many b -> Many.hamdist a b | Many a, Many b -> Many.hamdist a b
| _ -> invalid_arg "Bitstring.hamdist" | _ -> invalid_arg "Bitstring.hamdist"
(* ~hamdist~:2 ends here *) (* ~hamdist~:2 ends here *)
(* Returns the number of bits set to one in the bit string. *)
(* [[file:../bitstring.org::*~popcount~][~popcount~:2]] *) (* [[file:../bitstring.org::*~popcount~][~popcount~:2]] *)
let popcount = function let popcount = function
| One x -> One.popcount x | One x -> One.popcount x
| Many x -> Many.popcount x | Many x -> Many.popcount x
(* ~popcount~:2 ends here *) (* ~popcount~:2 ends here *)
(* 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~:2]] *) (* [[file:../bitstring.org::*~to_list~][~to_list~:2]] *)
let rec to_list ?(accu=[]) = function let rec to_list ?(accu=[]) = function
| t when (is_zero t) -> List.rev accu | t when (is_zero t) -> List.rev accu
| t -> let newlist = | t -> let newlist =
(trailing_zeros t + 1)::accu (trailing_zeros t + 1)::accu
in in
logand t @@ minus_one t logand t @@ minus_one t
|> (to_list [@tailcall]) ~accu:newlist |> (to_list [@tailcall]) ~accu:newlist
(* ~to_list~:2 ends here *) (* ~to_list~:2 ends here *)
(* ~permutations 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.permutations 2 4
* |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
* - : string list =
* ["++--------------------------------------------------------------";
* "+-+-------------------------------------------------------------";
* "-++-------------------------------------------------------------";
* "+--+------------------------------------------------------------";
* "-+-+------------------------------------------------------------";
* "--++------------------------------------------------------------"]
* #+end_example *)
(* [[file:../bitstring.org::*~permutations~][~permutations~:2]] *) (* [[file:../bitstring.org::*~permutations~][~permutations~:2]] *)
let permutations m n = let permutations m n =
@ -230,6 +374,6 @@ let permutations m n =
(* [[file:../bitstring.org::*Printers][Printers:2]] *) (* [[file:../bitstring.org::*Printers][Printers:2]] *)
let pp ppf = function let pp ppf = function
| One x -> One.pp ppf x | One x -> One.pp ppf x
| Many x -> Many.pp ppf x | Many x -> Many.pp ppf x
(* Printers:2 ends here *) (* Printers:2 ends here *)

125
common/lib/bitstring.mli
View File

@ -5,229 +5,148 @@
type t type t
(* Type:1 ends here *) (* Type:1 ends here *)
(* ~of_int~ (* ~of_int~ *)
*
* Creates a bit string from an ~int~. *)
(* [[file:../bitstring.org::*~of_int~][~of_int~:1]] *) (* [[file:../bitstring.org::*~of_int~][~of_int~:1]] *)
val of_int : int -> t val of_int : int -> t
(* ~of_int~:1 ends here *) (* ~of_int~:1 ends here *)
(* ~of_z~ (* ~of_z~ *)
*
* Creates a bit string from an ~Z.t~ multi-precision integer. *)
(* [[file:../bitstring.org::*~of_z~][~of_z~:1]] *) (* [[file:../bitstring.org::*~of_z~][~of_z~:1]] *)
val of_z : Z.t -> t val of_z : Z.t -> t
(* ~of_z~:1 ends here *) (* ~of_z~:1 ends here *)
(* ~zero~ (* ~zero~ *)
*
* ~zero n~ creates a zero bit string with ~n~ bits. *)
(* [[file:../bitstring.org::*~zero~][~zero~:1]] *) (* [[file:../bitstring.org::*~zero~][~zero~:1]] *)
val zero : int -> t val zero : int -> t
(* ~zero~:1 ends here *) (* ~zero~:1 ends here *)
(* ~numbits~ (* ~numbits~ *)
*
* Returns the number of bits used to represent the bit string. *)
(* [[file:../bitstring.org::*~numbits~][~numbits~:1]] *) (* [[file:../bitstring.org::*~numbits~][~numbits~:1]] *)
val numbits : t -> int val numbits : t -> int
(* ~numbits~:1 ends here *) (* ~numbits~:1 ends here *)
(* ~is_zero~ (* ~is_zero~ *)
*
* True if all the bits of the bit string are zero. *)
(* [[file:../bitstring.org::*~is_zero~][~is_zero~:1]] *) (* [[file:../bitstring.org::*~is_zero~][~is_zero~:1]] *)
val is_zero : t -> bool val is_zero : t -> bool
(* ~is_zero~:1 ends here *) (* ~is_zero~:1 ends here *)
(* ~neg~ (* ~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]] *) (* [[file:../bitstring.org::*~neg~][~neg~:1]] *)
val neg : t -> t val neg : t -> t
(* ~neg~:1 ends here *) (* ~neg~:1 ends here *)
(* ~shift_left~ (* ~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]] *) (* [[file:../bitstring.org::*~shift_left~][~shift_left~:1]] *)
val shift_left : t -> int -> t val shift_left : t -> int -> t
(* ~shift_left~:1 ends here *) (* ~shift_left~:1 ends here *)
(* ~shift_right~ (* ~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]] *) (* [[file:../bitstring.org::*~shift_right~][~shift_right~:1]] *)
val shift_right : t -> int -> t val shift_right : t -> int -> t
(* ~shift_right~:1 ends here *) (* ~shift_right~:1 ends here *)
(* ~shift_left_one~ (* ~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]] *) (* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:1]] *)
val shift_left_one : int -> int -> t val shift_left_one : int -> int -> t
(* ~shift_left_one~:1 ends here *) (* ~shift_left_one~:1 ends here *)
(* ~testbit~ (* ~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]] *) (* [[file:../bitstring.org::*~testbit~][~testbit~:1]] *)
val testbit : t -> int -> bool val testbit : t -> int -> bool
(* ~testbit~:1 ends here *) (* ~testbit~:1 ends here *)
(* ~logor~ (* ~logor~ *)
*
* Bitwise logical or. *)
(* [[file:../bitstring.org::*~logor~][~logor~:1]] *) (* [[file:../bitstring.org::*~logor~][~logor~:1]] *)
val logor : t -> t -> t val logor : t -> t -> t
(* ~logor~:1 ends here *) (* ~logor~:1 ends here *)
(* ~logxor~ (* ~logxor~ *)
*
* Bitwise logical exclusive or. *)
(* [[file:../bitstring.org::*~logxor~][~logxor~:1]] *) (* [[file:../bitstring.org::*~logxor~][~logxor~:1]] *)
val logxor : t -> t -> t val logxor : t -> t -> t
(* ~logxor~:1 ends here *) (* ~logxor~:1 ends here *)
(* ~logand~ (* ~logand~ *)
*
* Bitwise logical and. *)
(* [[file:../bitstring.org::*~logand~][~logand~:1]] *) (* [[file:../bitstring.org::*~logand~][~logand~:1]] *)
val logand : t -> t -> t val logand : t -> t -> t
(* ~logand~:1 ends here *) (* ~logand~:1 ends here *)
(* ~lognot~ (* ~lognot~ *)
*
* Bitwise logical negation. *)
(* [[file:../bitstring.org::*~lognot~][~lognot~:1]] *) (* [[file:../bitstring.org::*~lognot~][~lognot~:1]] *)
val lognot : t -> t val lognot : t -> t
(* ~lognot~:1 ends here *) (* ~lognot~:1 ends here *)
(* ~minus_one~ (* ~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]] *) (* [[file:../bitstring.org::*~minus_one~][~minus_one~:1]] *)
val minus_one : t -> t val minus_one : t -> t
(* ~minus_one~:1 ends here *) (* ~minus_one~:1 ends here *)
(* ~plus_one~ (* ~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]] *) (* [[file:../bitstring.org::*~plus_one~][~plus_one~:1]] *)
val plus_one : t -> t val plus_one : t -> t
(* ~plus_one~:1 ends here *) (* ~plus_one~:1 ends here *)
(* ~trailing_zeros~ (* ~trailing_zeros~ *)
*
* Returns the number of trailing zeros in the bit string. *)
(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:1]] *) (* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:1]] *)
val trailing_zeros : t -> int val trailing_zeros : t -> int
(* ~trailing_zeros~:1 ends here *) (* ~trailing_zeros~:1 ends here *)
(* ~hamdist~ (* ~hamdist~ *)
*
* Returns the Hamming distance, i.e. the number of bits differing
* between two bit strings. *)
(* [[file:../bitstring.org::*~hamdist~][~hamdist~:1]] *) (* [[file:../bitstring.org::*~hamdist~][~hamdist~:1]] *)
val hamdist : t -> t -> int val hamdist : t -> t -> int
(* ~hamdist~:1 ends here *) (* ~hamdist~:1 ends here *)
(* ~popcount~ (* ~popcount~ *)
*
* Returns the number of bits set to one in the bit string. *)
(* [[file:../bitstring.org::*~popcount~][~popcount~:1]] *) (* [[file:../bitstring.org::*~popcount~][~popcount~:1]] *)
val popcount : t -> int val popcount : t -> int
(* ~popcount~:1 ends here *) (* ~popcount~:1 ends here *)
(* ~to_list~ (* ~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]] *) (* [[file:../bitstring.org::*~to_list~][~to_list~:1]] *)
val to_list : ?accu:(int list) -> t -> int list val to_list : ?accu:(int list) -> t -> int list
(* ~to_list~:1 ends here *) (* ~to_list~:1 ends here *)
(* ~permutations~ (* ~permutations~ *)
*
* ~permutations 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.permutations 2 4
* |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
* - : string list =
* ["++--------------------------------------------------------------";
* "+-+-------------------------------------------------------------";
* "-++-------------------------------------------------------------";
* "+--+------------------------------------------------------------";
* "-+-+------------------------------------------------------------";
* "--++------------------------------------------------------------"]
* #+end_example *)
(* [[file:../bitstring.org::*~permutations~][~permutations~:1]] *) (* [[file:../bitstring.org::*~permutations~][~permutations~:1]] *)

56
common/lib/command_line.ml
View File

@ -1,3 +1,16 @@
(* - Short option: in the command line, a dash with a single character
* (ex: =ls -l=)
* - Long option: in the command line, two dashes with a word
* (ex: =ls --directory=)
* - Command-line options can be ~Mandatory~ or ~Optional~
* - Documentation of the option is used in the help function
* - Some options require an argument (~ls --ignore="*.ml"~ ), some
* don't (~ls -l~) and for some arguments the argument is optional
* (~git --log[=<n>]~) *)
(* [[file:../command_line.org::*Type][Type:2]] *) (* [[file:../command_line.org::*Type][Type:2]] *)
type short_opt = char type short_opt = char
type long_opt = string type long_opt = string
@ -29,21 +42,33 @@ let specs = ref []
let dict = Hashtbl.create 67 let dict = Hashtbl.create 67
(* Mutable attributes:1 ends here *) (* Mutable attributes:1 ends here *)
(* Functions to set the header, footer and main description of the
* documentation provided by the ~help~ function: *)
(* [[file:../command_line.org::*Mutable attributes][Mutable attributes:3]] *) (* [[file:../command_line.org::*Mutable attributes][Mutable attributes:3]] *)
let set_header_doc s = header_doc := s let set_header_doc s = header_doc := s
let set_description_doc s = description_doc := s let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s let set_footer_doc s = footer_doc := s
(* Mutable attributes:3 ends here *) (* Mutable attributes:3 ends here *)
(* Function to create an anonymous argument. *)
(* [[file:../command_line.org::*Mutable attributes][Mutable attributes:5]] *) (* [[file:../command_line.org::*Mutable attributes][Mutable attributes:5]] *)
let anonymous name opt doc = let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; } { short=' ' ; long=name; opt; doc; arg=Without_arg; }
(* Mutable attributes:5 ends here *) (* Mutable attributes:5 ends here *)
(* Text formatting functions (* Text formatting functions :noexport:
* *
* Function to print some text such that it fits on the screen *) * Function to print some text such that it fits on the screen *)
(* [[file:../command_line.org::*Text formatting functions][Text formatting functions:1]] *) (* [[file:../command_line.org::*Text formatting functions][Text formatting functions:1]] *)
let output_text t = let output_text t =
Format.printf "@[<v 0>"; Format.printf "@[<v 0>";
@ -70,6 +95,7 @@ let output_text t =
(* Function to build the short description of the command-line (* Function to build the short description of the command-line
* arguments, such as * arguments, such as
*
* #+begin_example * #+begin_example
* my_program -b <string> [-h] [-u <float>] -x <string> [--] * my_program -b <string> [-h] [-u <float>] -x <string> [--]
* #+end_example *) * #+end_example *)
@ -93,6 +119,7 @@ let output_short x =
(* Function to build the long description of the command-line (* Function to build the long description of the command-line
* arguments, such as * arguments, such as
*
* #+begin_example * #+begin_example
* -x --xyz=<string> Name of the file containing the nuclear * -x --xyz=<string> Name of the file containing the nuclear
* coordinates in xyz format * coordinates in xyz format
@ -109,8 +136,8 @@ let output_long max_width x =
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg | _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
in in
let long = let long =
let l = String.length arg in let l = String.length arg in
arg^(String.make (max_width-l) ' ') arg^(String.make (max_width-l) ' ')
in in
Format.printf "@[<v 0>"; Format.printf "@[<v 0>";
begin begin
@ -122,11 +149,16 @@ let output_long max_width x =
output_text x.doc output_text x.doc
(* Text formatting functions:3 ends here *) (* Text formatting functions:3 ends here *)
(* Returns the list of anonymous arguments *)
(* [[file:../command_line.org::*~anon_args~][~anon_args~:2]] *) (* [[file:../command_line.org::*~anon_args~][~anon_args~:2]] *)
let anon_args () = !anon_args_ref let anon_args () = !anon_args_ref
(* ~anon_args~:2 ends here *) (* ~anon_args~:2 ends here *)
(* ~help~ (* ~help~ :noexport:
* *
* Prints the documentation of the program. *) * Prints the documentation of the program. *)
@ -199,16 +231,32 @@ let help () =
Format.printf "@." Format.printf "@."
(* ~help~:1 ends here *) (* ~help~:1 ends here *)
(* Returns the argument associated with a long option. *)
(* [[file:../command_line.org::*~get~][~get~:2]] *) (* [[file:../command_line.org::*~get~][~get~:2]] *)
let get x = let get x =
try Some (Hashtbl.find dict x) try Some (Hashtbl.find dict x)
with Not_found -> None with Not_found -> None
(* ~get~:2 ends here *) (* ~get~:2 ends here *)
(* True if the ~Optional~ argument is present in the command-line *)
(* [[file:../command_line.org::*~get_bool~][~get_bool~:2]] *) (* [[file:../command_line.org::*~get_bool~][~get_bool~:2]] *)
let get_bool x = Hashtbl.mem dict x let get_bool x = Hashtbl.mem dict x
(* ~get_bool~:2 ends here *) (* ~get_bool~:2 ends here *)
(* Sets the specifications of the current program from a list of
* ~descrption~ variables. *)
(* [[file:../command_line.org::*Specification][Specification:2]] *) (* [[file:../command_line.org::*Specification][Specification:2]] *)
let set_specs specs_in = let set_specs specs_in =
specs := { short = 'h' ; specs := { short = 'h' ;

38
common/lib/command_line.mli
View File

@ -1,14 +1,4 @@
(* Type (* Type
*
* - Short option: in the command line, a dash with a single character
* (ex: =ls -l=)
* - Long option: in the command line, two dashes with a word
* (ex: =ls --directory=)
* - Command-line options can be ~Mandatory~ or ~Optional~
* - Documentation of the option is used in the help function
* - Some options require an argument (~ls --ignore="*.ml"~ ), some
* don't (~ls -l~) and for some arguments the argument is optional
* (~git --log[=<n>]~)
* *
* #+NAME:type *) * #+NAME:type *)
@ -28,58 +18,38 @@ type description = {
} }
(* type ends here *) (* type ends here *)
(* Functions to set the header, footer and main description of the
* documentation provided by the ~help~ function: *)
(* [[file:../command_line.org::*Mutable attributes][Mutable attributes:2]] *) (* [[file:../command_line.org::*Mutable attributes][Mutable attributes:2]] *)
val set_header_doc : string -> unit val set_header_doc : string -> unit
val set_description_doc : string -> unit val set_description_doc : string -> unit
val set_footer_doc : string -> unit val set_footer_doc : string -> unit
(* Mutable attributes:2 ends here *) (* Mutable attributes:2 ends here *)
(* Function to create an anonymous argument: *)
(* [[file:../command_line.org::*Mutable attributes][Mutable attributes:4]] *) (* [[file:../command_line.org::*Mutable attributes][Mutable attributes:4]] *)
val anonymous : long_opt -> optional -> documentation -> description val anonymous : long_opt -> optional -> documentation -> description
(* Mutable attributes:4 ends here *) (* Mutable attributes:4 ends here *)
(* ~anon_args~ (* ~anon_args~ *)
*
* Returns the list of anonymous arguments *)
(* [[file:../command_line.org::*~anon_args~][~anon_args~:1]] *) (* [[file:../command_line.org::*~anon_args~][~anon_args~:1]] *)
val anon_args : unit -> string list val anon_args : unit -> string list
(* ~anon_args~:1 ends here *) (* ~anon_args~:1 ends here *)
(* ~get~ (* ~get~ *)
*
* Returns the argument associated with a long option. *)
(* [[file:../command_line.org::*~get~][~get~:1]] *) (* [[file:../command_line.org::*~get~][~get~:1]] *)
val get : long_opt -> string option val get : long_opt -> string option
(* ~get~:1 ends here *) (* ~get~:1 ends here *)
(* ~get_bool~ (* ~get_bool~ *)
*
* True if the ~Optional~ argument is present in the command-line *)
(* [[file:../command_line.org::*~get_bool~][~get_bool~:1]] *) (* [[file:../command_line.org::*~get_bool~][~get_bool~:1]] *)
val get_bool : long_opt -> bool val get_bool : long_opt -> bool
(* ~get_bool~:1 ends here *) (* ~get_bool~:1 ends here *)
(* Specification (* Specification *)
*
* Gives the specifications of the current program as a list of
* ~descrption~ variables. *)
(* [[file:../command_line.org::*Specification][Specification:1]] *) (* [[file:../command_line.org::*Specification][Specification:1]] *)

58
common/test/bitstring.ml
View File

@ -5,62 +5,62 @@
open Common.Bitstring open Common.Bitstring
let check msg x = Alcotest.(check bool) msg true x let check msg x = Alcotest.(check bool) msg true x
let test_all () = let test_all () =
let x = 8745687 in let x = 8745687 in
let one_x = of_int x in let one_x = of_int x in
let z = Z.shift_left (Z.of_int x) 64 in let z = Z.shift_left (Z.of_int x) 64 in
let many_x = of_z z in let many_x = of_z z in
(* Tests header:1 ends here *) (* Tests header:1 ends here *)
(* [[file:../bitstring.org::*~of_int~][~of_int~:3]] *) (* [[file:../bitstring.org::*~of_int~][~of_int~:3]] *)
Alcotest.(check bool) "of_x" true (one_x = (of_int x)); Alcotest.(check bool) "of_x" true (one_x = (of_int x));
(* ~of_int~:3 ends here *) (* ~of_int~:3 ends here *)
(* [[file:../bitstring.org::*~of_z~][~of_z~:3]] *) (* [[file:../bitstring.org::*~of_z~][~of_z~:3]] *)
Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x))); Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
(* ~of_z~:3 ends here *) (* ~of_z~:3 ends here *)
(* [[file:../bitstring.org::*~shift_left~][~shift_left~:3]] *) (* [[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_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_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); Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
(* ~shift_left~:3 ends here *) (* ~shift_left~:3 ends here *)
(* [[file:../bitstring.org::*~shift_right~][~shift_right~:3]] *) (* [[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_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); Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
(* ~shift_right~:3 ends here *) (* ~shift_right~:3 ends here *)
(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:3]] *) (* [[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_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); 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 *) (* ~shift_left_one~:3 ends here *)
(* [[file:../bitstring.org::*~testbit~][~testbit~:3]] *) (* [[file:../bitstring.org::*~testbit~][~testbit~:3]] *)
Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3); Alcotest.(check bool) "testbit1" true (testbit (of_int 8) 3);
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2); Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4); 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) "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) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4); Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
(* ~testbit~:3 ends here *) (* ~testbit~:3 ends here *)
(* [[file:../bitstring.org::*~logor~][~logor~:3]] *) (* [[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) "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))); 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 *) (* ~logor~:3 ends here *)
(* [[file:../bitstring.org::*~logxor~][~logxor~:3]] *) (* [[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) "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))); 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 *) (* ~logxor~:3 ends here *)
(* [[file:../bitstring.org::*~logand~][~logand~:3]] *) (* [[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) "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))); 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 *) (* ~logand~:3 ends here *)
(* [[file:../bitstring.org::*~to_list~][~to_list~:3]] *) (* [[file:../bitstring.org::*~to_list~][~to_list~:3]] *)
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45))); Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
(* ~to_list~:3 ends here *) (* ~to_list~:3 ends here *)
(* [[file:../bitstring.org::*~permutations~][~permutations~:3]] *) (* [[file:../bitstring.org::*~permutations~][~permutations~:3]] *)
@ -73,9 +73,9 @@ check "permutations"
(* [[file:../bitstring.org::*Tests][Tests:1]] *) (* [[file:../bitstring.org::*Tests][Tests:1]] *)
() ()
let tests = [ let tests = [
"all", `Quick, test_all; "all", `Quick, test_all;
] ]
(* Tests:1 ends here *) (* Tests:1 ends here *)