prePatterns.ml
29.6 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
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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
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
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
(*
* 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 Printf
open PreTypes
let rec flatten_tokens rev_variants = function
| [] -> rev_variants
| Token t :: l -> flatten_tokens (Xlist.map rev_variants (fun rev_variant -> Token t :: rev_variant)) l
| Seq seq :: l -> flatten_tokens rev_variants (seq @ l)
| Variant variants :: l -> flatten_tokens (List.flatten (Xlist.map variants (fun variant -> flatten_tokens rev_variants [variant]))) l
let rec normalize_tokens rev = function
[] -> List.rev rev
| Token t :: l -> normalize_tokens (Token t :: rev) l
| Seq seq :: l -> normalize_tokens rev (seq @ l)
| Variant[t] :: l -> normalize_tokens rev (t :: l)
| Variant variants :: l ->
let variants = flatten_tokens [[]] [Variant variants] in
let variants = Xlist.map variants (fun rev_seq ->
match List.rev rev_seq with
[] -> failwith "normalize_tokens"
| [t] -> t
| seq -> Seq seq) in
let t = match variants with
[] -> failwith "normalize_tokens"
| [t] -> t
| variants -> Variant variants in
normalize_tokens (t :: rev) l
let concat_orths l =
String.concat "" (Xlist.map l (fun t -> t.orth))
let concat_orths2 l =
String.concat "" (Xlist.map l (fun t -> PreTokenizer.get_orth t.token))
let concat_intnum = function
[{token=Dig(v4,_)};_;{token=Dig(v3,_)};_;{token=Dig(v2,_)};_;{token=Dig(v1,_)}] -> v4^v3^v2^v1
| [{token=Dig(v3,_)};_;{token=Dig(v2,_)};_;{token=Dig(v1,_)}] -> v3^v2^v1
| [{token=Dig(v2,_)};_;{token=Dig(v1,_)}] -> v2^v1
| [{token=Dig(v1,_)}] -> v1
| _ -> failwith "concat_intnum"
let dig_value t =
match t.token with
Dig(v,_) -> v
| _ -> failwith "dig_value"
(* FIXME: problem z ordnum - wyklucza year co stanowi problem na końcu zdania *)
let digit_patterns1 = [ (* FIXME: problem z nadmiarowymi interpretacjami - trzeba uwzględnić w preprocesingu brak spacji - albo w dezambiguacji *)
[D "dig"; S "."; D "dig"; S "."; D "dig"; S "."; D "dig"; S "."; D "dig"], (fun tokens -> Proper(concat_orths tokens,"obj-id",[[]],["obj-id"]));
[D "dig"; S "."; D "dig"; S "."; D "dig"; S "."; D "dig"], (fun tokens -> Proper(concat_orths tokens,"obj-id",[[]],["obj-id"]));
[D "dig"; S "."; D "dig"; S "."; D "dig"], (fun tokens -> Proper(concat_orths tokens,"obj-id",[[]],["obj-id"]));
[D "dig"; S "."; D "dig"], (fun tokens -> Proper(concat_orths tokens,"obj-id",[[]],["obj-id"]));
(* [D "dig"], "obj-id"; *)
[D "pref3dig"; S "."; D "3dig"; S "."; D "3dig"; S "."; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "pref3dig"; S "."; D "3dig"; S "."; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "pref3dig"; S "."; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "pref3dig"; S " "; D "3dig"; S " "; D "3dig"; S " "; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "pref3dig"; S " "; D "3dig"; S " "; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "pref3dig"; S " "; D "3dig"], (fun tokens -> Dig(concat_intnum tokens,"intnum"));
[D "intnum"; S "."], (function [token;_] -> Dig(concat_intnum [token],"ordnum") | _ -> failwith "digit_patterns1"); (* FIXME: to nie powinno wykluczać innych interpretacji *)
[D "day"; S "."; D "month"; S "."; D "year"], (function [day;_;month;_;year] -> Compound("date",[day.token;month.token;year.token]) | _ -> failwith "digit_patterns2");
[D "day"; S "."; RD "month"; S "."; D "year"], (function [day;_;month;_;year] -> Compound("date",[day.token;month.token;year.token]) | _ -> failwith "digit_patterns3");
[D "day"; S " "; RD "month"; S " "; D "year"], (function [day;_;month;_;year] -> Compound("date",[day.token;month.token;year.token]) | _ -> failwith "digit_patterns3");
[D "day"; S "."; D "month"; S "."; D "2dig"], (function [day;_;month;_;year] -> Compound("date",[day.token;month.token;year.token]) | _ -> failwith "digit_patterns2");
[D "day"; S "."; RD "month"; S "."; D "2dig"], (function [day;_;month;_;year] -> Compound("date",[day.token;month.token;year.token]) | _ -> failwith "digit_patterns3");
[D "day"; S "."; D "month"; S "."], (function [day;_;month;_] -> Compound("day-month",[day.token;month.token]) | _ -> failwith "digit_patterns4");
[D "hour"; S "."; D "minute"], (function [hour;_;minute] -> Compound("hour-minute",[hour.token;minute.token]) | _ -> failwith "digit_patterns5");
[D "hour"; S ":"; D "minute"], (function [hour;_;minute] -> Compound("hour-minute",[hour.token;minute.token]) | _ -> failwith "digit_patterns6");
[D "intnum"; S ":"; D "intnum"], (function [x;_;y] -> Compound("match-result",[x.token;y.token]) | _ -> failwith "digit_patterns7");
] (* bez 1 i *2 *3 *4 mamy rec *) (* w morfeuszu zawsze num:pl?*)
let digit_patterns2 = [
[D "intnum"; S ","; D "dig"], (function [x;_;y] -> Dig(dig_value x ^ "," ^ dig_value y,"realnum") | _ -> failwith "digit_patterns8");
(* [S "-"; D "intnum"; S ","; D "dig"], (function [_;x;_;y] -> Dig("-" ^ dig_value x ^ "," ^ dig_value y,"realnum") | _ -> failwith "digit_patterns9");
[S "-"; D "intnum"], (function [_;x] -> Dig("-" ^ dig_value x,"realnum") | _ -> failwith "digit_patterns10");*)
[S "’"; D "2dig"], (function [_;x] -> Dig("’" ^ dig_value x,"year") | _ -> failwith "digit_patterns12");
(* [D "intnum"], "realnum"; *)
]
let compose_latek_lemma t interp =
PreTokenizer.make_lemma (PreTokenizer.get_orth t.token ^ "-latek", interp)
let compose_latka_lemma t interp =
PreTokenizer.make_lemma (PreTokenizer.get_orth t.token ^ "-latka", interp)
let compose_latek_int_lemma t t2 interp =
PreTokenizer.make_lemma (PreTokenizer.get_orth t.token ^ "-" ^ PreTokenizer.get_orth t2.token ^ "-latek", interp)
let compose_latka_int_lemma t t2 interp =
PreTokenizer.make_lemma (PreTokenizer.get_orth t.token ^ "-" ^ PreTokenizer.get_orth t2.token ^ "-latka", interp)
let digit_patterns3 = [
[S "-"; D "intnum"], (function [_;x] -> Dig("-" ^ dig_value x,"intnum") | _ -> failwith "digit_patterns10");
[S "-"; D "realnum"], (function [_;x] -> Dig("-" ^ dig_value x,"realnum") | _ -> failwith "digit_patterns10");
[D "intnum"; S "-"; D "intnum"], (function [x;_;y] -> Compound("intnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns11");
[D "realnum"; S "-"; D "realnum"], (function [x;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[D "intnum"; S "-"; D "realnum"], (function [x;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[D "realnum"; S "-"; D "intnum"], (function [x;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[C "date"; S "-"; C "date"], (function [x;_;y] -> Compound("date-interval",[x.token;y.token]) | _ -> failwith "digit_patterns13");
[C "day-month"; S "-"; C "day-month"], (function [x;_;y] -> Compound("day-month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns14");
[D "day"; S "-"; D "day"], (function [x;_;y] -> Compound("day-interval",[x.token;y.token]) | _ -> failwith "digit_patterns15");
[D "month"; S "-"; D "month"], (function [x;_;y] -> Compound("month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[RD "month"; S "-"; RD "month"], (function [x;_;y] -> Compound("month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns17");
[D "year"; S "-"; D "year"], (function [x;_;y] -> Compound("year-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[D "year"; S "-"; D "2dig"], (function [x;_;y] -> Compound("year-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[C "hour-minute"; S "-"; C "hour-minute"], (function [x;_;y] -> Compound("hour-minute-interval",[x.token;y.token]) | _ -> failwith "digit_patterns18");
[D "hour"; S "-"; D "hour"], (function [x;_;y] -> Compound("hour-interval",[x.token;y.token]) | _ -> failwith "digit_patterns19");
[D "minute"; S "-"; D "minute"], (function [x;_;y] -> Compound("minute-interval",[x.token;y.token]) | _ -> failwith "digit_patterns20");
[RD "roman"; S "-"; RD "roman"], (function [x;_;y] -> Compound("roman-interval",[x.token;y.token]) | _ -> failwith "digit_patterns21");
[D "intnum"; S " "; S "-"; S " "; D "intnum"], (function [x;_;_;_;y] -> Compound("intnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns11");
[D "realnum"; S " "; S "-"; S " "; D "realnum"], (function [x;_;_;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[D "intnum"; S " "; S "-"; S " "; D "realnum"], (function [x;_;_;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[D "realnum"; S " "; S "-"; S " "; D "intnum"], (function [x;_;_;_;y] -> Compound("realnum-interval",[x.token;y.token]) | _ -> failwith "digit_patterns12"); (* FIXME: konflikt z liczbami ujemnymi *)
[C "date"; S " "; S "-"; S " "; C "date"], (function [x;_;_;_;y] -> Compound("date-interval",[x.token;y.token]) | _ -> failwith "digit_patterns13");
[C "day-month"; S " "; S "-"; S " "; C "day-month"], (function [x;_;_;_;y] -> Compound("day-month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns14");
[D "day"; S " "; S "-"; S " "; D "day"], (function [x;_;_;_;y] -> Compound("day-interval",[x.token;y.token]) | _ -> failwith "digit_patterns15");
[D "month"; S " "; S "-"; S " "; D "month"], (function [x;_;_;_;y] -> Compound("month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[RD "month"; S " "; S "-"; S " "; RD "month"], (function [x;_;_;_;y] -> Compound("month-interval",[x.token;y.token]) | _ -> failwith "digit_patterns17");
[D "year"; S " "; S "-"; S " "; D "year"], (function [x;_;_;_;y] -> Compound("year-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[D "year"; S " "; S "-"; S " "; D "2dig"], (function [x;_;_;_;y] -> Compound("year-interval",[x.token;y.token]) | _ -> failwith "digit_patterns16");
[C "hour-minute"; S " "; S "-"; S " "; C "hour-minute"], (function [x;_;_;_;y] -> Compound("hour-minute-interval",[x.token;y.token]) | _ -> failwith "digit_patterns18");
[D "hour"; S " "; S "-"; S " "; D "hour"], (function [x;_;_;_;y] -> Compound("hour-interval",[x.token;y.token]) | _ -> failwith "digit_patterns19");
[D "minute"; S " "; S "-"; S " "; D "minute"], (function [x;_;_;_;y] -> Compound("minute-interval",[x.token;y.token]) | _ -> failwith "digit_patterns20");
[RD "roman"; S " "; S "-"; S " "; RD "roman"], (function [x;_;_;_;y] -> Compound("roman-interval",[x.token;y.token]) | _ -> failwith "digit_patterns21");
[D "intnum"; S "-"; O "latek"], (function [x;_;_] -> compose_latek_lemma x "subst:sg:nom:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latka"], (function [x;_;_] -> compose_latek_lemma x "subst:sg:gen.acc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkowi"], (function [x;_;_] -> compose_latek_lemma x "subst:sg:dat:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkiem"], (function [x;_;_] -> compose_latek_lemma x "subst:sg:inst:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latku"], (function [x;_;_] -> compose_latek_lemma x "subst:sg:loc.voc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkowie"], (function [x;_;_] -> compose_latek_lemma x "subst:pl:nom.voc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latków"], (function [x;_;_] -> compose_latek_lemma x "subst:pl:gen.acc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkom"], (function [x;_;_] -> compose_latek_lemma x "subst:pl:dat:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkami"], (function [x;_;_] -> compose_latek_lemma x "subst:pl:inst:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkach"], (function [x;_;_] -> compose_latek_lemma x "subst:pl:loc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latka"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:nom:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latki"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:gen:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latce"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:dat.loc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkę"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:acc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latką"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:inst:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latko"], (function [x;_;_] -> compose_latka_lemma x "subst:sg:voc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latki"], (function [x;_;_] -> compose_latka_lemma x "subst:pl:nom.acc.voc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latek"], (function [x;_;_] -> compose_latka_lemma x "subst:pl:gen:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkom"], (function [x;_;_] -> compose_latka_lemma x "subst:pl:dat:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkami"], (function [x;_;_] -> compose_latka_lemma x "subst:pl:inst:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; O "latkach"], (function [x;_;_] -> compose_latka_lemma x "subst:pl:loc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latek"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:sg:nom:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latka"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:sg:gen.acc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkowi"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:sg:dat:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkiem"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:sg:inst:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latku"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:sg:loc.voc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkowie"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:pl:nom.voc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latków"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:pl:gen.acc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkom"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:pl:dat:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkami"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:pl:inst:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkach"], (function [x;_;y;_;_] -> compose_latek_int_lemma x y "subst:pl:loc:m1" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latka"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:nom:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latki"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:gen:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latce"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:dat.loc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkę"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:acc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latką"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:inst:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latko"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:sg:voc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latki"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:pl:nom.acc.voc:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latek"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:pl:gen:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkom"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:pl:dat:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkami"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:pl:inst:f" | _ -> failwith "digit_patterns22");
[D "intnum"; S "-"; D "intnum"; S "-"; O "latkach"], (function [x;_;y;_;_] -> compose_latka_int_lemma x y "subst:pl:loc:f" | _ -> failwith "digit_patterns22");
]
let url_patterns1 = [
[L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "pl"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "uk"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "cz"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "eu"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "org"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "com"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "net"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "."; L; S "."; L; S "."; L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
[L; S "."; L; S "-"; L; S "."; O "gov"], (function l -> Dig(concat_orths2 l,"url"));
]
let url_patterns2 = [
[L; S "@"; D "url"], (function l -> Dig(concat_orths2 l,"email"));
[O "http"; S ":"; S "/"; S "/"; D "url"], (function l -> Dig(concat_orths2 l,"email"));
]
let url_patterns3 = [
[D "url"; S "/"], (function l -> Dig(concat_orths2 l,"url"));
[D "url"; S "/"; L], (function l -> Dig(concat_orths2 l,"url"));
[D "url"; S "/"; L; S "."; L], (function l -> Dig(concat_orths2 l,"url"));
]
type matching = {
prefix: tokens list;
matched: token_record list;
suffix: tokens list;
pattern: pat list;
command: token_record list -> token;
command_abr: token_record list -> tokens list;
}
let execute_command matching =
let l = List.rev matching.matched in
let len = Xlist.fold l 0 (fun len t -> t.len + len) in
Seq((List.rev matching.prefix) @ [Token{empty_token with
orth=concat_orths l;
beg=(List.hd l).beg;
len=len;
next=(List.hd l).beg+len;
token=matching.command l;
weight=0.; (* FIXME: dodać wagi do konkretnych reguł i uwzględnić wagi maczowanych tokenów *)
attrs=PreTokenizer.merge_attrs l}] @ matching.suffix)
let execute_abr_command matching =
let l = List.rev matching.matched in
Seq((List.rev matching.prefix) @ (matching.command_abr l) @ matching.suffix)
let match_token = function
D cat, Dig(_,cat2) -> cat = cat2
| C s, Compound(s2,_) -> s = s2
| S s, Symbol s2 -> s = s2
| RD cat, RomanDig(_,cat2) -> cat = cat2
| O pat, Dig(s,"dig") -> pat = s
| O pat, Symbol s -> pat = s
| O pat, SmallLetter orth -> pat = orth
| O pat, CapLetter(orth,lc) -> pat = orth
| O pat, AllSmall orth -> pat = orth
| O pat, AllCap(orth,lc,lc2) -> pat = orth
| O pat, FirstCap(orth,lc,_,_) -> pat = orth
| O pat, SomeCap orth -> pat = orth
| L, SmallLetter _ -> true
| L, CapLetter _ -> true
| L, AllSmall _ -> true
| L, AllCap _ -> true
| L, FirstCap _ -> true
| L, SomeCap _ -> true
| CL, CapLetter _ -> true
| CL, AllCap _ -> true
| CL, SomeCap _ -> true
| _ -> false
let rec find_first_token matching pat = function
Token t -> if match_token (pat,t.token) then [{matching with matched = t :: matching.matched}] else []
| Seq l -> Xlist.map (find_first_token matching pat (List.hd (List.rev l))) (fun matching -> {matching with prefix = matching.prefix @ (List.tl (List.rev l))})
| Variant l -> List.flatten (Xlist.map l (find_first_token matching pat))
let rec find_middle_token matching pat = function
Token t -> if match_token (pat,t.token) then [{matching with matched = t :: matching.matched}] else []
| Seq _ -> []
| Variant l -> List.flatten (Xlist.map l (find_middle_token matching pat))
let rec find_last_token matching pat = function
Token t -> if match_token (pat,t.token) then [{matching with matched = t :: matching.matched}] else []
| Seq l -> Xlist.map (find_last_token matching pat (List.hd l)) (fun matching -> {matching with suffix = matching.suffix @ (List.tl l)})
| Variant l -> List.flatten (Xlist.map l (find_last_token matching pat))
let rec find_pattern_tail matchings = function
[] -> raise Not_found
| token :: l ->
let found,finished = Xlist.fold matchings ([],[]) (fun (found,finished) matching ->
match matching.pattern with
[pat] -> found, (find_last_token {matching with pattern=[]} pat token) @ finished
| pat :: pattern -> (find_middle_token {matching with pattern=pattern} pat token) @ found, finished
| _ -> failwith "find_pattern: ni") in
(try
if found = [] then raise Not_found else
find_pattern_tail found l
with Not_found ->
let finished = List.flatten (Xlist.map finished (fun matching -> try [execute_command matching] with Not_found -> [])) in
if finished = [] then raise Not_found else Variant finished,l)
(* wzorce nie mogą mieć długości 1 *)
let rec find_pattern matchings rev = function
token :: l ->
let found = Xlist.fold matchings [] (fun found matching ->
match matching.pattern with
pat :: pattern -> (find_first_token {matching with pattern=pattern} pat token) @ found
| [] -> failwith "find_pattern: empty pattern") in
if found = [] then find_pattern matchings (token :: rev) l else
(try
let token,l = find_pattern_tail found l in
find_pattern matchings (token :: rev) l
with Not_found -> find_pattern matchings (token :: rev) l)
| [] -> List.rev rev
let find_patterns patterns tokens =
find_pattern (Xlist.map patterns (fun (pattern,command) ->
{prefix=[]; matched=[]; suffix=[]; pattern=pattern; command=command; command_abr=(fun _ -> [])})) [] tokens
let rec find_abr_pattern_tail matchings = function
[] -> raise Not_found
| token :: l ->
let found,finished = Xlist.fold matchings ([],[]) (fun (found,finished) matching ->
match matching.pattern with
[pat] -> found, (find_last_token {matching with pattern=[]} pat token) @ finished
| pat :: pattern -> (find_middle_token {matching with pattern=pattern} pat token) @ found, finished
| [] -> found, matching :: finished) in
(try
if found = [] then raise Not_found else
find_abr_pattern_tail found l
with Not_found ->
let finished = List.flatten (Xlist.map finished (fun matching -> try [execute_abr_command matching] with Not_found -> [])) in
if finished = [] then raise Not_found else Variant finished,l)
let rec find_abr_pattern matchings rev = function
token :: l ->
let found = Xlist.fold matchings [] (fun found matching ->
match matching.pattern with
pat :: pattern -> (find_first_token {matching with pattern=pattern} pat token) @ found
| [] -> failwith "find_abr_pattern: empty pattern") in
if found = [] then find_abr_pattern matchings (token :: rev) l else
(try
let token,l = find_abr_pattern_tail found l in
find_abr_pattern matchings (token :: rev) l
with Not_found -> find_abr_pattern matchings (token :: rev) l)
| [] -> List.rev rev
let find_abr_patterns patterns tokens =
find_abr_pattern (Xlist.map patterns (fun (pattern,command) ->
{prefix=[]; matched=[]; suffix=[]; pattern=pattern; command=(fun _ -> Symbol ""); command_abr=command})) [] tokens
let find_replacement_patterns tokens =
let tokens = find_patterns digit_patterns1 tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns digit_patterns2 tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns digit_patterns3 tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns PreAcronyms.acronym_patterns tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns PreAcronyms.mte_patterns tokens in
let tokens = normalize_tokens [] tokens in
(* Xlist.iter tokens (fun t -> print_endline (PreTokenizer.string_of_tokens 0 t)); *)
let tokens = find_patterns PreAcronyms.name_patterns tokens in
(* Xlist.iter tokens (fun t -> print_endline (PreTokenizer.string_of_tokens 0 t)); *)
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns url_patterns1 tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns url_patterns2 tokens in
let tokens = normalize_tokens [] tokens in
let tokens = find_patterns url_patterns3 tokens in
let tokens = normalize_tokens [] tokens in
(* Xlist.iter tokens (fun t -> print_endline (PreTokenizer.string_of_tokens 0 t)); *)
tokens
let rec set_next_id n = function
Token t -> Token{t with next=n}
| Seq l ->
(match List.rev l with
t :: l -> Seq(List.rev ((set_next_id n t) :: l))
| [] -> failwith "set_next_id n")
| Variant l -> Variant(Xlist.map l (set_next_id n))
let rec remove_spaces rev = function
[] -> List.rev rev
| x :: Token{token=Symbol " "; next=n} :: l -> remove_spaces ((set_next_id n x) :: rev) l
| Token{token=Symbol " "} :: l -> remove_spaces rev l
| x :: l -> remove_spaces (x :: rev) l