2:- ['working/verbnet/temp.pl'].    3:- use_module(library(lists),[reverse/2,append/3,member/2,select/3]).    4:- dynamic vnpattern/4, role/2.    5
    6/* ----------------------------------------------------------------------
    7   Compute Patterns
    8---------------------------------------------------------------------- */ 
    9
   10patterns:-
   11   init(Len1,Len2),
   12   findall(Ma,verbnet(_,_,_,Ma,_),Roles),
   13   freq(Roles),
   14   setof(V,Pr^Pa^Ma^ID^verbnet(V,Pr,Pa,Ma,ID),L),
   15   reverse(L,R),
   16   patterns(R,1,Len1,Len2),
   17   write('% note: this file was created by "make working/verbnet/verbnet.pl"'),nl,nl,
   18   write(':- module(verbnet,[vnpattern/3]).'),nl,nl,
   19   factors(Max),
   20   printpatterns(Max),
   21   format('% max: ~p~n',[Max]),
   22   halt.
   23
   24
   25/* ----------------------------------------------------------------------
   26   Init VerbNet ID
   27---------------------------------------------------------------------- */ 
   28
   29init(Len1,Len2):-
   30   lensepid('.',Len1),
   31   lensepid('-',Len2).
   32
   33lensepid(Sep,Len):-   
   34   verbnet(_,_,_,_,ID),
   35   count(ID,Sep,Max),
   36   \+ (verbnet(_,_,_,_,ID2), \+ ID=ID2, count(ID2,Sep,Higher), Higher > Max), !,
   37   findall(Sep,member(Sep,ID),Seps),
   38   length(Seps,Len).
   39
   40count([],_,0):- !.
   41count([X|L],X,N):- !, count(L,X,M), N is M + 1.
   42count([_|L],X,N):- count(L,X,N).
   43
   44
   45/* ----------------------------------------------------------------------
   46   Compute frequencies of roles
   47---------------------------------------------------------------------- */ 
   48
   49freq([]).
   50freq([Ma|L]):- roleFreq(Ma), freq(L).
   51
   52roleFreq([]).
   53roleFreq([_:Role|L]):- !, addRole(Role), roleFreq(L).
   54roleFreq([_|L]):- roleFreq(L).
   55
   56addRole(R):- role(R,N), !, retract(role(R,_)), M is N + 1, assert(role(R,M)).
   57addRole(R):- assert(role(R,1)).
   58
   59
   60/* ----------------------------------------------------------------------
   61   Compute VerbNet Id
   62---------------------------------------------------------------------- */ 
   63
   64computeID([X],[Max],Factor,X):- !,
   65   (Max > 9, !, Factor = 100; Factor = 10).
   66
   67computeID([X|L1],[Max|L2],NewPow,Num):-
   68   computeID(L1,L2,Pow,Temp), 
   69   Num is (Pow*X)+Temp,
   70   (Max > 9, !, Factor = 100; Factor = 10),
   71   NewPow is (Pow * Factor).
   72
   73
   74/* ----------------------------------------------------------------------
   75   Compute Factors for VerbNet ID
   76---------------------------------------------------------------------- */ 
   77
   78factors(Max):-
   79   findall(I,vnpattern(_,_,_,I),L),
   80   max(L,[],0,Max), !.
   81
   82max([],[],Max,[Max]):- !.
   83
   84max([],Acc,Max,[Max|L]):- !,
   85   max(Acc,[],0,L).
   86
   87max([[X]|L1],L2,High,Max):- !,
   88   (X > High, !, New = X; New = High),
   89   max(L1,L2,New,Max).
   90
   91max([[X|N1]|L1],L2,High,Max):-
   92   (X > High, !, New = X; New = High),
   93   max(L1,[N1|L2],New,Max).
   94
   95
   96/* ----------------------------------------------------------------------
   97   Print Patterns
   98---------------------------------------------------------------------- */ 
   99
  100printpatterns(Max):-
  101   vnpattern(Verb,Pat,PreMap,NumList),   
  102   map(PreMap,Map),
  103   computeID(NumList,Max,_,Num),
  104   format('~q. %%% ~p~n',[vnpattern(Verb,Num,Map),Pat]), 
  105   fail.
  106
  107printpatterns(_).
  108
  109
  110/* ----------------------------------------------------------------------
  111   Format ID
  112---------------------------------------------------------------------- */ 
  113
  114formatid(['.'|L1],N1,N,L2):- !,
  115   N2 is N1 - 1,
  116   formatid(L1,N2,N,L2).
  117
  118formatid(['-'|L1],0,N1,L2):- !,
  119   N2 is N1 - 1,
  120   formatid(L1,0,N2,L2).
  121
  122formatid(['-'|L1],N1,N,[0|L2]):- 
  123   N1 > 0, !,
  124   N2 is N1 - 1,
  125   formatid(['-'|L1],N2,N,L2).
  126
  127formatid([X|L1],N1,N2,[X|L2]):- 
  128   formatid(L1,N1,N2,L2).
  129
  130formatid([],N1,N,[0|L]):-
  131   N1 > 0, !,
  132   N2 is N1 - 1,
  133   formatid([],N2,N,L).
  134
  135formatid([],N,N1,[0|L]):-
  136   N1 > 0, !,
  137   N2 is N1 - 1,
  138   formatid([],N,N2,L).
  139
  140formatid([],_,_,[]).
  141
  142
  143/* ----------------------------------------------------------------------
  144   Mapping from Proto to VerbNet roles
  145---------------------------------------------------------------------- */ 
  146
  147map(M1,[Prep:Role|M3]):- sublist([prep:Prep,np:Role],M1,M2), map(M2,M3), !.
  148map(M1,[Prep:Role|M3]):- sublist([prep:Prep,s:Role],M1,M2), map(M2,M3), !.
  149map(M1,[rel:Role|M3]):- select(pp:Role,M1,M2), map(M2,M3), !.
  150
  151map([np:R1,v,np:R2,np:R3],[agent:R1,recipient:R2,theme:R3]):- !.
  152map([np:R1,v,np:R2,s:R3],[agent:R1,recipient:R2,theme:R3]):- !.
  153map([np:R1,v,np:R2],[agent:R1,patient:R2]):- !.
  154map([np:R1,v,s:R2],[agent:R1,theme:R2]):- !.
  155map([np:R1,v],[agent:R1]):- !.
  156map([v,np:R1],[agent:R1]):- !.
  157
  158% map(X,_):- format('% ~p~n',[X]), fail.
  159
  160
  161/* ----------------------------------------------------------------------
  162   Probability of pattern, based on role frequency
  163---------------------------------------------------------------------- */ 
  164
  165patprob([],0):- !.
  166patprob([_:R|L],Sum):- role(R,Tmp1), !, patprob(L,Tmp2), Sum is Tmp1 + Tmp2.
  167patprob([_|L],Sum):- patprob(L,Sum).
  168
  169
  170/* ----------------------------------------------------------------------
  171   Patterns
  172---------------------------------------------------------------------- */ 
  173
  174patterns([],_,_,_):- !.
  175
  176patterns([V|L],Len,Len1,Len2):-
  177   verbnet(V,XX,Pat,Map,Id),
  178   length(Pat,Len),
  179   patprob(Map,Score),
  180   \+ (verbnet(V,_,Pat1,Map1,_), length(Pat1,Len), patprob(Map1,Score1), Score1 < Score), !,
  181   formatid(Id,Len1,Len2,FId),
  182   addpat(V,Pat,Map,FId), 
  183   retract(verbnet(V,XX,Pat,Map,Id)),
  184   patterns([V|L],Len,Len1,Len2).
  185
  186patterns([V|L],Len,Len1,Len2):-
  187   verbnet(V,_,Pat,_,_),
  188   length(Pat,Higher), Len < Higher,
  189   NewLen is Len + 1,
  190   patterns([V|L],NewLen,Len1,Len2).
  191
  192patterns([_|L],_,Len1,Len2):- 
  193   patterns(L,1,Len1,Len2).
  194
  195
  196/* ----------------------------------------------------------------------
  197   Add Patterns to Database (longest one first)
  198---------------------------------------------------------------------- */ 
  199
  200addpat(Verb,Pat,Map,Id):-
  201   member(prep:Prep,Map),
  202   atom_chars(Prep,Chars), 
  203   member(' ',Chars), !,
  204   split(Map,Map1,Map2),
  205   addpat(Verb,Pat,Map1,Id),
  206   addpat(Verb,Pat,Map2,Id).
  207
  208addpat(Verb,Pat,Map,Id):-
  209   vnpattern(Verb,Pat,Map,Id), !.
  210
  211addpat(Verb,Pat,Map,Id):-
  212   asserta(vnpattern(Verb,Pat,Map,Id)).
  213
  214
  215/* ----------------------------------------------------------------------
  216   Split Patterns
  217---------------------------------------------------------------------- */ 
  218
  219split([],[],[]).
  220
  221split([prep:X|L],[prep:X1|L],[prep:X2|L]):-
  222   atom_chars(X,Chars),
  223   append(First,[' '|Rest],Chars), !,
  224   atom_chars(X1,First),
  225   atom_chars(X2,Rest).
  226
  227split([X|L],[X|L1],[X|L2]):-
  228   split(L,L1,L2).
  229
  230
  231/* ----------------------------------------------------------------------
  232   Sub List
  233---------------------------------------------------------------------- */ 
  234
  235sublist(Sub,Old,New):- 
  236   append(Start,Rest,Old), 
  237   append(Sub,Temp,Rest), 
  238   append(Start,Temp,New).
  239
  240/* ----------------------------------------------------------------------
  241   Self Starting
  242---------------------------------------------------------------------- */ 
  243
  244:- patterns.