|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
(*
* ENIAM: Categorial Syntactic-Semantic Parser for Polish
* Copyright (C) 2016 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
* Copyright (C) 2016 Institute of Computer Science Polish Academy of Sciences
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
open Xstd
open PreTypes
|
|
23
|
let to_string (paths,last) =
|
|
24
25
26
|
String.concat "\n" (Xlist.map paths (fun t -> PreTokenizer.string_of_tokens 0 (Token t)))
^ Printf.sprintf "\nlast=%d" last
|
|
27
28
|
let to_string_indexed (paths,last) =
String.concat "\n" (Xlist.map paths (fun (i,j,t) ->
|
|
29
30
31
32
|
Printf.sprintf "%2d %2d %s" i j (PreTokenizer.string_of_tokens 0 (Token t))))
^ Printf.sprintf "\nlast=%d" last
(*let indexed_token_record_to_xml i j t =
|
|
33
|
let lemma,pos,tags =
|
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
match t.token with
Lemma(lemma,pos,tags) -> lemma,pos,tags
| _ -> failwith "indexed_token_record_to_xml" in
Xml.Element("token",["i",string_of_int i;"j",string_of_int j;
"beg",string_of_int t.beg;"len",string_of_int t.len;"weight",string_of_float t.weight],[
Xml.Element("orth",[],[Xml.PCData t.orth]);
Xml.Element("lemma",[],[Xml.PCData lemma]);
Xml.Element("pos",[],[Xml.PCData pos]);
Xml.Element("tags",[],Xlist.map tags (fun l ->
Xml.Element("variant",[],[Xml.PCData (String.concat ":" (Xlist.map l (fun l2 -> String.concat "." l2)))])));
Xml.Element("valence",[],Xlist.map t.valence WalXmlOf.num_frame);
Xml.Element("senses",[],
Xlist.map t.senses (fun (sense,hipero,weight) ->
Xml.Element("sense",["name",sense;"weight",string_of_float weight],
Xlist.map hipero (fun s -> Xml.Element("hipero",[],[Xml.PCData s])))))])
|
|
49
50
|
let to_xml (paths,last) =
|
|
51
52
|
Xml.Element("paths",["last",string_of_int last],
Xlist.map paths (fun (i,j,t) -> indexed_token_record_to_xml i j t)) *)
|
|
53
|
|
|
54
55
56
57
58
59
60
|
let compare_token_record p r =
let v = compare p.beg r.beg in
if v <> 0 then v else
let v = compare p.next r.next in
if v <> 0 then v else
compare p r
|
|
61
|
let sort (paths,last) =
|
|
62
63
64
65
66
67
|
Xlist.sort paths compare_token_record, last
let rec uniq_rec rev = function
[] -> List.rev rev
| [p] -> List.rev (p :: rev)
| p :: r :: l -> if p = r then uniq_rec rev (r :: l) else uniq_rec (p :: rev) (r :: l)
|
|
68
69
|
let uniq (paths,last) =
|
|
70
|
uniq_rec [] paths, last
|
|
71
|
|
|
72
73
74
75
|
let rec translate_into_paths_rec paths = function
Token t -> t :: paths
| Seq l -> Xlist.fold l paths translate_into_paths_rec
| Variant l -> Xlist.fold l paths translate_into_paths_rec
|
|
76
77
78
|
let translate_into_paths tokens =
let paths = Xlist.fold tokens [] (fun paths token ->
|
|
79
80
81
82
|
translate_into_paths_rec paths token) in
let last = if paths = [] then 0 else (List.hd paths).next in
let paths = sort (paths,last) in
let paths = uniq paths in
|
|
83
84
|
paths
|
|
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
(**********************************************************************************)
let excluded_interps = StringSet.of_list [
"praet:sg:f:ter:perf";
"praet:sg:f:ter:imperf.perf";
"praet:sg:f:ter:imperf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:ter:perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:ter:imperf.perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:ter:imperf";
"praet:pl:m1.p1:ter:perf";
"praet:pl:m1.p1:ter:imperf.perf";
"praet:pl:m1.p1:ter:imperf";
"praet:sg:m1.m2.m3:ter:perf";
"praet:sg:m1.m2.m3:ter:imperf.perf";
"praet:sg:m1.m2.m3:ter:imperf";
"praet:sg:n1.n2:ter:perf";
"praet:sg:n1.n2:ter:imperf.perf";
"praet:sg:n1.n2:ter:imperf";
"cond:sg:m1.m2.m3:ter:perf";
"cond:sg:m1.m2.m3:ter:imperf.perf";
"cond:sg:m1.m2.m3:ter:imperf";
"cond:sg:m1.m2.m3:sec:perf";
"cond:sg:m1.m2.m3:sec:imperf.perf";
"cond:sg:m1.m2.m3:sec:imperf";
"cond:sg:m1.m2.m3:pri:perf";
"cond:sg:m1.m2.m3:pri:imperf.perf";
"cond:sg:m1.m2.m3:pri:imperf";
"cond:sg:m1.m2.m3:perf";
"cond:sg:m1.m2.m3:imperf.perf";
"cond:sg:m1.m2.m3:imperf";
"cond:sg:f:ter:perf";
"cond:sg:f:ter:imperf.perf";
"cond:sg:f:ter:imperf";
"cond:sg:f:sec:perf";
"cond:sg:f:sec:imperf.perf";
"cond:sg:f:sec:imperf";
"cond:sg:f:pri:perf";
"cond:sg:f:pri:imperf.perf";
"cond:sg:f:pri:imperf";
"cond:sg:f:perf";
"cond:sg:f:imperf.perf";
"cond:sg:f:imperf";
"cond:sg:n1.n2:ter:perf";
"cond:sg:n1.n2:ter:imperf.perf";
"cond:sg:n1.n2:ter:imperf";
"cond:sg:n1.n2:sec:perf";
"cond:sg:n1.n2:sec:imperf.perf";
"cond:sg:n1.n2:sec:imperf";
"cond:sg:n1.n2:pri:perf";
"cond:sg:n1.n2:pri:imperf.perf";
"cond:sg:n1.n2:pri:imperf";
"cond:sg:n1.n2:perf";
"cond:sg:n1.n2:imperf.perf";
"cond:sg:n1.n2:imperf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:ter:perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:ter:imperf.perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:ter:imperf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:sec:perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:sec:imperf.perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:sec:imperf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:pri:perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:pri:imperf.perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:pri:imperf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:imperf.perf";
"cond:pl:m2.m3.f.n1.n2.p2.p3:imperf";
"cond:pl:m1.p1:ter:perf";
"cond:pl:m1.p1:ter:imperf.perf";
"cond:pl:m1.p1:ter:imperf";
"cond:pl:m1.p1:sec:perf";
"cond:pl:m1.p1:sec:imperf.perf";
"cond:pl:m1.p1:sec:imperf";
"cond:pl:m1.p1:pri:perf";
"cond:pl:m1.p1:pri:imperf.perf";
"cond:pl:m1.p1:pri:imperf";
"cond:pl:m1.p1:perf";
"cond:pl:m1.p1:imperf.perf";
"cond:pl:m1.p1:imperf";
"winien:sg:n1.n2:ter:imperf";
"winien:sg:n1.n2:sec:imperf";
"winien:sg:n1.n2:pri:imperf";
(* "winien:sg:n1.n2:imperf"; *)
"winien:sg:m1.m2.m3:ter:imperf";
"winien:sg:m1.m2.m3:sec:imperf";
"winien:sg:m1.m2.m3:pri:imperf";
(* "winien:sg:m1.m2.m3:imperf"; *)
"winien:sg:f:ter:imperf";
"winien:sg:f:sec:imperf";
"winien:sg:f:pri:imperf";
(* "winien:sg:f:imperf"; *)
"winien:pl:m2.m3.f.n1.n2.p2.p3:ter:imperf";
"winien:pl:m2.m3.f.n1.n2.p2.p3:sec:imperf";
"winien:pl:m2.m3.f.n1.n2.p2.p3:pri:imperf";
(* "winien:pl:m2.m3.f.n1.n2.p2.p3:imperf"; *)
"winien:pl:m1.p1:ter:imperf";
"winien:pl:m1.p1:sec:imperf";
"winien:pl:m1.p1:pri:imperf";
(* "winien:pl:m1.p1:imperf"; *)
]
let transformed_interps = Xlist.fold [
"praet:sg:f:perf:agl","praet:sg:f:perf";
"praet:sg:f:imperf.perf:agl","praet:sg:f:imperf.perf";
"praet:sg:f:imperf:agl","praet:sg:f:imperf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:perf:agl","praet:pl:m2.m3.f.n1.n2.p2.p3:perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:imperf.perf:agl","praet:pl:m2.m3.f.n1.n2.p2.p3:imperf.perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:imperf:agl","praet:pl:m2.m3.f.n1.n2.p2.p3:imperf";
"praet:pl:m1.p1:perf:agl","praet:pl:m1.p1:perf";
"praet:pl:m1.p1:imperf.perf:agl","praet:pl:m1.p1:imperf.perf";
"praet:pl:m1.p1:imperf:agl","praet:pl:m1.p1:imperf";
"praet:sg:m1.m2.m3:perf:agl","praet:sg:m1.m2.m3:perf";
"praet:sg:m1.m2.m3:imperf.perf:agl","praet:sg:m1.m2.m3:imperf.perf";
"praet:sg:m1.m2.m3:imperf:agl","praet:sg:m1.m2.m3:imperf";
"praet:sg:n1.n2:perf:agl","praet:sg:n1.n2:perf";
"praet:sg:n1.n2:imperf.perf:agl","praet:sg:n1.n2:imperf.perf";
"praet:sg:n1.n2:imperf:agl","praet:sg:n1.n2:imperf";
"praet:sg:f:perf:nagl","praet:sg:f:perf";
"praet:sg:f:imperf.perf:nagl","praet:sg:f:imperf.perf";
"praet:sg:f:imperf:nagl","praet:sg:f:imperf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:perf:nagl","praet:pl:m2.m3.f.n1.n2.p2.p3:perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:imperf.perf:nagl","praet:pl:m2.m3.f.n1.n2.p2.p3:imperf.perf";
"praet:pl:m2.m3.f.n1.n2.p2.p3:imperf:nagl","praet:pl:m2.m3.f.n1.n2.p2.p3:imperf";
"praet:pl:m1.p1:perf:nagl","praet:pl:m1.p1:perf";
"praet:pl:m1.p1:imperf.perf:nagl","praet:pl:m1.p1:imperf.perf";
"praet:pl:m1.p1:imperf:nagl","praet:pl:m1.p1:imperf";
"praet:sg:m1.m2.m3:perf:nagl","praet:sg:m1.m2.m3:perf";
"praet:sg:m1.m2.m3:imperf.perf:nagl","praet:sg:m1.m2.m3:imperf.perf";
"praet:sg:m1.m2.m3:imperf:nagl","praet:sg:m1.m2.m3:imperf";
"praet:sg:n1.n2:perf:nagl","praet:sg:n1.n2:perf";
"praet:sg:n1.n2:imperf.perf:nagl","praet:sg:n1.n2:imperf.perf";
"praet:sg:n1.n2:imperf:nagl","praet:sg:n1.n2:imperf";
] StringMap.empty (fun map (k,v) -> StringMap.add map k v)
|
|
217
|
|
|
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
let merge_lemmata l =
let map = Xlist.fold l StringMap.empty (fun map (lemma,interp,quantity,attrs) ->
let interp = if interp = "num:comp" then "numc" else interp in
if StringSet.mem excluded_interps interp then map else
let interp = try StringMap.find transformed_interps interp with Not_found -> interp in
let s = lemma ^ "#" ^ String.concat "|" attrs in
StringMap.add_inc map s (lemma,quantity,[interp],attrs) (fun (_,q,l,_) -> lemma,q+quantity,interp :: l,attrs)) in
let map = StringMap.map map (fun (lemma,quantity,interps,attrs) ->
lemma,
Xlist.fold interps StringMap.empty (fun map interp ->
Xlist.fold (PreTokenizer.parse_postags interp) map (fun map (pos,tags) ->
StringMap.add_inc map pos [tags] (fun l -> tags :: l))),
max 1 (quantity / Xlist.size interps),
attrs) in
|
|
232
|
StringMap.fold map [] (fun l _ (lemma,map,quantity,attrs) ->
|
|
233
234
235
236
237
238
|
StringMap.fold map l (fun l cat interp ->
(lemma,cat,interp,quantity,attrs) :: l))
let uppercase lemma cl ll =
let n = String.length lemma in
let nll = String.length ll in
|
|
239
240
241
|
cl ^ String.sub lemma nll (n - nll)
let quant_mod quantity =
|
|
242
|
log10 (float quantity)
|
|
243
244
245
246
|
let lemmatize_token = function
| {token=AllSmall s} as t ->
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
247
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs=attrs @ t.attrs}))
|
|
248
249
|
| {token=SmallLetter s} as t ->
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
250
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs=attrs @ t.attrs}))
|
|
251
252
|
| {token=FirstCap(s,lower,cl,ll)} as t ->
let l = Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
253
254
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs="notvalidated proper" :: attrs @ t.attrs}) in
let b = Xlist.fold l false (fun b t -> if Xlist.mem t.attrs "lemma not validated" || Xlist.mem t.attrs "token not found" then b else true) in
|
|
255
256
|
if b then t :: l else
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations lower)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
257
|
{t with token=Lemma(uppercase lemma cl ll,cat,interp); weight=t.weight+.(quant_mod quantity); attrs="notvalidated proper" :: "lemmatized as lowercase" :: attrs @ t.attrs}))
|
|
258
259
|
| {token=AllCap(s,_,_)} as t ->
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
260
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs="notvalidated proper" :: attrs @ t.attrs}))
|
|
261
262
|
| {token=CapLetter(s,_)} as t ->
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
263
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs="notvalidated proper" :: attrs @ t.attrs}))
|
|
264
265
|
| {token=SomeCap s} as t ->
t :: (Xlist.map (merge_lemmata (Inflexion.get_interpretations s)) (fun (lemma,cat,interp,quantity,attrs) ->
|
|
266
267
|
{t with token=Lemma(lemma,cat,interp); weight=t.weight+.(quant_mod quantity); attrs="notvalidated proper" :: attrs @ t.attrs}))
| t -> [t]
|
|
268
269
270
|
let rec lemmatize_rec rev = function
[] -> List.rev rev
|
|
271
272
273
274
275
|
| t :: l -> lemmatize_rec (lemmatize_token t @ rev) l
let lemmatize (paths,last) =
List.rev (Xlist.fold (lemmatize_rec [] paths) [] (fun paths t ->
match t.token with
|
|
276
|
Lemma _ -> if (Xlist.mem t.attrs "lemma not validated" || Xlist.mem t.attrs "token not found") &&
|
|
277
278
279
|
(Xlist.mem t.attrs "required validated lemmatization") then paths
else t(*{t with attrs=List.remove "required validated lemmatization" t.attrs}*) :: paths
| _ -> t :: paths)), last
|
|
280
|
|
|
281
282
283
284
285
|
(* TODO: docelowa lematyzacja:
- lematyzacja za pomocą półręcznie wytworzonych reguł lematyzacji i listy wyjątków
- walidacja lematów za pomocą listy znanych lematów zawierającej lemat, kategorię, rodzaj subst, aspekt verb (obejmuje też walidację akronimów)
- rozpoznawanie wyrażeń wielosłownych (mwe i mte) za pomocą listy zawierającej ich lematy i szablony odmiany
*)
|
|
286
|
|
|
287
|
(**********************************************************************************)
|
|
288
|
|
|
289
290
|
(**********************************************************************************)
|
|
291
|
|
|
292
|
(**********************************************************************************)
|
|
293
294
295
|
|
|
296
297
298
299
300
|
(*let rec get_beg_id = function
Token t -> t.beg
| Seq(t :: _) -> get_beg_id t
| Variant(t :: _) -> get_beg_id t
| _ -> failwith "get_beg_id"
|
|
301
|
|
|
302
303
304
305
306
307
|
let rec get_end_id = function
Token t -> t.beg + t.len
| Seq [] -> failwith "get_end_id"
| Seq l -> get_end_id (List.hd (List.rev l))
| Variant(t :: _) -> get_end_id t
| _ -> failwith "get_end_id"*)
|
|
308
|
|
|
309
310
311
312
|
(*let rec lemmatize_tokens paths next_id = function
Token({token=Dig(v,cat)} as t)-> PrePaths.add_edge paths t.beg next_id t.orth v (parse_postags cat) t.beg t.len
| Token({token=Lemma(lemma,interp)} as t) -> PrePaths.add_edge paths t.beg next_id t.orth lemma (parse_postags interp) t.beg t.len
| Token({token=Interp lemma} as t) -> PrePaths.add_edge paths t.beg next_id t.orth lemma (parse_postags "interp") t.beg t.len
|
|
313
|
| Token({token=AllSmall s} as t) ->
|
|
314
315
316
317
318
319
320
321
322
323
|
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg next_id t.orth lemma (parse_postags postags) t.beg t.len)
| Token({token=FirstCap(s,s2)} as t) -> (* FIXME: dodać wersję z s2 ; uporządkować słownik; dodać akronimy *)
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg next_id t.orth lemma (parse_postags postags) t.beg t.len)
| Token _ -> paths
| Seq [t] -> lemmatize_tokens paths next_id t
| Seq(t :: next :: l) -> lemmatize_tokens (lemmatize_tokens paths (get_beg_id next) t) next_id (Seq(next :: l))
| Seq [] -> failwith "lemmatize_tokens"
| Variant l -> Xlist.fold l paths (fun paths t -> lemmatize_tokens paths next_id t)*)
|
|
324
|
|
|
325
326
|
(*let rec lemmatize_paths_tokens paths = function (* FIXME: uzgodnić postać lematów *)
Token({token=Dig(v,cat)} as t)-> PrePaths.add_edge paths t.beg t.next t.orth v (parse_postags cat) t.attrs t.beg t.len
|
|
327
|
| Token({token=Lemma(lemma,interp)} as t) ->
|
|
328
329
330
331
332
|
if Xlist.mem t.attrs "lemmatized as lowercase" || Xlist.mem t.attrs "lemma not validated" then paths else (* FIXME *)
PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags interp) t.attrs t.beg t.len
| Token({token=Interp lemma} as t) -> PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags "interp") t.attrs t.beg t.len
| Token({token=Proper _} as t) -> failwith "lemmatize_paths_tokens: ni"
| Token({token=Compound _} as t) -> failwith "lemmatize_paths_tokens: ni"
|
|
333
|
(* | Token({token=AllSmall s} as t) ->
|
|
334
335
|
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags postags) t.beg t.len)
|
|
336
|
| Token({token=SmallLetter s} as t) ->
|
|
337
338
339
340
341
342
343
344
345
346
347
|
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags postags) t.beg t.len)
| Token({token=FirstCap(s,s2)} as t) -> (* FIXME: dodać wersję z s2 ; uporządkować słownik; dodać akronimy *)
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags postags) t.beg t.len)
| Token({token=CapLetter(s,s2)} as t) -> (* FIXME: dodać wersję z s2 ; uporządkować słownik; dodać akronimy *)
Xlist.fold (Inflexion.get_interpretations s) paths (fun paths (lemma,postags) ->
PrePaths.add_edge paths t.beg t.next t.orth lemma (parse_postags postags) t.beg t.len)*)
| Token _ -> paths
| Seq l -> Xlist.fold l paths (fun paths t -> lemmatize_paths_tokens paths t)
| Variant l -> Xlist.fold l paths (fun paths t -> lemmatize_paths_tokens paths t)
|
|
348
|
|
|
349
350
351
352
|
(*let rec lemmatize paths = function
t :: next :: l -> lemmatize (lemmatize_tokens paths (get_beg_id next) t) (next :: l)
| [t] -> lemmatize_tokens paths (get_end_id t) t
| [] -> failwith "lemmatize"*)
|
|
353
|
|
|
354
355
356
|
let rec lemmatize_paths paths = function
t :: l -> lemmatize_paths (lemmatize_paths_tokens paths t) l
| [] -> paths *)
|
|
357
|
|
|
358
|
(* FIXME: dodać 'co do' prep:gen *)
|
|
359
360
|
|
|
361
362
363
364
365
366
367
|
(* Dane do przekazania:
- lematy i interpretacje: generowanie typów i termów
- orths
- początki i długości: decydują o wyświetlaniu struktury składnikowej (zwłaszcza niejednoznacznej)
- struktura grafu: wyróżniki przy niejednoznaczności
- sensy wraz z hiperonimami
- <indent> *)
|
|
368
369
|
(*
|
|
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
|
Ala zjadła kota.
Ala subst:sg:nom:f imię -> istota
kot subst:sg:nom:m2 pospolita - kot 2 - istota 1 istota żywa 1 zwierzę 1 strunowiec 1 czaszkowiec 1 kręgowiec 1 tetrapod 1 owodniowiec 1 ssak 1 ssak żyworodny 1 łożyskowiec 1 ssak drapieżny 1 kot 1 kot 2
zjeść - zjeść 1 - CZASOWNIK 1 CZASOWNIK należący do określonego pola leksykalnego 1 CZASOWNIK oznaczający sytuację związaną z reakcją organizmu lub czynnością fizjologiczną 1 CZASOWNIK - AKT oznaczający reakcję organizmu lub czynność fizjologiczne 1 zjeść 1
Ala -> common("imię")
Ala -> proper("istota")
kot -> common("kot 2")
czas 3 doba 1=dzień 2
czas 3 miesiąc 1
czas 3 rok 1 rok 2
czas 3 termin 1 dzień 3
data 1=termin 1
czas 3 pora roku 1 lato 1
punkt lub odcinek czasu w obrębie doby, określany na podstawie wskazań zegara
"o godzinie 15:20."
czas 3 godzina 4
do opisu czasu trwania:
jednostka czasu 1: godzina 3, sekunda 2, (minuta 4 - nie podłączona) dzień 2, miesiąc 1, rok 1/2
|
|
395
396
397
398
|
*)
(**
|
|
399
400
401
402
403
404
405
406
407
408
|
(* empty *)
let empty = IntMap.empty, 0, 0
let dict_empty = {lemmas=StringMap.empty; dbeg=0-1; dlen=0-1}
let poss_record_empty = {interp=[]; attrs=[]; proper=[]; senses=[]}
(* add *)
|
|
409
|
let dict_add dict lemma postags attrs beg len =
|
|
410
411
412
|
if postags = [] then dict else
let interps = try StringMap.find dict.lemmas lemma with Not_found -> StringMap.empty in
let interps = Xlist.fold postags interps (fun interps (pos,tags) ->
|
|
413
|
StringMap.add_inc interps pos {poss_record_empty with interp=[tags]; attrs=attrs} (fun l ->
|
|
414
415
416
417
418
419
420
421
422
423
424
425
426
|
{l with interp=tags :: l.interp; attrs=StringSet.to_list (StringSet.union (StringSet.of_list l.attrs) (StringSet.of_list attrs))})) in
if dict.dbeg <> beg && dict.dbeg <> -1 then failwith "dict_add" else
if dict.dlen <> len && dict.dlen <> -1 then failwith "dict_add" else
{lemmas=StringMap.add dict.lemmas lemma interps; dbeg=beg; dlen=len}
let add_simple map i j orth lemma postags attrs beg len =
let map2 = try IntMap.find map i with Not_found -> IntMap.empty in
let orths = try IntMap.find map2 j with Not_found -> StringMap.empty in
let dict = try StringMap.find orths orth with Not_found -> dict_empty in
let dict = dict_add dict lemma postags attrs beg len in
let orths = StringMap.add orths orth dict in
let map2 = IntMap.add map2 j orths in
IntMap.add map i map2
|
|
427
|
|
|
428
429
|
let add_edge (map,last,n) i j orth lemma postags attrs beg len =
add_simple map i j orth lemma postags attrs beg len, max j last, max j n
|
|
430
|
|
|
431
432
|
let rec add_path (map,last,n) i j = function
[] -> failwith "add_path"
|
|
433
|
| [orth,lemma,postags,beg,len] ->
|
|
434
|
add_simple map i j orth lemma postags [] beg len, last, n
|
|
435
|
| (orth,lemma,postags,beg,len) :: l ->
|
|
436
|
add_path (add_simple map i (n+1) orth lemma postags [] beg len, last, n+1) (n+1) j l
|
|
437
|
(*
|
|
438
439
440
441
|
let insert (map,last,n) i j orth dict =
let map2 = try IntMap.find map i with Not_found -> IntMap.empty in
let orths = try IntMap.find map2 j with Not_found -> StringMap.empty in
let orths = StringMap.add orths orth dict in
|
|
442
|
let map2 = IntMap.add map2 j orths in
|
|
443
|
IntMap.add map i map2, last, n
|
|
444
|
|
|
445
446
|
let rec insert_path (map,last,n) i j = function
[] -> failwith "add_path"
|
|
447
|
| [orth,dict] ->
|
|
448
|
insert (map,last,n) i j orth dict
|
|
449
|
| (orth,dict) :: l ->
|
|
450
|
insert_path (insert (map,last,n+1) i (n+1) orth dict) (n+1) j l
|
|
451
452
|
let set_sentence_begin (map,last,n) i j orth =
|
|
453
454
455
456
457
458
|
try
let map2 = IntMap.find map i in
let orths = IntMap.find map2 j in
let dict = StringMap.find orths orth in
let orths = StringMap.add orths orth {dict with sentence_begin=true} in
let map2 = IntMap.add map2 j orths in
|
|
459
|
IntMap.add map i map2, last, n
|
|
460
461
|
with Not_found -> failwith "set_sentence_begin"
|
|
462
|
let set_sentence_end (map,last,n) i j orth =
|
|
463
464
465
466
467
468
|
try
let map2 = IntMap.find map i in
let orths = IntMap.find map2 j in
let dict = StringMap.find orths orth in
let orths = StringMap.add orths orth {dict with sentence_end=true} in
let map2 = IntMap.add map2 j orths in
|
|
469
|
IntMap.add map i map2, last, n
|
|
470
471
|
with Not_found -> failwith "set_sentence_end"
|
|
472
|
let is_sentence_end (map,last,n) i j orth =
|
|
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
try
let map2 = IntMap.find map i in
let orths = IntMap.find map2 j in
let dict = StringMap.find orths orth in
dict.sentence_end
with Not_found -> failwith "is_sentence_end"
let manage_sentence_end (map,last,n) =
IntMap.map map (fun map2 ->
IntMap.map map2 (fun orths ->
StringMap.fold orths StringMap.empty (fun orths orth dict ->
if orth = ".last_node" then StringMap.add orths "." {dict with sentence_end=true}
else StringMap.add orths orth dict))),last,n
(* other *)
let remove (map,last,n) i j orth =
try
let map2 = IntMap.find map i in
let orths = IntMap.find map2 j in
let orths = StringMap.remove orths orth in
let map2 = if StringMap.is_empty orths then IntMap.remove map2 j else IntMap.add map2 j orths in
(if IntMap.is_empty map2 then IntMap.remove map i else IntMap.add map i map2), last, n
with Not_found -> map,last,n
let rec find_paths_bound (map,last,n) k i =
if i = last || k = 0 then [[]] else
if not (IntMap.mem map i) then failwith "find_paths_bound" else
IntMap.fold (IntMap.find map i) [] (fun paths j set ->
let tails = find_paths_bound (map,last,n) (k-1) j in
StringMap.fold set paths (fun paths s _ ->
Xlist.fold tails paths (fun paths tail -> (s :: tail) :: paths)))
|
|
506
|
|
|
507
508
509
510
511
512
513
|
let rec find_paths_rec (map,last,n) i =
if i = last then [[]] else
if not (IntMap.mem map i) then failwith "find_paths_rec" else
IntMap.fold (IntMap.find map i) [] (fun paths j set ->
let tails = find_paths_rec (map,last,n) j in
StringMap.fold set paths (fun paths s _ ->
Xlist.fold tails paths (fun paths tail -> (s :: tail) :: paths)))
|
|
514
|
|
|
515
516
|
let find_paths (map,last,n) =
find_paths_rec (map,last,n) 0
|
|
517
518
|
*)
let has_lemma orths =
|
|
519
520
|
StringMap.fold orths false (fun b _ dict ->
if StringMap.is_empty dict.lemmas then b else true)
|
|
521
|
|
|
522
523
524
525
526
527
528
|
let rec no_possible_path_rec map last i =
if last = i then false else
let map2 = try IntMap.find map i with Not_found -> IntMap.empty in
IntMap.fold map2 true (fun b j orths ->
if has_lemma orths then
b && no_possible_path_rec map last j
else b)
|
|
529
|
|
|
530
531
|
let no_possible_path (map,last,n) =
no_possible_path_rec map last 0
|
|
532
|
(*
|
|
533
|
let rec match_path_rec map found i rev = function
|
|
534
|
[] -> (i :: rev) :: found
|
|
535
536
537
538
539
|
| s :: l ->
let map2 = try IntMap.find map i with Not_found -> IntMap.empty in
let found2 = IntMap.fold map2 [] (fun found2 j set ->
if StringMap.mem set s then j :: found2 else found2) in
Xlist.fold found2 found (fun found j -> match_path_rec map found j (i :: rev) l)
|
|
540
|
|
|
541
542
|
let match_path (map,last,n) = function
[] -> failwith "match_path"
|
|
543
|
| s :: l ->
|
|
544
545
546
547
548
|
let found = IntMap.fold map [] (fun found i map2 ->
IntMap.fold map2 found (fun found j set ->
if StringMap.mem set s then (i,j) :: found else found)) in
Xlist.fold found [] (fun found (i,j) -> match_path_rec map found j [i] l)
|
|
549
|
let get_matched orths = function
|
|
550
551
552
553
554
555
556
|
Orth s -> if StringMap.mem orths s then [s] else []
| Pos s -> (*print_endline ("a1 " ^ s);*) StringSet.to_list (StringMap.fold orths StringSet.empty (fun set orth dict ->
StringMap.fold dict.lemmas set (fun set lemma interps ->
StringMap.fold interps set (fun set pos _ ->
(* print_endline ("a2 " ^ pos); *)
if s = pos then StringSet.add set orth else set))))
(* | All -> orths *)
|
|
557
|
|
|
558
|
let rec match_path_ex_rec map found i rev = function
|
|
559
|
[] -> ((i,[]) :: rev) :: found
|
|
560
561
562
563
564
565
|
| s :: l ->
let map2 = try IntMap.find map i with Not_found -> IntMap.empty in
let found2 = IntMap.fold map2 [] (fun found2 j orths ->
let l = get_matched orths s in
if l <> [] then (j,l) :: found2 else found2) in
Xlist.fold found2 found (fun found (j,l2) -> match_path_ex_rec map found j ((i,l2) :: rev) l)
|
|
566
|
|
|
567
568
|
let match_path_ex (map,last,n) = function
[] -> failwith "match_path_ex"
|
|
569
|
| s :: l ->
|
|
570
571
572
573
574
575
576
577
578
579
580
|
let found = IntMap.fold map [] (fun found i map2 ->
IntMap.fold map2 found (fun found j orths ->
let l = get_matched orths s in
if l <> [] then (i,j,l) :: found else found)) in
Xlist.fold found [] (fun found (i,j,l2) -> (*print_endline ("b1 " );*) match_path_ex_rec map found j [i,l2] l)
let last_node (_,last,_) = last
let set_last_node (map,last,n) new_last = map, new_last, n
let find (map,last,n) i =
|
|
581
|
try
|
|
582
583
584
585
586
587
|
IntMap.fold (IntMap.find map i) [] (fun found j orths ->
StringMap.fold orths found (fun found orth _ ->
(i,j,orth) :: found))
with Not_found -> []
let find_full (map,last,n) i =
|
|
588
|
try
|
|
589
590
591
592
593
|
IntMap.fold (IntMap.find map i) [] (fun found j orths ->
StringMap.fold orths found (fun found orth dict ->
(i,j,orth,dict) :: found))
with Not_found -> []
*)
|
|
594
|
let fold (map,last,n) s f =
|
|
595
596
597
598
|
IntMap.fold map s (fun s i map2 ->
IntMap.fold map2 s (fun s j set ->
StringMap.fold set s (fun s orth lemmas ->
f s orth i j lemmas)))
|
|
599
600
|
(*
let map (map,last,n) f =
|
|
601
602
603
604
|
IntMap.map map (fun map2 ->
IntMap.map map2 (fun orths ->
StringMap.map orths (fun lemmas ->
f lemmas))), last, n
|
|
605
606
|
let mapi (map,last,n) f =
|
|
607
608
609
610
|
IntMap.mapi map (fun i map2 ->
IntMap.mapi map2 (fun j orths ->
StringMap.mapi orths (fun orth lemmas ->
f orth i j lemmas))), last, n
|
|
611
612
|
let get_edges (map,_,_) i j =
|
|
613
|
IntMap.find (IntMap.find map i) j
|
|
614
615
|
let get_edges_from (map,_,_) i =
|
|
616
|
IntMap.find map i
|
|
617
|
*)
|
|
618
|
let rec topological_sort_rec map visited l i =
|
|
619
|
if IntSet.mem visited i then (l,visited) else
|
|
620
621
622
|
let l, visited = IntMap.fold (try IntMap.find map i with Not_found -> IntMap.empty) (l,IntSet.add visited i) (fun (l,visited) j _ ->
topological_sort_rec map visited l j) in
i :: l, visited
|
|
623
|
|
|
624
625
626
627
628
629
630
631
632
|
let topological_sort (map,last,n) =
let l, _ = topological_sort_rec map IntSet.empty [] 0 in
let translation, k = Xlist.fold l (IntMap.empty,0) (fun (translation,k) i ->
IntMap.add translation i k, k+1) in
let map = IntMap.fold map IntMap.empty (fun map i map2 ->
let map2 = IntMap.fold map2 IntMap.empty (fun map2 j orths ->
try IntMap.add map2 (IntMap.find translation j) orths with Not_found -> map2) in
try IntMap.add map (IntMap.find translation i) map2 with Not_found -> map) in
map, (try IntMap.find translation last with Not_found -> failwith "topological_sort 3"), k-1
|
|
633
|
|
|
634
635
636
|
(*let interp_to_string interp =
String.concat " " (Xlist.fold interp.interp [] (fun l tags ->
(String.concat ":" (Xlist.map tags (String.concat "."))) :: l))
|
|
637
|
|
|
638
639
640
|
let interps_to_string interps =
String.concat " " (StringMap.fold interps [] (fun l pos interp ->
(pos ^ "[" ^ interp_to_string interp ^ "]") :: l))
|
|
641
|
|
|
642
643
644
|
let lemmas_to_string lemmas =
String.concat " " (StringMap.fold lemmas [] (fun l lemma interps ->
(lemma ^ "[" ^ interps_to_string interps ^ "]") :: l))
|
|
645
646
|
let to_string (map,last,n) =
|
|
647
648
|
let l = IntMap.fold map [] (fun l i map2 ->
IntMap.fold map2 l (fun l j orths ->
|
|
649
|
(Printf.sprintf "%5d %5d %s" i j (String.concat " " (StringMap.fold orths [] (fun l2 orths dict ->
|
|
650
651
|
(Printf.sprintf "%s %5d %5d [%s]" orths dict.dbeg dict.dlen (lemmas_to_string dict.lemmas)) :: l2)))) :: l)) in
Printf.sprintf "last=%d n=%d\n %s" last n (String.concat "\n " (List.sort compare l))*)
|
|
652
653
|
(*
let make_unique_orths (map,last,n) =
|
|
654
655
656
657
658
659
660
|
let names = fold (map,last,n) StringQMap.empty (fun names orth _ _ _ ->
StringQMap.add names orth) in
let names = StringQMap.fold names StringSet.empty (fun names name n ->
if n = 1 (*|| name = "."*) then names else StringSet.add names name) in (* FIXME: trzeba dodać usuwanie wszystkich orth zdefiniowanych w leksykonach POLFIE *)
let map,_ = IntMap.fold map (IntMap.empty,StringMap.empty) (fun (map,used) i map2 ->
let map2,used = IntMap.fold map2 (IntMap.empty,used) (fun (map2,used) j orths ->
let orths,used = StringMap.fold orths (StringMap.empty,used) (fun (orths,used) orth lemmas ->
|
|
661
|
let orth,used =
|
|
662
|
if StringSet.mem names orth then
|
|
663
664
|
let n =
try StringMap.find used orth + 1
|
|
665
666
667
668
669
670
671
672
|
with Not_found -> 1 in
orth ^ "-" ^ string_of_int n, StringMap.add used orth n
else orth,used in
StringMap.add orths orth lemmas, used) in
IntMap.add map2 j orths, used) in
IntMap.add map i map2, used) in
map,last,n
|
|
673
674
675
|
*)
**)
|