Changing qp_set_mo_class.ml. Not finished yet

This commit is contained in:
Anthony Scemama 2014-09-16 18:58:42 +02:00
parent 7a9316df55
commit cb509d2d93
11 changed files with 437 additions and 180 deletions

45
ocaml/MO_class.ml Normal file
View File

@ -0,0 +1,45 @@
open Core.Std;;
open Qptypes ;;
type t =
| Core of MO_number.t list
| Inactive of MO_number.t list
| Active of MO_number.t list
| Virtual of MO_number.t list
| Deleted of MO_number.t list
;;
let to_string x =
let print_list l =
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
|> (String.concat ~sep:", ")
in
"("^s^")"
in
match x with
| Core l -> "Core : "^(print_list l)
| Inactive l -> "Inactive : "^(print_list l)
| Active l -> "Active : "^(print_list l)
| Virtual l -> "Virtual : "^(print_list l)
| Deleted l -> "Deleted : "^(print_list l)
;;
let _mo_number_list_of_range range =
Range.of_string range |> List.map ~f:MO_number.of_int
;;
let create_core range = Core (_mo_number_list_of_range range) ;;
let create_inactive range = Inactive (_mo_number_list_of_range range) ;;
let create_active range = Active (_mo_number_list_of_range range) ;;
let create_virtual range = Virtual (_mo_number_list_of_range range) ;;
let create_deleted range = Deleted (_mo_number_list_of_range range) ;;
let to_bitlist holes particles =
let mask = Bitlist.of_int64 (Int64.of_int 513) in
let l = Bitlist.to_mo_number_list mask in
let i = Inactive l in
print_string (to_string i)
;;

View File

@ -10,8 +10,6 @@ $(error )
endif
EXECUTABLES=set_mo_class
LIBS=
PKGS=
OCAMLCFLAGS=-g
@ -19,11 +17,12 @@ OCAMLBUILD=ocamlbuild -cflags $(OCAMLCFLAGS) -lflags -g
MLFILES=$(wildcard *.ml) ezfio.ml qptypes.ml
MLIFILES=$(wildcard *.mli)
ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml))
default: $(ALL_TESTS) executables
executables: $(patsubst %, %.native, $(EXECUTABLES))
executables: $(ALL_EXE)
%.inferred.mli: $(MLFILES)
$(OCAMLBUILD) $*.inferred.mli -cflags -i -use-ocamlfind $(PKGS)
@ -48,4 +47,4 @@ ${QPACKAGE_ROOT}/EZFIO/Ocaml/ezfio.ml:
$(MAKE) -C ${QPACKAGE_ROOT}/src ezfio
clean:
rm -rf _build
rm -rf _build *.native *.byte

View File

@ -91,6 +91,23 @@ let of_mo_number_list n_int l =
Array.to_list a
;;
let to_mo_number_list l =
let a = Array.of_list l in
let rec do_work accu = function
| 0 -> accu
| i ->
begin
let new_accu =
match a.(i-1) with
| Bit.One -> (MO_number.of_int i)::accu
| Bit.Zero -> accu
in
do_work new_accu (i-1)
end
in
do_work [] (List.length l)
;;
(* logical operations on bit_list *)

83
ocaml/excitation.ml Normal file
View File

