[Haskell-cafe] RE: Substring replacements (was: Differences in optimisiation ...)

Branimir Maksimovic bmaxa at hotmail.com
Sat Dec 10 21:19:22 EST 2005


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/



More information about the Haskell-Cafe mailing list