ENIAMwalFrames.ml
29.5 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
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
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
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
(*
* ENIAMlexSemantics is a library that assigns tokens with lexicosemantic information.
* Copyright (C) 2016-2017 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
* Copyright (C) 2016-2017 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 expands,compreps,comprep_reqs,subtypes,equivs = ENIAMwalParser.load_realizations ()
(*let verb_frames = ENIAMwalParser.load_frames (Paths.walenty_path ^ Paths.verb_filename)
let noun_frames = ENIAMwalParser.load_frames (Paths.walenty_path ^ Paths.noun_filename)
let adj_frames = ENIAMwalParser.load_frames (Paths.walenty_path ^ Paths.adj_filename)
let adv_frames = ENIAMwalParser.load_frames (Paths.walenty_path ^ Paths.adv_filename) *)
let walenty = (*StringMap.empty*)ENIAMwalTEI.load_walenty2 ()
(*let _ = StringMap.iter walenty (fun pos map ->
StringMap.iter map (fun lexeme frames ->
Printf.printf "%s %s %d\n%!" pos lexeme (Xlist.size frames)))*)
(*let all_frames =
["subst",noun_frames;
"adj",adj_frames;
"adv",adv_frames;
"ger",verb_frames;
"pact",verb_frames;
"ppas",verb_frames;
"fin",verb_frames;
"praet",verb_frames;
"impt",verb_frames;
"imps",verb_frames;
"inf",verb_frames;
"pcon",verb_frames]*)
let rec get_role_and_sense = function
Phrase(Lex "się") -> "Theme","", []
| PhraseAbbr(Xp "abl",_) -> "Location","Source", []
| PhraseAbbr(Xp "adl",_) -> "Location","Goal", []
| PhraseAbbr(Xp "caus",_) -> "Condition","", []
| PhraseAbbr(Xp "dest",_) -> "Purpose","", []
| PhraseAbbr(Xp "dur",_) -> "Duration","", []
| PhraseAbbr(Xp "instr",_) -> "Instrument","", []
| PhraseAbbr(Xp "locat",_) -> "Location","", []
| PhraseAbbr(Xp "mod",_) -> "Manner","", []
| PhraseAbbr(Xp "perl",_) -> "Path","", []
| PhraseAbbr(Xp "temp",_) -> "Time","", []
| PhraseAbbr(Advp "abl",_) -> "Location","Source", []
| PhraseAbbr(Advp "adl",_) -> "Location","Goal", []
| PhraseAbbr(Advp "dur",_) -> "Duration","", []
| PhraseAbbr(Advp "locat",_) -> "Location","", []
| PhraseAbbr(Advp "mod",_) -> "Manner","", []
| PhraseAbbr(Advp "perl",_) -> "Path","", []
| PhraseAbbr(Advp "temp",_) -> "Time","", []
(* | PhraseAbbr(Advp "pron",_) -> "Arg","", []
| PhraseAbbr(Advp "misc",_) -> "Arg","", []*)
| PhraseAbbr(Distrp,_) -> "Distributive","", [] (* FIXME: to jest kwantyfikator *)
| PhraseAbbr(Possp,_) -> "Possesive","", []
| LexPhraseMode("abl",_,_) -> "Location","Source", []
| LexPhraseMode("adl",_,_) -> "Location","Goal", []
| LexPhraseMode("caus",_,_) -> "Condition","", []
| LexPhraseMode("dest",_,_) -> "Purpose","", []
| LexPhraseMode("dur",_,_) -> "Duration","", []
| LexPhraseMode("instr",_,_) -> "Instrument","", []
| LexPhraseMode("locat",_,_) -> "Location","", []
| LexPhraseMode("mod",_,_) -> "Manner","", []
| LexPhraseMode("perl",_,_) -> "Path","", []
| LexPhraseMode("temp",_,_) -> "Time","", []
| _ -> "Arg","", []
(*let rec get_gf_role = function
[],Phrase(NP case) -> "C", "", ["T"]
| [],Phrase(AdjP case) -> "R", "", ["T"]
| [],Phrase(NumP(case,_)) -> "C", "", ["T"]
| [],Phrase(PrepNP _) -> "C", "", ["T"]
| [],Phrase(PrepAdjP _) -> "C", "", ["T"]
| [],Phrase(PrepNumP _) -> "C", "", ["T"]
| [],Phrase(ComprepNP _) -> "C", "", ["T"]
| [],Phrase(ComparP _) -> "C", "", ["T"]
| [],Phrase(CP _) -> "C", "", ["T"]
| [],Phrase(NCP(case,_,_)) -> "C", "", ["T"]
| [],Phrase(PrepNCP _) -> "C", "", ["T"]
| [],Phrase(InfP _) -> "C", "", ["T"]
| [],Phrase(FixedP _) -> "C", "", ["T"]
| [],Phrase Or -> "C", "", ["T"] (* FIXME: zbadać w walentym faktyczne użycia or, bo to nie tylko zdania, ale też np(nom) w cudzysłowach *)
| [],Phrase(Lex "się") -> "C", "Ptnt", ["T"]
| [],PhraseAbbr(Xp mode,_) -> "C", mode, ["T"]
| [],PhraseAbbr(Advp "pron",_) -> "R", "", ["T"]
| [],PhraseAbbr(Advp "misc",_) -> "R", "", ["T"]
| [],PhraseAbbr(Advp mode,_) -> "C", mode, ["T"]
| [],PhraseAbbr(Nonch,_) -> "C", "", ["T"]
| [],PhraseAbbr(Distrp,_) -> "C", "Distr", ["T"]
| [],PhraseAbbr(Possp,_) -> "C", "Poss", ["T"]
| [],LexPhraseMode(mode,_,_) -> "C", mode, ["T"]
| [],LexPhrase((SUBST(_,case),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((PREP _,_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((NUM(case,_,_),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((ADJ(_,case,_,_),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((ADV _,_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((GER(_,case,_,_,_,_),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((PACT(_,case,_,_,_,_),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((PPAS(_,case,_,_,_),_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((INF _,_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((QUB,_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((COMPAR,_) :: _,_) -> "C", "", ["T"]
| [],LexPhrase((COMP _,_) :: _,_) -> "C", "", ["T"]
| [],morf -> print_endline(*failwith*) ("get_gf: []," ^ ENIAMwalStringOf.morf morf);"","",[]
| _,Phrase(InfP _) -> "X", "", ["T"]
| _,Phrase(CP _) -> "X", "", ["T"] (* zwykle możliwa koordynacja z infp *)
| _,Phrase _ -> "X", "", ["T"]
| _,PhraseAbbr _ -> "X", "", ["T"]
| _,LexPhraseMode _ -> "X", "", ["T"]
| _,LexPhrase((INF _,_) :: _,_) -> "X", "", ["T"]
| _,LexPhrase _ -> "X", "", ["T"]
| _,morf -> failwith ("get_gf: _," ^ ENIAMwalStringOf.morf morf)*)
(*let gf_rank = Xlist.fold [
"",1;
] StringMap.empty (fun gf_rank (gf,v) -> StringMap.add gf_rank gf v)*)
(*let agregate_gfs s gfs_roles =
(* fst (Xlist.fold gfs ("",0) (fun (best_gf,best_rank) gf ->
let rank = try StringMap.find gf_rank gf with Not_found -> failwith ("agregate_gfs: " ^ gf) in
if rank > best_rank then gf, rank else best_gf, best_rank))*)
(* let gfs,roles = List.split gfs_roles in
let gfs = StringSet.to_list (Xlist.fold gfs StringSet.empty StringSet.add) in
if Xlist.size gfs > 1 then print_endline ("agregate_gfs: " ^ String.concat " " gfs);
if Xlist.size roles > 1 then print_endline ("agregate_gfs: " ^ String.concat " " roles);*)
let gf,role,prefs = List.hd gfs_roles in
{s with gf=gf; role=role; prefs=prefs}
let rec make_gfs schema =
let schema = Xlist.map schema (function
{gf="subj"} as s -> {s with gf="SUBJ"; role="Agnt"; prefs=["T"]; morfs=make_gfs_morfs s.morfs}
| {gf="obj"} as s -> {s with gf="OBJ"; role="Ptnt"; prefs=["T"]; morfs=make_gfs_morfs s.morfs}
| {gf=""} as s -> agregate_gfs {s with morfs=make_gfs_morfs s.morfs} (Xlist.map s.morfs (fun morf -> get_gf_role (s.ce,morf)))
| {gf=t} -> failwith ("make_gfs: " ^ t)) in
(* let schema = List.rev (fst (Xlist.fold schema ([],StringMap.empty) (fun (schema,map) s ->
try
let n = StringMap.find map s.gf in
{s with gf=s.gf ^ string_of_int (n+1)} :: schema,
StringMap.add map s.gf (n+1)
with Not_found ->
s :: schema, StringMap.add map s.gf 1))) in*)
schema
and make_gfs_morfs morfs =
List.flatten (Xlist.map morfs (function
Phrase _ as morf -> [morf]
| PhraseAbbr(Advp _,[]) -> [Phrase AdvP]
| PhraseAbbr(_,[]) -> failwith "make_gfs_morfs"
| PhraseAbbr(_,morfs) -> make_gfs_morfs morfs
| LexPhrase(pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,make_gfs schema))]
| LexPhraseMode(_,pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,make_gfs schema))]
| _ -> failwith "make_gfs_morfs"))*)
let mark_nosem_morfs morfs =
Xlist.map morfs (function
Phrase(PrepNP(_,prep,c)) -> Phrase(PrepNP(NoSem,prep,c))
| Phrase(PrepAdjP(_,prep,c)) -> Phrase(PrepAdjP(NoSem,prep,c))
| Phrase(PrepNumP(_,prep,c)) -> Phrase(PrepNumP(NoSem,prep,c))
(* | Phrase(ComprepNP(_,prep)) -> Phrase(ComprepNP(NoSem,prep)) *) (* FIXME: na razie ComprepNP są zawsze semantyczne *)
(* | Phrase(ComparNP(_,prep,c)) -> Phrase(ComparNP(NoSem,prep,c)) (* FIXME: pomijam niesemantyczny compar *)
| Phrase(ComparPP(_,prep)) -> Phrase(ComparPP(NoSem,prep))*)
| Phrase(PrepNCP(_,prep,c,ct,co)) -> Phrase(PrepNCP(NoSem,prep,c,ct,co))
| t -> t)
let agregate_role_and_sense s l =
let roles,senses = Xlist.fold l (StringSet.empty,StringSet.empty) (fun (roles,senses) (role,role_attr,sense) ->
StringSet.add roles (role ^ " " ^ role_attr),
Xlist.fold sense senses StringSet.add) in
let roles = if StringSet.size roles = 1 then roles else StringSet.remove roles "Arg " in
let role,role_attr =
match Str.split (Str.regexp " ") (StringSet.min_elt roles) with
[r;a] -> r,a
| [r] -> r,""
| _ -> failwith "agregate_role_and_sense" in
{s with role=role; role_attr=role_attr(*; sel_prefs=StringSet.to_list senses*)}
let rec assign_role_and_sense schema =
Xlist.map schema (function
{gf=SUBJ} as s ->
if s.role = "" then {s with role="Initiator"; sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs}
else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
| {gf=OBJ} as s ->
if s.role = "" then {s with role="Theme"; sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs}
else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
| {gf=ARG} as s ->
if s.role = "" then agregate_role_and_sense {s with sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs}
(Xlist.map s.morfs (fun morf -> get_role_and_sense morf))
else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
| _ -> failwith "assign_role_and_sense")
and assign_role_and_sense_morfs morfs =
List.flatten (Xlist.map morfs (function
Phrase _ as morf -> [morf]
| E _ as morf -> [morf]
| PhraseAbbr(Advp _,[]) -> [Phrase AdvP]
| PhraseAbbr(_,[]) -> failwith "assign_role_and_sense_morfs"
| PhraseAbbr(_,morfs) -> assign_role_and_sense_morfs morfs
| LexPhrase(pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,assign_role_and_sense schema))]
| LexPhraseMode(_,pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,assign_role_and_sense schema))]
| _ -> failwith "assign_role_and_sense_morfs"))
(*let _ =
Xlist.iter walenty_filenames (fun filename ->
print_endline filename;
let frames = load_frames (walenty_path ^ filename) in
StringMap.iter frames (fun _ l ->
Xlist.iter l (fun (refl,opinion,negation,pred,aspect,schema) ->
ignore (process_opinion opinion);
ignore (process_negation [Text negation]);
ignore (process_pred [Text pred]);
ignore (process_aspect [Text aspect]);
ignore (assign_pro_args (make_gfs (process_schema expands subtypes equivs schema))))))*)
let remove_trivial_args schema =
Xlist.fold schema [] (fun l (_,_,_,morfs) ->
let morfs = Xlist.fold morfs [] (fun morfs -> function
Phrase(AdjP _) -> morfs
| Phrase(NP(Case "gen")) -> morfs
| Phrase(NCP(Case "gen",_,_)) -> morfs
| Phrase(PrepNP _) -> morfs
| Phrase(FixedP _) -> morfs
| LexPhrase([ADJ _,_],_) -> morfs
| LexPhrase([PPAS _,_],_) -> morfs
| LexPhrase([PACT _,_],_) -> morfs
| LexPhrase([SUBST(_,Case "gen"),_],_) -> morfs
| LexPhrase([PREP _,_;_],_) -> morfs
| morf -> morf :: morfs) in
if morfs = [] then l else morfs :: l)
(* leksykalizacje do zmiany struktury
lex([PREP(gen),'z';SUBST(sg,gen),'nazwa'],atr1[OBL{lex([QUB,'tylko'],natr[])}])
lex([PREP(loc),'na';SUBST(sg,loc),'papier'],atr1[OBL{lex([QUB,'tylko'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(gen),'z';SUBST(sg,gen),'most'],ratr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(gen),'z';SUBST(sg,gen),'most'],ratr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
*)
let num_arg_schema_field morfs =
{gf=CORE; role="QUANT-ARG"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Forward; morfs=morfs}
let std_arg_schema_field dir morfs =
{gf=ARG; role="Arg"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}
let simple_arg_schema_field morfs =
{gf=ARG; role=""; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=morfs}
let nosem_refl_schema_field =
{gf=NOSEM; role=""; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[Phrase(Lex "się")]}
let expand_lexicalizations = function
Frame(atrs,schema) -> Frame(atrs,expand_lexicalizations_schema schema)
(* ComprepFrame(s,morfs) -> ComprepFrame(atrs,expand_lexicalizations_morfs morfs) *)
| _ -> failwith "expand_lexicalizations"
let prepare_schema_comprep expands subtypes equivs schema =
assign_pro_args (assign_role_and_sense (ENIAMwalParser.expand_equivs_schema equivs (ENIAMwalParser.expand_subtypes subtypes (ENIAMwalParser.expand_schema expands schema))))
let prepare_schema expands subtypes equivs schema =
prepare_schema_comprep expands subtypes equivs (ENIAMwalParser.parse_schema schema)
let prepare_schema_sem expands subtypes equivs schema =
prepare_schema_comprep expands subtypes equivs schema
let default_frames = Xlist.fold [ (* FIXME: poprawić domyślne ramki po ustaleniu adjunctów *)
"verb",(ReflEmpty,Domyslny,NegationUndef,PredNA,AspectUndef,"subj{np(str)}+obj{np(str)}"); (* FIXME: dodać ramkę z refl *)
"noun",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{possp}+{adjp(agr)}");
"adj",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
"adv",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
"empty",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
"date",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(np(gen),sg,'rok',natr)}");
"date2",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(np(gen),sg,'rok',atr1({adjp(agr)}))}"); (* FIXME: wskazać możliwe podrzędniki *)
"day",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,""
(*"{lex(np(gen),sg,XOR('styczeń','luty','marzec','kwiecień','maj','czerwiec','lipiec','sierpień','wrzesień','październik','litopad','grudzień'),atr1({np(gen)}))}"*)); (* FIXME: wskazać możliwe podrzędniki *)
"hour",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(advp(temp),pos,'rano',natr)}");
] StringMap.empty (fun map (k,(refl,opinion,negation,pred,aspect,schema)) ->
StringMap.add map k (Frame(DefaultAtrs([],refl,opinion,negation,pred,aspect),prepare_schema expands subtypes equivs schema)))
let adjunct_schema_field role dir morfs =
{gf=ADJUNCT; role=role; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}
let verb_prep_adjunct_schema_field lemma case =
{gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
Phrase Null;
Phrase(PrepNP(Sem,lemma,Case case));
Phrase(PrepAdjP(Sem,lemma,Case case));
Phrase(PrepNumP(Sem,lemma,Case case))]}
let verb_comprep_adjunct_schema_field lemma =
{gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
Phrase Null;
Phrase(ComprepNP(Sem,lemma))]}
let verb_compar_adjunct_schema_field lemma =
{gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
Phrase Null;
Phrase(ComparPP(Sem,lemma))] @
Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case)))}
let noun_prep_adjunct_schema_field preps compreps =
{gf=ADJUNCT; role="Attribute"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
let l = Xlist.fold preps [Phrase Null] (fun l (lemma,case) ->
[Phrase(PrepNP(Sem,lemma,Case case));
Phrase(PrepAdjP(Sem,lemma,Case case));
Phrase(PrepNumP(Sem,lemma,Case case))] @ l) in
Xlist.fold compreps l (fun l lemma ->
Phrase(ComprepNP(Sem,lemma)) :: l)}
let noun_compar_adjunct_schema_field compars =
{gf=ADJUNCT; role="Attribute"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
Xlist.fold compars [Phrase Null] (fun l lemma ->
[Phrase(ComparPP(Sem,lemma))] @ Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case))) @ l)}
let adj_compar_adjunct_schema_field compars =
{gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
Xlist.fold compars [Phrase Null] (fun l lemma ->
[Phrase(ComparPP(Sem,lemma))] @ Xlist.map ["nom"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case))) @ l)}
(*let nogf_schema_field dir morfs =
{gf=NOGF; role=""; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=dir; morfs=morfs} *)
let schema_field gf role dir morfs =
{gf=gf; role=role; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}
(*let verb_adjuncts = [
adjunct_schema_field "R" "" Both [Phrase AdvP];
adjunct_schema_field "R" "" Both [Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *)
]
let noun_adjuncts = [
adjunct_schema_field "C" "poss" Both [Phrase(NP(Case "gen"))];
adjunct_schema_field "C" "=" Both [Phrase(NP(Case "nom"))];
adjunct_schema_field "C" "=" Both [Phrase(NP(CaseAgr))];
adjunct_schema_field "R" "" Backward [Multi[AdjP AllAgr]];
adjunct_schema_field "R" "" Forward [Multi[AdjP AllAgr]];
adjunct_schema_field "R" "" Both [Phrase PrepP];
]
let adj_adjuncts = [
adjunct_schema_field "R" "" Both [Phrase PrepP];
]*)
let verb_adjuncts = [
(* adjunct_schema_field "" Both [Phrase Null;Phrase AdvP];
adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *)
adjunct_schema_field "Topic" Forward [Phrase Null;Phrase (CP(CompTypeUndef,CompUndef))]; (* poprawić semantykę *) (* FIXME: to powinno być jako ostatnia lista argumentów *)*)
]
(* FIXME: pozycje dublują się z domyślną ramką "noun" *)
let noun_adjuncts = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
(* adjunct_schema_field "poss" Both [Phrase Null;Phrase(NP(Case "gen"))];
adjunct_schema_field "=" Both [Phrase Null;Phrase(NP(Case "nom"))];
adjunct_schema_field "=" Both [Phrase Null;Phrase(NP(CaseAgr))];
adjunct_schema_field "" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
adjunct_schema_field "" Forward [Phrase Null;Phrase(AdjP AllAgr)];
adjunct_schema_field "" Both [Phrase Null;Phrase PrepP];*)
]
let adj_adjuncts = [
(* adjunct_schema_field "" Both [Phrase Null;Phrase AdvP]; *)
]
let verb_adjuncts_simp = [
adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP];
adjunct_schema_field "Recipent" Both [Phrase Null;Phrase (NP(Case "dat"));Phrase (NumP(Case "dat"));Phrase (NCP(Case "dat",CompTypeUndef,CompUndef))];
adjunct_schema_field "Instrument" Both [Phrase Null;Phrase (NP(Case "inst"));Phrase (NumP(Case "inst"));Phrase (NCP(Case "inst",CompTypeUndef,CompUndef))];
adjunct_schema_field "Time" Both [Phrase Null;Phrase (Lex "date");Phrase (Lex "day-lex");Phrase (Lex "day-month");Phrase (Lex "day")];
(* adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *) *)
adjunct_schema_field "Condition" Forward [Phrase Null;Phrase (CP(CompTypeUndef,CompUndef))]; (* poprawić semantykę *) (* FIXME: to powinno być jako ostatnia lista argumentów *)
adjunct_schema_field "Theme" Both [Phrase Null;Phrase Or];
]
let verb_adjuncts_simp2 = [
adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP];
adjunct_schema_field "Recipent" Both [Phrase Null;Phrase (NP(Case "dat"));Phrase (NumP(Case "dat"));Phrase (NCP(Case "dat",CompTypeUndef,CompUndef))];
adjunct_schema_field "Instrument" Both [Phrase Null;Phrase (NP(Case "inst"));Phrase (NumP(Case "inst"));Phrase (NCP(Case "inst",CompTypeUndef,CompUndef))];
adjunct_schema_field "Time" Both [Phrase Null;Phrase (Lex "date");Phrase (Lex "day-lex");Phrase (Lex "day-month");Phrase (Lex "day")];
(* adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *) *)
adjunct_schema_field "Condition" Forward [Phrase Null;Phrase (CP(CompTypeUndef,CompUndef))]; (* poprawić semantykę *) (* FIXME: to powinno być jako ostatnia lista argumentów *)
adjunct_schema_field "Theme" Both [Phrase Null;Phrase Or];
adjunct_schema_field "Theme" Both [Phrase Null;Phrase(Lex "się")];
]
let noun_adjuncts_simp = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
adjunct_schema_field "Possesive" Both [Phrase Null;Phrase(NP(Case "gen"));Phrase(NumP(Case "gen"))];
adjunct_schema_field "Aposition" Forward [Phrase Null;Phrase(NP(Case "nom"));Phrase(NumP(Case "nom"));Phrase Null;Phrase(NP(CaseAgr));Phrase(NumP(CaseAgr))];
adjunct_schema_field "Attribute" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
adjunct_schema_field "Base" Forward [Phrase Null;Phrase(AdjP AllAgr)];
(* adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; *)
]
let noun_measure_adjuncts_simp = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
adjunct_schema_field "Attribute" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
adjunct_schema_field "Base" Forward [Phrase Null;Phrase(AdjP AllAgr)];
(* adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; *)
]
let adj_adjuncts_simp = [
adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP];
]
let adv_adjuncts_simp = [
adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP];
]
let convert_frame expands subtypes equivs lexemes valence lexeme pos (refl,opinion,negation,pred,aspect,schema) =
(* Printf.printf "convert_frame %s %s\n" lexeme pos; *)
try
if refl = "się" && not (StringMap.mem lexemes "się") then raise ImpossibleSchema else
let frame =
try StringMap.find default_frames refl (* w refl jest przekazywana informacja o typie domyślnej ramki *)
with Not_found ->
Frame(DefaultAtrs([],ENIAMwalParser.parse_refl [Text refl],
ENIAMwalParser.parse_opinion opinion,
ENIAMwalParser.parse_negation [Text negation],
ENIAMwalParser.parse_pred [Text pred],
ENIAMwalParser.parse_aspect [Text aspect]),
prepare_schema expands subtypes equivs schema) in
let frame = if StringMap.is_empty lexemes then frame else reduce_schema_frame lexemes frame in
let frame = expand_lexicalizations frame in
Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
lexeme,pos,Frame(atrs,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [Frame(atrs,schema)] (fun l -> Frame(atrs,schema) :: l) in
StringMap.add valence lexeme poss)
| lexeme,pos,LexFrame(id,pos2,restr,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
StringMap.add valence lexeme poss)
| _ -> failwith "convert_frame")
with ImpossibleSchema -> valence
let convert_frame_sem expands subtypes equivs lexemes valence lexeme pos = function
Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),positions) ->
(* Printf.printf "convert_frame_sem %s\n" (ENIAMwalStringOf.frame lexeme (Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),positions))); *)
(try
if refl = ReflSie && not (StringMap.mem lexemes "się") then raise ImpossibleSchema else
let frame =
Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),
prepare_schema_sem expands subtypes equivs positions) in
let frame = if StringMap.is_empty lexemes then frame else reduce_schema_frame lexemes frame in
let frame = expand_lexicalizations frame in
Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
lexeme,pos,Frame(atrs,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [Frame(atrs,schema)] (fun l -> Frame(atrs,schema) :: l) in
StringMap.add valence lexeme poss)
| lexeme,pos,LexFrame(id,pos2,restr,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
StringMap.add valence lexeme poss)
| _ -> failwith "convert_frame_sem")
with ImpossibleSchema -> valence)
| _ -> failwith "convert_frame_sem"
let make_comprep_frames_of_schema s = function
[{cr=[];ce=[]; morfs=[LexPhrase([pos,Lexeme lex],(restr,schema))]}] ->
lex,
(match get_pos lex pos with [pos] -> pos | _ -> failwith "make_comprep_frame_of_schema 2"),
ComprepFrame(s,pos,restr,schema)
| schema -> failwith ("make_comprep_frame_of_schema: " ^ ENIAMwalStringOf.schema schema)
let convert_comprep_frame expands subtypes equivs lexemes valence lexeme pos (s,morf) =
try
let schema = prepare_schema_comprep expands subtypes equivs [simple_arg_schema_field [morf]] in
let schema = if StringMap.is_empty lexemes then schema else reduce_schema lexemes schema in
let schema = expand_lexicalizations_schema schema in
let lexeme,pos,frame = make_comprep_frames_of_schema s schema in
Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
lexeme,pos,ComprepFrame(s,pos2,restr,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [ComprepFrame(s,pos2,restr,schema)] (fun l -> ComprepFrame(s,pos2,restr,schema) :: l) in
StringMap.add valence lexeme poss)
| lexeme,pos,LexFrame(id,pos2,restr,schema) ->
let schemas = simplify_lex (split_xor (split_or_coord schema)) in
Xlist.fold schemas valence (fun valence schema ->
let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
StringMap.add valence lexeme poss)
| _ -> failwith "convert_comprep_frame")
with ImpossibleSchema -> valence
let remove_pro_args schema = (* FIXME: sprawdzić czy Pro i Null są zawsze na początku *)
List.rev (Xlist.fold schema [] (fun schema -> function
{morfs=[Phrase Pro]} -> schema
| {morfs=(Phrase Pro) :: morfs} as s -> {s with morfs=morfs} :: schema
| {morfs=[Phrase Null]} -> schema
| {morfs=(Phrase Null) :: morfs} as s -> {s with morfs=morfs} :: schema
| s -> s :: schema))
(*let _ =
let valence = Xlist.fold all_frames StringMap.empty (fun valence (pos,frame_map) ->
print_endline pos;
StringMap.fold frame_map valence (fun valence lexeme frames ->
Xlist.fold frames valence (fun valence frame ->
(* print_endline (ENIAMwalStringOf.unparsed_frame lexeme frame); *)
convert_frame expands subtypes equivs StringMap.empty valence lexeme pos frame))) in
print_endline "comprepnp";
let valence = StringMap.fold compreps valence (fun valence lexeme frames ->
Xlist.fold frames valence (fun valence (pos,frame) ->
convert_comprep_frame expands subtypes equivs StringMap.empty valence lexeme pos frame)) in
print_endline "expand_restr";
let valence = StringMap.mapi valence (fun lexeme poss ->
StringMap.mapi poss (fun pos frames ->
List.flatten (Xlist.map frames (expand_restr valence lexeme pos)))) in
print_endline "transform_frame";
let _ = StringMap.mapi valence (fun lexeme poss ->
StringMap.mapi poss (fun pos frames ->
(* print_endline lexeme; *)
List.flatten (Xlist.map frames (transform_frame lexeme pos)))) in
print_endline "done";
()*)
(* StringMap.iter valence (fun lexeme poss ->
StringMap.iter poss (fun pos frames ->
Xlist.iter frames (fun frame -> print_endline (ENIAMwalStringOf.frame lexeme frame))))*)