[Haskell-cafe] my take at knucleotide

[Gregory Collins]

What happens to performance if you compile and link with "cabal install
--constraint='hashable < 1.2'" ?

G


On Sun, Mar 24, 2013 at 4:08 PM, Branimir Maksimovic <bmaxa at hotmail.com>wrote:

> Hi, I have tried to implement knucleotide benchmark program this time:
>
> http://benchmarksgame.alioth.debian.org/u64q/performance.php?test=knucleotide
>
> Implementation is shorter (uses hashtable from hashtables package),
> but two time slower then current Haskell entry ( which is too low level
> for my taste :)).
> What is interesting is that if I try to place Int64 as a key to
> hash table, performance is even slower.
> Strange that dropping and taking from bytestring would be
> faster than packing string in 64 bit int and directly indexing.
>
> If someone can see something that can bring performance on par
> with current haskell entry , I would post it , otherwise no point,
> except that program is shorter and not low level.
>
> {-# Language BangPatterns #-}
> --
> -- The Computer Language Benchmarks Game
> -- http://benchmarksgame.alioth.debian.org/
> --
> -- Contributed by Branimir Maksimovic
> --
> import Data.Char
> import Data.List
> import Data.IORef
> import qualified Data.HashTable.IO as H
> import qualified Data.ByteString.Char8 as S
> import Control.Concurrent
> import Text.Printf
>
> main = do
>     s <- S.getContents
>     let content = (S.map toUpper . S.concat . tail .
>                   dropWhile (\l->not $ S.isPrefixOf (S.pack ">THREE") l) .
>                   S.lines) s
>     mapM_ (execute content) actions
>
> data Actions = I Int | S String
> actions = [I 1,I 2,
>            S "GGT",S "GGTA",S "GGTATT",S "GGTATTTTAATT",S
> "GGTATTTTAATTTATAGT"]
> execute content (I i) = writeFrequencies content i
> execute content (S s) = writeCount content s
>
> writeFrequencies input size = do
>     ht <- tcalculate input size
>     lst <- H.foldM (\lst (k,v)->do
>         v' <- readIORef v
>         return $ insertBy (\(_,x) (_,y)->y `compare` x) (k,v') lst) [] ht
>     let sum = fromIntegral ((S.length input) + 1 - size)
>     mapM_ (\(k,v)-> do
>         printf "%s %.3f\n"
>             (S.unpack k) ((100 * (fromIntegral v)/sum)::Double)) lst
>     putChar '\n'
>
> writeCount input string = do
>     let size = length string
>     ht <- tcalculate input size
>     res <- H.lookup ht (S.pack string)
>     case res of
>         Nothing -> putStrLn $ string ++ " not found..."
>         Just v -> do
>             r <- readIORef v
>             printf "%d\t%s\n" r (string::String)
>
> tcalculate input size = do
>     let
>         l = [0..7]
>         actions = map (\i -> (calculate input i size (length l))) l
>     vars <- mapM (\action -> do
>                     var <- newEmptyMVar
>                     forkIO $ do
>                         answer <- action
>                         putMVar var answer
>                     return var) actions
>     result <- newTable
>     results <- mapM takeMVar vars
>     mapM_ (\ht -> H.foldM (\lst (k,v) -> do
>                             res <- H.lookup lst k
>                             case res of
>                                 Nothing -> do
>                                     r1 <- readIORef v
>                                     r2 <- newIORef r1
>                                     H.insert lst k r2
>                                 Just v1 -> do
>                                     r1 <- readIORef v1
>                                     r2 <- readIORef v
>                                     writeIORef v1 (r1+r2)
>                             return lst) result ht) results
>     return result
>
> calculate input beg size incr = do
>     ht <- newTable
>     let
>         calculate' :: S.ByteString -> Int -> IO HashTable
>         calculate' str i
>          | i >= ((S.length input)+1 - size) = return ht
>          | otherwise = do
>             res <- H.lookup ht k
>             case res of
>                 Nothing -> do
>                     !r <- newIORef 1
>                     H.insert ht k r
>                 Just v -> do
>                     !r <- readIORef v
>                     writeIORef v (r+1)
>             calculate' (S.drop incr str) (i+incr)
>                 where k = S.take size str
>     calculate' (S.drop beg input) beg
>
> type HashTable = H.BasicHashTable S.ByteString (IORef Int)
> newTable :: IO HashTable
> newTable = H.new
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>


-- 
Gregory Collins <greg at gregorycollins.net>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130324/48a46911/attachment.htm>