git.iko.soy/project-m36
on master help sign in
implement first-pass optimization and parallelization in relation creation

2000 tuples-per-second -> 14,000 tuples per second (parallel 8 CPUs)

commit84b3b93a3a71f25b342b5466b15a30b683aadc76 authorAgentM <agentm@themactionfaction.com> dateSun 3 May 2015, 22:05 (11 years ago) parent4d59a8c
6 files changed+39−26
compare with master
unifiedsplit
ProjectM36/Attribute.hs+5−2 ProjectM36/Error.hs+7−1 ProjectM36/Tuple.hs+8−15 ProjectM36/TupleSet.hs+10−4 benchmark/bigrel.hs+7−2 project-m36.cabal+2−2
ProjectM36/Attribute.hs+5−2
@@ -31,6 +31,9 @@ attributesFromList attrList = mergedAttributes
3131attributeName :: Attribute -> AttributeName
3232attributeName (Attribute name _) = name
3333
34+atomType :: Attribute -> AtomType
35+atomType (Attribute _ atype) = atype
36+
3437isRelationAtomType :: AtomType -> Bool
3538isRelationAtomType (RelationAtomType _) = True
3639isRelationAtomType _ = False
@@ -67,11 +70,11 @@ renameAttributes oldAttrName newAttrName attrs = V.map renamer attrs
6770
6871atomTypeForAttributeName :: AttributeName -> Attributes -> Maybe AtomType
6972atomTypeForAttributeName attrName attrs = case attr of
70− (Just (Attribute _ atomType)) -> Just atomType
73+ (Just (Attribute _ atype)) -> Just atype
7174 _ -> Nothing
7275 where
7376 attr = attributeForName attrName attrs
74−
77+
7578attributeForName :: AttributeName -> Attributes -> Maybe Attribute
7679attributeForName attrName attrs = V.find ((attrName ==) . attributeName) attrs
7780
ProjectM36/Error.hs+7−1
@@ -1,6 +1,11 @@
1+{-# LANGUAGE DeriveGeneric #-}
12module ProjectM36.Error where
23import ProjectM36.Base
34import qualified Data.UUID as U
5+import Control.DeepSeq (NFData, rnf)
6+import Control.DeepSeq.Generics (genericRnf)
7+import GHC.Generics (Generic)
8+
49
510data RelationalError = NoSuchAttributeNameError AttributeName
611 | TupleAttributeCountMismatchError Int --attribute name
@@ -19,6 +24,7 @@ data RelationalError = NoSuchAttributeNameError AttributeName
1924 | NoSuchHeadNameError HeadName
2025 | TransactionIsNotAHeadError U.UUID
2126 | TransactionGraphCycleError U.UUID
22− deriving (Show,Eq)
27+ deriving (Show,Eq,Generic)
2328
2429
30+instance NFData RelationalError where rnf = genericRnf
ProjectM36/Tuple.hs+8−15
@@ -146,21 +146,14 @@ tupleToMap (RelationTuple attrs tupVec) = M.fromList assocList
146146 assocList = V.toList $ V.map (\(index, attr) -> (attributeName attr, tupVec V.! index)) (V.indexed attrs)
147147
148148verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
149−verifyTuple attrs tuple = if V.length attrs /= V.length (tupleAtoms tuple) then
150− Left $ TupleAttributeCountMismatchError 0
151− else
152−
153− V.foldr (\attr acc ->
154− case atomForAttributeName (attributeName attr) tuple of
155− Left err -> Left err
156− Right atom -> case atomTypeForAttributeName (attributeName attr) (tupleAttributes tuple) of
157− Nothing -> Left $ NoSuchAttributeNameError (attributeName attr)
158− Just expectedAtomType -> if atomTypeForAtom atom == expectedAtomType
159− then
160− acc
161− else
162− Left $ TupleAttributeTypeMismatchError (attributesFromList [attr])
163− ) (Right tuple) attrs
149+verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs
150+ tupleTypes = V.map atomTypeForAtom (tupleAtoms tuple) in
151+ if V.length attrs /= V.length tupleTypes then
152+ Left $ TupleAttributeCountMismatchError 0
153+ else if attrsTypes /= tupleTypes then
154+ Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))
155+ else
156+ Right $ tuple
164157
165158
166159
ProjectM36/TupleSet.hs+10−4
@@ -3,8 +3,10 @@ import ProjectM36.Base
33import ProjectM36.Tuple
44import ProjectM36.Error
55import qualified Data.HashSet as HS
6−import Control.Monad
6+--import Control.Monad (forM)
77import qualified Data.Vector as V
8+import qualified Control.Parallel.Strategies as P
9+import Data.Either
810
911emptyTupleSet :: RelationTupleSet
1012emptyTupleSet = HS.empty
@@ -16,9 +18,13 @@ singletonTupleSet = HS.singleton emptyTuple
1618
1719verifyTupleSet :: Attributes -> RelationTupleSet -> Either RelationalError RelationTupleSet
1820verifyTupleSet attrs tupleSet = do
19− --check that all tuples have the same types
20− tupleList <- forM (HS.toList tupleSet) (verifyTuple attrs)
21− return $ HS.fromList tupleList
21+ --check that all tuples have the same attributes and that the atom types match
22+ let tupleList = (map (verifyTuple attrs) (HS.toList tupleSet)) `P.using` P.parListChunk (100000 `div` 24) P.rdeepseq
23+ --let tupleList = P.parMap P.rdeepseq (verifyTuple attrs) (HS.toList tupleSet)
24+ if length (lefts tupleList) > 0 then
25+ Left $ head (lefts tupleList)
26+ else
27+ return $ HS.fromList (rights tupleList)
2228
2329mkTupleSet :: Attributes -> [RelationTuple] -> Either RelationalError RelationTupleSet
2430mkTupleSet attrs tuples = verifyTupleSet attrs tupSet
benchmark/bigrel.hs+7−2
@@ -20,13 +20,18 @@ main = matrixRun
2020 --intmapMatrixRun
2121
2222-- takes 30 minutes to run and 1.1 GB
23−matrixRun = do
23+matrixRestrictRun = do
2424 case matrixRelation 100 100000 of
2525 Left err -> putStrLn (show err)
2626 Right rel -> case restrict (\tuple -> atomForAttributeName "0" tuple == Right (IntAtom 5)) rel of
2727 Left err -> putStrLn (show err)
2828 Right rel -> dumpcsv rel
2929
30+matrixRun = do
31+ case matrixRelation 100 100000 of
32+ Left err -> putStrLn (show err)
33+ Right rel -> putStrLn "Done"
34+
3035intmapMatrixRun = do
3136 let matrix = intmapMatrixRelation 100 100000
3237 putStrLn (show matrix)
@@ -53,4 +58,4 @@ vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tu
5358 mapper tupCount = V.replicate attributeCount (IntAtom tupCount)
5459
5560instance Hash.Hashable (V.Vector Atom) where
56− hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
61+ hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
project-m36.cabal+2−2
@@ -7,7 +7,7 @@ Category: Relational Algebra
77Cabal-Version: >= 1.2
88
99Library
10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector
10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel
1111 Exposed-Modules: ProjectM36.Error,
1212 ProjectM36.Transaction,
1313 ProjectM36.Transaction.Show,
@@ -40,7 +40,7 @@ Executable bigrel
4040 ProjectM36.Error,
4141 ProjectM36.Relation.Show.CSV
4242 main-is: benchmark/bigrel.hs
43− GHC-Options: -Wall
43+ GHC-Options: -Wall -threaded -rtsopts
4444 GHC-Prof-Options: -fprof-auto "-with-rtsopts -p -s -h -i0.1"
4545
4646Test-Suite test-tutoriald