home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l217 / 2.ddi / PROGRAMS / SEN_AN.PRO < prev    next >
Encoding:
Text File  |  1990-03-26  |  12.9 KB  |  484 lines
  1. /********************************************************************/
  2. /*                                                                  */
  3. /*                  PDC Prolog example program                      */
  4. /*                                    */
  5. /*   Copyright (c) 1986, 90 by Prolog Development Center            */
  6. /*                                                                  */
  7. /*             SENTENCE ANALYSIS                */
  8. /* This sample shows how sentence analysing can be done in PDC      */
  9. /* PROLOG.                                */
  10. /* The structure of sentences is nicely modelled in the typesystem, */
  11. /* and the resulting parse-tree illustrates how easily these things */
  12. /* can be done in PDC Prolog                        */
  13. /*                                    */
  14. /* As an example the following sentence can be recognized:        */
  15. /*  - every man that lives loves a woman                */
  16. /*                                    */
  17. /********************************************************************/
  18.  
  19. include "tdoms.pro"
  20. include "tpreds.pro" 
  21.  
  22. DATABASE
  23. % words which can be recognized
  24.   det( STRING )
  25.   noun( STRING )
  26.   rel( STRING )
  27.   verb( STRING )
  28.  
  29. include "MENU2.PRO"
  30.  
  31. DOMAINS
  32.   DETERM   = none ; determ( STRING )
  33.   NOUNP    = nounp( DETERM, STRING, RELCL)
  34.   RELCL    = none ; relcl( STRING, VERBP )
  35.   SENTENCE = sent( NOUNP, VERBP )
  36.   TOKL     = STRING*
  37.   VERBP    = verb( STRING ) ; verbp( STRING, NOUNP )
  38.  
  39. % Domains for the tree with positions
  40.   d_SENTENCE = sent( d_NOUNP, d_VERBP )
  41.   d_NOUNP    = nounp( d_DETERM, COL, d_RELCL)
  42.   d_DETERM   = none ; determ( COL )
  43.   d_RELCL    = none ; relcl( COL, d_VERBP )
  44.   d_VERBP    = verb( COL ) ; verbp( COL, d_NOUNP )
  45.  
  46.   COLL = COL*
  47.  
  48. PREDICATES
  49. % Recognition of words in different forms
  50.   is_det( STRING )
  51.   is_noun( STRING )
  52.   is_rel( STRING )
  53.   is_verb( STRING )
  54.  
  55. % Parser
  56.   nondeterm s_determ(   TOKL, TOKL, COLL, COLL, DETERM, d_DETERM )
  57.   nondeterm s_nounp(    TOKL, TOKL, COLL, COLL, NOUNP, d_NOUNP )
  58.   nondeterm s_relcl(    TOKL, TOKL, COLL, COLL, RELCL, d_RELCL )
  59.   nondeterm s_sentence( TOKL, TOKL, COLL, COLL, SENTENCE, d_SENTENCE )
  60.   nondeterm s_verbp(    TOKL, TOKL, COLL, COLL, VERBP, d_VERBP )
  61.  
  62. % draw a sentence tree
  63.   draw_nounp( ROW, ROW, d_NOUNP, NOUNP, COL )
  64.   draw_relcl( ROW, ROW, d_RELCL, RELCL, COL )
  65.   draw_sentence( ROW, ROW, d_SENTENCE, SENTENCE )
  66.   draw_verbp( ROW, ROW, d_VERBP, VERBP, COL )
  67.  
  68. % Miscellaneous drawing predicates
  69.   lin(ROW,COL,ROW,COL)
  70.   line_hor(COL,COL,ROW)
  71.   line_ver(ROW,ROW,COL)
  72.   mark(ROW,COL,STRING,ATTR)
  73.   mark2(ROW,COL,STRING,ATTR)
  74.   markfinal(ROW,COL,STRING,STRING)
  75.   mk_ulin(STRING,STRING)
  76.   scr_tegn(ROW,COL,CHAR)
  77.   writetext(ROW,COL,STRING,ATTR)
  78.  
  79. % scanner
  80.   check(STRING)
  81.   tokl( COL, COLL, STRING, TOKL )
  82.   tom(TOKL).
  83.  
  84. % Main predicates
  85.   analyze
  86.   key
  87.   process(INTEGER)
  88.   run1
  89.   run2(STRING)
  90.   sen_an
  91.  
  92. % Update database predicates
  93.   read(STRING,STRING)
  94.   updatdba
  95.   updatdba1(INTEGER)
  96.  
  97. GOAL
  98.     makewindow(1,6,0,"",0,0,25,80),
  99. %      makewindow(1,6,2," Sentence Analyzer ",0,0,25,80),
  100. %      Makes a nicer display, but can't analyze long sentences!
  101.     sen_an.
  102.  
  103. CLAUSES
  104.  
  105. key:-
  106.     write("\n\n>> Press any key: "),
  107.     readkey(_).
  108.  
  109. % * * * * * * * * * * * * * * * * * * * * * * * *
  110. % Main menu
  111. % * * * * * * * * * * * * * * * * * * * * * * * *
  112.  
  113. sen_an:-repeat,
  114.   menu(5,27,7,7,
  115.       [ "Analyze a sentence",
  116.         "Load database from file",
  117.         "Erase current database",
  118.         "",
  119.         "Show/update the language",
  120.         "Save database to file",
  121.         "",
  122.         "Edit database file",
  123.         "",
  124.         "Tutorial",
  125.         "",
  126.         "Operating system",
  127.         "eXit"] ,"Sentence Analyser",2,
  128.   CHOICE) ,
  129.   process(CHOICE),
  130.   CHOICE=0,!.
  131.  
  132. process(0):-
  133.     write("\nAre you sure ? (y/n): "),
  134.     readchar(T),
  135.     T='y'.
  136. process(1) :- analyze.
  137. process(2):-consult("sen_an.san"),!.
  138. process(2):-write(">> Can't read sen_an.san\n").
  139. process(3):- retractall(_).
  140. process(5):-updatdba.
  141. process(6):-
  142.     existfile("sen_an.bak"),!,
  143.     deletefile("sen_an.bak"),
  144.     renamefile("sen_an.san","sen_an.bak"),
  145.     save("sen_an.san");
  146.     renamefile("sen_an.san","sen_an.bak"),
  147.     save("sen_an.san").
  148.     
  149. process(8):-
  150.     file_str("sen_an.san",DB),
  151.     edit(DB,DBNEW),
  152.     clearwindow,
  153.     not(DB = DBNEW),
  154.     write("Do you wish to save the changes? (y/n) "),
  155.     readchar(Ans), str_char(Ans1,Ans),
  156.     upper_lower(Ans1,Ans2), clearwindow ,
  157.     Ans2 = "y",
  158.     file_str("sen_an.san",DBNEW),
  159.     retractall(_),
  160.     process(2).
  161. process(10):-
  162.     file_str("sen_an.hlp",TXT),
  163.     display(TXT),
  164.     clearwindow,!.
  165. process(10):-write(">> Can't read sen_an.hlp\n"),
  166.              readchar(_),clearwindow.
  167. process(12):-
  168.     makewindow(2,2,0," DOS ", 10,10,10,60) ,
  169.     system(""),!,
  170.     removewindow.
  171. process(12):-
  172.     write(">> command.com not accesible. press any"),
  173.     readchar(_),
  174.     removewindow.
  175. process(13) :- exit.
  176.  
  177. % * * * * * * * * * * * * * * * * * * * * * * * *
  178. % Analyze a sentence
  179. % * * * * * * * * * * * * * * * * * * * * * * * *
  180.  
  181. analyze:-
  182.      clearwindow, cursor(21,1),
  183.      write("Try: every man that lives loves a woman"),
  184.      cursor(0,1) ,
  185.      run1,!
  186.     ; clearwindow.
  187.  
  188. run1:-
  189.     write("\n Write a sentence:\n    "),
  190.     readln(LIN), LIN >< "" ,
  191.     run2(LIN), !,
  192.     run1.
  193.  
  194. run2(LIN):-
  195.     clearwindow,
  196.     tokl(5,POSL,LIN,TOKL),
  197.     s_sentence( TOKL, _, POSL, _, SENT, POS ),
  198.     draw_sentence( 4, 0, POS, SENT ), 
  199.     cursor(21,1),
  200. %    write("SENTENCE=",LIN),nl,nl,
  201.     write("PROLOG OBJECT=",SENT," "),
  202.     readchar(_),clearwindow,!.
  203. run2(_).
  204.  
  205. tokl(POS,[POS1|POSL],STR,[TOK|TOKL]) :-
  206.     fronttoken(STR,TOK,STR1),
  207.     check(TOK),!,
  208.     str_len(TOK,LEN),
  209.     POS1=POS+(LEN+1) div 2,
  210.     POS2=POS+5+LEN,
  211.     tokl(POS2,POSL,STR1,TOKL).
  212. tokl(_,[],_,[]).
  213.  
  214. s_sentence(TOKL,TOKL2,COLL,COLL2,sent(NOUNP,VERBP),
  215.  sent(D_NOUNP,D_VERBP)):-
  216.     s_nounp(TOKL,TOKL1,COLL,COLL1,NOUNP,D_NOUNP),
  217.     s_verbp(TOKL1,TOKL2,COLL1,COLL2,VERBP,D_VERBP),
  218.     tom(TOKL2),!.
  219. s_sentence(_,_,_,_,_,_):-
  220.     write(">> Sentence not recognized (Use F8 to get the old line)\n"),fail.
  221.  
  222. tom([]).
  223.  
  224. s_nounp(TOKL,TOKL2,COLL,COLL2,nounp(DETERM,NOUN,RELCL),
  225.  nounp(D_DETERM,COL,D_RELCL)):-
  226.     s_determ(TOKL,[NOUN|TOKL1],COLL,[COL|COLL1],DETERM,D_DETERM),
  227.     is_noun(NOUN),
  228.     s_relcl(TOKL1,TOKL2,COLL1,COLL2,RELCL,D_RELCL).
  229.  
  230. s_determ([DETERM|TOKL],TOKL,[COL|COLL],COLL,determ(DETERM),
  231.  determ(COL)):-
  232.     is_det(DETERM).
  233. s_determ(TOKL,TOKL,COLL,COLL,none,none).
  234.  
  235. s_relcl([REL|TOKL],TOKL1,[COL|COLL],COLL1,relcl(REL,VERBP),
  236.  relcl(COL,D_VERBP) ):-
  237.     is_rel(REL),
  238.     s_verbp(TOKL,TOKL1,COLL,COLL1,VERBP,D_VERBP).
  239. s_relcl(TOKL,TOKL,COLL,COLL,none,none).
  240.  
  241. s_verbp([VERB|TOKL],TOKL1,[COL|COLL],COLL1,verbp(VERB,NOUNP),
  242.  verbp(COL,D_NOUNP)):-
  243.     is_verb(VERB),
  244.     s_nounp(TOKL,TOKL1,COLL,COLL1,NOUNP,D_NOUNP).
  245. s_verbp([VERB|TOKL],TOKL,[COL|COLL],COLL,verb(VERB),verb(COL)):-
  246.     is_verb(VERB).
  247.  
  248. check(WORD):-is_noun(WORD),!.
  249. check(WORD):-is_det(WORD),!.
  250. check(WORD):-is_rel(WORD),!.
  251. check(WORD):-is_verb(WORD),!.
  252. check(WORD):- write(">> Unknown word: ",WORD),
  253.               nl, readchar(_).
  254.  
  255. is_noun(X):-noun(X),!.
  256. is_noun(X):-noun(Y),concat(Y,"s",X),!.
  257.  
  258. is_det(X):-det(X),!.
  259.  
  260. is_rel(X):-rel(X),!.
  261.  
  262. is_verb(X):-verb(X),!.
  263. is_verb(X):-verb(Y),concat(Y,"s",X),!.
  264. is_verb(X):-verb(Y),concat(Y,"ed",X),!.
  265. is_verb(X):-verb(Y),concat(Y,"es",X),!.
  266. is_verb(X):-verb(Y),concat(Y,"ing",X),!.
  267.  
  268. % * * * * * * * * * * * * * * * * * * * * * * * *
  269. %  Draw the sentence
  270. % * * * * * * * * * * * * * * * * * * * * * * * *
  271.  
  272. draw_sentence(STEP,DEPT,sent(D_NOUNP,D_VERBP),sent(NOUNP,VERBP)):-
  273.     DEPT1=DEPT+STEP,
  274.     draw_nounp(STEP,DEPT1,D_NOUNP,NOUNP,COL1),
  275.     draw_verbp(STEP,DEPT1,D_VERBP,VERBP,COL2),
  276.     COL=(COL1+COL2) div 2,
  277.     lin(DEPT,COL,DEPT1,COL1),
  278.     lin(DEPT,COL,DEPT1,COL2),
  279.     mark(DEPT,COL,"SENTENCE",33).
  280.  
  281. draw_nounp(STEP,DEPT,nounp(none,COL,none),nounp(_,NOUN,_),COL):-
  282.     DEPT1=DEPT+STEP div 2,
  283.     lin(DEPT1,COL,DEPT,COL),
  284.     markfinal(DEPT1,COL,"NOUN",NOUN),
  285.     mark(DEPT,COL,"NOUNP",33).
  286. draw_nounp(STEP,DEPT,nounp(determ(COL1),COL2,none),
  287.  nounp(determ(DET),NOUN,_),COL):-
  288.     DEPT1=DEPT+STEP,
  289.     COL=(COL1+COL2) div 2,
  290.     lin(DEPT1,COL1,DEPT,COL),
  291.     lin(DEPT1,COL2,DEPT,COL),
  292.     markfinal(DEPT1,COL1,"DETERM",DET),
  293.     markfinal(DEPT1,COL2,"NOUN",NOUN),
  294.     mark(DEPT,COl,"NOUNP",33).
  295. draw_nounp(STEP,DEPT,nounp(none,COL1,relcl(REL,VERBP)),
  296.  nounp(none,NOUN,RELCL),COL):-
  297.     DEPT1=DEPT+STEP,
  298.     draw_relcl(STEP,DEPT1,relcl(REL,VERBP),RELCL,COL2),
  299.     COL=(COL1+COL2) div 2,
  300.     lin(DEPT1,COL1,DEPT,COL),
  301.     lin(DEPT1,COL2,DEPT,COL),
  302.     markfinal(DEPT1,COL1,"NOUN",NOUN),
  303.     mark(DEPT,COL,"NOUNP",33).
  304. draw_nounp(STEP,DEPT,nounp(determ(COL1),COL2,relcl(REL,VERBP)),
  305.  nounp(determ(DET),NOUN,RELCL),COL):-
  306.     DEPT1=DEPT+STEP,
  307.     draw_relcl(STEP,DEPT1,relcl(REL,VERBP),RELCL,COL3),
  308.     COL=(COL1+COL2+COL3) div 3,
  309.     lin(DEPT1,COL1,DEPT,COL),
  310.     lin(DEPT1,COL2,DEPT,COL),
  311.     lin(DEPT1,COL3,DEPT,COL),
  312.     markfinal(DEPT1,COL1,"DETERM",DET),
  313.     markfinal(DEPT1,COL2,"NOUN",NOUN),
  314.     mark(DEPT,COL,"NOUNP",33).
  315.  
  316. draw_verbp(STEP,DEPT,verb(COL),verb(VERB),COL):-
  317.     DEPT1=DEPT+STEP div 2,
  318.     lin(DEPT1,COL,DEPT,COL),
  319.     markfinal(DEPT1,COL,"VERB",VERB),
  320.     mark(DEPT,COL,"VERBP",33).
  321. draw_verbp(STEP,DEPT,verbp(COL1,D_NOUNP),verbp(VERB,NOUNP),COL):-
  322.     DEPT1=DEPT+STEP,
  323.     draw_nounp(STEP,DEPT1,D_NOUNP,NOUNP,COL2),
  324.     COL=(COL1+COL2) div 2,
  325.     lin(DEPT1,COL1,DEPT,COL),
  326.     lin(DEPT1,COL2,DEPT,COL),
  327.     markfinal(DEPT1,COL1,"VERB",VERB),
  328.     mark(DEPT,COL,"VERBP",33).
  329.  
  330. draw_relcl(STEP,DEPT,relcl(COL1,D_VERBP),relcl(REL,VERBP),COL):-
  331.     DEPT1=DEPT+STEP,
  332.     draw_verbp(STEP,DEPT1,D_VERBP,VERBP,COL2),
  333.     COL=(COL1+COL2) div 2,
  334.     lin(DEPT1,COL1,DEPT,COL),
  335.     lin(DEPT1,COL2,DEPT,COL),
  336.     markfinal(DEPT1,COL1,"REL",REL),
  337.     mark(DEPT,COL,"RELCL",33).
  338.  
  339. lin(R1,C,R2,C):-!,
  340.     line_ver(R1,R2,C).
  341. lin(R1,C1,R2,C2):-
  342.     RM=(R1+R2) div 2,
  343.     line_ver(R1,RM,C1),
  344.     line_hor(C1,C2,RM),
  345.     line_ver(RM,R2,C2),
  346.     scr_tegn(RM,C1,'+'),
  347.     scr_tegn(RM,C2,'+').
  348.  
  349. line_ver(R,R,_):-!.
  350. line_ver(R1,R2,C):-
  351.     R2>R1,!,
  352.     scr_tegn(R1,C,'|'),
  353.     R=R1+1,
  354.     line_ver(R,R2,C).
  355. line_ver(R2,R1,C):-
  356.     scr_tegn(R1,C,'|'),
  357.     R=R1+1,
  358.     line_ver(R,R2,C).
  359.  
  360. line_hor(C,C,_):-!.
  361. line_hor(C1,C2,R):-
  362.     C2>C1,!,
  363.     scr_tegn(R,C1,'-'),
  364.     C=C1+1,
  365.     line_hor(C,C2,R).
  366. line_hor(C2,C1,R):-
  367.     scr_tegn(R,C1,'-'),
  368.     C=C1+1,
  369.     line_hor(C,C2,R).
  370.  
  371. mark(ROW,COL,TEXT,ATTR):-
  372.     str_len(TEXT,LEN),
  373.     C=COL-(LEN-1) div 2,
  374.     writetext(ROW,C,TEXT,ATTR).
  375.  
  376. mark2(ROW,COL,TEXT,ATTR):-
  377.     str_len(TEXT,LEN),
  378.     C=COL-LEN div 2,
  379.     writetext(ROW,C,TEXT,ATTR).
  380.  
  381. markfinal(ROW,COL,TEXT1,TEXT2):-
  382.     str_len(TEXT1,L1),
  383.     str_len(TEXT2,L2),
  384.     L2>L1,!,
  385.     R1=ROW+1, R2=ROW+2,
  386.     mk_ulin(TEXT1,ULINE),
  387.     mark2(ROW,COL,TEXT1,33),
  388.     mark2(R1,COL,ULINE,7),
  389.     mark(R2,COL,TEXT2,112).
  390.  
  391. markfinal(ROW,COL,TEXT1,TEXT2):-
  392.     str_len(TEXT1,L),
  393.     str_len(TEXT2,L),!,
  394.     R1=ROW+1,
  395.     R2=ROW+2,
  396.     mk_ulin(TEXT1,ULINE),
  397.     mark(ROW,COL,TEXT1,33),
  398.     mark(R1,COL,ULINE,7),
  399.     mark(R2,COL,TEXT2,112).
  400.  
  401. markfinal(ROW,COL,TEXT1,TEXT2):-
  402.     R1=ROW+1,
  403.     R2=ROW+2,
  404.     mk_ulin(TEXT1,ULINE),
  405.     mark(ROW,COL,TEXT1,33),
  406.     mark(R1,COL,ULINE,7),
  407.     mark2(R2,COL,TEXT2,112).
  408.  
  409. mk_ulin(STR1,STR2):-
  410.     frontchar(STR1,_,REST),!,
  411.     mk_ulin(REST,ULI1),
  412.     concat(ULI1,"-",STR2).
  413. mk_ulin("","").
  414.  
  415. scr_tegn(R,C,CH):-
  416.     R<25,
  417.     C<80,!,
  418.     scr_char(R,C,CH).
  419. scr_tegn(_,_,_).
  420.  
  421. writetext(ROW,COL,TEXT,ATTR):-
  422.     ROW<25,
  423.     COL<80,
  424.     frontchar(TEXT,CH,REST),!,
  425.     scr_char(ROW,COL,CH),
  426.     scr_attr(ROW,COL,ATTR),
  427.     COL1=COL+1,
  428.     writetext(ROW,COL1,REST,ATTR).
  429. writetext(_,_,_,_).
  430.  
  431. % * * * * * * * * * * * * * * * * * * * * * * * *
  432. %  Update/Show database
  433. % * * * * * * * * * * * * * * * * * * * * * * * *
  434.  
  435. updatdba:-
  436.     repeat,
  437.     menu(10,20,7,7,
  438.      ["Show verbs", 
  439.       "Show nouns",
  440.       "Show relatives", 
  441.       "Show determiners",
  442.       "",
  443.       "Add a verb", 
  444.       "Add a noun",
  445.       "Add a relative", 
  446.       "Add a determiner"],"Update/Show database",
  447.       5,CHOICE),
  448.     updatdba1(CHOICE),
  449.     CHOICE=0,!.
  450.  
  451. updatdba1(0).
  452. updatdba1(1):-
  453.     write("\n\nVerbs:\n******\n"),
  454.     verb(X), write(X,' '), fail.
  455. updatdba1(1):-nl,key,clearwindow.
  456. updatdba1(2):-
  457.     write("\n\nNouns:\n******\n"),
  458.     noun(X), write(X,' '), fail.
  459. updatdba1(2):-nl,key,clearwindow.
  460. updatdba1(3):-
  461.     write("\n\nRelatives:\n**********\n"),
  462.     rel(X), write(X,' '), fail.
  463. updatdba1(3):-nl,key,clearwindow.
  464. updatdba1(4):-
  465.     write("\n\nDeterminers:\n************\n"),
  466.     det(X), write(X,' '), fail.
  467. updatdba1(4):-nl,key,clearwindow.
  468. updatdba1(6):-
  469.     read("New verb",X),
  470.     assert(verb(X)).
  471. updatdba1(7):-
  472.     read("New noun",X),
  473.     assert(noun(X)).
  474. updatdba1(8):-
  475.     read("New relative",X),
  476.     assert(rel(X)).
  477. updatdba1(9):-
  478.     read("New determiner",X),
  479.     assert(det(X)).
  480.  
  481. read(TXT,ANS):-nl,
  482.     write(TXT,": "),
  483.     readln(ANS),clearwindow,ANS><"".
  484.