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 levelfor my taste :)).What 
is interesting is that if I try to place Int64 as a key tohash table, 
performance is even slower.Strange that dropping and taking from bytestring 
would befaster than packing string in 64 bit int and directly indexing.
If someone can see something that can bring performance on parwith 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.Charimport Data.Listimport Data.IORefimport qualified 
Data.HashTable.IO as Himport qualified Data.ByteString.Char8 as Simport 
Control.Concurrentimport 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 Stringactions = [I 1,I 2,           S "GGT",S "GGTA",S 
"GGTATT",S "GGTATTTTAATT",S "GGTATTTTAATTTATAGT"]execute content (I i) = 
writeFrequencies content iexecute 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 
HashTablenewTable = H.new
                                          
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to