-- | Working with natural languages entails having large, sparse scoring
-- matrices. Here, we run through a bunch of options for these.
--
-- We create a table to look things up, and two sets of queries: one of
-- known elements, one of unknown elements.
module Main where
import Criterion.Main
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector as VV
import Text.Printf
import Data.Tuple (swap)
import Control.Applicative ((<$>))
import System.Random.MWC
import System.Random
import Control.DeepSeq
import Control.Monad
import qualified Data.HashMap.Strict as UCHS
import qualified Data.IntMap.Strict as CIS
import Data.String
import qualified Data.HashTable.IO as HT
import System.IO.Unsafe (unsafePerformIO)
import NLP.Alphabet.IMMC
main :: IO ()
main = do ( !keys , !unks , (!hmsH,!cisH,!htH) , (!hmsK,!cisK,!htK) ) <- setupEnv
printf "We have %d keys, and %d / %d / %d resp. %d / %d / %d keys in the lookup maps\n"
(VU.length keys)
(UCHS.size hmsH) (CIS.size cisH) (-1 :: Int)
(UCHS.size hmsK) (CIS.size cisK) (-1 :: Int)
defaultMain
[ bgroup " 100 keys" [ bench "HashMap.Strict" $ whnf (\k -> UCHS.lookupDefault 0 k hmsH) (VU.head keys)
, bench "IntMap.Strict" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head keys)
, bench "HashTable" $ whnf (\k -> htLookup htH k) (VU.head keys)
]
, bgroup "10000 keys" [ bench "HashMap.Strict" $ whnf (\k -> UCHS.lookupDefault 0 k hmsK) (VU.head keys)
, bench "IntMap.Strict" $ whnf (\k -> CIS.findWithDefault 0 k cisK) (getIMMC $ VU.head keys)
, bench "HashTable" $ whnf (\k -> htLookup htK k) (VU.head keys)
]
-- , bgroup " 100 known" [ bench "uchsH" $ whnf (\ks -> VU.sum $ VU.map (\k -> UCHS.lookupDefault 0 k hmsH) ks) (VU.take 100 keys)
-- , bench " cisH" $ whnf (\ks -> VU.sum $ VU.map (\k -> CIS.findWithDefault 0 k cisH) ks) (VU.map getIMMC $ VU.take 100 keys)
-- ]
-- , bgroup " 1 unknown" [ bench "uchsH" $ whnf (\k -> UCHS.lookupDefault 0 k hmsH) (VU.head unks)
-- , bench " cisH" $ whnf (\k -> CIS.findWithDefault 0 k cisH) (getIMMC $ VU.head unks)
-- ]
]
htLookup ht k = unsafePerformIO $ do
l <- HT.lookup ht k
case l of
Nothing -> return 0
Just v -> return v
{-# Inline htLookup #-}
type HTB = HT.BasicHashTable IMMC Double
setupEnv = do
-- create keys
strs :: [String] <- replicateM 10000 rString
-- scores to look up
scrs :: [Double] <- replicateM 10000 $ randomRIO (0 , 9)
-- create IMMC keys
let keys = map (immc . fromString) strs
-- create random keys, mostly not in strs
unks :: [String] <- replicateM 10000 rString
let sknu = map (immc . fromString) unks
-- for 100 keys
let hmsK = UCHS.fromList $ take 100 $ zip keys scrs
let cisK = CIS.fromList $ take 100 $ zip (map getIMMC keys) scrs
htH :: HTB <- HT.fromList $ take 100 $ zip keys scrs
-- for 10 000 keys
let hmsM = UCHS.fromList $ zip keys scrs
let cisM = CIS.fromList $ zip (map getIMMC keys) scrs
htK :: HTB <- HT.fromList $ zip keys scrs
return (VU.fromList keys , VU.fromList sknu , (hmsK,cisK,htH) , (hmsM,cisM,htK) )
rString :: IO String
rString = do
k :: Int <- randomRIO (1,4)
replicateM k $ randomRIO ('A','Z')