Skip to content
Permalink
Browse files

Splitted base error checks and base stats (new Stats module).

  • Loading branch information
sagotch committed Dec 2, 2019
1 parent 2d798bc commit bafe17f4f195a54eb712620417c4e66183f6cd26
Showing with 146 additions and 138 deletions.
  1. +0 −2 benchmark/bench.ml
  2. +19 −13 bin/db1link/db1link.ml
  3. +11 −6 bin/ged2gwb/ged2gwb.camlp5.ml
  4. +1 −2 lib/api.ml
  5. +2 −113 lib/check.ml
  6. +0 −2 lib/check.mli
  7. +113 −0 lib/stats.ml
@@ -92,9 +92,7 @@ let bench () =
Check.check_base base
(Sys.opaque_identity ignore)
(Sys.opaque_identity ignore)
(fun _ -> true)
(Sys.opaque_identity ignore)
false
end
[ conf ]
:: suite
@@ -1349,25 +1349,31 @@ let link next_family_fun bdir =
in
Hashtbl.clear gen.g_patch_p;
let base = dsk_base in
if !do_check && gen.g_pcnt > 0 then
begin let changed_p (ip, p, o_sex, o_rpar) =
if !do_check && gen.g_pcnt > 0 then begin
let changed_p (ip, p, o_sex, o_rpar) =
let p = Gwdb1.dsk_person_of_person (Gwdb1.OfGwdb.person p) in
let p =
{p with sex = fold_option (fun s -> s) p.sex o_sex;
rparents =
fold_option
(List.map
(Futil.map_relation_ps Gwdb1.OfGwdb.iper
(fun _ -> 0)))
p.rparents o_rpar}
{ p with sex = fold_option (fun s -> s) p.sex o_sex
; rparents =
fold_option
(List.map
(Futil.map_relation_ps Gwdb1.OfGwdb.iper
(fun _ -> 0)))
p.rparents o_rpar }
in
let i = Gwdb1.OfGwdb.iper ip in Hashtbl.replace gen.g_patch_p i p
in
let base = Gwdb1.ToGwdb.base base in
Check.check_base base (set_error base gen) (set_warning base)
(fun i -> gen.g_def.(Gwdb1.OfGwdb.iper i)) changed_p !pr_stats;
flush stdout
end;
Check.check_base
base (set_error base gen) (set_warning base) changed_p ;
if !pr_stats then Stats.(print_stats base @@ stat_base base) ;
Gwdb.Collection.iter begin fun i ->
if not (gen.g_def.(Gwdb1.OfGwdb.iper i))
then
Printf.printf "Undefined: %s\n"
(Gutil.designation base @@ Gwdb.poi base i)
end (Gwdb.ipers base) ;
end ;
if not gen.g_errored then
begin
if !do_consang then
@@ -3607,12 +3607,17 @@ let finish_base base (persons, families, _, _) =
if !try_negative_dates then negative_dates base persons families;
if !do_check then
let base = Gwdb1.ToGwdb.base base in
Check.check_base base
(fun x -> Check.print_base_error !log_oc base x; Printf.fprintf !log_oc "\n")
(function
UndefinedSex _ -> ()
| x -> Check.print_base_warning !log_oc base x; Printf.fprintf !log_oc "\n")
(fun _ -> true) (fun _ -> ()) false;
let base_error x =
Check.print_base_error !log_oc base x ;
Printf.fprintf !log_oc "\n"
in
let base_warning = function
| UndefinedSex _ -> ()
| x ->
Check.print_base_warning !log_oc base x ;
Printf.fprintf !log_oc "\n"
in
Check.check_base base base_error base_warning ignore ;
flush !log_oc
let output_command_line bname =
@@ -780,8 +780,7 @@ let print_base_warnings conf base =
let errors = ref [] in
let warnings = ref [] in
Check.check_base base
(Api_warnings.set_list errors) (Api_warnings.set_list warnings)
(fun _ -> true) (fun _ -> ()) false;
(Api_warnings.set_list errors) (Api_warnings.set_list warnings) ignore ;
(* On rend la liste unique, parce qu'il se peut qu'un warning soit *)
(* levé par plusieurs fonctions différents selon le context. *)
let warnings =
@@ -208,80 +208,9 @@ let print_base_warning oc base =
| YoungForMarriage (p, a) ->
Printf.fprintf oc "%s married at age %d\n" (designation base p) a.year

type stats =
{ mutable men : int;
mutable women : int;
mutable neutre : int;
mutable noname : int;
mutable oldest_father : int * person;
mutable oldest_mother : int * person;
mutable youngest_father : int * person;
mutable youngest_mother : int * person;
mutable oldest_dead : int * person;
mutable oldest_still_alive : int * person }

