Rabin Karp Algorithm

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
import Data.Char
import Data.List
import Data.Maybe

rabinKarp :: String -> String -> Int
rabinKarp text pattern = 
	if pattern == "" 
		then -1 
	else 
		fromMaybe (-1) $ mapOnMaybe fst $ find matchingString $ zip [0..] $ scanl nextHash (hash text m) $ windowed (m+1) text					
	where n = length text
	      m = length pattern	      
	      nextHash currentHash chars = reHash currentHash (head chars) (last chars) m
	      matchingString (offset, textHash) = hash pattern m == textHash && pattern == subString text offset m 

mapOnMaybe :: (a -> b) -> Maybe a -> Maybe b
mapOnMaybe fn (Just x) = Just (fn x)   
mapOnMaybe _ (Nothing) = Nothing  
	      
subString text start end = take end $ drop start text

windowed :: Int -> [a] -> [[a]]
windowed size [] = []
windowed size ls@(x:xs) = if length ls >= size then take size ls : windowed size xs else windowed size xs		      

globalQ = 1920475943
globalR = 256

hash = hash' globalR globalQ
hash' r q string m = foldl (\acc x -> (r * acc + ord x) `mod` q) 0 $ take m string

reHash = reHash' globalR globalQ
reHash' r q existingHash firstChar nextChar m = 
	(takeOffFirstChar `mod` fromIntegral q * fromIntegral r + ord nextChar) `mod` fromIntegral q
	where 
		rm = if m >0 then (fromIntegral r ^ fromIntegral (m-1)) `mod` fromIntegral q else 0
		takeOffFirstChar = existingHash - fromIntegral rm * ord firstChar

Rabin Karp Algorithm (annotation)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
import Data.Char
import Data.List
import Data.Maybe

rabinKarp :: String -> String -> Int
rabinKarp text pattern = 
	if pattern == "" 
		then -1 
	else 
		fromMaybe (-1) $ mapOnMaybe fst $ find matchingString $ zip [0..] $ scanl nextHash (hash text m) $ windowed (m+1) text					
	where n = length text
	      m = length pattern	      
	      nextHash currentHash chars = reHash currentHash (head chars) (last chars) m
	      matchingString (offset, textHash) = hash pattern m == textHash && pattern == subString text offset m 

mapOnMaybe :: (a -> b) -> Maybe a -> Maybe b
mapOnMaybe fn (Just x) = Just (fn x)   
mapOnMaybe _ (Nothing) = Nothing  
	      
subString text start end = take end $ drop start text

windowed :: Int -> [a] -> [[a]]
windowed size [] = []
windowed size ls@(x:xs) = if length ls >= size then take size ls : windowed size xs else windowed size xs		      

globalQ = 1920475943
globalR = 256

hash = hash' globalR globalQ
hash' r q string m = foldl (\acc x -> (r * acc + ord x) `mod` q) 0 $ take m string

reHash = reHash' globalR globalQ
reHash' r q existingHash firstChar nextChar m = 
	(takeOffFirstChar `mod` fromIntegral q * fromIntegral r + ord nextChar) `mod` fromIntegral q
	where 
		rm = if m >0 then (fromIntegral r ^ fromIntegral (m-1)) `mod` fromIntegral q else 0
		takeOffFirstChar = existingHash - fromIntegral rm * ord firstChar

1
EE