[Haskell-cafe] Substring replacements

[Branimir Maksimovic]

>From: Daniel Fischer <daniel.is.fischer at web.de>
>To: "Branimir Maksimovic" <bmaxa at hotmail.com>
>CC: Haskell-Cafe at haskell.org
>Subject: Re: [Haskell-cafe] Substring replacements
>Date: Mon, 12 Dec 2005 13:07:29 +0100
>
>Sorry, but
>Prelude SearchRep> searchReplace "abaaba" "##" "abababaaba"
>"abababaaba"
>
>I haven't analyzed the algorithm, so I don't know why exactly this fails.
>I'll take a look sometime soon.

It failed because I didn;t adjusted search string for rollBack when previous 
rollBack is not null.
this is corrected version: (with your changes it looks much better)
-------------------------------------------------------------------------------
searchReplace :: String->String->String -> String
searchReplace "" _ xs  = xs
searchReplace sr rp xs = searchr sr rp xs "" ""
   where
     searchr :: String->String->String->String->String -> String
     searchr _ _ "" _ _ = ""
     searchr sr rp xs retB rollB
        | found     = rp ++ searchr sr rp rema ret roll
	| otherwise = reverse (proc ++ rollB) ++
	              searchr sr rp rema ret roll
	   where
	     (found, proc, rema, ret, roll)
	        = searchr' sr sr (reverse retB ++ xs) "" rollB

     searchr' src@(s:sr) src'@(s':sr') xs soFar rollB
        = searchr'' (drop (length rollB) src) src' xs soFar (not (null 
rollB),"","") s

     searchr'' "" _ xs fnd _ _ = (True,fnd,xs,"","")
     searchr'' _ _ "" fnd (_,ret,roll) _ = (False,ret++roll++fnd,"","","")
     searchr'' src@(s:sr) src'@(s':sr') xxs@(x:xs) soFar (cnt,ret,roll) c
        | s == x = if s' == x && null ret && cnt
	              then searchr'' sr sr' xs soFar (True, "", x:roll) c
		      else
		        if null ret && null roll
			   then searchr'' sr src' xs (x:soFar) (True, "", "") c
			   else searchr'' sr src' xs soFar (True, x:roll++ret, "") c
	| otherwise = if null roll && null ret
	                 then
			    if c == x
			      then (False, soFar, xxs, "", "")
			      else let (from, pre) = break (==c) xs
			           in (False, reverse from ++ x:soFar, pre, "", "")
			  else
			    if s'/=x
                  then if null ret
                       then (False, (x:roll) ++ soFar, xs,"","")
                       else (False, soFar, xxs,ret,"")
                  else if null ret
			           then (False, soFar, xs, "", x:roll)
			           else (False, soFar, xxs, ret, "")
----------------------------------------------------------------------------

However it is significantly slower then previous ugly version:

searchReplace :: String->String->String -> String
searchReplace sr rp xs = searchr sr rp xs "" ""
   where
    searchr :: String->String->String->String->String -> String
    searchr [] _ xs _ _ =  xs
    searchr _ _ [] _ _  = []
    searchr sr rp xs retBack rollBack
                 | isFound $ fnd rollBack = rp
                                      ++ searchr sr rp (remaining $ fnd 
rollBack )
                                                       ( getRetBack $ fnd 
rollBack)
                                                       ( getRollBack $ fnd 
rollBack)
                 | otherwise = reverse ((processed $ fnd rollBack) ++ 
rollBack)
                               ++ searchr sr rp (remaining $ fnd rollBack)
                                                ( getRetBack $ fnd rollBack)
                                                ( getRollBack $ fnd 
rollBack)
                where fnd  = searchr' sr sr (reverse retBack ++ xs) ""

    isFound = fst . fst
    remaining = snd . snd . fst
    getRollBack = snd . snd
    getRetBack = fst . snd
    processed = fst . snd . fst

    searchr' :: String->String->String->String->String
                -> ((Bool,(String,String)),(String,String))
    searchr' srch@(sr:srs) srch'@(sr':srs') xs fndSoFar rollBack =
                           searchr'' (drop (length rollBack) srch) srch' xs 
fndSoFar
                                     (not (isEmpty rollBack),"","") sr

    searchr'' :: String->String->String->String->(Bool,String,String)->Char
             -> ((Bool,(String,String)),(String,String))
    searchr'' [] _ xs fnd _ _  = ((True,(fnd,xs)),("",""))
    searchr'' _ _ [] fnd (_,retBack,rollBack) _ = ((False,(retBack ++ 
rollBack ++ fnd,[])),("",""))
    searchr'' srch@(sr:srs) srch'@(sr':srs') xxs@(x:xs) fndSoFar 
(cnt,retBack,rollBack) s
      | sr == x = if cnt && sr' == x && isEmpty retBack
                     then searchr'' srs srs' xs fndSoFar 
(True,"",x:rollBack) s
                     else if not (isEmpty retBack)  || not (isEmpty 
rollBack)
                             then searchr'' srs srch' xs fndSoFar
                                             (True,(x:rollBack) ++ 
retBack,"") s
                             else searchr'' srs srch' xs (x:fndSoFar) 
(True,"","") s
      | otherwise = if isEmpty rollBack && isEmpty retBack
                       then if s == x
                               then ((False,(fndSoFar,xxs)),("",""))
                               else ((False,searchr''' s xs 
(x:fndSoFar)),("",""))
                       else if sr/=x
                            then if isEmpty retBack
                                 then ((False,((x:rollBack)++fndSoFar, xs)), 
("",""))
                                 else ((False,(fndSoFar, xxs)), 
(retBack,""))
                            else if isEmpty retBack
                                 then ((False,(fndSoFar, xs)), 
("",x:rollBack))
                                 else ((False,(fndSoFar, xxs)), 
(retBack,""))


    searchr''' :: Char->String->String -> (String,String)
    searchr''' sr [] fndSoFar = (fndSoFar,[])
    searchr''' sr xxs@(x:xs) fndSoFar | sr/=x = searchr''' sr xs 
(x:fndSoFar)
                             | otherwise = (fndSoFar,xxs)
    isEmpty [] = True
    isEmpty (a:as) = False
-------------------------------------------------------------------------------
these are timings:

$ time MyBane.exe
Working:seasearch replace  able seaseasearch baker seasearch charlie
True
Done


real    0m19.984s
user    0m0.015s
sys     0m0.016s

bmaxa at MAXA ~/tutorial
$ time searchr.exe
Working:seasearch replace  able seaseasearch baker seasearch charlie
True
Done


real    0m13.719s
user    0m0.015s
sys     0m0.000s

It's 6 seconds difference.
Your KMP is always fastest of all version in any combination on  2gb p4 3ghz
hyperthreaded windows. Same results on linux will be I guess with same 
machine
as I;ve previously tested on linux but some other p4 and results were
proportionally the same.

Greetings, Bane.

_________________________________________________________________
Express yourself instantly with MSN Messenger! Download today it's FREE! 
http://messenger.msn.click-url.com/go/onm00200471ave/direct/01/