open Types open Xstd (* let alt_adj = "alt-adj.tab" let stem_adj = "stem-adj.tab" let rules_adj = "freq_rules-adj.tab" *) let alt_all = "alt.tab" let stem_all = "stem.tab" let rules_all = "freq_rules.tab" let resource_path = "../resources/SGJP/" let load_stems filename = File.fold_tab filename StringMap.empty (fun stems -> function [stem; lemma_suf; ids] -> let ids = StringSet.of_list (Xstring.split " " ids) in StringMap.add_inc stems stem ids (fun set -> StringSet.union set ids) | l -> failwith ("load_stems: " ^ String.concat " " l)) let prepare_inflexion resource_path alt_filename stem_filename rules_filename = let alt = Dict.load_tab (resource_path ^ alt_filename) in let alt = Xlist.fold alt StringMap.empty (fun alt entry -> Xlist.fold entry.forms alt (fun alt form -> let simple_lemma = Stem.simplify_lemma entry.lemma in let v = simple_lemma, form.interp, 1, [] in StringMap.add_inc alt form.orth [v] (fun l -> v :: l))) in let stems = load_stems (resource_path ^ stem_filename) in let rules = Rules.load_freq_rules (resource_path ^ rules_filename) in let rules = Rules.CharTrees.create rules in alt,stems,rules (* let alt,stems,rules = prepare_inflexion resource_path alt_adj stem_adj rules_adj *) (* let alt,stems,rules = prepare_inflexion resource_path alt_all stem_all rules_all *) (* let get_interpretations orth = let candidates = Rules.CharTrees.find rules orth in let found = try StringMap.find alt orth with Not_found -> [] in let found = Xlist.fold candidates found (fun found (stem,rule) -> (* Printf.printf "%s\t%s\n%!" stem (Rules.string_of_freq_rule rule); *) let ids = try StringMap.find stems stem with Not_found -> StringSet.empty in if not (StringSet.mem ids rule.id) && rule.star <> Productive then found else let tags = if StringSet.mem ids rule.id then [] else ["lemma not validated"] in (stem ^ rule.set, rule.interp, rule.freq, tags) :: found) in let found = (orth,"unk",1,["token not found"]) :: found in let valid = Xlist.fold found [] (fun valid -> function lemma,interp,quantity,[] -> (lemma,interp,quantity,[]) :: valid | _ -> valid) in if valid = [] then found else valid *)