Skip to content
Permalink
Browse files

API: Fixed place autocomplete for big trees (> 100 000 ind)

  • Loading branch information...
sagotch committed Sep 9, 2019
1 parent 14510d1 commit e00272cf0e5ee97bb12966c6346750d4bf4c2548
Showing with 82 additions and 82 deletions.
  1. +4 −7 lib/api_saisie_autocomplete.ml
  2. +3 −1 lib/api_saisie_write.ml
  3. +75 −74 lib/api_search.ml
@@ -10,7 +10,7 @@ open Util
module IstrSet = Set.Make (struct type t = Gwdb.istr let compare = compare end) module IstrSet = Set.Make (struct type t = Gwdb.istr let compare = compare end)


(** Create cache files used by autocomplete *) (** Create cache files used by autocomplete *)
let create_cache conf base mode place_mode cache_file = let create_cache base mode cache_file =
let add acc x = if not (is_empty_string x) then IstrSet.add x acc else acc in let add acc x = if not (is_empty_string x) then IstrSet.add x acc else acc in
let cache = let cache =
match mode with match mode with
@@ -51,15 +51,12 @@ let create_cache conf base mode place_mode cache_file =
(Gwdb.families base) (Gwdb.families base)
in in
let cache = List.rev_map (sou base) (IstrSet.elements cache) in let cache = List.rev_map (sou base) (IstrSet.elements cache) in
let cache =
Opt.map_default cache (fun m -> List.rev_append (Api_search.load_dico_lieu conf m) cache) place_mode
in
let cache = List.sort Gutil.alphabetic_order cache in let cache = List.sort Gutil.alphabetic_order cache in
let oc = Secure.open_out_bin cache_file in let oc = Secure.open_out_bin cache_file in
Marshal.to_channel oc cache [ Marshal.No_sharing ] ; Marshal.to_channel oc cache [ Marshal.No_sharing ] ;
close_out oc close_out oc


let rec get_list_from_cache ?(retry = true) conf base mode place_mode max_res s = let rec get_list_from_cache ?(retry = true) conf base mode max_res s =
let bfile = base_path [] (conf.bname ^ ".gwb") in let bfile = base_path [] (conf.bname ^ ".gwb") in
let cache_file = let cache_file =
match mode with match mode with
@@ -72,7 +69,7 @@ let rec get_list_from_cache ?(retry = true) conf base mode place_mode max_res s
let stats = Unix.stat cache_file in let stats = Unix.stat cache_file in
let last_mod = conf.ctime -. stats.Unix.st_mtime in let last_mod = conf.ctime -. stats.Unix.st_mtime in
if stats.Unix.st_size = 0 || last_mod > 3600. if stats.Unix.st_size = 0 || last_mod > 3600.
then create_cache conf base mode place_mode cache_file ; then create_cache base mode cache_file ;
let ic = Secure.open_in_bin cache_file in let ic = Secure.open_in_bin cache_file in
try try
let cache : string list = Marshal.from_channel ic in let cache : string list = Marshal.from_channel ic in
@@ -96,7 +93,7 @@ let rec get_list_from_cache ?(retry = true) conf base mode place_mode max_res s
| _ when retry -> | _ when retry ->
close_in ic ; close_in ic ;
Sys.remove cache_file ; Sys.remove cache_file ;
get_list_from_cache ~retry:false conf base mode place_mode max_res s ; get_list_from_cache ~retry:false conf base mode max_res s ;
| e -> | e ->
close_in ic ; close_in ic ;
raise e raise e
@@ -35,7 +35,9 @@ let print_auto_complete conf base =
let place_mode = params.Mwrite.Auto_complete.place_field in let place_mode = params.Mwrite.Auto_complete.place_field in
let list = let list =
if nb_of_persons base > 100000 then if nb_of_persons base > 100000 then
Api_saisie_autocomplete.get_list_from_cache conf base mode place_mode max_res s let cache = Api_saisie_autocomplete.get_list_from_cache conf base mode max_res s in
let ini = Name.lower @@ Mutil.tr '_' ' ' s in
Api_search.complete_with_dico conf (ref @@ List.length cache) max_res place_mode ini cache
else else
Api_search.search_auto_complete conf base mode place_mode max_res s Api_search.search_auto_complete conf base mode place_mode max_res s
in in
@@ -628,14 +628,71 @@ let load_dico_lieu conf pl_mode =
list list
with Sys_error _ -> [] with Sys_error _ -> []



let get_field mode = let get_field mode =
match mode with match mode with
| `lastname -> get_surname | `lastname -> get_surname
| `firstname -> get_first_name | `firstname -> get_first_name
| _ -> failwith "get_field" | _ -> failwith "get_field"


let search_auto_complete conf base mode place_mode max_res n = (** [ini] must be in the form of [Name.lower @@ Mutil.tr '_' ' ' ini] *)
let complete_with_dico conf nb max mode ini list =
let reduce_dico mode ignored format list =
let rec loop acc = function
| [] -> acc
| hd :: tl ->
let acc =
let k = Mutil.tr '_' ' ' hd in
let k = if mode <> `subdivision then UpdateData.remove_suburb k else k in
if string_start_with ini (Name.lower k) then begin
let hd =
if format <> []
then
let expl_hd = String.split_on_char ',' hd in
String.concat ", " @@
Util.filter_map begin function
| `town -> List.nth_opt expl_hd 0
| `area_code -> List.nth_opt expl_hd 1
| `county -> List.nth_opt expl_hd 2
| `region -> List.nth_opt expl_hd 3
| `country -> List.nth_opt expl_hd 4
| _ -> None
end
format
else
hd
in
if List.mem hd ignored then acc
else begin incr nb ; hd :: acc end
end
else acc
in
if !nb < max then loop acc tl else acc
in loop [] list
in
match mode with
| Some mode when !nb < max ->
let format =
match p_getenv conf.base_env "places_format" with
| None -> []
| Some s ->
List.map begin function
| "Subdivision" -> `subdivision
| "Town" -> `town
| "Area code" -> `area_code
| "County" -> `county
| "Region" -> `region
| "Country" -> `country
| _ -> raise Not_found
end
(String.split_on_char ',' s)
in
let dico_place = reduce_dico mode list format (load_dico_lieu conf mode) in
List.rev_append
(List.sort (fun a b -> Gutil.alphabetic_order b a) list)
(List.sort Gutil.alphabetic_order dico_place)
| _ -> List.sort Gutil.alphabetic_order list

