
From: Daniel Fischer
To: "Branimir Maksimovic" CC: Haskell-Cafe@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@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/