1% This file is part of the Attempto Parsing Engine (APE). 2% Copyright 2008-2013, Attempto Group, University of Zurich (see http://attempto.ifi.uzh.ch). 3% 4% The Attempto Parsing Engine (APE) is free software: you can redistribute it and/or modify it 5% under the terms of the GNU Lesser General Public License as published by the Free Software 6% Foundation, either version 3 of the License, or (at your option) any later version. 7% 8% The Attempto Parsing Engine (APE) is distributed in the hope that it will be useful, but WITHOUT 9% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 10% PURPOSE. See the GNU Lesser General Public License for more details. 11% 12% You should have received a copy of the GNU Lesser General Public License along with the Attempto 13% Parsing Engine (APE). If not, see http://www.gnu.org/licenses/. 14 15 16:- module(drs_to_npace, [ 17 drs_to_npace/2 18 ]).
66:- use_module(drs_to_sdrs). 67 68:- use_module(implication_turn, [ 69 implication_turn/2 70 ]). 71 72:- use_module(morphgen, [ 73 clear_vars/0, 74 add_var/1, 75 remove_singletons/2, 76 listlist_listatom/2, 77 surface_noun/4, 78 surface_verb/3, 79 surface_neg_verb/3 80 ]). 81 82 83% Operators used in the DRS. 84:- op(400, fx, -). 85:- op(400, fx, ~). 86:- op(500, xfx, =>). 87:- op(500, xfx, v). 88 89 90/* 91:- debug(verbose). 92:- debug(toplevel). 93:- debug(turn). 94:- debug(cond). 95*/ 96 97 98:- dynamic ref_to_noun/5.
106drs_to_npace(Drs, AceSentenceList) :- 107 drs_acetext_np_x(Drs, AceList), 108 remove_singletons(AceList, AceListPruned), 109 listlist_listatom(AceListPruned, AceSentenceList), 110 !. 111 112drs_to_npace(_Drs, []). 113% TODO: Throw an exception 114%drs_to_npace(Drs, _) :- 115% throw(error('Not implemented', context(drs_to_npace/2, Drs))).
BUG: toplevel conditions (e.g. negation, relation/3, etc) which are not supported are ignored, but it doesn't cause a failure like in the previous versions.
135drs_acetext_np_x(Drs, AceText) :- 136 copy_term(Drs, DrsCopy), 137 drs_to_sdrs(DrsCopy, DrsSimpleWithNamed), 138 139 % BUG: temporary: remove named-object-conditions 140 exclude(is_named, DrsSimpleWithNamed, DrsSimple), 141 142 numbervars(DrsSimple, 0, _), 143 retractall(ref_to_noun(_, _, _, _, _)), 144 clear_vars, 145 retractall(morphgen:name_namespace(_, _)), 146 147 get_toplevel_referents(DrsSimple, toplevel(ToplevelReferents, UnsortedSubjectList, UnsortedObjectList, NamedList)), 148 subtract(ToplevelReferents, NamedList, UnnamedReferentList), 149 subtract(UnnamedReferentList, UnsortedObjectList, List1), 150 append(UnsortedSubjectList, List1, List2), 151 list_to_set(List2, SubjectList), 152 subtract(SubjectList, NamedList, UnnamedSubjectListWithNamed), 153 % BUG: temporary: remove named-object-conditions 154 exclude(is_named_ref, UnnamedSubjectListWithNamed, UnnamedSubjectList), 155 debug(toplevel, 'Toplevel referents: all: ~w; subjects: ~w; unnamed subjects: ~w~n', [ToplevelReferents, SubjectList, UnnamedSubjectList]), 156 157 individuals_ace(UnnamedSubjectList, AceSubjectList), 158 159 debug(toplevel, 'Individuals (nouns): ~w~n', [AceSubjectList]), 160 161 predicates_ace(DrsSimple, UnnamedSubjectList, RefsOut, AceTextListProperties), 162 163 debug(toplevel, 'Properties: ~w~n', [AceTextListProperties]), 164 165 subtract(UnnamedReferentList, RefsOut, Remaining2WithNamed), 166 exclude(is_named_ref, Remaining2WithNamed, Remaining2), 167 168 individuals_ace(Remaining2, AceTextListIndividuals), 169 170 include(is_implication, DrsSimple, Implications), 171 172 % BUG: we don't need the cut here, instead we should make sure that 173 % there is no backtracting in the previous statements 174 %!, 175 176 drs_ace(Implications, UnnamedReferentList, AceTextListClasses), 177 178 append(AceTextListProperties, AceTextListIndividuals, Tmp), 179 append(AceSubjectList, Tmp, Tmp1), 180 append(Tmp1, AceTextListClasses, AceText), 181 debug(toplevel, 'All: ~w~n', [AceText]). 182 183 184% BUG: temporary: remove named-object-conditions 185is_named(object(named(Name), Name, named, _, _, _)-_). 186is_named_ref(named(_)).
195is_implication(_ => _).
201acefragment_acesentence(Fragment, FragmentFlat) :-
202 flatten(Fragment, FragmentFlat).
209individuals_ace([], []). 210 211individuals_ace([Ref | Refs], [AceSentence | AceTexts]) :- 212 get_noun([], yes, no, Ref, Num, SurfaceNoun), 213 num_sgpl_copula(Num, _, Copula), 214 acefragment_acesentence(['there', Copula, SurfaceNoun], AceSentence), 215 individuals_ace(Refs, AceTexts).
225predicates_ace([], Refs, Refs, []). 226 227% BUG: this implementation is buggy, we rather fall back to Core ACE. 228/* 229predicates_ace( 230 [-Cond | RestPredicates], 231 RefsIn, 232 RefsOut, 233 [AceSentence | RestAceTexts] 234 ) :- 235 !, 236 get_main_subject(Cond, SubjRef), 237 get_noun(RefsIn, yes, no, SubjRef, _SubjDom, SurfaceSubj), 238 cond_acetext(-Cond, [yes, _Conj, [SubjRef | RefsIn]-RefsTmp, then, Ref, yes:no, Ref:_], AceText), 239 acefragment_acesentence([SurfaceSubj, AceText], AceSentence), 240 predicates_ace(RestPredicates, RefsTmp, RefsOut, RestAceTexts). 241*/ 242 243% BUG: this implementation is buggy, we rather fall back to Core ACE. 244/* 245predicates_ace( 246 [Cond1 v Cond2 | RestPredicates], 247 RefsIn, 248 RefsOut, 249 [AceSentence | RestAceTexts] 250 ) :- 251 !, 252 get_main_subject(Cond1, SubjRef), 253 get_noun(RefsIn, yes, no, SubjRef, _SubjDom, SurfaceSubj), 254 cond_acetext(Cond1 v Cond2, [yes, _Conj, [SubjRef | RefsIn]-RefsTmp, then, Ref, yes:no, Ref:_], AceText), 255 acefragment_acesentence([SurfaceSubj, AceText], AceSentence), 256 predicates_ace(RestPredicates, RefsTmp, RefsOut, RestAceTexts). 257*/ 258 259predicates_ace( 260 [predicate(_, Verb, Subj, Obj)-_ | RestPredicates], 261 RefsIn, 262 RefsOut, 263 [AceSentence | RestAceTexts] 264 ) :- 265 !, 266 get_noun(RefsIn, yes, no, Subj, SubjNum, SurfaceSubj), 267 get_noun([Subj | RefsIn], yes, no, Obj, _ObjDom, SurfaceObj), 268 num_sgpl_copula(SubjNum, SgPl, _Copula), 269 surface_verb(SgPl, Verb, SurfaceVerb), 270 acefragment_acesentence([SurfaceSubj, SurfaceVerb, SurfaceObj], AceSentence), 271 predicates_ace(RestPredicates, [Subj, Obj | RefsIn], RefsOut, RestAceTexts). 272 273predicates_ace( 274 [predicate(_, Verb, Subj)-_ | RestPredicates], 275 RefsIn, 276 RefsOut, 277 [AceSentence | RestAceTexts] 278 ) :- 279 !, 280 get_noun(RefsIn, yes, no, Subj, SubjNum, SurfaceSubj), 281 num_sgpl_copula(SubjNum, SgPl, _Copula), 282 surface_verb(SgPl, Verb, SurfaceVerb), 283 acefragment_acesentence([SurfaceSubj, SurfaceVerb], AceSentence), 284 predicates_ace(RestPredicates, [Subj | RefsIn], RefsOut, RestAceTexts). 285 286predicates_ace([object(_, _, _, na, _, _)-_ | RestPredicates], RefsIn, RefsOut, RestAceTexts) :- 287 !, 288 predicates_ace(RestPredicates, RefsIn, RefsOut, RestAceTexts). 289 290predicates_ace([[has_part(_, _)-_] => _ | _], _, _, _) :- 291 !, 292 fail. 293 294% BUG: we should verbalize it now, not later 295predicates_ace([_ => _ | RestPredicates], RefsIn, RefsOut, RestAceTexts) :- 296 predicates_ace(RestPredicates, RefsIn, RefsOut, RestAceTexts).
303drs_ace(Drs, ToplevelObjects, AceTextList) :-
304 conds_acetext(Drs, [yes, _, ToplevelObjects-_, _, _, _, _], AceTextList).
313conds_acetext([], [_, _, Refs-Refs, _, _, F:F, In:In], []). 314 315conds_acetext([Cond | Conds], [YesNo, Conj, RefsIn-RefsOut, Box, MainSubj, FIn:FOut, In:Out], [AceText | AceTexts]) :- 316 cond_acetext(Cond, [YesNo, Conj, RefsIn-RefsTmp, Box, MainSubj, FIn:FTmp, In:Tmp], AceText), 317 get_coordinator(Cond, Conj, NewConj), 318 conds_acetext(Conds, [YesNo, NewConj, RefsTmp-RefsOut, Box, MainSubj, FTmp:FOut, Tmp:Out], AceTexts).
346cond_acetext(Condition-_, _Features, _AceText) :- 347 functor(Condition, F, Args), 348 ( 349 F = modifier_adv 350 ; 351 F = modifier_pp 352 ; 353 F = has_part 354 ; 355 F = property 356 ; 357 F = relation 358 ; 359 F = query 360 ; 361 F = predicate, Args = 6 362 ), 363 !, 364 fail. 365 366cond_acetext(_:_, _, _) :- !, fail. 367 368cond_acetext(~_, _, _) :- !, fail. 369 370% If there is a dog then there is a cat. 371% This should fail, since we can't handle it with NPs. 372% BUG: But this rule should be made more general to cover e.g. negation and conjunction of object/8. 373cond_acetext(_ => [object(_, _, _, _, _, _)-_], _, _) :- 374 !, 375 fail. 376 377% Here we handle all kinds of implication forms. 378% They all produce full sentences. 379cond_acetext(A => B, Features, AceSentence) :- 380 !, 381 implication_turn_acetext(A => B, Features, AceSentence). 382 383 384% v (disjunction) 385cond_acetext(Conds1 v Conds2, [C, Coord, RefsIn-RefsIn, Box, MainSubj, FIn:no, Subj:Subj], [AceText1, or, AceText2]) :- 386 !, 387 make_comma_and_if_needed(Coord, NewCoord), 388 conds_acetext(Conds1, [C, NewCoord, RefsIn-RefsTmp, Box, MainSubj, FIn:no, Subj:_], AceText1), 389 conds_acetext(Conds2, [C, [], RefsTmp-_, Box, MainSubj, no:no, Subj:_], AceText2). 390 391 392% F = -, can, must, should, may (not, can, must, should, may) 393% BUG: why not In:In, i.e. why do we expose the embedded subject to the upper level? 394% In case of In:In there was one regression. Study it further! 395cond_acetext(Cond, [C, Conj, RefsIn-RefsOut, Box, MainSubj, FIn:no, In:Out], [AceText]) :- 396 functor(Cond, F, 1), 397 arg(1, Cond, Conds), 398 modify_first_verb(F, Conds, Subj, NewConds), 399 check_conds(Conds, Subj), 400 !, 401 conds_acetext(NewConds, [C, Conj, RefsIn-RefsOut, Box, MainSubj, FIn:no, In:Out], AceText). 402 403 404% predicate-condition will be verbalized. 405cond_acetext(Predicate, [Neg, Conj, RefsIn-RefsOut, Box, MainSubj, FIn:FOut, A:B], [Subj, Binder, Verb, Obj]) :- 406 predicate_acefragment(Predicate, [Conj, Box, MainSubj, FIn:FOut, A:B], [DeepSubj, Binder, DeepVerb, DeepObj]), 407 get_noun([], Neg, FIn, DeepSubj, _, Subj), 408 get_noun(RefsIn, yes, no, DeepObj, _, Obj), 409 ref_to_noun_wrapper(B, _, _, _, Number), 410 num_sgpl_copula(Number, SgPl, _), 411 get_verb(DeepVerb, SgPl, Verb), 412 add_refs(RefsIn, DeepObj, RefsOut). 413 414 415% Fallback (catches only object/8) 416cond_acetext(object(_, _, _, _, _, _)-_, [_C, _Conj, Refs-Refs, _Box, _MSubj, F:F, Subj:Subj], [[], [], [], []]). 417 418 419% BUG: clean this up, the "1" is not correct, 420% in case the named-object is in plural. 421ref_to_noun_wrapper(named(_), _, _, _, 1) :- !. 422 423ref_to_noun_wrapper(B, _, _, _, Number) :- 424 ref_to_noun(B, _, _, _, Number).
432implication_turn_acetext(A => B, Features, AceSentence) :- 433 implication_turn(A => B, ATurned => BTurned), 434 implication_acetext(ATurned => BTurned, Features, AceFragment), 435 !, 436 acefragment_acesentence(AceFragment, AceSentence). 437 438implication_turn_acetext(_, _, []).
448% Every man does not wait. 449% Every man waits. 450implication_acetext([object(Ref, _Lemma, Quant, _, Eq, Number)-_] => Conds2, [NegIn, _, RefsIn-RefsOut, _, _, _, _], [AceText1, AceText2]) :- 451 !, 452 countable_or_mass_or_dom(Quant), 453 ( 454 Eq = eq, 455 Number = 1 456 ; 457 Eq = na, 458 Number = na 459 ), 460 ( 461 Conds2 = [-NotConds] 462 -> 463 NegOut = no, 464 Conds2Out = NotConds 465 ; 466 NegOut = yes, 467 Conds2Out = Conds2 468 ), 469 get_noun([], NegOut, yes, Ref, _, AceText1), 470 %get_noun_x(Ref, new, NegOut, yes, Quant, _Lemma, Eq, Number, AceText1), 471 %add_var(Ref), 472 conds_acetext(Conds2Out, [NegIn, and, [Ref | RefsIn]-RefsOut, then, Ref, yes:no, Ref:_], AceText2). 473 474 475% Every man who sleeps does not wait. 476% Every man who sleeps waits. 477implication_acetext(Conds1 => Conds2, [NegIn, _, RefsIn-RefsOut, _, _, _, _], [AceText1, AceText2]) :- 478 select(object(Ref, _, Quant, _, Eq, Number)-_, Conds1, Conds1Out), 479 countable_or_mass_or_dom(Quant), 480 ( 481 Eq = eq, 482 Number = 1 483 ; 484 Eq = na, 485 Number = na 486 ), 487 ( 488 Conds2 = [-NotConds] 489 -> 490 NegOut = no, 491 Conds2Out = NotConds 492 ; 493 NegOut = NegIn, 494 Conds2Out = Conds2 495 ), 496 conds_acetext(Conds1Out, [NegOut, and, [Ref | RefsIn]-RefsTmp, if, Ref, yes:no, Ref:_], AceText1), 497 conds_acetext(Conds2Out, [NegIn, and, RefsTmp-RefsOut, then, Ref, yes:no, Ref:_], AceText2).
521% In THEN-box only. 522% Every man [HATES A RAT] ... 523% Every man that sees a dog [HATES A RAT] ... 524% Every man that sees a dog and that hears a cat that eats a mouse [HATES A RAT] ... 525predicate_acefragment(predicate(_, Verb, Subj, Obj)-_, [_, then, Subj, yes:no, Subj:Subj], [[], [], Verb, Obj]) :- !. 526 527 528% In THEN-box only. 529% Every man likes a cat [AND DRINKS SOME BEER]. 530% Every man likes a cat [OR DRINKS SOME BEER]. 531predicate_acefragment(predicate(_, Verb, Subj, Obj)-_, [Conj, then, Subj, no:no, _:Subj], [[], Conj, Verb, Obj]) :- !. 532 533 534% In the IF-box only. 535% Every [MAN THAT SEES A DOG] ... 536predicate_acefragment(predicate(_, Verb, Subj, Obj)-_, [_, if, Subj, yes:no, Subj:Subj], [Subj, 'that', Verb, Obj]) :- !. 537 538 539% Every man that sees a dog and that hears a cat [THAT EATS A MOUSE] ... 540predicate_acefragment(predicate(_, Verb, NewSubj, Obj)-_, [_, _, _, no:no, Subj:NewSubj], [[], 'that', Verb, Obj]) :- Subj \= NewSubj, !. 541 542 543% Every man that sees a dog [AND THAT HEARS A CAT] ... 544% Every man that sees a dog [OR THAT HEARS A CAT] ... 545predicate_acefragment(predicate(_, Verb, Subj, Obj)-_, [Conj, _, _, no:no, Subj:Subj], [[], [Conj, that], Verb, Obj]) :- !. 546 547 548 549 550% Intransitive verb support 551 552% In THEN-box only. 553% Every man [WAITS] ... 554predicate_acefragment(predicate(_, Verb, Subj)-_, [_, then, Subj, yes:no, Subj:Subj], [[], [], Verb, []]) :- !. 555 556% In THEN-box only. 557% Every man waits [AND eats] ... 558% Every man waits [OR eats] ... 559predicate_acefragment(predicate(_, Verb, Subj)-_, [Conj, then, Subj, no:no, _:Subj], [[], Conj, Verb, []]) :- !. 560 561% In the IF-box only. 562% Every man [THAT WAITS] eats ... 563predicate_acefragment(predicate(_, Verb, Subj)-_, [_, if, Subj, yes:no, Subj:Subj], [Subj, 'that', Verb, []]) :- !. 564 565predicate_acefragment(predicate(_, Verb, NewSubj)-_, [_, _, _, no:no, Subj:NewSubj], [[], 'that', Verb, []]) :- Subj \= NewSubj, !. 566 567predicate_acefragment(predicate(_, Verb, Subj)-_, [Conj, _, _, no:no, Subj:Subj], [[], [Conj, that], Verb, []]).
582get_verb([], _, []) :- 583 !. 584 585% BUG: special case if the verb is copula 586% this should be handled for other cases as well (can, cannot, ...) 587get_verb(not(i(be)), SgPl, IsAreNot) :- 588 surface_neg_verb(SgPl, be, IsAreNot), 589 !. 590 591get_verb(not(i(Verb)), SgPl, [IsAreNot, VerbEd, by]) :- 592 surface_neg_verb(SgPl, be, IsAreNot), 593 surface_verb(part, Verb, VerbEd), 594 !. 595 596get_verb(can(i(be)), _, [can, be]) :- 597 !. 598 599get_verb(can(i(Verb)), _, [can, be, VerbEd, by]) :- 600 surface_verb(part, Verb, VerbEd), 601 !. 602 603get_verb(must(i(be)), _, [must, be]) :- 604 !. 605 606get_verb(must(i(Verb)), _, [must, be, VerbEd, by]) :- 607 surface_verb(part, Verb, VerbEd), 608 !. 609 610get_verb(should(i(be)), _, [should, be]) :- 611 !. 612 613get_verb(should(i(Verb)), _, [should, be, VerbEd, by]) :- 614 surface_verb(part, Verb, VerbEd), 615 !. 616 617get_verb(may(i(be)), _, [may, be]) :- 618 !. 619 620get_verb(may(i(Verb)), _, [may, be, VerbEd, by]) :- 621 surface_verb(part, Verb, VerbEd), 622 !. 623 624/* 625get_verb(not(not(be)), _, [is, bug_not]) :- 626 !. 627 628get_verb(not(not(Verb)), _, [does, bug_not, Verb]) :- 629 !. 630*/ 631 632 633/* 634get_verb(not(be), SgPl, IsAreNot) :- 635 surface_neg_verb(SgPl, be, IsAreNot), 636 !. 637*/ 638 639get_verb(not(Verb), SgPl, NegVerb) :- 640 surface_neg_verb(SgPl, Verb, NegVerb), 641 !. 642 643get_verb(can(not(i(Verb))), _, [cannot, be, VerbEd, by]) :- 644 surface_verb(part, Verb, VerbEd), 645 !. 646 647get_verb(can(not(Verb)), _, [cannot, Verb]) :- 648 !. 649 650get_verb(can(Verb), _, [can, Verb]) :- 651 !. 652 653get_verb(must(not(i(Verb))), SgPl, [NegHave, to, be, VerbEd, by]) :- 654 surface_neg_verb(SgPl, have, NegHave), 655 surface_verb(part, Verb, VerbEd), 656 !. 657 658get_verb(must(not(Verb)), SgPl, [NegHave, to, Verb]) :- 659 surface_neg_verb(SgPl, have, NegHave), 660 !. 661 662get_verb(must(Verb), _, [must, Verb]) :- !. 663get_verb(should(Verb), _, [should, Verb]) :- !. 664get_verb(can(Verb), _, [can, Verb]) :- !. 665 666% BUG: special case if the verb is copula 667% this should be handled for other cases as well (can, cannot, ...) 668get_verb(i(be), sg, is) :- 669 !. 670 671get_verb(i(Verb), sg, [is, VerbEd, by]) :- 672 surface_verb(part, Verb, VerbEd), 673 !. 674 675get_verb(i(Verb), pl, [are, VerbEd, by]) :- 676 surface_verb(part, Verb, VerbEd), 677 !. 678 679get_verb(Verb, SgPl, SurfaceVerb) :- 680 surface_verb(SgPl, Verb, SurfaceVerb).
693% BUG: is this needed? yes, removing it causes some regression 694% BUG: sg is wrong anyway 695get_noun(_, _, _, [], 1, []) :- !. 696 697% BUG: The Num-detection does not seem to work. 698get_noun(_Refs, _Positive, _Pos, named(Name), Num, NameText) :- 699 surface_noun(pn, Name, SgPl, NameText), 700 (SgPl = sg -> Num = 1 ; Num = 2), 701 !. 702 703get_noun(Refs, Positive, Pos, Ref, Number, NP) :- 704 ref_to_noun(Ref, Quantisation, Noun, Operator, Number), 705 get_det(Ref, Refs, OldNew), 706 add_var(Ref), 707 get_noun_x(Ref, OldNew, Positive, Pos, Quantisation, Noun, Operator, Number, NP), 708 !.
726get_noun_x(Ref, _, yes, yes, countable, somebody, eq, 1, ['everybody', Ref]). 727get_noun_x(Ref, _, yes, yes, dom, something, na, na, ['everything', Ref]). 728get_noun_x(Ref, _, no, yes, countable, somebody, eq, 1, ['nobody', Ref]). 729get_noun_x(Ref, _, no, yes, dom, something, na, na, ['nothing', Ref]). 730get_noun_x(Ref, new, yes, _, countable, somebody, eq, 1, [somebody, Ref]). 731get_noun_x(Ref, new, yes, _, dom, something, na, na, [something, Ref]). 732get_noun_x(Ref, old, yes, _, countable, somebody, eq, 1, [Ref]). 733get_noun_x(Ref, old, yes, _, dom, something, na, na, [Ref]). 734get_noun_x(Ref, _, yes, yes, countable, Noun, eq, 1, ['every', NounSg, Ref]) :- surface_noun(cn, Noun, sg, NounSg). 735% 736get_noun_x(Ref, _, yes, yes, mass, Noun, na, na, ['all', NounSg, Ref]) :- surface_noun(cn, Noun, mass, NounSg). 737get_noun_x(Ref, _, no, yes, countable, Noun, eq, 1, ['no', NounSg, Ref]) :- surface_noun(cn, Noun, sg, NounSg). 738% 739get_noun_x(Ref, _, no, yes, mass, Noun, na, na, ['no', NounSg, Ref]) :- surface_noun(cn, Noun, mass, NounSg). % BUG: ambiguity 740get_noun_x(Ref, new, yes, _, countable, Noun, eq, 1, [a, NounSg, Ref]) :- surface_noun(cn, Noun, sg, NounSg). 741get_noun_x(Ref, new, yes, _, mass, Noun, na, na, [some, NounSg, Ref]) :- surface_noun(cn, Noun, mass, NounSg). 742get_noun_x(Ref, old, yes, _, countable, Noun, _, 1, [the, NounSg, Ref]) :- surface_noun(cn, Noun, sg, NounSg). 743% BUG: number was 1. why? 744get_noun_x(Ref, old, yes, _, mass, Noun, na, na, [the, NounSg, Ref]) :- surface_noun(cn, Noun, mass, NounSg). 745 746% BUG: was group 747get_noun_x(_, old, yes, _, countable, Noun, _, _, [the, NounPl]) :- surface_noun(cn, Noun, pl, NounPl). 748 749% Num = {0, 1, ...} 750get_noun_x(_, new, yes, _, countable, Noun, eq, Num, [Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form). 751get_noun_x(_, new, yes, _, countable, Noun, less, Num, [less, than, Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form). 752get_noun_x(_, new, yes, _, countable, Noun, greater, Num, [more, than, Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form). 753get_noun_x(_, new, yes, _, countable, Noun, leq, Num, [at, most, Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form). 754get_noun_x(_, new, yes, _, countable, Noun, geq, Num, [at, least, Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form). 755get_noun_x(_, new, yes, _, countable, Noun, exactly, Num, [exactly, Num, Form]) :- num_num(Num, SgPl), surface_noun(cn, Noun, SgPl, Form).
765num_num(0, pl) :- !. 766num_num(1, sg) :- !. 767num_num(N, pl) :- N > 1.
773get_det(El, List, old) :- 774 member(El, List), 775 !. 776 777get_det(_, _, new).
785get_toplevel_referents(Conds, toplevel(ReferentList, SubjectList, ObjectList, NamedList)) :-
786 store_objects(Conds, toplevel(-([], ReferentList), -([], SubjectList), -([], ObjectList), -([], NamedList))).
792store_objects([], toplevel(R-R, S-S, O-O, N-N)). 793 794store_objects([Cond | Conds], toplevel(R1-R2, S1-S2, O1-O2, N1-N2)) :- 795 do_cond(Cond, toplevel(R1-RT, S1-ST, O1-OT, N1-NT)), 796 store_objects(Conds, toplevel(RT-R2, ST-S2, OT-O2, NT-N2)).
802do_cond(A => B, toplevel(R-R, S-S, O-O, N-N)) :- 803 !, 804 store_objects(A, _), 805 store_objects(B, _). 806 807do_cond(A v B, toplevel(R-R, S-S, O-O, N-N)) :- 808 !, 809 store_objects(A, _), 810 store_objects(B, _). 811 812do_cond(-A, toplevel(R-R, S-S, O-O, N-N)) :- 813 !, 814 store_objects(A, _). 815 816do_cond(can(A), toplevel(R-R, S-S, O-O, N-N)) :- 817 !, 818 store_objects(A, _). 819 820do_cond(must(A), toplevel(R-R, S-S, O-O, N-N)) :- 821 !, 822 store_objects(A, _). 823 824do_cond(should(A), toplevel(R-R, S-S, O-O, N-N)) :- 825 !, 826 store_objects(A, _). 827 828do_cond(may(A), toplevel(R-R, S-S, O-O, N-N)) :- 829 !, 830 store_objects(A, _). 831 832do_cond(object(Ref, Noun, Type, _, Eq, na)-_, toplevel(R-[Ref | R], S-S, O-O, N-N)) :- 833 !, 834 assert(ref_to_noun(Ref, Type, Noun, Eq, na)). 835 836do_cond(object(Ref, Noun, Type, _, Eq, Number)-_, toplevel(R-[Ref | R], S-S, O-O, N-N)) :- 837 number(Number), 838 !, 839 assert(ref_to_noun(Ref, Type, Noun, Eq, Number)). 840 841do_cond(object(Ref, Noun, Type, _, Eq, RawNumber)-_, toplevel(R-[Ref | R], S-S, O-O, N-N)) :- 842 atom(RawNumber), 843 !, 844 atom_number(RawNumber, Number), 845 assert(ref_to_noun(Ref, Type, Noun, Eq, Number)). 846 847do_cond(predicate(_, _, Ref)-_, toplevel(R-R, S-[Ref | S], O-O, N-N)) :- !. 848 849do_cond(predicate(_, _, Ref, O1)-_, toplevel(R-R, S-[Ref | S], O-[O1 | O], N-N)) :- !. 850 851do_cond(predicate(_, _, Ref, O1, O2)-_, toplevel(R-R, S-[Ref | S], O-[O1, O2 | O], N-N)) :- !. 852 853do_cond(_, toplevel(R-R, S-S, O-O, N-N)).
BUG: should we add: Conds \= [object(_, _, _, _, _, _)
-_]
868check_conds([_ v _], _) :- !, fail. 869 870check_conds(Conds, Subject) :- 871 findall(Cond, ( 872 member(Cond-_, Conds), 873 functor(Cond, predicate, _), 874 arg(4, Cond, Subject) 875 ), [_, _ | _]), 876 !, 877 fail. 878 879check_conds(_, _).
can(see)
.
888modify_first_verb(Functor, Conds, Subject, NewConds) :-
889 rep(Functor, Conds, Subject, NewConds).
895rep(Functor, Conds, Subject, [ModifiedPredicate | Rest]) :- 896 select(Predicate, Conds, Rest), 897 pred(Functor, Predicate, Subject, ModifiedPredicate), 898 !. 899 900rep(Functor, [-Conds], Subject, [-NewConds]) :- 901 rep(Functor, Conds, Subject, NewConds). 902 903rep(Functor, [can(Conds)], Subject, [can(NewConds)]) :- 904 rep(Functor, Conds, Subject, NewConds). 905 906rep(Functor, [must(Conds)], Subject, [must(NewConds)]) :- 907 rep(Functor, Conds, Subject, NewConds). 908 909rep(Functor, [should(Conds)], Subject, [should(NewConds)]) :- 910 rep(Functor, Conds, Subject, NewConds). 911 912rep(Functor, [may(Conds)], Subject, [may(NewConds)]) :- 913 rep(Functor, Conds, Subject, NewConds). 914 915pred(Functor, predicate(Ref, Verb, Subject, Object)-Id, Subject, predicate(Ref, ModifiedVerb, Subject, Object)-Id) :- 916 verb_modifiedverb(Functor, Verb, ModifiedVerb). 917 918pred(Functor, predicate(Ref, Verb, Subject)-Id, Subject, predicate(Ref, ModifiedVerb, Subject)-Id) :- 919 verb_modifiedverb(Functor, Verb, ModifiedVerb).
925verb_modifiedverb('-', Verb, not(Verb)). 926verb_modifiedverb(can, Verb, can(Verb)). 927verb_modifiedverb(must, Verb, must(Verb)). 928verb_modifiedverb(should, Verb, should(Verb)). 929verb_modifiedverb(may, Verb, may(Verb)).
936get_main_subject(Conds, Subject) :- 937 member(predicate(_, _, Subject, _)-_, Conds). 938 939get_main_subject(Conds, Subject) :- 940 member(predicate(_, _, Subject)-_, Conds).
We added this hackish solution to support:
Every man works or eats and sleeps. Every man works or eats ,and sleeps or drinks.
957get_coordinator(Cond-_, _, and) :- 958 functor(Cond, predicate, _), 959 !. 960 961get_coordinator(_ v _, _, ', and') :- 962 !. 963 964get_coordinator(_, Old, Old).
972add_refs(List, [], List) :- !. 973add_refs(List, Ref, [Ref | List]).
980make_comma_and_if_needed(', and', [',', and]) :- !. 981make_comma_and_if_needed(and, [',', and]) :- !. 982make_comma_and_if_needed(_, []).
988num_sgpl_copula(1, sg, is) :- !. 989num_sgpl_copula(na, sg, is) :- !. 990num_sgpl_copula(_, pl, are).
996countable_or_mass_or_dom(countable). 997countable_or_mass_or_dom(mass). 998countable_or_mass_or_dom(dom)
Attempto DRS to ACE NP translator
In general we handle only those DRSs which contain only implications, but there is some support also for objects and predicates in the toplevel.
TODO
:Some notes relocated from the PhD draft:
Usage:
tnp("Every man who likes a dog which sees a rat hates a cat.")
.tnp('Every man who likes a dog hates a cat and sees a rat.')
.tnp('Every man who likes a dog is hated by a cat.')
.tnp("Every man who can see a dog is hated by a cat.")
. */