home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / medi / match.pas < prev    next >
Pascal/Delphi Source File  |  1984-09-02  |  4KB  |  141 lines
  1.  
  2. (*MATCH FUNCTION FOR NATURAL LANGUAGE*)
  3. (*RESPONSE ANALYSIS*)
  4.  
  5. (*PAUL F. MERRILL*)
  6. (*BRIGHAM YOUNG UNIVERSITY*)
  7.  
  8. PROGRAM PILOT;
  9.  TYPE STRARRAY=ARRAY[1..100] OF STRING;
  10.  VAR C:CHAR;
  11.      KEYWORDSTR,ANS,MATCHSTR:STRING;
  12.  
  13.  FUNCTION MATCH (ANSSTR,STUDENTANS:STRING):BOOLEAN;
  14.     CONST SPACE=' ';
  15.     VAR P,NWORDS,INDEX:INTEGER;
  16.         ORDER,FOUND:BOOLEAN;ANSARRAY:STRARRAY;
  17.  
  18.     PROCEDURE DELCOMMA (VAR MATCHSTR:STRING);
  19.       VAR I:INTEGER;
  20.       BEGIN
  21.          FOR I:= 1 TO LENGTH(MATCHSTR) DO
  22.             IF MATCHSTR[I]<'A'
  23.               THEN
  24.                 MATCHSTR[I]:= ' ';
  25.       END;  (*DELCOMMA*)
  26.     
  27.     PROCEDURE SEPRTE (ANSSTR:STRING;VAR ANSARRAY:STRARRAY;VAR NWORDS:INTEGER);
  28.        CONST COMMA=',';
  29.        VAR LOCCOMMA:INTEGER;
  30.        BEGIN
  31.           ANSSTR:=CONCAT(ANSSTR,COMMA);
  32.           NWORDS:=0;
  33.           WHILE LENGTH (ANSSTR)>1 DO
  34.             BEGIN
  35.               LOCCOMMA:=POS(COMMA,ANSSTR);
  36.               NWORDS:=NWORDS+1;
  37.               ANSARRAY[NWORDS]:=COPY(ANSSTR,1,LOCCOMMA-1);
  38.               DELETE (ANSSTR,1,LOCCOMMA);
  39.             END; (*WHILE*)
  40.       END;  (*SEPRTE*)
  41.       
  42.     
  43.     PROCEDURE ORDERCHK;
  44.       BEGIN
  45.         FOUND:=TRUE;
  46.         IF ORDER 
  47.           THEN
  48.             BEGIN
  49.               DELETE (STUDENTANS,1,P+LENGTH(ANSARRAY[INDEX])-1);
  50.               STUDENTANS:=CONCAT(SPACE,STUDENTANS);
  51.             END;  (*IF*)
  52.       END;  (*ORDERCHK*)
  53.    
  54.     PROCEDURE ORTEST;
  55.       BEGIN
  56.         ANSARRAY[INDEX]:=COPY(ANSARRAY[INDEX],2,LENGTH(ANSARRAY[INDEX])-1);
  57.         WHILE POS(')',ANSARRAY[INDEX])=0 DO
  58.           BEGIN
  59.              P:=POS (ANSARRAY[INDEX],STUDENTANS);
  60.              IF P<>0
  61.                 THEN ORDERCHK;
  62.              INDEX:=INDEX+1;
  63.           END; (*WHILE*)
  64.         IF NOT FOUND 
  65.           THEN
  66.             BEGIN
  67.               DELETE (ANSARRAY[INDEX],LENGTH(ANSARRAY[INDEX]),1);
  68.               P:=POS (ANSARRAY[INDEX],STUDENTANS);
  69.               IF P<>0
  70.                  THEN ORDERCHK
  71.             END; (*IF NOT FOUND*)
  72.       END;  (*ORTEST*)
  73.     
  74.    BEGIN  (*MATCH FUNCTION*)
  75.      DELCOMMA(STUDENTANS);
  76.      STUDENTANS:=CONCAT(SPACE,STUDENTANS,SPACE);
  77.      ORDER:=ANSSTR[1]='*';
  78.      IF ORDER THEN DELETE (ANSSTR,1,1);
  79.      SEPRTE(ANSSTR,ANSARRAY,NWORDS);
  80.      INDEX:=1;
  81.      REPEAT
  82.         FOUND:=FALSE;
  83.         IF ANSARRAY[INDEX,1]='('
  84.             THEN
  85.                BEGIN
  86.                  ORTEST;
  87.                  IF NOT FOUND 
  88.                    THEN
  89.                       BEGIN
  90.                         MATCH:=FALSE;
  91.                         EXIT(MATCH)
  92.                       END;
  93.                END (*THEN*)
  94.             ELSE 
  95.               BEGIN
  96.                 P:=POS (ANSARRAY[INDEX],STUDENTANS);
  97.                 IF P<>0
  98.                   THEN ORDERCHK
  99.                   ELSE 
  100.                     BEGIN
  101.                       MATCH:=FALSE;
  102.                       EXIT(MATCH);
  103.                     END;  (*ELSE*)
  104.               END; (*ELSE*)
  105.         INDEX:=INDEX+1
  106.      UNTIL INDEX>NWORDS;
  107.      MATCH:=FOUND
  108.    END;  (*MATCH FUNCTION*)
  109.   
  110.  BEGIN  (*MAIN PROGRAM*)
  111.    KEYWORDSTR:='';
  112.    REPEAT
  113.      PAGE (OUTPUT);
  114.      WRITELN;WRITELN;
  115.      WRITELN('MATCH FUNCTION DEMO':28);
  116.      WRITELN;WRITELN('THIS DEMONSTRATION PROGRAM CAN BE USED');
  117.      WRITELN('TO EXPERIMENT WITH THE MATCH FUNCTION.');
  118.      WRITELN;WRITELN('ENTER CORRECT @NSWER STRING OR RETURN:');
  119.      WRITELN(' EG.:  * RED ,(GREEN, PINK ),YELLOW');
  120.      WRITELN;
  121.      READLN (ANS);
  122.      IF LENGTH(ANS)<>0 
  123.         THEN KEYWORDSTR:=ANS
  124.         ELSE 
  125.           BEGIN
  126.              WRITELN;WRITELN('DEFAULT CORRECT ANSWER STRING:');
  127.              WRITELN('  ',KEYWORDSTR);
  128.           END;
  129.      WRITELN;WRITELN('ENTER MATCH STRING:');
  130.      WRITELN;
  131.      READLN(MATCHSTR);
  132.      WRITELN;WRITE('*****   ');
  133.      IF MATCH (KEYWORDSTR,MATCHSTR)
  134.        THEN WRITE('MATCH')
  135.        ELSE WRITE('NO MATCH');
  136.      WRITELN('   *****');
  137.      WRITELN;WRITE('<SPACE> TO CONTINUE     <ESC> TO QUIT ');
  138.      READ(C);
  139.   UNTIL C=CHR(27);
  140. END.
  141.