[Haskell-cafe] RE: Substring replacements (was: Differences
inoptimisiation
Branimir Maksimovic
bmaxa at hotmail.com
Sun Dec 11 02:29:46 EST 2005
I've found one remaining bug, and this is corrected version.
Now it is fastest with your test (still 0.25 seconds), but undoubtly slowest
with mine:0)
But I crafted this test to be really rigorous to mine implementation. Lot of
replaces, repated
patterns and so. In real world situtaion it will perform much better, I
hope.
so here it is:
-------------------------------------------------------------------------------
main :: IO ()
main =let src = replicate 1000 'r'
dst = " # "
str = replicate 999 'r' ++ 'c': replicate 1000 'r'
out = searchReplace src dst $ concat $ replicate 500 str
out1 = searchReplace src dst $ concat $ replicate 500 str
in do putStrLn $ "Working very long"
putStrLn $ show (out == out1) ++ "\nDone"
-------------------------------------------------------------------------------
searchReplace :: String->String->String -> String
searchReplace sr rp xs = searchr sr rp xs ""
where
searchr :: String->String->String->String -> String
searchr [] _ xs _ = xs
searchr _ _ [] _ = []
searchr sr rp xs rollBack
| fst $ fst $ fnd = rp
++ searchr sr rp (snd $ snd $ fst $
fnd )
( snd fnd )
| otherwise = reverse ((fst $ snd $ fst $ fnd ) ++
rollBack)
++ searchr sr rp (snd $ snd $ fst $ fnd)
( snd fnd)
where fnd = searchr' (drop (length rollBack) sr) xs ""
searchr' :: String->String->String -> ((Bool,(String,String)),String)
searchr' (sr:srs) xs fndSoFar = searchr'' (sr:srs) xs fndSoFar
(False,False,"") sr
searchr'' :: String->String->String->(Bool,Bool,String)->Char
-> ((Bool,(String,String)),String)
searchr'' [] xs fnd _ _ = ((True,(fnd,xs)),"")
searchr'' _ [] fnd (_,_,rollBack) _ = ((False,(fnd,[])),rollBack)
searchr'' (sr:srs) (x:xs) fndSoFar (cnt,f,rollBack) s
| sr == x = if cnt && (f || s == x)
then searchr'' srs xs fndSoFar (True,True,x:rollBack) s
else searchr'' srs xs (x:fndSoFar) (True,False,"") s
| otherwise = if not f
then if s == x
then ((False,(fndSoFar,x:xs)),"")
else ((False,searchr''' s xs
(x:fndSoFar)),"")
else if s == x && getFst rollBack == s
then ((False,(fndSoFar, xs)),x:rollBack)
else ((False,(fndSoFar,x:xs)),rollBack)
searchr''' :: Char->String->String -> (String,String)
searchr''' sr [] fndSoFar = (fndSoFar,[])
searchr''' sr (x:xs) fndSoFar -- | sr/=x = searchr''' sr xs (x:fndSoFar)
| otherwise = (fndSoFar,x:xs)
getFst (a:as) = a;
-------------------------------------------------------------------------------
>From: "Branimir Maksimovic" <bmaxa at hotmail.com>
>To: daniel.is.fischer at web.de
>CC: Haskell-Cafe at haskell.org
>Subject: [Haskell-cafe] RE: Substring replacements (was: Differences
>inoptimisiation ...)
>Date: Sun, 11 Dec 2005 02:19:22 +0000
>
>
>After seeing your test, I've implemented full KMP algorithm, which
>is blazingly fast with your test. It is slower in mine test due excessive
>temporaries
>I guess, but perhaps you can help me to make it better as I'm just Haskell
>newbie.
>You can see that by my code :0)
>Especially I'm clumsy with passing parameters around.
>
>main :: IO ()
>main =let src = replicate 1000 'r'
> dst = " # "
> str = replicate 999 'r' ++ 'c': replicate 1000 'r'
> out = searchReplace src dst $ concat $ replicate 500 str
> out1 = searchReplace src dst $ concat $ replicate 501 str
> in do putStrLn $ "Working very long"
> putStrLn $ show (out == out1) ++ "\nDone"
>-------------------------------------------------------------------------------
>searchReplace :: String->String->String -> String
>searchReplace sr rp xs = searchr sr rp xs ""
>
>searchr :: String->String->String->String -> String
>searchr [] _ xs _ = xs
>searchr _ _ [] _ = []
>searchr sr rp xs rollBack | fst $ fst fnd = rp
> ++ searchr sr rp (snd $ snd $
>fst fnd)
> (snd fnd)
> | otherwise = reverse ((fst $ snd $ fst $ fnd) ++
>rollBack)
> ++ searchr sr rp (snd $ snd $ fst fnd)
> (snd fnd)
> where fnd = searchr' (drop (length rollBack) sr) xs ""
>
>searchr' :: String->String->String -> ((Bool,(String,String)),String)
>searchr' (sr:srs) xs fndSoFar = searchr'' (sr:srs) xs fndSoFar
>(False,False,"") sr
>
>searchr'' :: String->String->String->(Bool,Bool,String)->Char
> -> ((Bool,(String,String)),String)
>searchr'' [] xs fnd _ _ = ((True,(fnd,xs)),"")
>searchr'' _ [] fnd _ _ = ((False,(fnd,[])),"")
>searchr'' (sr:srs) (x:xs) fndSoFar (cnt,f,rollBack) s
> | sr == x = if cnt && (f || s == x)
> then searchr'' srs xs fndSoFar (True,True,x:rollBack)
>s
> else searchr'' srs xs (x:fndSoFar) (True,False,"") s
> | otherwise = if not f
> then ((False,searchr''' s (x:xs) fndSoFar),"")
> else ((False,(fndSoFar,x:xs)),rollBack)
>
>searchr''' :: Char->String->String -> (String,String)
>searchr''' sr [] fndSoFar = (fndSoFar,[])
>searchr''' sr (x:xs) fndSoFar | sr/=x = searchr''' sr xs (x:fndSoFar)
> | otherwise = (fndSoFar,x:xs)
>-------------------------------------------------------------------------------
>
>Optimiser works extremilly well with this version in combination with
>your test:
>$ ghc -fglasgow-exts -O2 searchr.hs --make -o searchr.exe
>Chasing modules from: searchr.hs
>Compiling Main ( searchr.hs, searchr.o )
>Linking ...
>
>bmaxa at MAXA ~/tutorial
>$ time searchr.exe
>Working very long
>False
>Done
>
>real 0m0.250s
>user 0m0.031s
>sys 0m0.000s
>
>Wow, just 0.25 seconds! No c++ program can approach near that!
>
>Perhaps I have bug somewhere but I've compared results
>with yours searchrep and seems same.
>
>Greetings, Bane.
>
>>From: Daniel Fischer <daniel.is.fischer at web.de>
>>To: "Branimir Maksimovic" <bmaxa at hotmail.com>
>>CC: Haskell-Cafe at haskell.org
>>Subject: Substring replacements (was: Differences in optimisiation ...)
>>Date: Sat, 10 Dec 2005 22:56:10 +0100
>>
>>Am Samstag, 10. Dezember 2005 02:51 schrieben Sie:
>> > From: Daniel Fischer <daniel.is.fischer at web.de>
>> >
>> > >To: "Branimir Maksimovic" <bmaxa at hotmail.com>
>> > >CC: Haskell-Cafe at haskell.org
>> > >Subject: Re: Differences in optimisiation with interactive and
>>compiled mo
>> > >Date: Fri, 9 Dec 2005 23:27:00 +0100
>> > >
>> > >Still doesn't work, though:
>> > >
>> > >*Main> searchr "hahal" "jupp" "hahahalala"
>> > >"hahahalala"
>> > >
>> > >The problem is that the string to replace may contain a repeated
>>pattern
>> > >and the pattern that begins the actual occurence might be consumed
>>before
>> > > a failure is detected.
>> >
>> > Yes, I've corrected it. Now it is just 25% faster and that is only with
>>-O2
>> > flag.
>> > Here is whole thing, I hope there are no more bugs left :) :
>> >
>>None that sprang to my eyes. However, on my machine, yours is not faster
>>than
>>Lemmih's.
>>Now, using the new Strings, I get the following times:
>> -O2 -O1 no opt
>>Lemmih's: 38.9 sec 38.9 sec 76.7 sec
>>Yours : 40.1 sec 41.5 sec 131.1 sec
>>Mine : 32.9 sec 33.1 sec 82.8 sec.
>>
>>However, there's a problem with Lemmih's replace:
>>
>>*Main> searchr "ababcab" "###" "ababcababcabab"
>>"###abcab"
>>*Main> replace "ababcab" "###" "ababcababcabab"
>>"ababc###ab"
>>
>>due to the fact that Lemmih's version scans the input from right to left
>>(that's easily changed by a few reverses, though -- but costly for long
>>inputs), more serious is
>>
>>Prelude Main> replace "ja" "aja" "jjjjjjja"
>>"ajajajajajajaja".
>>
>>
>>The fastest -- and nicely simple above -- that I could come up with is
>>
>>replace :: String -> String -> String -> String
>>replace _ _ "" = ""
>>replace "" _ str = str
>>replace src dst inp
>> = process inp
>> where
>> n = length src
>> process "" = ""
>> process st@(c:cs)
>> | src `isPrefixOf` st = dst ++ process (drop n st)
>> | otherwise = c:process cs
>>
>>It's roughly 10% faster than my other version on "seasearch" ...
>>and if you try it on
>>
>>main2 :: IO ()
>>main2 = let src = replicate 1000 'r'
>> dst = " # "
>> str = replicate 999 'r' ++ 'c': replicate 1000 'r'
>> out = replace src dst $ concat $ replicate 500 str
>> out1 = replace src dst $ concat $ replicate 501 str
>> in do putStrLn $ "Working very long"
>> putStrLn $ show (out == out1) ++ "\nDone"
>>
>>you'll see a real difference. I'm not sure, why your algorithm pays a so
>>much
>>higher penalty, though. Maybe, it'll be faster if you make searchr' &c
>>local
>>functions? I'll try.
>>
>>Cheers,
>>Daniel
>>
>
>_________________________________________________________________
>FREE pop-up blocking with the new MSN Toolbar - get it now!
>http://toolbar.msn.click-url.com/go/onm00200415ave/direct/01/
>
>_______________________________________________
>Haskell-Cafe mailing list
>Haskell-Cafe at haskell.org
>http://www.haskell.org/mailman/listinfo/haskell-cafe
_________________________________________________________________
Express yourself instantly with MSN Messenger! Download today it's FREE!
http://messenger.msn.click-url.com/go/onm00200471ave/direct/01/
More information about the Haskell-Cafe
mailing list