let birth_year p =
match Adef.od_of_cdate (get_birth p) with
Some d ->
begin match d with
Dgreg ({year = y; prec = Sure}, _) -> Some y
| _ -> None
end
| _ -> None

let death_year current_year p =
match get_death p with
Death (_, d) ->
begin match Adef.date_of_cdate d with
Dgreg ({year = y; prec = Sure}, _) -> Some y
| _ -> None
end
| NotDead -> Some current_year
| _ -> None

let update_stats base current_year s p =
begin match get_sex p with
Male -> s.men <- s.men + 1
| Female -> s.women <- s.women + 1
| Neuter -> s.neutre <- s.neutre + 1
end;
if p_first_name base p = "?" && p_surname base p = "?" then
s.noname <- s.noname + 1;
begin match birth_year p, death_year current_year p with
Some y1, Some y2 ->
let age = y2 - y1 in
if age > fst s.oldest_dead && get_death p <> NotDead then
s.oldest_dead <- age, p;
if age > fst s.oldest_still_alive && get_death p = NotDead then
s.oldest_still_alive <- age, p
| _ -> ()
end;
match birth_year p, get_parents p with
Some y2, Some ifam ->
let cpl = foi base ifam in
begin match birth_year (poi base (get_father cpl)) with
Some y1 ->
let age = y2 - y1 in
if age > fst s.oldest_father then
s.oldest_father <- age, poi base (get_father cpl);
if age < fst s.youngest_father then
s.youngest_father <- age, poi base (get_father cpl)
| _ -> ()
end;
begin match birth_year (poi base (get_mother cpl)) with
Some y1 ->
let age = y2 - y1 in
if age > fst s.oldest_mother then
s.oldest_mother <- age, poi base (get_mother cpl);
if age < fst s.youngest_mother then
s.youngest_mother <- age, poi base (get_mother cpl)
| _ -> ()
end
| _ -> ()

let min_year_of p =
match Adef.od_of_cdate (get_birth p) with
Some (Dgreg (d, _)) -> Some d.year
| Some (Dgreg (d, _)) -> Some d.year
| Some (Dtext _) | None -> None

let rec check_ancestors base warning year year_tab ip ini_p =
@@ -310,7 +239,7 @@ let rec check_ancestors base warning year year_tab ip ini_p =
f get_mother
| None -> ()

let check_base_aux base error warning changed_p =
let check_base base error warning changed_p =
Printf.eprintf "check persons\n";
let persons = Gwdb.ipers base in
let len = Gwdb.Collection.length persons in
@@ -337,43 +266,3 @@ let check_base_aux base error warning changed_p =
) families ;
ProgrBar.finish ();
Consang.check_noloop base error

let check_base base error warning def changed_p pr_stats =
let s =
let y = 1000, poi base Gwdb.dummy_iper in
let o = 0, poi base Gwdb.dummy_iper in
{men = 0; women = 0; neutre = 0; noname = 0; oldest_father = o;
oldest_mother = o; youngest_father = y; youngest_mother = y;
oldest_dead = o; oldest_still_alive = o}
in
let current_year = (Unix.localtime (Unix.time ())).Unix.tm_year + 1900 in
check_base_aux base error warning changed_p;
Gwdb.Collection.iter (fun i ->
let p = poi base i in
if not (def i) then Printf.printf "Undefined: %s\n" (designation base p);
if pr_stats then update_stats base current_year s p;
flush stdout
) (Gwdb.ipers base) ;
if pr_stats then
begin
Printf.printf "\n";
Printf.printf "%d men\n" s.men;
Printf.printf "%d women\n" s.women;
Printf.printf "%d unknown sex\n" s.neutre;
Printf.printf "%d unnamed\n" s.noname;
Printf.printf "Oldest: %s, %d\n" (designation base (snd s.oldest_dead))
(fst s.oldest_dead);
Printf.printf "Oldest still alive: %s, %d\n"
(designation base (snd s.oldest_still_alive))
(fst s.oldest_still_alive);
Printf.printf "Youngest father: %s, %d\n"
(designation base (snd s.youngest_father)) (fst s.youngest_father);
Printf.printf "Youngest mother: %s, %d\n"
(designation base (snd s.youngest_mother)) (fst s.youngest_mother);
Printf.printf "Oldest father: %s, %d\n"
(designation base (snd s.oldest_father)) (fst s.oldest_father);
Printf.printf "Oldest mother: %s, %d\n"
(designation base (snd s.oldest_mother)) (fst s.oldest_mother);
Printf.printf "\n";
flush stdout
end
@@ -11,7 +11,5 @@ val check_base
: base
-> (CheckItem.base_error -> unit)
-> (CheckItem.base_warning -> unit)
-> (iper -> bool)
-> (iper * person * Def.sex option * relation list option -> unit)
-> bool
-> unit
@@ -0,0 +1,113 @@
open Def
open Gwdb