@ -0,0 +1,83 @@
open Core.Std;;
open Qptypes;;
module Hole : sig
type t
val to_mo_class : t -> MO_class.t
val of_mo_class : MO_class.t -> t
end = struct
type t = MO_class.t
let of_mo_class x = x
let to_mo_class x = x
end
module Particle : sig
type t
val to_mo_class : t -> MO_class.t
val of_mo_class : MO_class.t -> t
end = struct
type t = MO_class.t
let of_mo_class x = x
let to_mo_class x = x
end
type t =
| Single of Hole.t*Particle.t
| Double of Hole.t*Particle.t*Hole.t*Particle.t
;;
let failwith s = raise (Failure s)
;;
let create_single ~hole ~particle =
MO_class.(
match (hole,particle) with
| ( Core _, _ ) -> failwith "Holes can not be in core MOs"
| ( _, Core _ ) -> failwith "Particles can not be in core MOs"
| ( Deleted _, _ ) -> failwith "Holes can not be in deleted MOs"
| ( _, Deleted _ ) -> failwith "Particles can not be in deleted MOs"
| ( Virtual _, _ ) -> failwith "Holes can not be in virtual MOs"
| ( _, Inactive _ ) -> failwith "Particles can not be in virtual MOs"
| (h, p) -> Single ( (Hole.of_mo_class h), (Particle.of_mo_class p) )
)
;;
let double_of_singles s1 s2 =
let (h1,p1) = match s1 with
| Single (h,p) -> (h,p)
| _ -> assert false
and (h2,p2) = match s2 with
| Single (h,p) -> (h,p)
| _ -> assert false
in
Double (h1,p1,h2,p2)
;;
let create_double ~hole1 ~particle1 ~hole2 ~particle2 =
let s1 = create_single ~hole:hole1 ~particle:particle1
and s2 = create_single ~hole:hole2 ~particle:particle2
in
double_of_singles s1 s2
;;
let to_string = function
| Single (h,p) ->
[ "Single Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h));
"," ;
(MO_class.to_string (Particle.to_mo_class p));
"]"]
|> String.concat ~sep:" "
| Double (h1,p1,h2,p2) ->
[ "Double Exc. : [" ;
(MO_class.to_string (Hole.to_mo_class h1));
"," ;
(MO_class.to_string (Particle.to_mo_class p1));
";" ;
(MO_class.to_string (Hole.to_mo_class h2));
"," ;
(MO_class.to_string (Particle.to_mo_class p2));
"]"]
|> String.concat ~sep:" "
;;

46
ocaml/mo_class.ml Normal file
View File

@ -0,0 +1,46 @@
open Core.Std;;
open Qptypes ;;
type t =
| Core of MO_number.t list
| Inactive of MO_number.t list
| Active of MO_number.t list
| Virtual of MO_number.t list
| Deleted of MO_number.t list
;;
let to_string x =
let print_list l =
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
|> (String.concat ~sep:", ")
in
"("^s^")"
in
match x with
| Core l -> "Core : "^(print_list l)
| Inactive l -> "Inactive : "^(print_list l)
| Active l -> "Active : "^(print_list l)
| Virtual l -> "Virtual : "^(print_list l)
| Deleted l -> "Deleted : "^(print_list l)
;;
let _mo_number_list_of_range range =
Range.of_string range |> List.map ~f:MO_number.of_int
;;
let create_core range = Core (_mo_number_list_of_range range) ;;
let create_inactive range = Inactive (_mo_number_list_of_range range) ;;
let create_active range = Active (_mo_number_list_of_range range) ;;
let create_virtual range = Virtual (_mo_number_list_of_range range) ;;
let create_deleted range = Deleted (_mo_number_list_of_range range) ;;
let to_bitlist x =
match x with
| Core l
| Inactive l
| Active l
| Virtual l
| Deleted l -> Bitlist.of_mo_number_list n_int l
;;

211
ocaml/qp_set_mo_class.ml Normal file
View File

