home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STSRCHP.ZIP / STSEARCH.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-12-01  |  4.2 KB  |  153 lines
  1. {***************************************************************
  2.  
  3.  StSearch - An APL like string search routine
  4.  version 1.01      12/1/88
  5.  
  6.  Based on the article "String Searching In C" by Sanford J.
  7.  Hersh in the Dec 1988 issue of Computer Language Magazine
  8.  Volume 5, Number 12
  9.  
  10.  Ported from C to Turbo Pascal 5
  11.  by Richard S. Sadowsky
  12.  CIS: [74017,1670]
  13.  
  14.  I did this port for "kicks" because I found the algorithm
  15.  interesting.  Porting C code to Pascal and vice versa is a
  16.  hobby of mine.  This particular example shows how the C
  17.  algorithm is actually MORE readable the same algorithm in
  18.  Pascal (in my opinion).  I did not include the C code in this
  19.  upload.  It can be found in the Dec '88 issue of CLM (I'm also
  20.  confident you could find it in the CLMForum on Compuserve,
  21.  though I haven't looked).
  22.  
  23.  The purpose of this routine is to find all occurrences of a
  24.  substring within a string.  It is similar to the Turbo Pascal
  25.  Pos() function, except it returns a pointer to a table of all
  26.  the occurrences of the substring within the string.  The maximum
  27.  number of substrings that can be stored in the table is
  28.  controled by the constant SizeVec.  The table is terminated by
  29.  a -1 (the constant Terminator).  A negative value prior to the
  30.  occurrence of a -1 in the Table indicates an error.  See the
  31.  sample program StTest.Pas for a sample usage of this routine.
  32.  
  33.  Note:  Many things in this routine could be modified to make it
  34.  "more Pascal like" as well as more efficient.  For the most
  35.  part, I did a strait port from the C code for purposes of
  36.  allowing comparisons of the two languages.  Anyone interested
  37.  in optimizations or adaptations of this routine should send me
  38.  a message on Compuserve's BPROGA Section 2 (the Turbo Pascal 5
  39.  topic).
  40.  
  41.  
  42.  This fixes a bug in the first upload which caused the StrSearch
  43.  routine to work incorrectly when any portion of the substring
  44.  was the last character of the string to search.
  45.  
  46. ***************************************************************}
  47. Unit StSearch;
  48.  
  49. Interface
  50.  
  51. const
  52.   SizeVec          = 15;
  53.   Terminator       = -1;
  54.  
  55. type
  56.   IntTable         = Array[1..SizeVec+1] of Integer;
  57.   BoolTable        = Array[0..SizeOf(String)] of Boolean;
  58.   StrSearchTable   = ^IntTable;
  59.   TruthTable       = ^BoolTable;
  60.  
  61. function StrSearch(St,SubSt : String) : StrSearchTable;
  62. { Uses a Truth table to find all occurrences of a substring within a }
  63. { string.  Returns a pointer (type StrSearchTable) to a list of the  }
  64. { found positions.  A -1 terminates the list.  A negative number     }
  65. { prior to the -1 indicates an error. }
  66.  
  67. Implementation
  68.  
  69. function StrSearch(St,SubSt : String) : StrSearchTable;
  70.  
  71. const
  72.   Vec              : IntTable = (-1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  73.  
  74. var
  75.   X,Y              : Integer;
  76.   AryIndex         : Word;
  77.   SizeSt           : Byte Absolute St;
  78.   SizeSub          : Byte Absolute SubSt;
  79.   EndSize          : Byte;
  80.   Ary              : TruthTable;
  81.  
  82. begin
  83.   StrSearch := @Vec;
  84.   EndSize   := SizeSt - SizeSub + 1;
  85.  
  86.   if (SizeSt = 0) and (SizeSub = 0) then begin
  87.     Vec[1] := -5;
  88.     Vec[2] := Terminator;
  89.     Exit;
  90.   end;
  91.  
  92.   if (SizeSub = 0) then begin
  93.     Vec[1] := -3;
  94.     Vec[2] := Terminator;
  95.     Exit;
  96.   end;
  97.  
  98.   if (SizeSt = 0) then begin
  99.     Vec[1] := -2;
  100.     Vec[2] := Terminator;
  101.     Exit;
  102.   end;
  103.  
  104.   if (SizeSub > SizeSt) then begin
  105.     Vec[1] := -6;
  106.     Vec[2] := Terminator;
  107.     Exit;
  108.   end;
  109.  
  110.   GetMem(Ary,EndSize * SizeOf(Boolean));
  111.  
  112.   X        := 1;
  113.   AryIndex := 0;
  114.  
  115.   while (X <= EndSize) do begin
  116.     Ary^[AryIndex] := St[X] = SubSt[1];
  117.     Inc(AryIndex);
  118.     Inc(X);
  119.   end;
  120.  
  121.   Y        := 2;
  122.   AryIndex := 0;
  123.   while (Y <= SizeSub) do begin
  124.     X := Y;
  125.     while (X <= (EndSize + Y)) do begin
  126.       Ary^[AryIndex] := Ary^[AryIndex] AND (St[X] = SubSt[Y]);
  127.       Inc(AryIndex);
  128.       Inc(X);
  129.     end;
  130.     Inc(Y);
  131.     AryIndex := 0;
  132.   end;
  133.  
  134.   Y        := 1;
  135.   X        := 1;
  136.   AryIndex := 0;
  137.   while (X <= EndSize) and (Y <= SizeVec) do begin
  138.     if Ary^[AryIndex] then begin
  139.       Vec[Y] := X;
  140.       Inc(Y);
  141.     end;
  142.     Inc(AryIndex);
  143.     Inc(X);
  144.   end;
  145.  
  146.   Vec[Y] := Terminator;
  147.  
  148.   FreeMem(Ary,EndSize * SizeOf(Boolean));
  149. end;
  150.  
  151.  
  152. end.
  153.