Author: Tomas Rutkauskas
Boyer-Moore-Horspool pattern matching
Answer:
Solve 1:
1
2 function search(pat: PATTERN; text: TEXT): integer;
3 var
4 i, j, k, m, n: integer;
5 skip: array[0..MAXCHAR] of integer;
6 found: boolean;
7 begin
8 found := FALSE;
9 search := 0;
10 m := length(pat);
11 if m = 0 then
12 begin
13 search := 1;
14 found := TRUE;
15 end;
16 for k := 0 to MAXCHAR do
17 skip[k] := m;
18 {Preprocessing}
19 for k := 1 to m - 1 do
20 skip[ord(pat[k])] := m - k;
21 k := m;
22 n := length(text);
23 {Search}
24 while not found and (k < = n) do
25 begin
26 i := k;
27 j := m;
28 while (j = 1) do
29 if text[i] <> pat[j] then
30 j := -1
31 else
32 begin
33 j := j - 1;
34 i := i - 1;
35 end;
36 if j = 0 then
37 begin
38 search := i + 1;
39 found := TRUE;
40 end;
41 k := k + skip[ord(text[k])];
42 end;
43 end;
Solve 2:
44 unit exbmh;
45
46 interface
47
48 uses
49 Windows, SysUtils;
50
51 procedure BMHInit(const pattern: pchar);
52 function BMHSearch(cstring: pchar; const stringlen: integer): pchar;
53
54 var
55 found: pchar;
56
57 implementation
58
59 {Date last modified: 05-Jul-1997
60 Case-sensitive Boyer-Moore-Horspool pattern match
61 Public domain by Raymond Gardner 7/92
62 Limitation: pattern length + string length must be less than 32767
63 10/21/93 rdg Fixed bug found by Jeff Dunlop}
64
65 const
66 Large = 32767;
67
68 type
69 TSkip = array[0..256] of integer;
70 PSkip = ^TSkip;
71 TByteArray = array[0..0] of byte;
72 PByteArray = ^TByteArray;
73
74 var
75 patlen: integer;
76 skip: TSkip;
77 skip2: integer;
78 pat: pchar;
79
80 procedure BMHInit1(const pattern: pchar);
81 var
82 i, lastpatchar: integer;
83 begin
84 pat := pattern;
85 patlen := StrLen(pattern);
86 for i := 0 to 255 do
87 skip[i] := patlen;
88 for i := 0 to patlen - 1 do
89 skip[Byte(pat[i])] := patlen - i - 1;
90 lastpatchar := byte(pat[patlen - 1]);
91 skip[lastpatchar] := Large;
92 skip2 := patlen;
93 for i := 0 to patlen - 2 do
94 if byte(pat[i]) = lastpatchar then
95 skip2 := patlen - i - 1;
96 end;
97
98 function BMHSearch1(cstring: pchar; const stringlen: integer): pchar;
99 var
100 i, j: integer;
101 s: pchar;
102 begin
103 i := patlen - 1 - stringlen;
104 result := nil;
105 if i >= 0 then
106 exit;
107 inc(cstring, stringlen);
108 while true do
109 begin
110 repeat
111 inc(i, skip[byte(cstring[i])]);
112 until
113 i > = 0;
114 if i < (Large - StringLen) then
115 exit;
116 dec(i, Large);
117 j := patlen - 1;
118 s := cstring + (i - j);
119 dec(j);
120 while (j >= 0) and (s[j] = pat[j]) do
121 dec(j);
122 if (j < 0) then
123 begin
124 result := s;
125 exit;
126 end;
127 inc(i, skip2);
128 if (i >= 0) then
129 exit;
130 end;
131 end;
132
133 procedure BMHInit(const pattern: pchar);
134 var
135 i, lastpatchar: integer;
136 len: integer;
137 skip: PSkip;
138 begin
139 pat := pattern;
140 len := StrLen(pattern);
141 patlen := len;
142 skip := @BMHSearchs.Skip;
143 for i := 0 to 255 do
144 skip[i] := len;
145 for i := 0 to len - 1 do
146 skip[Byte(pattern[i])] := len - i - 1;
147 lastpatchar := byte(pattern[len - 1]);
148 skip[lastpatchar] := Large;
149 skip2 := len;
150 for i := 0 to len - 2 do
151 if byte(pattern[i]) = lastpatchar then
152 skip2 := len - i - 1;
153 end;
154
155 function inner(i: integer; c: PByteArray): integer;
156 asm
157 push ebx
158 @L1:
159 movzx ebx, byte ptr[edx + eax]
160 add eax, [offset skip + ebx]
161 jl @l1;
162 pop ebx
163 end;
164
165 function BMHSearch(cstring: pchar; const stringlen: integer): pchar;
166 var
167 i, j: integer;
168 s: pchar;
169 pat: pchar;
170 begin
171 pat := BMHSearchs.pat;
172 i := patlen - 1 - stringlen;
173 result := nil;
174 if i >= 0 then
175 exit;
176 inc(cstring, stringlen);
177 while true do
178 begin
179 repeat
180 inc(i, skip[byte(cstring[i])]);
181 until
182 i >= 0;
183 if i < (Large - StringLen) then
184 exit;
185 dec(i, Large);
186 j := patlen - 1;
187 s := cstring + (i - j);
188 dec(j);
189 while (j >= 0) and (s[j] = pat[j]) do
190 dec(j);
191 if (j < 0) then
192 begin
193 result := s;
194 exit;
195 end;
196 inc(i, skip2);
197 if (i >= 0) then
198 exit;
199 end;
200 end;
201
202 const
203 data = 'of a procedure to find a pattern in a stringThis is a test of a procedure
204 to find a pattern in a string last This is a test of aprocedure to find a pattern
205 in a string'
206
207 initialization
208 BMHInit('last');
209 found := BMHSearch(data, length(data));
210
211 end.
|
