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.