Ada Programming/Algorithms/Knuth-Morris-Pratt pattern matcher

Algorithms/pattern_match_knuth_morris_pratt_test.adb pattern_match_knuth_morris_pratt_test.adb an implementation for fixed strings Written by Wikibob, 2004, from notes on the Knuth_Morris_Pratt pattern match algorithm adapted to fixed strings of characters. It is in the public domain. If you are using GNAT, use gnatmake to compile and link this program. To use the pattern match functions in your own software extract the inner package's specification and body into separate files. This program is self-contained and demonstrates a particular implementation of the Knuth_Morris_Pratt algorithm applied to fixed strings, with the following restrictions: * the search pattern is limited to a maximum of 256 characters * the caller must first call the function Pre_Compute on a pattern to obtain a context variable containing the pre-computed pattern. There is no limit to the number of contexts. * the caller must handle the exception Pattern_Error that will be raised if function Find_Location was unable to find the pattern in the given string. Suggested improvements to the inner package are: * add type Result_T is record Location : Index; Found : Boolean; end record; and use it instead of raising Pattern_Error. * produce a version that dispenses with the Context and has Find_Location perform the Pre_process internally. References: http://ww0.java3.datastructures.net/handouts/PatternMatching.pdf procedure Pattern_Match_Knuth_Morris_Pratt_Fixed_Test is You may extract this spec into file pattern_match.ads package Pattern_Match is Max_Pattern_Length : constant Positive := 256; type Context is private; function Pre_Compute (Pattern : in String) return Context; precomputes the table of skips for the Pattern. function Find_Location (Of_Context : in Context; In_Text : in String) return Positive; Pattern_Error : exception; alternative is return Natural and use 0 to mean not found. private subtype Pattern_Length_T is Positive range 1..Max_Pattern_Length; type Failure_Function_T is array (Pattern_Length_T) of Positive; subtype Slided_Pattern_T is String (1 .. Max_Pattern_Length); type Context is record Failure_Function : Failure_Function_T; M_Pattern : Slided_Pattern_T; Pattern_Length : Positive; end record; end Pattern_Match; Variables and data for testing. IFPLID_Context : Pattern_Match.Context; SRC_Context : Pattern_Match.Context; Text_Test1 : constant String := "IMCHG DLH5877 -BEGIN ADDR -IFPLID AT05428113 -SRC FPL -RFL F330"; Text_Test2 : constant String := "IMCHG DLH5877 EDDKCLHD -BEGIN ADDR -FAC CFMUTACT AA05428113 FPL -STAR WLD5M -SRC "; IFPLID_Pos : Positive; IFPLID_Pos_2 : Positive := 1; SRC_Pos : Positive; SRC_Pos_2 : Positive; You may extract this spec into file pattern_match.adb package body Pattern_Match is function Pre_Compute (Pattern : in String) return Context is I, J : Positive; Pattern_Context : Context; begin if Pattern = "" then raise Pattern_Error; end if; Pattern_Context.M_Pattern (1..Pattern'Length) := Pattern; Pattern_Context.Pattern_Length := Pattern'Length; Pattern_Context.Failure_Function (1) := 1; I := 2; J := 1; while I <= Pattern_Context.Pattern_Length loop if Pattern (I) = Pattern (J) then we have matched J + 1 chars. Pattern_Context.Failure_Function (I) := J + 1; I := I + 1; J := J + 1; elsif J > 1 then use failure function to shift Pattern J := Pattern_Context.Failure_Function (J - 1); else Pattern_Context.Failure_Function (I) := 1; I := I + 1; end if; end loop; return Pattern_Context; end Pre_Compute; function Find_Location (Of_Context : in Context; In_Text : in String) return Positive is subtype Slided_Text_T is String (1 .. In_Text'Length); Slided_Text : constant Slided_Text_T := Slided_Text_T (In_Text); I, J : Positive; begin I := 1; J := 1; while I <= Slided_Text'Last loop if Slided_Text (I) = Of_Context.M_Pattern (J) then if J = Of_Context.Pattern_Length then return I - J + 1; else I := I + 1; J := J + 1; end if; elsif J > 1 then J := Of_Context.Failure_Function (J - 1); else I := I + 1; end if; end loop; raise Pattern_Error; Or change function to return Natural and return 0. end Find_Location; end Pattern_Match; You may extract the rest of this file into file pattern_match_test.adb and modify accordingly. procedure Check_Pattern_Found (Pattern : in String; At_Location : in Positive; In_Text : in String) is subtype Slided_Text_T is String (1 .. Pattern'Length); Slided_Pattern : constant Slided_Text_T := Slided_Text_T (Pattern); begin if At_Location > In_Text'Last or else At_Location + Pattern'Length - 1 > In_Text'Last or else Slided_Text_T (In_Text (At_Location .. At_Location + Pattern'Length - 1)) /= Slided_Pattern then We expected Find_Location to return the location of the pattern, as it did not there is a program error. raise Program_Error; end if; end Check_Pattern_Found; begin IFPLID_Context := Pattern_Match.Pre_Compute ("-IFPLID "); SRC_Context := Pattern_Match.Pre_Compute ("-SRC "); Expect_Pattern_Found: begin IFPLID_Pos := Pattern_Match.Find_Location (Of_Context => IFPLID_Context, In_Text => Text_Test1); exception when Pattern_Match.Pattern_Error => We expected Find_Location to find the pattern, but it did not so there is a program error. raise Program_Error; end Expect_Pattern_Found; Check_Pattern_Found (Pattern => "-IFPLID ", At_Location => IFPLID_Pos, In_Text => Text_Test1); Expect_Pattern_Not_Found: begin IFPLID_Pos_2 := Pattern_Match.Find_Location (Of_Context => IFPLID_Context, In_Text => Text_Test2); We expected Find_Location to NOT find the pattern, but it did so there is a program error. raise Program_Error; exception when Pattern_Match.Pattern_Error => We expected Find_Location to NOT find the pattern, and it did not so there is no error. null; end Expect_Pattern_Not_Found; if IFPLID_Pos_2 /= 1 then We expected Find_Location to NOT return a result, so there is a program error. raise Program_Error; end if; Expect_Second_Pattern_Found: begin SRC_Pos := Pattern_Match.Find_Location (Of_Context => SRC_Context, In_Text => Text_Test1); exception when Pattern_Match.Pattern_Error => We expected Find_Location to find the pattern, but it did not so there is a program error. raise Program_Error; end Expect_Second_Pattern_Found; Check_Pattern_Found (Pattern => "-SRC ", At_Location => SRC_Pos, In_Text => Text_Test1); Expect_Second_Pattern_Found_At_End: begin SRC_Pos_2 := Pattern_Match.Find_Location (Of_Context => SRC_Context, In_Text => Text_Test2); exception when Pattern_Match.Pattern_Error => We expected Find_Location to find the pattern, but it did not so there is a program error. raise Program_Error; end Expect_Second_Pattern_Found_At_End; Check_Pattern_Found (Pattern => "-SRC ", At_Location => SRC_Pos_2, In_Text => Text_Test2); end Pattern_Match_Knuth_Morris_Pratt_Fixed_Test;