-- | 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 Control.Applicative ((<$>))
import Control.DeepSeq
import Control.Monad
import Criterion.Main
import Data.String
import Data.Tuple (swap)
import qualified Data.HashMap.Strict as UCHS
import qualified Data.HashTable.IO as HT
import qualified Data.IntMap.Strict as CIS
import qualified Data.Vector as VV
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Unboxed as VU
import System.IO.Unsafe (unsafePerformIO)
import System.Random
import System.Random.MWC
import Text.Printf
import Data.ByteString.Interned
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) (getIBS $ 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) (getIBS $ 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 getBTI $ 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) (getBTI $ 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 (IBS ()) Double
setupEnv = do
-- create keys
strs :: [String] <- replicateM 10000 rString
-- scores to look up
scrs :: [Double] <- replicateM 10000 $ randomRIO (0 , 9)
-- create IBS keys
let keys = map (ibsFrom) strs
-- create random keys, mostly not in strs
unks :: [String] <- replicateM 10000 rString
let sknu = map ibsFrom unks
-- for 100 keys
let hmsK = UCHS.fromList $ take 100 $ zip keys scrs
let cisK = CIS.fromList $ take 100 $ zip (map getIBS 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 getIBS 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')