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