From ebd753d48efff461b8660d7696d05b27cb50cb56 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 26 Dec 2020 01:47:55 +0100 Subject: [PATCH] Added org-mode files in common --- common/README.org | 79 +++++ common/angular_momentum.org | 330 +++++++++++++++++++ common/bitstring.org | 559 ++++++++++++++++++++++++++++++++ common/lib/angular_momentum.ml | 110 ++++--- common/lib/angular_momentum.mli | 205 +++++++----- common/lib/bitstring.ml | 101 ++++-- common/lib/bitstring.mli | 244 ++++++++++++++ common/lib/dune | 12 +- common/test/bitstring.ml | 114 ++++--- common/test/dune | 6 +- 10 files changed, 1542 insertions(+), 218 deletions(-) create mode 100644 common/README.org create mode 100644 common/angular_momentum.org create mode 100644 common/bitstring.org create mode 100644 common/lib/bitstring.mli diff --git a/common/README.org b/common/README.org new file mode 100644 index 0000000..a23fe4b --- /dev/null +++ b/common/README.org @@ -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 + + diff --git a/common/angular_momentum.org b/common/angular_momentum.org new file mode 100644 index 0000000..ea6b92d --- /dev/null +++ b/common/angular_momentum.org @@ -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) +<> +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 diff --git a/common/bitstring.org b/common/bitstring.org new file mode 100644 index 0000000..47a12e7 --- /dev/null +++ b/common/bitstring.org @@ -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 + diff --git a/common/lib/angular_momentum.ml b/common/lib/angular_momentum.ml index f988c91..6c87125 100644 --- a/common/lib/angular_momentum.ml +++ b/common/lib/angular_momentum.ml @@ -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 *) diff --git a/common/lib/angular_momentum.mli b/common/lib/angular_momentum.mli index 0206eef..a5a764c 100644 --- a/common/lib/angular_momentum.mli +++ b/common/lib/angular_momentum.mli @@ -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 *) diff --git a/common/lib/bitstring.ml b/common/lib/bitstring.ml index 889ffdd..1491eea 100644 --- a/common/lib/bitstring.ml +++ b/common/lib/bitstring.ml @@ -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 *) diff --git a/common/lib/bitstring.mli b/common/lib/bitstring.mli new file mode 100644 index 0000000..af80e56 --- /dev/null +++ b/common/lib/bitstring.mli @@ -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 *) diff --git a/common/lib/dune b/common/lib/dune index fda41f1..66db8a1 100644 --- a/common/lib/dune +++ b/common/lib/dune @@ -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.")) + +) diff --git a/common/test/bitstring.ml b/common/test/bitstring.ml index 453c6ee..76d59d1 100644 --- a/common/test/bitstring.ml +++ b/common/test/bitstring.ml @@ -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 *) diff --git a/common/test/dune b/common/test/dune index 3d152f1..c902c42 100644 --- a/common/test/dune +++ b/common/test/dune @@ -1,7 +1,11 @@ (library + (name test_common) + (synopsis "Test for common library") + (libraries alcotest qcaml.common ) - (synopsis "Tests for common library")) + +)