2:- module(typechange,[typechange/5  % +OldCat,+OldSem,+Att,+NewCat,-NewSem
    3                     ]).    4
    5:- use_module(boxer(slashes)).    6:- use_module(boxer(lexicon),[semlex/5]).    7:- use_module(boxer(categories),[att/3]).    8:- use_module(semlib(errors),[warning/2]).    9:- use_module(library(lists),[member/2]).   10
   11
   12/* -------------------------------------------------------------------------
   13
   14   This file contains the rules for the phenomenon called 'type
   15   changing' (not to be confused with type raising). These are called
   16   "lexical rules" in CCGbank. They are unary type changing rules that
   17   change the type of the category, or derived from binary type
   18   changing rules represented as unary type changing rule.  As they
   19   are not regular, like type shifting rules, it is impossible to give
   20   a general semantic pattern for them. Instead each pair of
   21   categories (consisting of the old and the new type of the category,
   22   will get its own semantic interpretation. Often, a type-changing
   23   rule corresponds to ellipsis. In the comments below, the elided
   24   phrases are indicated by square brackets.
   25
   26------------------------------------------------------------------------- */
   27
   28% Ex: a company [that is] based in ...
   29%
   30typechange(Old,Phi,_,New,app(Psi,Phi)):- 
   31   member(Old,[s:_\np,s:_/np]), 
   32   New = np\np, 
   33   semlex(New/Old,that,[],[]-_,Psi), !.
   34
   35% Ex: an effort [ ... ] to end the violence
   36%
   37typechange(Old,Phi,_,New,app(Psi,Phi)):- 
   38   member(Old,[s:_\np,s:_/np]), 
   39   member(New,[n/n,n\n]), 
   40   semlex(New/Old,that,[],[]-_,Psi), !.
   41
   42% Ex: a sign [that] the effort is working 
   43% 
   44typechange(Old,Phi,_,New,app(Psi,Phi)):- 
   45   Old = s:_,
   46   New = np\np, 
   47   semlex(New/Old,that,[],[]-_,Psi), !.
   48
   49% Ex: sign [that] the effort is working 
   50%
   51typechange(Old,Phi,_,New,app(Psi,Phi)):- 
   52   Old = s:_,
   53   New = n\n, 
   54   semlex(New/Old,that,[],[]-_,Psi), !.
   55
   56% <example missing>
   57%
   58typechange(Old,Phi,_,New,app(Psi,Phi)):-
   59   Old = (s:_\np)/np, 
   60   member(New,[np/np,np\np]),
   61   semlex(New/Old,empty,[],[]-_,Psi), !.
   62
   63% Ex: walking [in order] to get fit
   64%
   65typechange(Old,Phi,_,New,app(Psi,Phi)):- 
   66   Old = s:_\np,
   67   member(New,[(s:X\np)\(s:X\np), (s:X\np)/(s:X\np)]),
   68   semlex(New/Old,for,[],[]-_,Psi), !.
   69
   70% Ex: [the] man
   71%
   72typechange(Old,Phi,_,New,app(Psi,Phi)):-
   73   Old = n, New = pn,                     %%% preserved for Kilian
   74   semlex(New/Old,the,[],[]-_,Psi), !.
   75
   76% Ex: [the] men
   77%
   78typechange(Old,Phi,Att,New,app(Psi,Phi)):-
   79   Old = n, New = np,
   80   att(Att,pos,POS), 
   81   member(POS,['NNP','NNPS']), 
   82   semlex(New/Old,the,[],[]-_,Psi), !.
   83
   84% Ex: [some] men
   85%
   86typechange(Old,Phi,_,New,app(Psi,Phi)):-
   87   Old = n, New = np,
   88   semlex(New/Old,some,[],[]-_,Psi), !.
   89
   90% Ex: there is hope [and] the rain will end
   91%
   92typechange(Old,Phi,_,New,app(Psi,Phi)):-
   93   Old = s:_, 
   94   member(New,[s:X\s:X,s:X/s:X]),
   95   semlex(New/Old,and,[],[]-_,Psi), !.
   96
   97% Ex: (they say) [the event of] running a marathon (helps)
   98%
   99typechange(Old,Phi,_,New,app(Psi,Phi)):-
  100   Old = (s:ng\np),
  101   New = np, !, 
  102   Psi = lam(VP,lam(F,app(app(VP,lam(P,merge(B:drs([B:[]:X],[B:[]:pred(X,thing,n,12)]),
  103                                             app(P,X)))),lam(E,app(F,E))))).
  104
  105% Ex: [while] regarded as the winner John lost the game
  106%
  107typechange(Old,Phi,_,New,app(Psi,Phi)):-
  108   Old = s:_\np, 
  109   member(New,[s:X/s:X,s:X\s:X]),
  110   semlex(New/Old,while,[],[]-_,Psi), !.
  111
  112% General rule, could be further instantiated (rel)
  113%
  114typechange(Old,Phi,_,New,app(Psi,Phi)):-
  115   semlex(New/Old,rel,[],[]-_,Psi), !,
  116   warning('type changing for ~p',[New/Old]).
  117
  118%typechange(np,Phi,_, (s:X/s:X),app(New,Phi)):- !,
  119%   New = lam(Old,lam(S,lam(E,app(S,lam(X,merge(app(Old,lam(Y,B:drs([],[B:[]:rel(X,Y,rel,0)]))),app(E,X))))))).
  120
  121%typechange(np,Phi,_,(s:X\np)\(s:X\np),app(New,Phi)):- !,
  122%   New = lam(Old,lam(V,lam(N,lam(E,app(app(V,N),lam(X,merge(app(Old,lam(Y,B:drs([],[B:[]:rel(X,Y,rel,0)]))),app(E,X)))))))).
  123
  124%typechange((s:dcl/s:dcl),Old,_,Mod,app(New,Old)):- 
  125%   member(Mod,[(s:X\np)\(s:X\np),(s:X\np)/(s:X\np)]), !,
  126%   New = lam(Old,lam(V,lam(N,app(Old,app(V,N))))).
  127
  128
  129/* -------------------------------------------------------------------------
  130   Type Change (old rules, might need revision)
  131------------------------------------------------------------------------- */
  132
  133typechange((s:dcl/s:dcl),Sem,_, (s:X/s:X),Sem):- !.
  134typechange((s:dcl\s:dcl),Sem,_, (s:X/s:X),Sem):- !.
  135typechange((s:dcl/s:dcl),Sem,_, (s:X\s:X),Sem):- !.
  136typechange((s:dcl\s:dcl),Sem,_, (s:X\s:X),Sem):- !.
  137
  138% not used anymore?
  139%
  140typechange(np,Phi,_, (np/np),app(New,Phi)):- !,
  141   New = lam(Old,lam(M,lam(P,app(Old,lam(X,app(M,lam(Y,merge(B:drs([],[B:[]:eq(X,Y)]),app(P,X))))))))).
  142
  143typechange(np,Old,_,np/(np\np),app(New,Old)):- !,
  144   New = lam(Old,lam(M,app(M,Old))).
  145
  146
  147/* -------------------------------------------------------------------------
  148   Print warning message if no type-changing rules are found
  149------------------------------------------------------------------------- */
  150
  151typechange(Cat1,_,_,Cat2,_):-
  152   warning('no type changing rule for ~p --> ~p',[Cat1,Cat2]),
  153   !, fail