Anonym

Program Pattern;
USES WinCrt;
VAR
  s,p: String;
  comps: Integer;

  FUNCTION CharMatching(p,s: STRING):Integer;
  VAR
    i: Integer;
  BEGIN
    i:=1;
    WHILE (i <= Length(s)) AND (p[1]<>s[i]) DO
      i := i+1;
    IF i > Length(s) THEN
      CharMatching := 0
    ELSE
      CharMatching := i;
    END;

  FUNCTION EQ(a,b:CHAR):BOOLEAN;
  BEGIN
    EQ := a=b;
    Inc(comps);
  END;

  (* links rechts 2loops *)
  FUNCTION BruteSearchLR2L(p,s:STRING):Integer;
  VAR
   plen, slen: INTEGER;
    i,j,pos: INTEGER;
  BEGIN
    plen := Length(p);
    slen := Length(s);
    i:=1;
    j:=1;
    pos:=1;
    WHILE pos <= slen-plen DO BEGIN
      j:=1;
      i:=pos;
      WHILE (j <= plen) AND (EQ(s[i],p[j])) DO BEGIN
        i:=i+1;
        j:=j+1;
      END;
      IF j > plen THEN BEGIN
        BruteSearchLR2L:=pos;
        EXIT;
      END ELSE BEGIN
        pos := pos +1;
      END;
    END; (* outter while *)
    BruteSearchLR2L := 0;
  END;

  FUNCTION BruteSearchLR1L(p,s:STRING):Integer;
  VAR      (* O(plen * slen) *)
    plen, slen: Integer;
    i,j: Integer;
  BEGIN
    plen := Length(p);
    slen := Length(s);
    i:=1;
    j:=1;
    REPEAT
     IF EQ(s[i],p[j]) THEN BEGIN
       i:=i+1;
       j:=j+1;
     END ELSE BEGIN
       i:= i-j+1+1; (* search-position + 1 *)
       j:=1;
     END;
     UNTIL (i> slen) OR (j>plen);
     IF j>plen THEN
       BruteSearchLR1L := i-j+1
     ELSE
       BruteSearchLR1L := 0;
  END;



  FUNCTION KnuthMorrisPratt1(p,s: STRING):INTEGER;
  VAR
    plen, slen: INTEGER;
    i,j: INTEGER;
    next: ARRAY[1..256] OF Integer;

    PROCEDURE InitNext;
    BEGIN
      i:=1;
      j:=0;
      next[1]:=0;
      REPEAT
        IF (j=0) OR EQ(p[i],p[j]) THEN BEGIN
          i:=i+1;
          j:=j+1;
          next[i] := j;
        END ELSE BEGIN
          j:=next[j];
        END;
      UNTIL i>= plen;
    END;

    PROCEDURE PrintNext;
    VAR
      i: Integer;
    BEGIN
      WriteLn;
      WriteLn('---printnext---');
      FOR i:=1 TO plen DO
        Write(next[i],'  ');
      WriteLn('---------------');
    END;
    BEGIN
      plen:=Length(p);
      slen:=Length(s);
      i:=1;
      j:=1;
      InitNext;
      (*PrintNext;*)
      REPEAT
        IF (j=0) OR (EQ(s[i],p[j])) THEN BEGIN
          i:=i+1;
          j:=j+1;
        END ELSE BEGIN
          j:= next[j];
        END;
      UNTIL (i>slen) OR (j>plen);
      IF j > plen THEN
        KnuthMorrisPratt1 := i-plen
      ELSE
        KnuthMorrisPratt1 :=0;
  END;

    FUNCTION KnuthMorrisPratt2(p,s: STRING):INTEGER;
  VAR
    plen, slen: INTEGER;
    i,j: INTEGER;
    next: ARRAY[1..256] OF Integer;

    PROCEDURE InitNext;
    BEGIN
      i:=1;
      j:=0;
      next[1]:=0;
      REPEAT
        IF (j=0) OR EQ(p[i],p[j]) THEN BEGIN
          i:=i+1;
          j:=j+1;
          IF EQ(p[i],p[j]) THEN
            next[i] := next[j]
          ELSE
            next[i] := j;
        END ELSE BEGIN
          j:=next[j];
        END;
      UNTIL i>= plen;
    END;

    PROCEDURE PrintNext;
    VAR
      i: Integer;
    BEGIN
      WriteLn;
      WriteLn('---printnext---');
      FOR i:=1 TO plen DO
        Write(next[i],'  ');
      WriteLn('---------------');
    END;
       BEGIN
      plen:=Length(p);
      slen:=Length(s);
      i:=1;
      j:=1;
      InitNext;
      (*PrintNext;*)
      REPEAT
        IF (j=0) OR (EQ(s[i],p[j])) THEN BEGIN
          i:=i+1;
          j:=j+1;
        END ELSE BEGIN
          j:= next[j];
        END;
      UNTIL (i>slen) OR (j>plen);
      IF j > plen THEN
        KnuthMorrisPratt2 := i-plen
      ELSE
        KnuthMorrisPratt2 :=0;
  END;

BEGIN
  s:='1234567890';
  Write('Enter Pattern: ');
  Readln(p);
  WriteLn('PASCAL POS ',Pos(p,s));
  WriteLn('CharMatching ',CharMatching(p,s));
  WriteLn('BruteSearchLR2L ',BruteSearchLR2L(p,s));
  WriteLn('BruteSearchLR1L ',BruteSearchLR1L(p,s));
  WriteLn('KMP: ',KnuthMorrisPratt1(p,s));
  WriteLn('KMP2: ',KnuthMorrisPratt2(p,s));
END.