mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-12-22 04:13:33 +01:00
Optimizations
This commit is contained in:
parent
0e694adf84
commit
bba7b6e8e4
@ -94,36 +94,21 @@ let zkey_array a =
|
||||
begin
|
||||
match a with
|
||||
| Singlet 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)
|
||||
List.map (fun x -> Zkey.of_int_tuple (Zkey.Three x)) (keys_1d @@ to_int l1)
|
||||
|
||||
| Doublet (l1, l2) ->
|
||||
|
||||
let a = Array.init 6 (fun _ -> 0) in
|
||||
List.map (fun (cx,cy,cz) ->
|
||||
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)
|
||||
List.map (fun a ->
|
||||
List.map (fun b ->
|
||||
Zkey.of_int_tuple (Zkey.Six (a,b))) (keys_1d @@ to_int l1)
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
|
||||
| Triplet (l1, l2, l3) ->
|
||||
|
||||
let a = Array.init 9 (fun _ -> 0) in
|
||||
List.map (fun (ax,ay,az) ->
|
||||
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ;
|
||||
List.map (fun (bx,by,bz) ->
|
||||
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)
|
||||
List.map (fun a ->
|
||||
List.map (fun b ->
|
||||
List.map (fun c ->
|
||||
Zkey.of_int_tuple (Zkey.Nine (a,b,c))) (keys_1d @@ to_int l3)
|
||||
) (keys_1d @@ to_int l2)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l1)
|
||||
@ -131,17 +116,11 @@ let zkey_array a =
|
||||
|
||||
| Quartet (l1, l2, l3, l4) ->
|
||||
|
||||
let a = Array.init 12 (fun _ -> 0) in
|
||||
List.map (fun (ax,ay,az) ->
|
||||
a.(0) <- ax ; a.(1) <- ay ; a.(2) <- az ;
|
||||
List.map (fun (bx,by,bz) ->
|
||||
a.(3) <- bx ; a.(4) <- by ; a.(5) <- bz ;
|
||||
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)
|
||||
List.map (fun a ->
|
||||
List.map (fun b ->
|
||||
List.map (fun c ->
|
||||
List.map (fun d ->
|
||||
Zkey.of_int_tuple (Zkey.Twelve (a,b,c,d))) (keys_1d @@ to_int l4)
|
||||
) (keys_1d @@ to_int l3)
|
||||
|> List.concat
|
||||
) (keys_1d @@ to_int l2)
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
|
||||
include Z
|
||||
|
||||
type kind =
|
||||
type kind_array =
|
||||
| Kind_3
|
||||
| Kind_6
|
||||
| Kind_12
|
||||
@ -12,7 +12,7 @@ type kind =
|
||||
| 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 (<|) x 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)
|
||||
|
||||
|
||||
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 *)
|
||||
let to_int_array ~kind a =
|
||||
match kind with
|
||||
@ -89,6 +130,7 @@ let to_int_array ~kind a =
|
||||
Z.to_int @@ Z.extract a 0 16 |]
|
||||
| Kind_1 -> [| Z.to_int a |]
|
||||
|
||||
|
||||
let to_string ~kind a =
|
||||
"< " ^ ( Z.to_string 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 k2 = of_int_array Kind_2 [| 1 ; 2 |]
|
||||
|
||||
@ -47,12 +47,14 @@ let run ~coord ~basis ~out =
|
||||
let () =
|
||||
let usage_msg = "Available options:" in
|
||||
Arg.parse speclist (fun _ -> ()) usage_msg;
|
||||
try
|
||||
run ~coord:!coord_file ~basis:!basis_file ~out:!out_file
|
||||
(*
|
||||
try
|
||||
with
|
||||
| Invalid_argument e ->
|
||||
begin
|
||||
print_string "Error: " ; print_endline e; print_newline ();
|
||||
Arg.usage speclist usage_msg
|
||||
end
|
||||
*)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user