mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-12-22 04:13:31 +01:00
Accelerated qmcchem result
This commit is contained in:
parent
6798019161
commit
97e47f8a85
112
ocaml/Block.ml
112
ocaml/Block.ml
@ -94,39 +94,37 @@ let to_bytes b =
|
|||||||
let result =
|
let result =
|
||||||
Bytes.concat Bytes.empty (zero :: l)
|
Bytes.concat Bytes.empty (zero :: l)
|
||||||
in
|
in
|
||||||
Bytes.set_int64_le result 0 (Int64.of_int ((Bytes.length result) - 8));
|
Bytes.set_int64_ne result 0 (Int64.of_int ((Bytes.length result) - 8));
|
||||||
result
|
result
|
||||||
|
|
||||||
|
|
||||||
let read_bytes b =
|
let read_bytes b idx =
|
||||||
(* Reads m, the first 8 bytes as an int64 containing the number of bytes to read.
|
(* Reads m, the first 8 bytes as an int64 containing the number of bytes to read.
|
||||||
Then, read the next m bytes and return a tuple containing the decoded data and the rest.
|
Then, read the next m bytes and return a tuple containing the decoded data and the rest.
|
||||||
*)
|
*)
|
||||||
let l = Bytes.length b in
|
let l = (Bytes.length b) - idx in
|
||||||
if l < 8 then
|
if l < 8 then
|
||||||
failwith "Zero-sized bytes"
|
None
|
||||||
else
|
else
|
||||||
let m =
|
let m =
|
||||||
Bytes.get_int64_le b 0
|
Bytes.get_int64_ne b idx
|
||||||
|> Int64.to_int
|
|> Int64.to_int
|
||||||
in
|
in
|
||||||
let nl = l-m-8 in
|
Some (Bytes.sub b (idx+8) m, idx+8+m)
|
||||||
if nl > 0 then
|
|
||||||
(Bytes.sub b 8 m, Some (Bytes.sub b (8+m) nl))
|
|
||||||
else
|
|
||||||
(Bytes.sub b 8 m, None)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let of_bytes b =
|
let of_bytes b =
|
||||||
|
(*
|
||||||
let rec loop accu s =
|
let rec loop accu s =
|
||||||
match read_bytes s with
|
match read_bytes s with
|
||||||
| data, None -> List.rev (data :: accu)
|
| None -> []
|
||||||
| data, (Some rest) -> loop (data :: accu) rest
|
| Some (data, None) -> (data :: accu)
|
||||||
|
| Some (data, (Some rest)) -> loop (data :: accu) rest
|
||||||
in
|
in
|
||||||
let result =
|
let result =
|
||||||
match loop [] b with
|
match loop [] b with
|
||||||
| property :: value :: weight :: pid :: block_id :: compute_node :: [] ->
|
| compute_node :: block_id :: pid :: weight :: value :: property :: [] ->
|
||||||
Some
|
Some
|
||||||
{ property = Property.of_bytes property;
|
{ property = Property.of_bytes property;
|
||||||
value = Sample.of_bytes value;
|
value = Sample.of_bytes value;
|
||||||
@ -137,6 +135,33 @@ let of_bytes b =
|
|||||||
}
|
}
|
||||||
| _ -> None
|
| _ -> None
|
||||||
in
|
in
|
||||||
|
*)
|
||||||
|
let get_x s idx =
|
||||||
|
match read_bytes s idx with
|
||||||
|
| Some ( data, i1) -> data, i1
|
||||||
|
| _ -> raise Exit
|
||||||
|
in
|
||||||
|
|
||||||
|
|
||||||
|
let result =
|
||||||
|
let idx=0 in
|
||||||
|
try
|
||||||
|
let property, idx = get_x b idx in
|
||||||
|
let value , idx = get_x b idx in
|
||||||
|
let weight , idx = get_x b idx in
|
||||||
|
let pid , idx = get_x b idx in
|
||||||
|
let block_id, idx = get_x b idx in
|
||||||
|
let compute_node, i5 = get_x b idx in
|
||||||
|
Some
|
||||||
|
{ property = Property.of_bytes property;
|
||||||
|
value = Sample.of_bytes value;
|
||||||
|
weight = Weight.of_bytes weight;
|
||||||
|
pid = int_of_bytes pid;
|
||||||
|
block_id = Block_id.of_bytes block_id;
|
||||||
|
compute_node = Compute_node.of_bytes compute_node;
|
||||||
|
}
|
||||||
|
with Exit -> None
|
||||||
|
in
|
||||||
result
|
result
|
||||||
|
|
||||||
|
|
||||||
@ -195,6 +220,35 @@ let update_raw_data ?(locked=true) () =
|
|||||||
) result
|
) result
|
||||||
in
|
in
|
||||||
|
|
||||||
|
if Qmcchem_config.binary_io then
|
||||||
|
begin
|
||||||
|
let result =
|
||||||
|
let rec aux buf idx accu =
|
||||||
|
(* Read one block *)
|
||||||
|
match read_bytes buf idx with
|
||||||
|
| None -> List.rev accu
|
||||||
|
| Some (item, new_idx) ->
|
||||||
|
match of_bytes item with
|
||||||
|
| None -> List.rev accu
|
||||||
|
| Some item -> (aux [@tailcall]) buf new_idx (item::accu)
|
||||||
|
in
|
||||||
|
List.concat_map (fun filename ->
|
||||||
|
let ic = open_in filename in
|
||||||
|
let length = in_channel_length ic in
|
||||||
|
let result =
|
||||||
|
if length > 0 then
|
||||||
|
let buf = Bytes.create length in
|
||||||
|
really_input ic buf 0 length;
|
||||||
|
aux buf 0 []
|
||||||
|
else []
|
||||||
|
in
|
||||||
|
close_in ic;
|
||||||
|
result ) files
|
||||||
|
in
|
||||||
|
result
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
let rec transform new_list = function
|
let rec transform new_list = function
|
||||||
| [] -> new_list
|
| [] -> new_list
|
||||||
| head :: tail ->
|
| head :: tail ->
|
||||||
@ -205,38 +259,6 @@ let update_raw_data ?(locked=true) () =
|
|||||||
| Some x -> transform (x::new_list) tail
|
| Some x -> transform (x::new_list) tail
|
||||||
in
|
in
|
||||||
|
|
||||||
if Qmcchem_config.binary_io then
|
|
||||||
begin
|
|
||||||
let result =
|
|
||||||
let rec aux buf accu =
|
|
||||||
(* Read one block *)
|
|
||||||
let item, rest =
|
|
||||||
read_bytes buf
|
|
||||||
in
|
|
||||||
match of_bytes item with
|
|
||||||
| None -> []
|
|
||||||
| Some item ->
|
|
||||||
match rest with
|
|
||||||
| None -> List.rev (item::accu)
|
|
||||||
| Some rest -> (aux [@tailcall]) rest (item::accu)
|
|
||||||
in
|
|
||||||
List.concat_map (fun filename ->
|
|
||||||
let ic = open_in filename in
|
|
||||||
let length = in_channel_length ic in
|
|
||||||
let result =
|
|
||||||
if length > 0 then
|
|
||||||
let buf = Bytes.create length in
|
|
||||||
really_input ic buf 0 length;
|
|
||||||
aux buf []
|
|
||||||
else []
|
|
||||||
in
|
|
||||||
close_in ic;
|
|
||||||
result ) files
|
|
||||||
in
|
|
||||||
result
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
let result =
|
let result =
|
||||||
let rec aux ic accu =
|
let rec aux ic accu =
|
||||||
let l =
|
let l =
|
||||||
|
@ -139,7 +139,7 @@ let display_summary ~range =
|
|||||||
and print_property property =
|
and print_property property =
|
||||||
let p = Random_variable.of_raw_data ~range property
|
let p = Random_variable.of_raw_data ~range property
|
||||||
in
|
in
|
||||||
Printf.printf "%20s : %s\n"
|
Printf.printf "%20s : %s\n%!"
|
||||||
(Property.to_string property)
|
(Property.to_string property)
|
||||||
(Random_variable.to_string p)
|
(Random_variable.to_string p)
|
||||||
in
|
in
|
||||||
|
@ -50,7 +50,7 @@ let to_bytes = function
|
|||||||
let b = Bytes.create (8 * Array.length x) in
|
let b = Bytes.create (8 * Array.length x) in
|
||||||
Array.iteri (fun i x ->
|
Array.iteri (fun i x ->
|
||||||
Int64.bits_of_float x
|
Int64.bits_of_float x
|
||||||
|> Bytes.set_int64_le b (i*8) ) x;
|
|> Bytes.set_int64_ne b (i*8) ) x;
|
||||||
b
|
b
|
||||||
|
|
||||||
let of_bytes b =
|
let of_bytes b =
|
||||||
@ -59,6 +59,6 @@ let of_bytes b =
|
|||||||
One_dimensional x
|
One_dimensional x
|
||||||
| l -> let len = l/8 in
|
| l -> let len = l/8 in
|
||||||
Multidimensional ( Array.init len (fun i ->
|
Multidimensional ( Array.init len (fun i ->
|
||||||
Bytes.get_int64_le b (i*8)
|
Bytes.get_int64_ne b (i*8)
|
||||||
|> Int64.float_of_bits ),
|
|> Int64.float_of_bits ),
|
||||||
len )
|
len )
|
||||||
|
@ -177,7 +177,7 @@ let input_ezfio = "
|
|||||||
let untouched = "
|
let untouched = "
|
||||||
let bytes_of_int64 i =
|
let bytes_of_int64 i =
|
||||||
let result = Bytes.create 8 in
|
let result = Bytes.create 8 in
|
||||||
Bytes.set_int64_le result 0 i;
|
Bytes.set_int64_ne result 0 i;
|
||||||
result
|
result
|
||||||
|
|
||||||
let bytes_of_int i =
|
let bytes_of_int i =
|
||||||
@ -186,7 +186,7 @@ let bytes_of_int i =
|
|||||||
|
|
||||||
|
|
||||||
let int64_of_bytes b =
|
let int64_of_bytes b =
|
||||||
Bytes.get_int64_le b 0
|
Bytes.get_int64_ne b 0
|
||||||
|
|
||||||
|
|
||||||
let int_of_bytes b =
|
let int_of_bytes b =
|
||||||
|
Loading…
Reference in New Issue
Block a user