|
1 | | -{-# LANGUAGE BangPatterns #-} |
| 1 | +{-# LANGUAGE CPP #-} |
| 2 | +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-} |
2 | 3 |
|
3 | 4 | module Main where |
4 | 5 |
|
5 | 6 | import Control.DeepSeq (rnf) |
6 | 7 | import Control.Exception (evaluate) |
7 | 8 | import Gauge (bench, defaultMain, whnf) |
8 | 9 | import Data.List (foldl') |
9 | | -import qualified Data.IntSet as S |
| 10 | +import Data.Monoid (Sum(..)) |
| 11 | +#if !MIN_VERSION_base(4,8,0) |
| 12 | +import Data.Foldable (foldMap) |
| 13 | +#endif |
| 14 | +import qualified Data.IntSet as IS |
| 15 | +-- benchmarks for "instance Ord IntSet" |
| 16 | +-- uses IntSet as keys of maps, and elements of sets |
| 17 | +import qualified Data.Set as S |
| 18 | +import qualified Data.IntMap as IM |
| 19 | +import qualified Data.Map.Strict as M |
10 | 20 |
|
11 | 21 | main = do |
12 | | - let s = S.fromAscList elems :: S.IntSet |
13 | | - s_even = S.fromAscList elems_even :: S.IntSet |
14 | | - s_odd = S.fromAscList elems_odd :: S.IntSet |
| 22 | + let s = IS.fromAscList elems :: IS.IntSet |
| 23 | + s_even = IS.fromAscList elems_even :: IS.IntSet |
| 24 | + s_odd = IS.fromAscList elems_odd :: IS.IntSet |
15 | 25 | evaluate $ rnf [s, s_even, s_odd] |
16 | 26 | defaultMain |
17 | 27 | [ bench "member" $ whnf (member elems) s |
18 | | - , bench "insert" $ whnf (ins elems) S.empty |
19 | | - , bench "map" $ whnf (S.map (+ 1)) s |
20 | | - , bench "filter" $ whnf (S.filter ((== 0) . (`mod` 2))) s |
21 | | - , bench "partition" $ whnf (S.partition ((== 0) . (`mod` 2))) s |
22 | | - , bench "fold" $ whnf (S.fold (:) []) s |
| 28 | + , bench "insert" $ whnf (ins elems) IS.empty |
| 29 | + , bench "map" $ whnf (IS.map (+ 1)) s |
| 30 | + , bench "filter" $ whnf (IS.filter ((== 0) . (`mod` 2))) s |
| 31 | + , bench "partition" $ whnf (IS.partition ((== 0) . (`mod` 2))) s |
| 32 | + , bench "fold" $ whnf (IS.fold (:) []) s |
23 | 33 | , bench "delete" $ whnf (del elems) s |
24 | | - , bench "findMin" $ whnf S.findMin s |
25 | | - , bench "findMax" $ whnf S.findMax s |
26 | | - , bench "deleteMin" $ whnf S.deleteMin s |
27 | | - , bench "deleteMax" $ whnf S.deleteMax s |
28 | | - , bench "unions" $ whnf S.unions [s_even, s_odd] |
29 | | - , bench "union" $ whnf (S.union s_even) s_odd |
30 | | - , bench "difference" $ whnf (S.difference s) s_even |
31 | | - , bench "intersection" $ whnf (S.intersection s) s_even |
32 | | - , bench "fromList" $ whnf S.fromList elems |
33 | | - , bench "fromAscList" $ whnf S.fromAscList elems |
34 | | - , bench "fromDistinctAscList" $ whnf S.fromDistinctAscList elems |
35 | | - , bench "disjoint:false" $ whnf (S.disjoint s) s_even |
36 | | - , bench "disjoint:true" $ whnf (S.disjoint s_odd) s_even |
37 | | - , bench "null.intersection:false" $ whnf (S.null. S.intersection s) s_even |
38 | | - , bench "null.intersection:true" $ whnf (S.null. S.intersection s_odd) s_even |
| 34 | + , bench "findMin" $ whnf IS.findMin s |
| 35 | + , bench "findMax" $ whnf IS.findMax s |
| 36 | + , bench "deleteMin" $ whnf IS.deleteMin s |
| 37 | + , bench "deleteMax" $ whnf IS.deleteMax s |
| 38 | + , bench "unions" $ whnf IS.unions [s_even, s_odd] |
| 39 | + , bench "union" $ whnf (IS.union s_even) s_odd |
| 40 | + , bench "difference" $ whnf (IS.difference s) s_even |
| 41 | + , bench "intersection" $ whnf (IS.intersection s) s_even |
| 42 | + , bench "fromList" $ whnf IS.fromList elems |
| 43 | + , bench "fromAscList" $ whnf IS.fromAscList elems |
| 44 | + , bench "fromDistinctAscList" $ whnf IS.fromDistinctAscList elems |
| 45 | + , bench "disjoint:false" $ whnf (IS.disjoint s) s_even |
| 46 | + , bench "disjoint:true" $ whnf (IS.disjoint s_odd) s_even |
| 47 | + , bench "null.intersection:false" $ whnf (IS.null. IS.intersection s) s_even |
| 48 | + , bench "null.intersection:true" $ whnf (IS.null. IS.intersection s_odd) s_even |
| 49 | + , bench "instanceOrd:dense" -- the IntSet will just use one Tip |
| 50 | + $ whnf (num_transitions . det 2 0) $ hard_nfa 1 16 |
| 51 | + , bench "instanceOrd:sparse" -- many Bin, each Tip is singleton |
| 52 | + $ whnf (num_transitions . det 2 0) $ hard_nfa 1111 16 |
39 | 53 | ] |
40 | 54 | where |
41 | 55 | elems = [1..2^12] |
42 | 56 | elems_even = [2,4..2^12] |
43 | 57 | elems_odd = [1,3..2^12] |
44 | 58 |
|
45 | | -member :: [Int] -> S.IntSet -> Int |
46 | | -member xs s = foldl' (\n x -> if S.member x s then n + 1 else n) 0 xs |
| 59 | +member :: [Int] -> IS.IntSet -> Int |
| 60 | +member xs s = foldl' (\n x -> if IS.member x s then n + 1 else n) 0 xs |
47 | 61 |
|
48 | | -ins :: [Int] -> S.IntSet -> S.IntSet |
49 | | -ins xs s0 = foldl' (\s a -> S.insert a s) s0 xs |
| 62 | +ins :: [Int] -> IS.IntSet -> IS.IntSet |
| 63 | +ins xs s0 = foldl' (\s a -> IS.insert a s) s0 xs |
50 | 64 |
|
51 | | -del :: [Int] -> S.IntSet -> S.IntSet |
52 | | -del xs s0 = foldl' (\s k -> S.delete k s) s0 xs |
| 65 | +del :: [Int] -> IS.IntSet -> IS.IntSet |
| 66 | +del xs s0 = foldl' (\s k -> IS.delete k s) s0 xs |
| 67 | + |
| 68 | + |
| 69 | + |
| 70 | +-- | Automata contain just the transitions |
| 71 | +type NFA = IM.IntMap (IM.IntMap IS.IntSet) |
| 72 | +type DFA = IM.IntMap (M.Map IS.IntSet IS.IntSet) |
| 73 | + |
| 74 | +newtype State = State Int deriving (Num, Enum) |
| 75 | +instance Show State where show (State s) = show s |
| 76 | +newtype Sigma = Sigma Int deriving (Num, Enum, Eq) |
| 77 | + |
| 78 | +num_transitions :: DFA -> Int |
| 79 | +num_transitions = getSum . foldMap (Sum . M.size) |
| 80 | + |
| 81 | +det :: Sigma -> State -> NFA -> DFA |
| 82 | +det sigma (State initial) aut = |
| 83 | + let get :: State -> Sigma -> IS.IntSet |
| 84 | + get (State p) (Sigma s) = IM.findWithDefault IS.empty p |
| 85 | + $ IM.findWithDefault IM.empty s aut |
| 86 | + go :: DFA -> S.Set IS.IntSet -> S.Set IS.IntSet -> DFA |
| 87 | + go !accu !done !todo = case S.minView todo of |
| 88 | + Nothing -> accu |
| 89 | + Just (t, odo) -> |
| 90 | + if S.member t done |
| 91 | + then go accu done odo |
| 92 | + else let ts = do |
| 93 | + s <- [0 .. sigma-1] |
| 94 | + let next :: IS.IntSet |
| 95 | + next = foldMap (\p -> get (State p) s) $ IS.toList t |
| 96 | + return (t, s, next) |
| 97 | + in go (union_dfa (dfa ts) accu) |
| 98 | + (S.insert t done) |
| 99 | + (Data.List.foldl' (\ o (_,_,q) -> S.insert q o) odo ts) |
| 100 | + in go IM.empty S.empty $ S.singleton $ IS.singleton initial |
| 101 | + |
| 102 | +nfa :: [(State,Sigma,State)] -> NFA |
| 103 | +nfa ts = IM.fromListWith ( IM.unionWith IS.union ) |
| 104 | + $ Prelude.map (\(State p,Sigma s,State q) -> |
| 105 | + (s, IM.singleton p (IS.singleton q))) ts |
| 106 | + |
| 107 | +dfa :: [(IS.IntSet, Sigma, IS.IntSet)] -> DFA |
| 108 | +dfa ts = IM.fromListWith ( M.unionWith ( error "WAT") ) |
| 109 | + $ Prelude.map (\( p, Sigma s, q) -> |
| 110 | + (s, M.singleton p q)) ts |
| 111 | + |
| 112 | +union_dfa a b = IM.unionWith (M.unionWith (error "WAT")) a b |
| 113 | + |
| 114 | +-- | for the language Sigma^* 1 Sigma^{n-2} where Sigma={0,1}. |
| 115 | +-- this NFA has n states. DFA has 2^(n-1) states |
| 116 | +-- since it needs to remember the last n characters. |
| 117 | +-- Extra parameter delta: the automaton will use states [0, delta .. ] |
| 118 | +-- for IntSet, larger deltas should be harder, |
| 119 | +-- since for delta=1, all the states do fit in one Tip |
| 120 | +hard_nfa :: State -> Int -> NFA |
| 121 | +hard_nfa delta n = nfa |
| 122 | + $ [ (0, 0, 0), (0,1,0), (0, 1, delta) ] |
| 123 | + ++ do k <- [1 .. State n - 2] ; c <- [0,1] ; return (delta * k,c,delta *(k+1)) |
0 commit comments