inflexion.ml
2.17 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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