Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Boyer-Moore-Horspool pattern matching Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
30-Aug-02
Category
Algorithm
Language
Delphi 2.x
Views
85
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC