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

10 Dec 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@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 
To: "Branimir Maksimovic" 
CC: Haskell-Cafe@haskell.org
Subject: Substring replacements (was: Differences in optimisiation ...)
Date: Sat, 10 Dec 2005 22:56:10 +0100
...
From: Daniel Fischer 
...
To: "Branimir Maksimovic" 
CC: Haskell-Cafe@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
Am Samstag, 10. Dezember 2005 02:51 schrieben Sie:
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/