10
1
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-12-22 12:23:31 +01:00

Optimizations

This commit is contained in:
Anthony Scemama 2018-01-19 20:20:19 +01:00
parent 0e694adf84
commit bba7b6e8e4
3 changed files with 108 additions and 38 deletions

View File

@ -94,36 +94,21 @@ let zkey_array a =
begin begin
match a with match a with
| Singlet l1 -> | Singlet l1 ->
List.map (fun x -> Zkey.of_int_tuple (Zkey.Three x)) (keys_1d @@ to_int l1)
let a = Array.init 3 (fun _ -> 0) in
List.map (fun (cx,cy,cz) ->
a.(0) <- cx ; a.(1) <- cy ; a.(2) <- cz ;
Zkey.(of_int_array Kind_3 a)
) (keys_1d @@ to_int l1)
| Doublet (l1, l2) -> | Doublet (l1, l2) ->
List.map (fun a ->
let a = Array.init 6 (fun _ -> 0) in List.map (fun b ->
List.map (fun (cx,cy,cz) -> Zkey.of_int_tuple (Zkey.Six (a,b))) (keys_1d @@ to_int l1)
a.(0) <- cx ; a.(1) <- cy ; a.(2) <- cz ;
List.map (fun (dx,dy,dz) ->
a.(3) <- dx ; a.(4) <- dy ; a.(5) <- dz ;
Zkey.(of_int_array Kind_6 a)
) (keys_1d @@ to_int l1)
) (keys_1d @@ to_int l2) ) (keys_1d @@ to_int l2)
|> List.concat |> List.concat
| Triplet (l1, l2, l3) -> | Triplet (l1, l2, l3) ->
let a = Array.init 9 (fun _ -> 0) in List.map (fun a ->
List.map (fun (ax,ay,az) -> List.map (fun b ->
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ; List.map (fun c ->
List.map (fun (bx,by,bz) -> Zkey.of_int_tuple (Zkey.Nine (a,b,c))) (keys_1d @@ to_int l3)
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ;
List.map (fun (cx,cy,cz) ->
a.(6) <- cx ; a.(7) <- cy ; a.(8) <- cz ;
Zkey.(of_int_array Kind_9 a)
) (keys_1d @@ to_int l3)
) (keys_1d @@ to_int l2) ) (keys_1d @@ to_int l2)
|> List.concat |> List.concat
) (keys_1d @@ to_int l1) ) (keys_1d @@ to_int l1)
@ -131,17 +116,11 @@ let zkey_array a =
| Quartet (l1, l2, l3, l4) -> | Quartet (l1, l2, l3, l4) ->
let a = Array.init 12 (fun _ -> 0) in List.map (fun a ->
List.map (fun (ax,ay,az) -> List.map (fun b ->
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ; List.map (fun c ->
List.map (fun (bx,by,bz) -> List.map (fun d ->
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ; Zkey.of_int_tuple (Zkey.Twelve (a,b,c,d))) (keys_1d @@ to_int l4)
List.map (fun (cx,cy,cz) ->
a.(6) <- cx ; a.(7) <- cy ; a.(8) <- cz ;
List.map (fun (dx,dy,dz) ->
a.(9) <- dx ; a.(10) <- dy ; a.(11) <- dz ;
Zkey.(of_int_array Kind_12 a)
) (keys_1d @@ to_int l4)
) (keys_1d @@ to_int l3) ) (keys_1d @@ to_int l3)
|> List.concat |> List.concat
) (keys_1d @@ to_int l2) ) (keys_1d @@ to_int l2)

View File

@ -2,7 +2,7 @@
include Z include Z
type kind = type kind_array =
| Kind_3 | Kind_3
| Kind_6 | Kind_6
| Kind_12 | Kind_12
@ -12,7 +12,7 @@ type kind =
| Kind_1 | Kind_1
(** Build a Zkey from an array or 1, 2, 3, 4, 6, or 12 integers *) (** Build a Zkey from an array or 1, 2, 3, 4, 6, 9, or 12 integers *)
let of_int_array ~kind a = let of_int_array ~kind a =
let (<|) x a = let (<|) x a =
Z.logor (Z.shift_left x 64) a Z.logor (Z.shift_left x 64) a
@ -48,6 +48,47 @@ let of_int_array ~kind a =
| Kind_1 -> Z.of_int a.(0) | Kind_1 -> Z.of_int a.(0)
type kind =
| One of (int)
| Two of (int*int)
| Three of (int*int*int)
| Four of ((int*int)*(int*int))
| Six of ((int*int*int)*(int*int*int))
| Nine of ((int*int*int)*(int*int*int)*(int*int*int))
| Twelve of ((int*int*int)*(int*int*int)*(int*int*int)*(int*int*int))
let (<|) x a =
Z.logor (Z.shift_left x 64) a
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_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
| Six ((a,b,c),(d,e,f)) ->
(Int64.of_int a) << b << c << d << e << f |> Z.of_int64
| 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
| 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
(** Transform the Zkey into an int array *) (** Transform the Zkey into an int array *)
let to_int_array ~kind a = let to_int_array ~kind a =
match kind with match kind with
@ -89,6 +130,7 @@ let to_int_array ~kind a =
Z.to_int @@ Z.extract a 0 16 |] Z.to_int @@ Z.extract a 0 16 |]
| Kind_1 -> [| Z.to_int a |] | Kind_1 -> [| Z.to_int a |]
let to_string ~kind a = let to_string ~kind a =
"< " ^ ( Z.to_string a ) ^ " | " ^ ( "< " ^ ( Z.to_string a ) ^ " | " ^ (
to_int_array kind a to_int_array kind a
@ -98,6 +140,53 @@ let to_string ~kind a =
) ^ " >" ) ^ " >"
(** Transform the Zkey into an int array *)
let to_int_tuple ~kind a =
match kind with
| Kind_3 -> Three ( Z.to_int @@ Z.extract a 20 10 ,
Z.to_int @@ Z.extract a 10 10 ,
Z.to_int @@ Z.extract a 0 10 )
| Kind_6 -> Six ((Z.to_int @@ Z.extract a 50 10 ,
Z.to_int @@ Z.extract a 40 10 ,
Z.to_int @@ Z.extract a 30 10),
(Z.to_int @@ Z.extract a 20 10 ,
Z.to_int @@ Z.extract a 10 10 ,
Z.to_int @@ Z.extract a 0 10))
| Kind_12 -> Twelve ((Z.to_int @@ Z.extract a 114 10 ,
Z.to_int @@ Z.extract a 104 10 ,
Z.to_int @@ Z.extract a 94 10),
(Z.to_int @@ Z.extract a 84 10 ,
Z.to_int @@ Z.extract a 74 10 ,
Z.to_int @@ Z.extract a 64 10),
(Z.to_int @@ Z.extract a 50 10 ,
Z.to_int @@ Z.extract a 40 10 ,
Z.to_int @@ Z.extract a 30 10),
(Z.to_int @@ Z.extract a 20 10 ,
Z.to_int @@ Z.extract a 10 10 ,
Z.to_int @@ Z.extract a 0 10))
| Kind_9 -> Nine ((Z.to_int @@ Z.extract a 84 10 ,
Z.to_int @@ Z.extract a 74 10 ,
Z.to_int @@ Z.extract a 64 10),
(Z.to_int @@ Z.extract a 50 10 ,
Z.to_int @@ Z.extract a 40 10 ,
Z.to_int @@ Z.extract a 30 10),
(Z.to_int @@ Z.extract a 20 10 ,
Z.to_int @@ Z.extract a 10 10 ,
Z.to_int @@ Z.extract a 0 10))
| Kind_4 -> Four ((Z.to_int @@ Z.extract a 48 16 ,
Z.to_int @@ Z.extract a 32 16),
(Z.to_int @@ Z.extract a 16 16 ,
Z.to_int @@ Z.extract a 0 16))
| Kind_2 -> Two ( Z.to_int @@ Z.extract a 16 16,
Z.to_int @@ Z.extract a 0 16 )
| Kind_1 -> One ( Z.to_int a )
(* (*
let debug () = let debug () =
let k2 = of_int_array Kind_2 [| 1 ; 2 |] let k2 = of_int_array Kind_2 [| 1 ; 2 |]

View File

@ -47,12 +47,14 @@ let run ~coord ~basis ~out =
let () = let () =
let usage_msg = "Available options:" in let usage_msg = "Available options:" in
Arg.parse speclist (fun _ -> ()) usage_msg; Arg.parse speclist (fun _ -> ()) usage_msg;
try
run ~coord:!coord_file ~basis:!basis_file ~out:!out_file run ~coord:!coord_file ~basis:!basis_file ~out:!out_file
(*
try
with with
| Invalid_argument e -> | Invalid_argument e ->
begin begin
print_string "Error: " ; print_endline e; print_newline (); print_string "Error: " ; print_endline e; print_newline ();
Arg.usage speclist usage_msg Arg.usage speclist usage_msg
end end
*)