type stats =
{ mutable men : int
; mutable women : int
; mutable neutre : int
; mutable noname : int
; mutable oldest_father : int * person
; mutable oldest_mother : int * person
; mutable youngest_father : int * person
; mutable youngest_mother : int * person
; mutable oldest_dead : int * person
; mutable oldest_still_alive : int * person
}

let birth_year p =
match Adef.od_of_cdate (get_birth p) with
| Some (Dgreg ( { year ; prec = Sure}, _)) -> Some year
| _ -> None

let death_year current_year p =
match get_death p with
| Death (_, d) ->
begin match Adef.date_of_cdate d with
| Dgreg ({year = y; prec = Sure}, _) -> Some y
| _ -> None
end
| NotDead -> Some current_year
| _ -> None

let update_stats base current_year s p =
begin match get_sex p with
| Male -> s.men <- s.men + 1
| Female -> s.women <- s.women + 1
| Neuter -> s.neutre <- s.neutre + 1
end;
if is_quest_string (get_first_name p)
&& is_quest_string (get_surname p)
then s.noname <- s.noname + 1 ;
begin match birth_year p, death_year current_year p with
| Some y1, Some y2 ->
let age = y2 - y1 in
if age > fst s.oldest_dead && get_death p <> NotDead
then s.oldest_dead <- age, p;
if age > fst s.oldest_still_alive && get_death p = NotDead
then s.oldest_still_alive <- age, p
| _ -> ()
end ;
match birth_year p, get_parents p with
| Some y2, Some ifam ->
let cpl = foi base ifam in
begin match birth_year (poi base (get_father cpl)) with
| Some y1 ->
let age = y2 - y1 in
if age > fst s.oldest_father
then s.oldest_father <- age, poi base (get_father cpl) ;
if age < fst s.youngest_father
then s.youngest_father <- age, poi base (get_father cpl)
| _ -> ()
end ;
begin match birth_year (poi base (get_mother cpl)) with
| Some y1 ->
let age = y2 - y1 in
if age > fst s.oldest_mother
then s.oldest_mother <- age, poi base (get_mother cpl) ;
if age < fst s.youngest_mother
then s.youngest_mother <- age, poi base (get_mother cpl)
| _ -> ()
end
| _ -> ()

let stat_base : base -> stats = fun base ->
let s =
let y = 1000, poi base Gwdb.dummy_iper in
let o = 0, poi base Gwdb.dummy_iper in
{men = 0; women = 0; neutre = 0; noname = 0; oldest_father = o;
oldest_mother = o; youngest_father = y; youngest_mother = y;
oldest_dead = o; oldest_still_alive = o}
in
let current_year = (Unix.localtime (Unix.time ())).Unix.tm_year + 1900 in
Gwdb.Collection.iter begin fun p ->
update_stats base current_year s p;
flush stdout
end (Gwdb.persons base) ;
s

let print_stats : base -> stats -> unit = fun base s ->
Printf.printf "\n";
Printf.printf "%d men\n" s.men;
Printf.printf "%d women\n" s.women;
Printf.printf "%d unknown sex\n" s.neutre;
Printf.printf "%d unnamed\n" s.noname;
Printf.printf "Oldest: %s, %d\n"
(Gutil.designation base (snd s.oldest_dead))
(fst s.oldest_dead);
Printf.printf "Oldest still alive: %s, %d\n"
(Gutil.designation base (snd s.oldest_still_alive))
(fst s.oldest_still_alive);
Printf.printf "Youngest father: %s, %d\n"
(Gutil.designation base (snd s.youngest_father))
(fst s.youngest_father);
Printf.printf "Youngest mother: %s, %d\n"
(Gutil.designation base (snd s.youngest_mother))
(fst s.youngest_mother);
Printf.printf "Oldest father: %s, %d\n"
(Gutil.designation base (snd s.oldest_father))
(fst s.oldest_father);
Printf.printf "Oldest mother: %s, %d\n"
(Gutil.designation base (snd s.oldest_mother))
(fst s.oldest_mother);
Printf.printf "\n" ;
flush stdout

0 comments on commit bafe17f

Please sign in to comment.
You can’t perform that action at this time.