[Haskell]
Programming language shootout (completing the Haskell entry)
Sean E. Russell
haskell at ser.fdns.net
Fri Mar 26 16:26:31 EST 2004
Hiya,
I know it is silly, but I'm interested in helping to complete the Haskell
entry in the Programming Language Shootout page[1]
(http://www.bagley.org/~doug/shootout/craps.shtml).
The Haskell entry is missing 5 (out of 13) entries, and since no points are
"scored" for missing entries, this skews Haskell's rank downwards.
Since I'm not the worlds Best Haskell Programmer -- and I'm certainly not
adept at optimizing, and since I'd like to provide the fastest Haskell code
that I can, I thought I'd run it through my code through this list and see if
anybody would like to suggest improvements.
The implementations for this particular test must be written in the "same
way"; this is defined to be that the submissions "use the same logic and data
structures", the goal being to "try to measure languages doing the same
operations, as closely as possible."
The "description" of the test is:
"In this test, we create 10000 hash entries, then add them into a new hash N
times. "
The correct output for this code where N=10 must be:
1 9999 10 99990
I chose to use (lookup) and associative arrays. I create a *bunch* of hashes,
rather than just two that I re-use because, honestly, I'm such a novice I
don't know how to do it otherwise.
Anyway, as I said, any suggestions for optimization are appreciated. This is
just for fun.
===== BEGIN hash2.hs
module Main where
import System (getArgs)
import Numeric (readDec)
import Maybe
main = do
argv <- getArgs
let h1 = hash1 9999 []
h2 = hash2 (fst $ head $ readDec $ argv!!0) h1 []
print h1 h2
where
hash1 0 x = x
hash1 n xs = hash1 (n-1) ((mkentry n):xs)
mkentry y = ( "foo_"++(show y), y )
hash2 0 _ x2 = x2
hash2 n x1 x2 = hash2 (n-1)
x1
[ (k1, v1+(get k1 x2)) | (k1, v1) <- x1 ]
print x1 x2 = putStrLn (
(show $ get "foo_1" x1)++" "++
(show $ get "foo_9999" x1)++" "++
(show $ get "foo_1" x2)++" "++
(show $ get "foo_9999" x2)
)
get :: String -> [(String, Int)] -> Int
get key hash = fromMaybe 0 $ lookup key hash
===== END hash2.hs
[1] The page is entirely tounge-in-cheek, but I find it interesting,
nonetheless.
--
### SER
### Deutsch|Esperanto|Francaise|Linux|XML|Java|Ruby|Aikido
### http://www.germane-software.com/~ser jabber.com:ser ICQ:83578737
### GPG: http://www.germane-software.com/~ser/Security/ser_public.gpg
More information about the Haskell
mailing list