RE: [Haskell-cafe] RE: Substring replacements (was: Differences inoptimisiation

11 Dec 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" 
To: daniel.is.fischer@web.de
CC: Haskell-Cafe@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@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/
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@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/