ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MISC/EDUCATIO/CATTEST.ZIP/CHECKANS.PAS

Pascal/Delphi Source File | 1990-11-02 | 5.5 KB | 199 lines

unit checkans;
{$UNDEF debug }
  (* remarks - October 5, 1990; added functions with open bracket
                                search
                                *)
interface
uses Crt,Utility,Eval3;

VAR
  MyErrTyp,MyErrPos  : Integer;
  MyErrMsg : STRING;
  uc_var : char;
FUNCTION Check_Answer(s1,s2:STRING;tolerance:real): BOOLEAN;
implementation


FUNCTION Check_Answer(s1,s2:STRING;tolerance:real): BOOLEAN;

VAR
  rno : REAL;
  arno : STRING[8];
  k,k1,l : INTEGER;
  const_val : ARRAY[1..26] OF STRING;

PROCEDURE EXCISE(VAR s:STRING;arno:STRING);

LABEL exit_this_loop;

CONST
  builtinNames : ARRAY [1..19] OF STRING
                 = ('abs(', 'round(', 'trunc(', 'sqrt(', 'sqr(',
                    'arcsin(', 'arccos(', 'arctan(', 'sinh(', 'cosh(', 'tanh(',
                    'sin(', 'cos(', 'tan(',
                    'ln(', 'log(', 'log2(', 'exp(', 'fact(');

VAR
  s2,s_mask  : STRING;
  k_pos,
  k,k_loc,k_len,count : integer;

procedure mask_string;
  var k : integer;
CONST
  Numbers : set of char = ['0'..'9','.'];
begin
  s_mask := '';
  if s[1] in Numbers then s := '(' + s  + ')';
  if s[length(s)] in Numbers then s:= '(' + s + ')';
  FOR k := 1 to Length(s) do (* mask off interface between numbers
                               and other characters *)
     if s[k] in ['0'..'9','.'] then s_mask := s_mask + '0' else
       s_mask := s_mask + '1';
end;
BEGIN (*1*)
  (*first enclose numbers in parenthesis*)
  mask_string;
  k := pos('01',s_mask);
  while k > 0 do
    begin
      insert(')',s,k+1);
      insert(')',s_mask,k+1);
      k := pos('01',s_mask);
    end;

  k := pos('10',s_mask);
  while k > 0 do
    begin
      insert('(',s,k+1);
      insert('(',s_mask,k+1);
      k := pos('10',s_mask);
    end;

  FOR k := 1 TO 19 DO
    BEGIN(*2*)
      k_loc := pos(builtinNames[k],s);
      WHILE k_loc > 0 DO
        BEGIN (*3*)
          FOR k_len := 0 TO Length(builtinNames[k] )-2 DO
            s[k_len+k_loc] := chr(ord(s[k_len+k_loc]) OR $80) ;
          insert('(',s,k_loc); {enclose function in brackets}
          count := 0;
          FOR k_len := k_loc+Length(builtinNames[k]) TO Length(s) DO
            BEGIN (*4*)
              IF s[k_len] = '('
                THEN inc(count);
              IF s[k_len] = ')'
                THEN dec(count);
              IF count = 0
                THEN
                  BEGIN (*5*)
                    insert(')',s,k_len+1);
                    GOTO exit_this_loop;
                  END;(*5*)
            END; (*4*)
          exit_this_loop:
                          k_loc := pos(builtinNames[k],s);
         END; (*3*)
      END; (*2*)

{once all functions are 8-bit highed, uppercase for constants}
  FOR  k := 1 TO length(s) DO
    s[k] := UpCase(s[k]);

     repeat
       l := LENGTH(s);
       k := POS(uc_var,s);
       s2 := COPY(s,1,k-1)+'('+arno+')'+COPY(s,k+1,l-k); { if variable
                                                           present, then
                                                           replace with random
                                                           number surrounded
                                                           in brackets }
       s := s2;
       k := POS(uc_var,s);
     UNTIL k = 0; {continue until variable gone}

{now eliminate all constants 'A' .. 'Z', assuming one letter, except
 for the variable itself}
  FOR k := 1 TO 26 DO
    BEGIN
      k_loc := pos(CHR(k+64),s);
      WHILE k_loc <> 0 DO
        BEGIN
          s := COPY(s,1,k_loc-1)+'('+const_val[k]+')'+COPY(s,k_loc+1,length(s));
          k_loc := pos(CHR(k+64),s);
        END;
    END;

(*     REPEAT
       s2 := '';
       IF (s[k-1] IN ['0'..'9','.']) AND (k>1)
         THEN insert('*',s,k); {example 7X -> 7*X}

       IF (s[k+1] IN ['0'..'9','.']) AND (k+1<=l)
         THEN insert('*',s,k+1); {example X9 -> X*9}
  *)
  FOR k_len := 1 TO length(s) DO
     s[k_len] := chr(ord(s[k_len]) AND $7F) ; {restore builtin functions}

  k_pos := POS(')(',s);
  WHILE k_pos > 0 DO
    BEGIN
      insert('*',s,k_pos+1);
      k_pos := POS(')(',s);
    END;

  k_pos := POS('()',s);
  WHILE k_pos > 0 DO
    BEGIN
      DELETE (s,k_pos,2);
      k_pos := POS('()',s);
    END;

END;

VAR
  Value1,Value2 : REAL;

   BEGIN
     FOR k := 1 TO 26 DO
       STR(RANDOM:8:7,const_val[k]); (*initialize
                                                      constant's
                                                      substitution list*)
     Check_Answer := FALSE;
     k := POS(uc_var,s1);
     rno := RANDOM;
     STR(rno:8:7,arno);(*initialize variable's substitution*)
     EXCISE(s1,arno);
     Value1 := RANDOM;
     Evaluate(s1,Value1,MyErrPos,MyErrMsg);
     {$IFDEF debug}
       GoToXY(1,15);
       WriteLn('s1 = ',s1);
       WriteLn('Value1 = ',Value1);
       Pause(1,25,'Press any key to continue.');
     {$ENDIF}
     IF MyErrPos <> 0
       THEN
         exit
         ELSE
           BEGIN
             EXCISE(s2,arno);
             Value2 := RANDOM;
             Evaluate(s2,Value2,MyErrPos,MyErrMsg);
             IF MyErrPos <> 0
               THEN
                 exit;
             {$IFDEF debug}
              GoToXY(1,17);
              WriteLn('s2 = ',s2);
              WriteLn('Value2 = ',Value2);
              Pause(1,25,'Press any key to continue.');
              {$ENDIF}
             IF abs(Value1-Value2) <= tolerance
               THEN Check_Answer := TRUE;

           END;
END;  {end Check_Answer}
END.