@ -0,0 +1,211 @@
open Qputils;;
open Qptypes;;
open Core.Std;;
(*
* Command-line arguments
* ----------------------
*)
let build_mask from upto n_int =
let from = MO_number.to_int from
and upto = MO_number.to_int upto
and n_int = N_int_number.to_int n_int
in
let rec build_mask bit = function
| 0 -> []
| i ->
if ( i = upto ) then
Bit.One::(build_mask Bit.One (i-1))
else if ( i = from ) then
Bit.One::(build_mask Bit.Zero (i-1))
else
bit::(build_mask bit (i-1))
in
let starting_bit =
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
else Bit.Zero
in
build_mask starting_bit (n_int*64)
|> List.rev
;;
let apply_mask mask n_int mo_tot_num =
let full_mask = build_mask (MO_number.of_int 1) (MO_number.of_int mo_tot_num) n_int in
let occ_mask = build_mask (MO_number.of_int 1) (MO_number.of_int mo_tot_num) n_int in
let virt_mask = Bitlist.not_operator occ_mask
in
let newmask = Bitlist.and_operator occ_mask mask
in
newmask |> Bitlist.to_string |> print_string;
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
Ezfio.set_bitmasks_bit_kind 8;
Ezfio.set_bitmasks_n_mask_gen 1;
let d = newmask
|> Bitlist.to_int64_list
in
let rec append_d = function
| 1 -> List.rev d
| n -> d@(append_d (n-1))
in
let d = append_d 12 in
Ezfio.ezfio_array_of_list ~rank:4 ~dim:([| (N_int_number.to_int n_int) ; 2; 6; 1|]) ~data:d
|> Ezfio.set_bitmasks_generators ;
;;
let failure s =
raise (Failure s)
;;
type t =
| Core
| Inactive
| Active
| Virtual
| Deleted
| None
;;
let t_to_string = function
| Core -> "core"
| Inactive -> "inactive"
| Active -> "active"
| Virtual -> "virtual"
| Deleted -> "deleted"
| None -> assert false
;;
let run ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio_filename =
Ezfio.set_file ezfio_filename ;
if not (Ezfio.has_mo_basis_mo_tot_num ()) then
failure "mo_basis/mo_tot_num not found" ;
let mo_tot_num = Ezfio.get_mo_basis_mo_tot_num () in
let n_int = N_int_number.of_int (Ezfio.get_determinants_n_int ()) in
let mo_class = Array.init mo_tot_num ~f:(fun i -> None) in
let apply_class l =
let rec apply_class t = function
| [] -> ()
| k::tail -> let i = MO_number.to_int k in
begin
match mo_class.(i-1) with
| None -> mo_class.(i-1) <- t ;
apply_class t tail;
| x -> failure
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
i (t_to_string x) (t_to_string t))
end
in
match l with
| MO_class.Core x -> apply_class Core x
| MO_class.Inactive x -> apply_class Inactive x
| MO_class.Active x -> apply_class Active x
| MO_class.Virtual x -> apply_class Virtual x
| MO_class.Deleted x -> apply_class Deleted x
in
MO_class.create_core core |> apply_class ;
MO_class.create_inactive inact |> apply_class ;
MO_class.create_active act |> apply_class ;
MO_class.create_virtual virt |> apply_class ;
MO_class.create_deleted del |> apply_class ;
for i=1 to (Array.length mo_class)
do
if (mo_class.(i-1) = None) then
failure (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
done;
MO_class.create_core core |> MO_class.to_string |> print_endline ;
MO_class.create_inactive inact |> MO_class.to_string |> print_endline ;
MO_class.create_active act |> MO_class.to_string |> print_endline ;
MO_class.create_virtual virt |> MO_class.to_string |> print_endline ;
MO_class.create_deleted del |> MO_class.to_string |> print_endline ;
(*
let inactive_mask = Range.of_string inact
|> List.map ~f:MO_number.of_int
|> Bitlist.of_mo_number_list n_int
and active_mask =
let s = Range.of_string act
in
List.map ~f:MO_number.of_int s
|> Bitlist.of_mo_number_list n_int
in
let mask =
Bitlist.not_operator inactive_mask
|> Bitlist.and_operator active_mask
in apply_mask mask n_int mo_tot_num
*)
;;
let ezfio_file =
let failure filename =
eprintf "'%s' is not an EZFIO file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
begin
match Sys.is_file (filename / ".version") with
| `Yes -> filename
| _ -> failure filename
end
| _ -> failure filename
)
;;
let default range =
let failure filename =
eprintf "'%s' is not a regular file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
begin
match Sys.is_file (filename / ".version") with
| `Yes -> filename
| _ -> failure filename
end
| _ -> failure filename
)
;;
let spec =
let open Command.Spec in
empty
+> flag "core" (optional string) ~doc:"range Range of core orbitals"
+> flag "inact" (optional string) ~doc:"range Range of inactive orbitals"
+> flag "act" (optional string) ~doc:"range Range of active orbitals"
+> flag "virt" (optional string) ~doc:"range Range of virtual orbitals"
+> flag "del" (optional string) ~doc:"range Range of deleted orbitals"
+> anon ("ezfio_filename" %: ezfio_file)
;;
let command =
Command.basic
~summary: "Set the orbital classes in an EZFIO directory"
~readme:(fun () ->
"The range of MOs has the form : \"[36-53,72-107,126-131]\"
")
spec
(fun core inact act virt del ezfio_filename () -> run ?core ?inact ?act ?virt ?del ezfio_filename )
;;
let () =
Command.run command

View File

@ -7,6 +7,8 @@ open Core.Std;;
* that should represent the list of integers
* [ 37 ; 37 ; 38 ; ... ; 52 ; 53 ; 72 ; 73 ; ... ; 106 ; 107 ; 126 ; 127 ; ...
* ; 130 ; 131 ]
*
* or it can be an integer
*)
@ -34,11 +36,15 @@ let expand_range r =
;;
let of_string s =
assert (s.[0] = '[') ;
assert (s.[(String.length s)-1] = ']') ;
let s = String.sub s 1 ((String.length s) - 2) in
let l = String.split ~on:',' s in
let l = List.map ~f:expand_range l in
match s.[0] with
| '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' ->
[ int_of_string s ]
| _ ->
assert (s.[0] = '[') ;
assert (s.[(String.length s)-1] = ']') ;
let s = String.sub s 1 ((String.length s) - 2) in
let l = String.split ~on:',' s in
let l = List.map ~f:expand_range l in
List.concat l |> List.dedup ~compare:Int.compare |> List.sort ~cmp:Int.compare
;;

