ENIAMwalReduce.ml
5.08 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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
(*
* ENIAMwalenty, an interface for Polish Valence Dictionary "Walenty".
* Copyright (C) 2016 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
* Copyright (C) 2016 Institute of Computer Science Polish Academy of Sciences
*
* This library is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
open ENIAMwalTypes
open Xstd
(* let rec assign_pro_args schema =
Xlist.map schema (fun s ->
let morfs = match s.morfs with
(E p) :: l -> E Pro :: (E p) :: l
| [LexPhrase _] as morfs -> morfs
| [Phrase(FixedP _)] as morfs -> morfs
| [Phrase(Lex _)] as morfs -> morfs
(* | [Phrase Refl] as morfs -> morfs
| [Phrase Recip] as morfs -> morfs*)
| Phrase Null :: _ as morfs -> morfs
| Phrase Pro :: _ as morfs -> morfs
| morfs -> if s.gf <> SUBJ && s.cr = [] && s.ce = [] then (Phrase Null) :: morfs else (Phrase Pro) :: morfs in (* FIXME: ustalić czy są inne przypadki uzgodnienia *)
(* let morfs = assign_pro_args_lex morfs in *) (* bez pro wewnątrz leksykalizacji *)
{s with morfs=morfs}) *)
(*let assign_pro_args_lex morfs =
Xlist.map morfs (function
Lex(morf,specs,lex,restr) -> LexN(morf,specs,lex,assign_pro_args_restr restr)
| LexNum(morf,lex1,lex2,restr) -> LexNum(morf,lex1,lex2,assign_pro_args_restr restr)
| LexCompar(morf,l) -> LexCompar(morf,make_gfs_lex l)
| morf -> morf)
and assign_pro_args_restr = function
Natr -> Natr
| Ratr1 schema -> Ratr1(assign_pro_args schema)
| Atr1 schema -> Atr1(assign_pro_args schema)
| Ratr schema -> Ratr(assign_pro_args schema)
| Atr schema -> Atr(assign_pro_args schema)*)
exception ImpossibleSchema
let rec reduce_comp lexemes = function
Comp s -> if StringMap.mem lexemes s then Comp s else raise Not_found
| Zeby -> if StringMap.mem lexemes "żeby" || StringMap.mem lexemes "że" then Zeby else raise Not_found
| Gdy -> if StringMap.mem lexemes "gdy" || StringMap.mem lexemes "gdyby" then Gdy else raise Not_found
| CompUndef -> failwith "reduce_comp"
let reduce_phrase comprep_reqs lexemes = function
| PrepNP(prep,case) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
| PrepAdjP(prep,case) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
| ComprepNP(prep) as phrase -> if Xlist.fold (try StringMap.find comprep_reqs prep with Not_found -> []) true (fun b s -> b && StringMap.mem lexemes s) then phrase else raise Not_found
| ComparP(prep) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
| CP(ctype,comp) -> CP(ctype,reduce_comp lexemes comp)
| NCP(case,ctype,comp) -> if StringMap.mem lexemes "to" then NCP(case,ctype,reduce_comp lexemes comp) else raise Not_found
| PrepNCP(prep,case,ctype,comp) -> if StringMap.mem lexemes prep && StringMap.mem lexemes "to" then PrepNCP(prep,case,ctype,reduce_comp lexemes comp) else raise Not_found
| SimpleLexArg(lemma,_) as phrase -> if StringMap.mem lexemes lemma then phrase else raise Not_found
| LexArg(_,lemma,_) as phrase -> if StringMap.mem lexemes lemma then phrase else raise Not_found
| FixedP lemma as phrase -> if StringMap.mem lexemes lemma then phrase else raise Not_found
| phrase -> phrase
let rec reduce_morfs comprep_reqs lexemes = function
[] -> []
| morf :: l -> (try [reduce_phrase comprep_reqs lexemes morf] with Not_found -> []) @ reduce_morfs comprep_reqs lexemes l
let rec reduce_schema2 comprep_reqs lexemes = function
[] -> []
| s :: l ->
let morfs = reduce_morfs comprep_reqs lexemes s.morfs in
if morfs = [] then reduce_schema2 comprep_reqs lexemes l else
{s with morfs=morfs} :: reduce_schema2 comprep_reqs lexemes l
let rec reduce_schema comprep_reqs lexemes = function
[] -> []
| s :: l ->
let morfs = reduce_morfs comprep_reqs lexemes s.morfs in
if morfs = [] then raise ImpossibleSchema else
{s with morfs=morfs} :: reduce_schema comprep_reqs lexemes l
(* let reduce_schema_frame lexemes = function
Frame(atrs,schema) -> Frame(atrs,reduce_schema lexemes schema)
(* | ComprepFrame(s,morfs) ->
let morfs = reduce_morfs lexemes morfs in
if morfs = [] then raise ImpossibleSchema else ComprepFrame(s,morfs)*)
| _ -> failwith "reduce_schema_frame" *)
let reduce_entries lexemes entries =
StringMap.map entries (fun entries ->
StringSet.fold lexemes StringMap.empty (fun reduced lemma ->
try StringMap.add reduced lemma (StringMap.find entries lemma)
with Not_found -> reduced))