diff --git a/Basis/ERI.ml b/Basis/ERI.ml index 0d9b6df..36ecd9b 100644 --- a/Basis/ERI.ml +++ b/Basis/ERI.ml @@ -52,7 +52,7 @@ let contracted_class_shell_pairs ?schwartz_p ?schwartz_q shell_p shell_q : float let cutoff2 = cutoff *. cutoff (* -type n_cls = { n : int ; cls : Z.t array } +type n_cls = { n : int ; cls : Zkey.t array } *) exception NullIntegral diff --git a/Utils/Angular_momentum.mli b/Utils/Angular_momentum.mli index bc145d2..dd826a5 100644 --- a/Utils/Angular_momentum.mli +++ b/Utils/Angular_momentum.mli @@ -12,4 +12,4 @@ type kind = | Quartet of (t*t*t*t) val n_functions : t -> int -val zkey_array : kind -> Z.t array +val zkey_array : kind -> Zkey.t array diff --git a/Utils/Zkey.ml b/Utils/Zkey.ml index 49eeae0..634a1d0 100644 --- a/Utils/Zkey.ml +++ b/Utils/Zkey.ml @@ -1,5 +1,4 @@ (** Key for hastables that contain tuples of integers encoded in a Zarith integer *) - type kind_array = | Kind_3 | Kind_6 @@ -9,41 +8,41 @@ type kind_array = | Kind_2 | Kind_1 -let (<|) x a = - Z.logor (Z.shift_left x 64) a +type t = + { + left : int ; + right : int ; + } -let (<<) x a = - Int64.logor (Int64.shift_left x 10) (Int64.of_int a) -let (<+) x a = - Int64.logor (Int64.shift_left x 16) (Int64.of_int a) +let of_int right = + { left = 0 ; right } + +let (<|) { left ; right } x = + { left=right ; right=x } + +let (<<) { left ; right } x = + { left ; right = (right lsl 10) lor x } + +let (<+) { left ; right } x = + { left ; right = (right lsl 15) lor x } (** Build a Zkey from an array or 1, 2, 3, 4, 6, 9, or 12 integers *) let of_int_array ~kind a = + match kind with - | Kind_3 -> (Int64.of_int a.(0)) << a.(1) << a.(2) |> Z.of_int64 - | Kind_6 -> (Int64.of_int a.(0)) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - |> Z.of_int64 - | Kind_12 -> - let a = - (Int64.of_int a.(0)) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - |> Z.of_int64 - and b = - (Int64.of_int a.(6)) << a.(7) << a.(8) << a.(9) << a.(10) << a.(11) - |> Z.of_int64 - in a <| b + | Kind_3 -> of_int a.(0) <+ a.(1) <+ a.(2) + | Kind_6 -> of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) + | Kind_12 -> + of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) + <| a.(6) << a.(7) << a.(8) << a.(9) << a.(10) << a.(11) | Kind_9 -> - let a = - (Int64.of_int a.(0)) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) - |> Z.of_int64 - and b = - (Int64.of_int a.(6)) << a.(7) << a.(8) - |> Z.of_int64 - in a <| b - | Kind_4 -> (Int64.of_int a.(0)) <+ a.(1) <+ a.(2) <+ a.(3) |> Z.of_int64 - | Kind_2 -> (Int64.of_int a.(0)) <+ a.(1) |> Z.of_int64 - | Kind_1 -> Z.of_int a.(0) + of_int a.(0) << a.(1) << a.(2) << a.(3) << a.(4) << a.(5) + <| a.(6) << a.(7) << a.(8) + | Kind_4 -> of_int a.(0) <+ a.(1) <+ a.(2) <+ a.(3) + | Kind_2 -> of_int a.(0) <+ a.(1) + | Kind_1 -> of_int a.(0) type kind = @@ -57,149 +56,168 @@ type kind = let of_int_tuple a = match a with - | One (a) -> Z.of_int a - | Two (a,b) -> (Int64.of_int a) <+ b |> Z.of_int64 - | Three (a,b,c) -> (Int64.of_int a) << b << c |> Z.of_int64 - | Four ((a,b),(c,d)) -> - (Int64.of_int a) <+ b <+ c <+ d |> Z.of_int64 + | One (a) -> of_int a + | Two (a,b) -> of_int a <+ b + | Three (a,b,c) -> of_int a <+ b <+ c + | Four ((a,b),(c,d)) -> of_int a <+ b <+ c <+ d | Six ((a,b,c),(d,e,f)) -> - (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 + of_int a << b << c << d << e << f | Twelve ((a,b,c),(d,e,f),(g,h,i),(j,k,l)) -> - let a = - (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 - and b = - (Int64.of_int g) << h << i << j << k << l |> Z.of_int64 - in a <| b + of_int a << b << c << d << e << f + <| g << h << i << j << k << l | Nine ((a,b,c),(d,e,f),(g,h,i)) -> - let a = - (Int64.of_int a) << b << c << d << e << f |> Z.of_int64 - and b = - (Int64.of_int g) << h << i |> Z.of_int64 - in a <| b + of_int a << b << c << d << e << f + <| g << h << i -let mask10 = Int64.of_int 0x3ff -and mask16 = Int64.of_int 0xffff +let mask10 = 0x3ff +and mask15 = 0x7fff + (** Transform the Zkey into an int array *) -let to_int_array ~kind a = - let open Int64 in +let to_int_array ~kind { left ; right } = match kind with - | Kind_3 -> let x = Z.to_int64 a in - [| to_int ( logand mask10 (shift_right x 20)) ; - to_int ( logand mask10 (shift_right x 10)) ; - to_int ( logand mask10 x) |] - | Kind_6 -> let x = Z.to_int64 a in - [| to_int ( logand mask10 (shift_right x 50)) ; - to_int ( logand mask10 (shift_right x 40)) ; - to_int ( logand mask10 (shift_right x 30)) ; - to_int ( logand mask10 (shift_right x 20)) ; - to_int ( logand mask10 (shift_right x 10)) ; - to_int ( logand mask10 x) |] - | Kind_12 -> let x = Z.to_int64 @@ Z.extract a 0 60 - and y = Z.to_int64 @@ Z.extract a 64 60 - in - [| to_int ( logand mask10 (shift_right y 114)) ; - to_int ( logand mask10 (shift_right y 104)) ; - to_int ( logand mask10 (shift_right y 94)) ; - to_int ( logand mask10 (shift_right y 84)) ; - to_int ( logand mask10 (shift_right y 74)) ; - to_int ( logand mask10 (shift_right y 64)) ; - to_int ( logand mask10 (shift_right x 50)) ; - to_int ( logand mask10 (shift_right x 40)) ; - to_int ( logand mask10 (shift_right x 30)) ; - to_int ( logand mask10 (shift_right x 20)) ; - to_int ( logand mask10 (shift_right x 10)) ; - to_int ( logand mask10 x) |] - | Kind_9 -> let x = Z.to_int64 @@ Z.extract a 0 60 - and y = Z.to_int64 @@ Z.extract a 64 60 - in - [| to_int ( logand mask10 (shift_right y 84)) ; - to_int ( logand mask10 (shift_right y 74)) ; - to_int ( logand mask10 (shift_right y 64)) ; - to_int ( logand mask10 (shift_right x 50)) ; - to_int ( logand mask10 (shift_right x 40)) ; - to_int ( logand mask10 (shift_right x 30)) ; - to_int ( logand mask10 (shift_right x 20)) ; - to_int ( logand mask10 (shift_right x 10)) ; - to_int ( logand mask10 x) |] - | Kind_4 -> let x = Z.to_int64 a in - [| to_int ( logand mask16 (shift_right x 48)) ; - to_int ( logand mask16 (shift_right x 32)) ; - to_int ( logand mask16 (shift_right x 16)) ; - to_int ( logand mask16 x) |] - | Kind_2 -> let x = Z.to_int64 a in - [| to_int ( logand mask16 (shift_right x 16)) ; - to_int ( logand mask16 x) |] - | Kind_1 -> [| Z.to_int a |] + | Kind_3 -> [| + mask15 land (right lsr 30) ; + mask15 land (right lsr 15) ; + mask15 land right + |] + + | Kind_6 -> [| + mask10 land (right lsr 50) ; + mask10 land (right lsr 40) ; + mask10 land (right lsr 30) ; + mask10 land (right lsr 20) ; + mask10 land (right lsr 10) ; + mask10 land right + |] + + | Kind_12 -> [| + mask10 land (left lsr 50) ; + mask10 land (left lsr 40) ; + mask10 land (left lsr 30) ; + mask10 land (left lsr 20) ; + mask10 land (left lsr 10) ; + mask10 land left ; + mask10 land (right lsr 50) ; + mask10 land (right lsr 40) ; + mask10 land (right lsr 30) ; + mask10 land (right lsr 20) ; + mask10 land (right lsr 10) ; + mask10 land right + |] + + | Kind_9 -> [| + mask10 land (left lsr 20) ; + mask10 land (left lsr 10) ; + mask10 land left ; + mask10 land (right lsr 50) ; + mask10 land (right lsr 40) ; + mask10 land (right lsr 30) ; + mask10 land (right lsr 20) ; + mask10 land (right lsr 10) ; + mask10 land right + |] + + | Kind_4 -> [| + mask15 land (right lsr 45) ; + mask15 land (right lsr 30) ; + mask15 land (right lsr 15) ; + mask15 land right + |] + + | Kind_2 -> [| + mask15 land (right lsr 15) ; + mask15 land right + |] + + | Kind_1 -> [| right |] (** Transform the Zkey into an int tuple *) -let to_int_tuple ~kind a = - let open Int64 in +let to_int_tuple ~kind { left ; right } = match kind with - | Kind_3 -> let x = Z.to_int64 a in - Three ( to_int ( logand mask10 (shift_right x 20)), - to_int ( logand mask10 (shift_right x 10)), - to_int ( logand mask10 x) ) - | Kind_6 -> let x = Z.to_int64 a in - Six ( ( to_int ( logand mask10 (shift_right x 50)), - to_int ( logand mask10 (shift_right x 40)), - to_int ( logand mask10 (shift_right x 30))), - ( to_int ( logand mask10 (shift_right x 20)), - to_int ( logand mask10 (shift_right x 10)), - to_int ( logand mask10 x) ) ) - | Kind_12 -> let x = Z.to_int64 @@ Z.extract a 0 60 - and y = Z.to_int64 @@ Z.extract a 64 60 - in - Twelve ( ( to_int ( logand mask10 (shift_right y 114)), - to_int ( logand mask10 (shift_right y 104)), - to_int ( logand mask10 (shift_right y 94))), - ( to_int ( logand mask10 (shift_right y 84)), - to_int ( logand mask10 (shift_right y 74)), - to_int ( logand mask10 (shift_right y 64))), - ( to_int ( logand mask10 (shift_right x 50)), - to_int ( logand mask10 (shift_right x 40)), - to_int ( logand mask10 (shift_right x 30))), - ( to_int ( logand mask10 (shift_right x 20)), - to_int ( logand mask10 (shift_right x 10)), - to_int ( logand mask10 x) )) - | Kind_9 -> let x = Z.to_int64 @@ Z.extract a 0 60 - and y = Z.to_int64 @@ Z.extract a 64 60 - in - Nine ( ( to_int ( logand mask10 (shift_right y 84)), - to_int ( logand mask10 (shift_right y 74)), - to_int ( logand mask10 (shift_right y 64))), - ( to_int ( logand mask10 (shift_right x 50)), - to_int ( logand mask10 (shift_right x 40)), - to_int ( logand mask10 (shift_right x 30))), - ( to_int ( logand mask10 (shift_right x 20)), - to_int ( logand mask10 (shift_right x 10)), - to_int ( logand mask10 x) )) - | Kind_4 -> let x = Z.to_int64 a in - Four ( ( to_int ( logand mask16 (shift_right x 48)), - to_int ( logand mask16 (shift_right x 32))), - ( to_int ( logand mask16 (shift_right x 16)), - to_int ( logand mask16 x) )) - | Kind_2 -> let x = Z.to_int64 a in - Two ( to_int ( logand mask16 (shift_right x 16)), - to_int ( logand mask16 x) ) - | Kind_1 -> One ( Z.to_int a ) + | Kind_3 -> Three ( + mask15 land (right lsr 30) , + mask15 land (right lsr 15) , + mask15 land right + ) + + | Kind_6 -> Six ( + ( mask10 land (right lsr 50) , + mask10 land (right lsr 40) , + mask10 land (right lsr 30)), + ( mask10 land (right lsr 20) , + mask10 land (right lsr 10) , + mask10 land right ) + ) + + | Kind_12 -> Twelve ( + ( mask10 land (left lsr 50) , + mask10 land (left lsr 40) , + mask10 land (left lsr 30)), + ( mask10 land (left lsr 20) , + mask10 land (left lsr 10) , + mask10 land left ) , + ( mask10 land (right lsr 50) , + mask10 land (right lsr 40) , + mask10 land (right lsr 30)), + ( mask10 land (right lsr 20) , + mask10 land (right lsr 10) , + mask10 land right ) + ) + + | Kind_9 -> Nine ( + ( mask10 land (left lsr 20) , + mask10 land (left lsr 10) , + mask10 land left ) , + ( mask10 land (right lsr 50) , + mask10 land (right lsr 40) , + mask10 land (right lsr 30)), + ( mask10 land (right lsr 20) , + mask10 land (right lsr 10) , + mask10 land right ) + ) + + | Kind_4 -> Four ( + ( mask15 land (right lsr 45) , + mask15 land (right lsr 30)), + ( mask15 land (right lsr 15) , + mask15 land right ) + ) + + | Kind_2 -> Two ( + mask15 land (right lsr 15) , + mask15 land right + ) + + | Kind_1 -> One right -let zero = Z.of_int 0 +let hash = Hashtbl.hash -include Z +let equal + { right = r1 ; left = l1 } + { right = r2 ; left = l2 } = + r1 = r2 && l1 = l2 -let to_string ~kind a = - "< " ^ ( Z.to_string a ) ^ " | " ^ ( - to_int_array kind a +let cmp + { right = r1 ; left = l1 } + { right = r2 ; left = l2 } = + if r1 < r2 then -1 + else if r1 > r2 then 1 + else if l1 < l2 then -1 + else if l1 > l2 then 1 + else 0 + +let to_string ~kind { left ; right } = + "< " ^ string_of_int left ^ string_of_int right ^ " | " ^ ( + to_int_array kind { left ; right } |> Array.map string_of_int |> Array.to_list |> String.concat ", " ) ^ " >" -(* let debug () = let k2 = of_int_array Kind_2 [| 1 ; 2 |] and k3 = of_int_array Kind_3 [| 1 ; 2 ; 3 |] @@ -213,6 +231,12 @@ let debug () = print_endline @@ to_string Kind_6 k6 ; print_endline @@ to_string Kind_12 k12 + (* +< 65538 | 1, 2 > +< 1050627 | 1, 2, 3 > +< 281483566841860 | 1, 2, 3, 4 > +< 1128102155523078 | 1, 2, 3, 4, 5, 6 > +< 20809811751934310026571282435288076 | 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 > +*) let () = debug () -*)