View File

@ -1,170 +0,0 @@
open Qputils;;
open Qptypes;;
open Core.Std;;
(*
* Command-line arguments
* ----------------------
*)
let build_mask from upto n_int =
let from = MO_number.to_int from
and upto = MO_number.to_int upto
and n_int = N_int_number.to_int n_int
in
let rec build_mask bit = function
| 0 -> []
| i ->
if ( i = upto ) then
Bit.One::(build_mask Bit.One (i-1))
else if ( i = from ) then
Bit.One::(build_mask Bit.Zero (i-1))
else
bit::(build_mask bit (i-1))
in
let starting_bit =
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
else Bit.Zero
in
build_mask starting_bit (n_int*64)
|> List.rev
;;
let mo_tot_num = ref 0;;
let n_int = ref (N_int_number.of_int 1);;
let apply_mask mask =
let full_mask = build_mask (MO_number.of_int 1) (MO_number.of_int !mo_tot_num) !n_int
in
let newmask = Bitlist.and_operator full_mask mask
in
(* TODO *)
newmask |> Bitlist.to_string |> print_endline;
string_of_int !mo_tot_num |> print_endline;
;;
let failure s =
raise (Failure s)
;;
let run ?active ?(inactive="[]") ezfio_filename =
Ezfio.set_file ezfio_filename ;
if not (Ezfio.has_mo_basis_mo_tot_num ()) then
failure "mo_basis/mo_tot_num not found" ;
mo_tot_num := Ezfio.get_mo_basis_mo_tot_num () ;
n_int := N_int_number.of_int (Ezfio.get_determinants_n_int ()) ;
let inactive_mask = Range.of_string inactive
|> List.map ~f:MO_number.of_int
|> Bitlist.of_mo_number_list !n_int
and active_mask =
let s =
match active with
| Some range -> Range.of_string range
| None -> Range.of_string ("[1-"^(Int.to_string !mo_tot_num)^"]")
in
List.map ~f:MO_number.of_int s
|> Bitlist.of_mo_number_list !n_int
in
let mask =
Bitlist.not_operator inactive_mask
|> Bitlist.and_operator active_mask
in apply_mask mask
;;
let ezfio_file =
let failure filename =
eprintf "'%s' is not an EZFIO file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
begin
match Sys.is_file (filename / ".version") with
| `Yes -> filename
| _ -> failure filename
end
| _ -> failure filename
)
;;
let default range =
let failure filename =
eprintf "'%s' is not a regular file.\n%!" filename;
exit 1
in
Command.Spec.Arg_type.create
(fun filename ->
match Sys.is_directory filename with
| `Yes ->
begin
match Sys.is_file (filename / ".version") with
| `Yes -> filename
| _ -> failure filename
end
| _ -> failure filename
)
;;
let spec =
let open Command.Spec in
empty
+> flag "inactive" (optional string) ~doc:"range Range of inactive orbitals"
+> flag "active" (optional string) ~doc:"range Range of active orbitals"
+> anon ("ezfio_filename" %: ezfio_file)
;;
let command =
Command.basic
~summary: "Set the active/inactive orbitals in an EZFIO directory"
~readme:(fun () ->
"The range of MOs has the form : \"[36-53,72-107,126-131]\"
")
spec
(fun inactive active ezfio_filename () -> run ?inactive
?active ezfio_filename )
;;
let () =
Command.run command
(*
let test_module () =
let { Ezfio.rank ; Ezfio.dim ; Ezfio.data } = Ezfio.get_bitmasks_generators () in
let test =
Ezfio.flattened_ezfio_data data
|> Array.to_list
|> List.map Int64.of_int
|> Bitlist.of_int64_list
in
print_string (Bitlist.to_string test);
print_newline ();
print_string (string_of_int (String.length (Bitlist.to_string test)));
print_newline ();
let a = Bitlist.of_int64_list ([-1L;0L])
and b = Bitlist.of_int64_list ([128L;127L])
in begin
print_newline ();
print_newline ();
Bitlist.to_string a |> print_string;
print_newline ();
Bitlist.to_string b |> print_string;
print_newline ();
Bitlist.and_operator a b |> Bitlist.to_string |> print_string;
print_newline ();
Bitlist.or_operator a b |> Bitlist.to_string |> print_string;
print_newline ();
Bitlist.xor_operator a b |> Bitlist.to_string |> print_string;
end
;;
*)
(*test_module ();;*)

20
ocaml/test_excitation.ml Normal file
View File

@ -0,0 +1,20 @@
let test_module () =
let c = MO_class.create_core "[1-4]" in
let i = MO_class.create_inactive "[5-8]" in
let a = MO_class.create_active "[9-13]" in
let v = MO_class.create_virtual "[14-18]" in
let d = MO_class.create_deleted "[18-20]" in
c |> MO_class.to_string |> print_endline ;
i |> MO_class.to_string |> print_endline ;
a |> MO_class.to_string |> print_endline ;
v |> MO_class.to_string |> print_endline ;
d |> MO_class.to_string |> print_endline ;
let b1 = Excitation.create_single i v in
Excitation.to_string b1 |> print_endline;
let b2 = Excitation.create_double i v i a in
Excitation.to_string b2 |> print_endline;
;;
test_module () ;;

View File

@ -103,7 +103,7 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_
! Bitmasks for generator determinants. (N_int, alpha/beta, hole/particle, generator).
! 3rd index is :
! * 1 : hole for single exc
! * 1 : particle for single exc
! * 2 : particle for single exc
! * 3 : hole for 1st exc of double
! * 4 : particle for 1st exc of double
! * 5 : hole for 2dn exc of double