packages feed

bimaps (empty) → 0.0.0.1

raw patch · 12 files changed

+553/−0 lines, 12 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bimaps, binary, cereal, containers, criterion, deepseq, hashable, mwc-random, primitive, storable-tuple, unordered-containers, vector, vector-binary-instances, vector-th-unbox

Files

+ Data/Bijection/Class.hs view
@@ -0,0 +1,37 @@++module Data.Bijection.Class where++++class Bijection z where+  type ContL z :: *+  type ContR z :: *+  type ElemL z :: *+  type ElemR z :: *+  contL :: z -> ContL z+  contR :: z -> ContR z+  memberL :: z -> ElemL z -> Bool+  memberL = (maybe False (const True) . ) . lookupL+  memberR :: z -> ElemR z -> Bool+  memberR = (maybe False (const True) . ) . lookupR+  lookupL :: z -> ElemL z -> Maybe (ElemR z)+  lookupR :: z -> ElemR z -> Maybe (ElemL z)+  empty :: z+  null :: z -> Bool+  size :: z -> Int+  fromList :: [(ElemL z, ElemR z)] -> z+  toList :: z -> [(ElemL z, ElemR z)]+  insert :: z -> (ElemL z, ElemR z) -> z+  deleteByL :: z -> ElemL z -> z+  deleteByR :: z -> ElemR z -> z+  {-# INLINE memberL #-}+  {-# INLINE memberR #-}++findWithDefaultL :: Bijection z => ElemR z -> z -> ElemL z -> ElemR z+findWithDefaultL def = (maybe def id . ) . lookupL+{-# INLINE findWithDefaultL #-}++findWithDefaultR :: Bijection z => ElemL z -> z -> ElemR z -> ElemL z+findWithDefaultR def = (maybe def id . ) . lookupR+{-# INLINE findWithDefaultR #-}+
+ Data/Bijection/Hash.hs view
@@ -0,0 +1,58 @@++module Data.Bijection.Hash+  ( module Data.Bijection.Class+  , Bimap+  ) where++import           Control.DeepSeq+import           Data.Aeson+import           Data.Binary+import           Data.Hashable (Hashable)+import           Data.Serialize+import           Data.Tuple (swap)+import           GHC.Generics+import qualified Data.HashMap.Strict as H++import           Data.Bijection.Class++++-- | A bijection between values of type @l@ and type @r@.++newtype Bimap l r = Bimap (H.HashMap l r, H.HashMap r l)+  deriving (Read,Show,Eq,Generic)++instance (Eq l, Eq r, Hashable l, Hashable r) => Bijection (Bimap l r) where+  type ContL (Bimap l r) = H.HashMap l r+  type ContR (Bimap l r) = H.HashMap r l+  type ElemL (Bimap l r) = l+  type ElemR (Bimap l r) = r+  contL (Bimap (l,r)) = l+  contR (Bimap (l,r)) = r+  lookupL (Bimap (l,r)) k = H.lookup k l+  lookupR (Bimap (l,r)) k = H.lookup k r+  empty = Bimap (H.empty, H.empty)+  null (Bimap (l,_)) = H.null l+  size (Bimap (l,_)) = H.size l+  fromList xs = Bimap (H.fromList xs, H.fromList $ map swap xs)+  toList (Bimap (l,_)) = H.toList l+  insert (Bimap (l,r)) (x,y) = Bimap (H.insert x y l, H.insert y x r)+  deleteByL (Bimap (l,r)) x =+    let r' = maybe r (`H.delete` r) $ H.lookup x l+        l' = H.delete x l+    in  Bimap (l',r')+  deleteByR (Bimap (l,r)) y =+    let l' = maybe l (`H.delete` l) $ H.lookup y r+        r' = H.delete y r+    in  Bimap (l',r')+  {-# INLINE lookupL #-}+  {-# INLINE lookupR #-}++instance (NFData l, NFData r) => NFData (Bimap l r) where+  rnf (Bimap (l,r)) = rnf (l,r)++instance (Binary (H.HashMap l r), Binary (H.HashMap r l)) => Binary (Bimap l r)+instance (Ord l, Ord r, Serialize (H.HashMap l r), Serialize (H.HashMap r l)) => Serialize (Bimap l r)+instance (ToJSON (H.HashMap l r), ToJSON (H.HashMap r l)) => ToJSON (Bimap l r)+instance (FromJSON (H.HashMap l r), FromJSON (H.HashMap r l)) => FromJSON (Bimap l r)+
+ Data/Bijection/Map.hs view
@@ -0,0 +1,60 @@++-- | Bijections via strict maps.++module Data.Bijection.Map+  ( module Data.Bijection.Class+  , Bimap+  ) where++import           Control.DeepSeq+import           Data.Aeson+import           Data.Binary+import           Data.Serialize+import           Data.Tuple (swap)+import           GHC.Generics+import qualified Data.Map.Strict as S++import           Data.Bijection.Class++++-- | A bijection between values of type @l@ and type @r@, implemented via+-- strict maps.++newtype Bimap l r = Bimap (S.Map l r, S.Map r l)+  deriving (Read,Show,Eq,Generic)++instance (Ord l, Ord r) => Bijection (Bimap l r) where+  type ContL (Bimap l r) = S.Map l r+  type ContR (Bimap l r) = S.Map r l+  type ElemL (Bimap l r) = l+  type ElemR (Bimap l r) = r+  contL (Bimap (l,r)) = l+  contR (Bimap (l,r)) = r+  lookupL (Bimap (l,r)) k = S.lookup k l+  lookupR (Bimap (l,r)) k = S.lookup k r+  empty = Bimap (S.empty,S.empty)+  null (Bimap (l,_)) = S.null l+  size (Bimap (l,_)) = S.size l+  fromList xs = Bimap (S.fromList xs, S.fromList $ map swap xs)+  toList (Bimap (l,_)) = S.toList l+  insert (Bimap (l,r)) (x,y) = Bimap (S.insert x y l, S.insert y x r)+  deleteByL (Bimap (l,r)) x =+    let r' = maybe r (`S.delete` r) $ S.lookup x l+        l' = S.delete x l+    in  Bimap (l',r')+  deleteByR (Bimap (l,r)) y =+    let l' = maybe l (`S.delete` l) $ S.lookup y r+        r' = S.delete y r+    in  Bimap (l',r')+  {-# INLINE lookupL #-}+  {-# INLINE lookupR #-}++instance (NFData l, NFData r) => NFData (Bimap l r) where+  rnf (Bimap (l,r)) = rnf (l,r)++instance (Binary l, Binary r) => Binary (Bimap l r)+instance (Ord l, Ord r, Serialize l, Serialize r) => Serialize (Bimap l r)+instance (ToJSON (S.Map l r), ToJSON (S.Map r l)) => ToJSON (Bimap l r)+instance (FromJSON (S.Map l r), FromJSON (S.Map r l)) => FromJSON (Bimap l r)+
+ Data/Bijection/Vector.hs view
@@ -0,0 +1,53 @@++-- | A bijection between boxed, immutable vectors.++module Data.Bijection.Vector+  ( module Data.Bijection.Class+  , Bimap+  ) where++import           Control.Applicative ((<$>))+import           Control.DeepSeq+import           Data.Aeson+import           Data.Binary+import           Data.Serialize+import           Data.Tuple (swap)+import           Data.Vector.Binary+import           Data.Vector.Cereal+import           Data.Vector (Vector)+import           GHC.Generics+import qualified Data.Vector.Generic as G++import           Data.Bijection.Class++++newtype Bimap l r = Bimap (Vector (l,r))+  deriving (Read,Show,Eq,Generic)++instance (Eq l, Eq r) => Bijection (Bimap l r) where+  type ContL (Bimap l r) = Vector (l,r)+  type ContR (Bimap l r) = Vector (r,l)+  type ElemL (Bimap l r) = l+  type ElemR (Bimap l r) = r+  contL (Bimap v) = v+  contR (Bimap v) = G.map swap v+  lookupL (Bimap v) k = snd <$> G.find ((==k) . fst) v+  lookupR (Bimap v) k = fst <$> G.find ((==k) . snd) v+  empty = Bimap G.empty+  null (Bimap v) = G.null v+  size (Bimap v) = G.length v+  fromList = Bimap . G.fromList+  toList (Bimap v) = G.toList v+  insert (Bimap v) = Bimap . G.snoc v+  deleteByL (Bimap v) x = Bimap $ G.filter ((/=x) . fst) v+  deleteByR (Bimap v) y = Bimap $ G.filter ((/=y) . snd) v++instance (NFData l, NFData r) => NFData (Bimap l r) where+  rnf (Bimap v) = rnf v++instance (Binary l, Binary r) => Binary (Bimap l r)+instance (Serialize l, Serialize r) => Serialize (Bimap l r)+instance (ToJSON l, ToJSON r) => ToJSON (Bimap l r)+instance (FromJSON l, FromJSON r) => FromJSON (Bimap l r)+
+ Data/Bijection/Vector/Storable.hs view
@@ -0,0 +1,54 @@++-- | A bijection between boxed, immutable vectors.++module Data.Bijection.Vector.Storable+  ( module Data.Bijection.Class+  , Bimap+  ) where++import           Control.Applicative ((<$>))+import           Control.DeepSeq+import           Data.Aeson+import           Data.Binary+import           Data.Serialize+import           Data.Tuple (swap)+import           Data.Vector.Binary+import           Data.Vector.Cereal+import           Data.Vector.Storable (Vector, Storable)+import           Foreign.Storable.Tuple+import           GHC.Generics+import qualified Data.Vector.Generic as G++import           Data.Bijection.Class++++newtype Bimap l r = Bimap (Vector (l,r))+  deriving (Read,Show,Eq,Generic)++instance (Eq l, Eq r, Storable l, Storable r, Storable (l,r)) => Bijection (Bimap l r) where+  type ContL (Bimap l r) = Vector (l,r)+  type ContR (Bimap l r) = Vector (r,l)+  type ElemL (Bimap l r) = l+  type ElemR (Bimap l r) = r+  contL (Bimap v) = v+  contR (Bimap v) = G.map swap v+  lookupL (Bimap v) k = snd <$> G.find ((==k) . fst) v+  lookupR (Bimap v) k = fst <$> G.find ((==k) . snd) v+  empty = Bimap G.empty+  null (Bimap v) = G.null v+  size (Bimap v) = G.length v+  fromList = Bimap . G.fromList+  toList (Bimap v) = G.toList v+  insert (Bimap v) = Bimap . G.snoc v+  deleteByL (Bimap v) x = Bimap $ G.filter ((/=x) . fst) v+  deleteByR (Bimap v) y = Bimap $ G.filter ((/=y) . snd) v++instance (NFData l, NFData r) => NFData (Bimap l r) where+  rnf (Bimap v) = rnf v++instance (Storable l, Storable r, Binary l, Binary r) => Binary (Bimap l r)+instance (Storable l, Storable r, Serialize l, Serialize r) => Serialize (Bimap l r)+instance (Storable l, Storable r, ToJSON l, ToJSON r) => ToJSON (Bimap l r)+instance (Storable l, Storable r, FromJSON l, FromJSON r) => FromJSON (Bimap l r)+
+ Data/Bijection/Vector/Unboxed.hs view
@@ -0,0 +1,55 @@++-- | A bijection between boxed, immutable vectors.++module Data.Bijection.Vector.Unboxed+  ( module Data.Bijection.Class+  , Bimap+  ) where++import           Control.Applicative ((<$>))+import           Control.DeepSeq+import           Data.Aeson+import           Data.Binary+import           Data.Serialize+import           Data.Tuple (swap)+import           Data.Vector.Binary+import           Data.Vector.Cereal+import           Data.Vector.Unboxed (Vector, Unbox)+import           GHC.Generics+import qualified Data.Vector.Generic as G++import           Data.Bijection.Class++++newtype Bimap l r = Bimap (Vector (l,r))+  deriving (Read,Show,Eq,Generic)++instance (Eq l, Eq r, Unbox l, Unbox r) => Bijection (Bimap l r) where+  type ContL (Bimap l r) = Vector (l,r)+  type ContR (Bimap l r) = Vector (r,l)+  type ElemL (Bimap l r) = l+  type ElemR (Bimap l r) = r+  contL (Bimap v) = v+  contR (Bimap v) = G.map swap v+  lookupL (Bimap v) k = snd <$> G.find ((==k) . fst) v+  lookupR (Bimap v) k = fst <$> G.find ((==k) . snd) v+  empty = Bimap G.empty+  null (Bimap v) = G.null v+  size (Bimap v) = G.length v+  fromList = Bimap . G.fromList+  toList (Bimap v) = G.toList v+  insert (Bimap v) = Bimap . G.snoc v+  deleteByL (Bimap v) x = Bimap $ G.filter ((/=x) . fst) v+  deleteByR (Bimap v) y = Bimap $ G.filter ((/=y) . snd) v+  {-# INLINE lookupL #-}+  {-# INLINE lookupR #-}++instance (NFData l, NFData r) => NFData (Bimap l r) where+  rnf (Bimap v) = rnf v++instance (Unbox l, Unbox r, Binary l, Binary r) => Binary (Bimap l r)+instance (Unbox l, Unbox r, Serialize l, Serialize r) => Serialize (Bimap l r)+instance (Unbox l, Unbox r, ToJSON l, ToJSON r) => ToJSON (Bimap l r)+instance (Unbox l, Unbox r, FromJSON l, FromJSON r) => FromJSON (Bimap l r)+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Christian Hoener zu Siederdissen nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,15 @@+bijections+==============++[![Build Status](https://travis-ci.org/choener/bimaps.svg?branch=master)](https://travis-ci.org/choener/bimaps)++Efficient bijections between sets with dense and sparse implementations.++++#### Contact++Christian Hoener zu Siederdissen+choener@bioinf.uni-leipzig.de+Leipzig University, Leipzig, Germany+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bimaps.cabal view
@@ -0,0 +1,112 @@+Name:           bimaps+Version:        0.0.0.1+License:        BSD3+License-file:   LICENSE+Author:         Christian Hoener zu Siederdissen+Maintainer:     choener@bioinf.uni-leipzig.de+Copyright:      Christian Hoener zu Siederdissen, 2014 - 2015+Homepage:       http://www.bioinf.uni-leipzig.de/~choener/+Stability:      Experimental+Category:       Data+Build-type:     Simple+Cabal-version:  >= 1.10+tested-with:    GHC == 7.8.4, GHC == 7.10.1+Synopsis:       bijections with multiple implementations.+Description:+                Bijections between sets of values.++++extra-source-files:+  changelog.md+  README.md++++flag benchmark+  description:  build the benchmark+  default:      False+  manual:       True++flag llvm+  description:  build using LLVM+  default:      False+  manual:       True++++library+  exposed-modules:+    Data.Bijection.Class+    Data.Bijection.Hash+    Data.Bijection.Map+    Data.Bijection.Vector+    Data.Bijection.Vector.Unboxed+    Data.Bijection.Vector.Storable++  -- 4.7.0.0 is ghc 7.8.1; 4.8.0.0 is ghc 7.10.1+  build-depends: base                     >= 4.7      && < 4.9+               , aeson                    == 0.8.*+               , binary                   == 0.7.*+               , cereal                   == 0.4.*+               , containers               == 0.5.*+               , deepseq                  >= 1.3      && < 1.5+               , hashable                 == 1.2.*+               , primitive                >= 0.5      && < 0.7+               , QuickCheck               >= 2.7      && < 2.9+               , storable-tuple           == 0.0.2+               , unordered-containers     == 0.2.5.*+               , vector                   == 0.10.*+               , vector-binary-instances  == 0.2.*+               , vector-th-unbox          == 0.2.*+  ghc-options:+    -O2+    -funbox-strict-fields+  default-language:+    Haskell2010+  default-extensions: BangPatterns+                    , DeriveGeneric+                    , FlexibleContexts+                    , TypeFamilies+                    , UndecidableInstances++++executable BenchmarkBimaps+  if flag(benchmark)+    buildable: True+    build-depends: base+                 , bimaps+                 , criterion   >= 1.0.2   && < 1.1.1+                 , deepseq+                 , mwc-random  == 0.13.*+                 , vector+  else+    buildable: False+  hs-source-dirs:+    src+  main-is:+    Benchmark.hs+  default-language:+    Haskell2010+  default-extensions: BangPatterns+                    , FlexibleContexts+                    , ScopedTypeVariables+                    , TypeFamilies+  ghc-options:+    -O2+    -funbox-strict-fields+    -funfolding-use-threshold1000+    -funfolding-keeness-factor1000+  if flag(llvm)+    ghc-options:+      -fllvm+      -optlo-O3 -optlo-std-compile-opts+      -fllvm-tbaa++++source-repository head+  type: git+  location: git://github.com/choener/bimaps+
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.0.1++- initial creation
+ src/Benchmark.hs view
@@ -0,0 +1,74 @@++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           Control.DeepSeq++import qualified Data.Bijection.Vector as BV+import qualified Data.Bijection.Vector.Unboxed as BU+import qualified Data.Bijection.Vector.Storable as BS+import qualified Data.Bijection.Map as BM+import qualified Data.Bijection.Hash as HS+import qualified Data.Bijection.Class as B++++runLookupBench xs' z = bench s $ whnf allLR xs'+  where s = printf "%5d" (B.size z)+        lL k = B.lookupL z k+        lR k = B.lookupR z k+        allL xs = VV.foldl' f 0 . VV.map lL . VG.convert $ xs+        allR xs = VV.foldl' f 0 . VV.map lR . VG.convert $ xs+        allLR xs = allL xs + allR xs+        f k (Just (!x)) = max k x+        f k _           = k+{-# INLINE runLookupBench #-}++benchLookup xs z = allLR -- bench s $ whnf allLR xs'+  where lL k = B.lookupL z k+        lR k = B.lookupR z k+        allL = VV.foldl' f 0 . VV.map lL . VG.convert $ xs+        allR = VV.foldl' f 0 . VV.map lR . VG.convert $ xs+        allLR = allL + allR+        f k (Just (!x)) = max k x+        f k _           = k+{-# INLINE benchLookup #-}++benchVU :: VU.Vector Int -> BU.Bimap Int Int -> Int+benchVU = benchLookup+{-# NOINLINE benchVU #-}++benchBM :: VU.Vector Int -> BM.Bimap Int Int -> Int+benchBM = benchLookup+{-# NOINLINE benchBM #-}++main :: IO ()+main = do+  lkup :: VU.Vector Int <- withSystemRandom . asGenIO $ \gen -> uniformVector gen 10+  inputs :: [[Int]] <- mapM (\l -> withSystemRandom . asGenIO $ \gen -> VU.toList <$> uniformVector gen l) [1, 5, 10, 50, 100, 1000] -- [1,10,100,1000,10000]+  let zVV :: [BV.Bimap Int Int] = map (\i -> B.fromList $ zip i i) inputs+  let zVU :: [BU.Bimap Int Int] = map (\i -> B.fromList $ zip i i) inputs+  let zVS :: [BS.Bimap Int Int] = map (\i -> B.fromList $ zip i i) inputs+  let zMS :: [BM.Bimap Int Int] = map (\i -> B.fromList $ zip i i) inputs+  let zHS :: [HS.Bimap Int Int] = map (\i -> B.fromList $ zip i i) inputs+  deepseq (lkup,inputs,zVV,zVU,zVS,zMS,zHS) `seq` defaultMain+    [ bgroup "5"+      [ bench "vector/ unboxed" $ whnf (benchVU lkup) (zVU !! 1)+      , bench "   map/  strict" $ whnf (benchBM lkup) (zMS !! 1)+      ]+    , bgroup "by type"+--      [ bgroup "vector/    boxed" (map (runLookupBench lkup) zVV)+--      , bgroup "vector/ storable" (map (runLookupBench lkup) zVS)+      [ bgroup "vector/  unboxed" (map (runLookupBench lkup) zVU)+      , bgroup "   map/   strict" (map (runLookupBench lkup) zMS)+      , bgroup "  hash/   strict" (map (runLookupBench lkup) zHS)+      ]+    ]+