2% para.pl, by Johan Bos
    3
    4:- use_module(library(readutil),[read_line_to_codes/2]).    5:- use_module(library(lists),[member/2,append/3]).    6:- ['working/ppdb.1.pl'].    7:- ['working/ppdb.2.pl'].    8:- ['working/ppdb.3.pl'].    9:- ['working/ppdb.4.pl'].   10
   11
   12/* ========================================================================
   13   Main
   14======================================================================== */
   15
   16main(T,H,Stream):-
   17   para(T,H,P,S),
   18   write(S),nl,
   19   outputP(P,Stream), fail.
   20  
   21main(_,_,_).
   22
   23
   24/* ========================================================================
   25   Paraphrasing
   26======================================================================== */
   27
   28para([X|L1],H,L3,[X]-Par):-
   29   p1(X,Par),
   30   ok(Par,L1,H),
   31   append(Par,L1,L3).
   32
   33para([X,Y|L1],H,L3,[X,Y]-Par):-
   34   p2(X,Y,Par),
   35   ok(Par,L1,H),
   36   append(Par,L1,L3).
   37
   38para([X,Y,Z|L1],H,L3,[X,Y,Z]-Par):-
   39   p3(X,Y,Z,Par),
   40   ok(Par,L1,H),
   41   append(Par,L1,L3).
   42
   43para([X,Y,Z,A|L1],H,L3,[X,Y,Z,A]-Par):-
   44   p4(X,Y,Z,A,Par),
   45   ok(Par,L1,H),
   46   append(Par,L1,L3).
   47
   48para([X|L1],H,[X|L2],S):-
   49   para(L1,H,L2,S).
   50
   51
   52/* ========================================================================
   53   Sanity check for paraphrase
   54======================================================================== */
   55
   56ok(Par,T,H):-
   57   \+ (member(Word,Par), member(Word,T)),        % no word of the paraphrase should occur already in T
   58   \+ (member(Word,Par), \+ member(Word,H)), !.  % every word of the paraphrase should occur in H
   59
   60ok([some],_,_).  % if the paraphrase is a determiner, take it as well.
   61
   62
   63/* ========================================================================
   64   Output
   65======================================================================== */
   66
   67outputP([X],S):- !, write(S,X), nl(S).
   68outputP([X|L],S):- write(S,X), write(S,' '), outputP(L,S).
   69
   70
   71/*------------------------------------------------------------------------
   72   Read contents of file
   73------------------------------------------------------------------------*/
   74
   75checkFile(Dir,F,S):-
   76   atomic_list_concat([Dir,'/',F],File),
   77   access_file(File,read),
   78   open(File,read,Stream),
   79   read_line_to_codes(Stream,Codes),
   80   close(Stream),
   81   atom_codes(Atom,Codes),
   82   downcase_atom(Atom,Down),
   83   atomic_list_concat(S,' ',Down).
   84
   85
   86/*------------------------------------------------------------------------
   87   Check presence of files t and h
   88------------------------------------------------------------------------*/
   89
   90checkFiles([]).
   91
   92checkFiles([Dir|L]):-
   93   checkFile(Dir,t,T),
   94   checkFile(Dir,h,H), !,
   95   atomic_list_concat([Dir,'/','paraphrases.txt'],File),   
   96   open(File,write,Stream),
   97   main(T,H,Stream),
   98   close(Stream),
   99   checkFiles(L).
  100
  101checkFiles([Dir|L]):-
  102   format('directory ~p does not contain files~n',[Dir]), 
  103   checkFiles(L).
  104
  105
  106/*------------------------------------------------------------------------
  107   Check directory
  108------------------------------------------------------------------------*/
  109
  110checkDir([Dir],List):-
  111   exists_directory(Dir), 
  112   access_file(Dir,write), 
  113   atom_concat(Dir,'/*',Wild),
  114   subdirs(Wild,List), !.
  115
  116checkDir([_|L],Dirs):- 
  117   checkDir(L,Dirs).
  118
  119
  120/*------------------------------------------------------------------------
  121   Sub Dirs
  122------------------------------------------------------------------------*/
  123
  124subdirs(Wild,Dirs):-
  125   expand_file_name(Wild,List),
  126   findall(D,( member(D,List),
  127               exists_directory(D),
  128               access_file(D,write) ),Dirs), !.
  129
  130
  131
  132/* =======================================================================
  133   Definition of start
  134========================================================================*/
  135
  136start:-
  137   current_prolog_flag(argv,Args), 
  138%   \+ Args = [],
  139   checkDir(Args,Dirs), 
  140   \+ Dirs=[],
  141   checkFiles(Dirs), !,
  142   halt.
  143
  144start:- halt.
  145
  146:- start.