let search_auto_complete conf base mode place_mode max n =
let aux data = let aux data =
let conf = { conf with env = ("data", data) :: conf.env } in let conf = { conf with env = ("data", data) :: conf.env } in
UpdateData.get_all_data conf base UpdateData.get_all_data conf base
@@ -645,106 +702,50 @@ let search_auto_complete conf base mode place_mode max_res n =


| `place -> | `place ->
let list = aux "place" in let list = aux "place" in
let nb_res = ref 0 in let nb = ref 0 in
let ini = Name.lower @@ Mutil.tr '_' ' ' n in let ini = Name.lower @@ Mutil.tr '_' ' ' n in
let place_format =
match p_getenv conf.base_env "places_format" with
| None -> []
| Some s ->
try
List.map
(function
| "Subdivision" -> `subdivision
| "Town" -> `town
| "Area code" -> `area_code
| "County" -> `county
| "Region" -> `region
| "Country" -> `country
| _ -> raise Not_found)
(String.split_on_char ',' s)
with Not_found -> []
in
let reduce_perso list = let reduce_perso list =
List.fold_left begin fun acc str ->
let str' =
if place_mode <> Some `subdivision
then UpdateData.remove_suburb str
else str
in
if Mutil.start_with ~wildcard:true ini 0 @@ Name.lower @@ Mutil.tr '_' ' ' str'
then str :: acc
else acc
end [] list
in
let reduce_dico ignored list =
let rec loop acc = function let rec loop acc = function
| [] -> acc | [] -> acc
| hd :: tl -> | hd :: tl ->
let hd' =
if place_mode <> Some `subdivision
then UpdateData.remove_suburb hd
else hd
in
let acc = let acc =
let k = Mutil.tr '_' ' ' hd in if Mutil.start_with ~wildcard:true ini 0 @@ Name.lower @@ Mutil.tr '_' ' ' hd'
let k = then (incr nb ; hd :: acc)
if place_mode <> Some `subdivision
then UpdateData.remove_suburb k
else k
in
if string_start_with ini (Name.lower k) then begin
let hd =
if place_format <> [] then
let expl_hd = String.split_on_char ',' hd in
String.concat ", " @@
Util.filter_map begin function
| `town -> List.nth_opt expl_hd 0
| `area_code -> List.nth_opt expl_hd 1
| `county -> List.nth_opt expl_hd 2
| `region -> List.nth_opt expl_hd 3
| `country -> List.nth_opt expl_hd 4
| _ -> None
end
place_format
else
hd
in
if List.mem hd ignored then acc
else begin incr nb_res ; hd :: acc end
end
else acc else acc
in in
if !nb_res < max_res then loop acc tl else acc if !nb < max then loop acc tl else acc
in loop [] list in
loop [] list
in in

complete_with_dico conf nb max place_mode ini (reduce_perso list)
let base_place : string list = reduce_perso list in
begin match place_mode with
| Some pl_mode when !nb_res < max_res ->
let dico_place = reduce_dico base_place (load_dico_lieu conf pl_mode) in
List.rev_append
(List.sort (fun a b -> Gutil.alphabetic_order b a) base_place)
(List.sort Gutil.alphabetic_order dico_place)
| _ -> List.sort Gutil.alphabetic_order base_place
end


| `source -> | `source ->
let list = aux "src" in let list = aux "src" in
let nb_res = ref 0 in let nb = ref 0 in
let ini = Name.lower @@ Mutil.tr '_' ' ' n in let ini = Name.lower @@ Mutil.tr '_' ' ' n in
let rec reduce acc = function let rec reduce acc = function
| [] -> acc | [] -> acc
| hd :: tl -> | hd :: tl ->
let k = Mutil.tr '_' ' ' hd in let k = Mutil.tr '_' ' ' hd in
let acc = let acc =
if string_start_with ini (Name.lower k) if string_start_with ini (Name.lower k)
then (incr nb_res ; hd :: acc) then (incr nb ; hd :: acc)
else acc else acc
in in
if !nb_res < max_res then reduce acc tl if !nb < max then reduce acc tl
else acc else acc
in in
List.sort Gutil.alphabetic_order (reduce [] list) List.sort Gutil.alphabetic_order (reduce [] list)


| _ -> | _ ->
if Name.lower n = "" then [] if Name.lower n = "" then []
else ( load_strings_array base else ( load_strings_array base
; select_start_with_auto_complete base mode max_res n ) ; select_start_with_auto_complete base mode max n )


let select_both_link_person base ini_n ini_p max_res = let select_both_link_person base ini_n ini_p max_res =
let find_sn p x = kmp x (sou base (get_surname p)) in let find_sn p x = kmp x (sou base (get_surname p)) in

0 comments on commit e00272c

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