91cfdd0 · project-m36 · git.iko.soy

git.iko.soy/project-m36

bigrel-related optimizations

matrixRelation tupleset parallelization restriction parallelization

commit91cfdd050e28bdc6f2798ab4fd12ade24386b152 authorAgentM <agentm@themactionfaction.com> dateMon 4 May 2015, 21:02 (11 years ago) parentf7681f6

9 files changed+49−29

compare with master

unifiedsplit

ProjectM36/Attribute.hs+1−10 ProjectM36/Base.hs+2 ProjectM36/Relation.hs+7−2 ProjectM36/Relation/Show/HTML.hs+5−4 ProjectM36/RelationalExpression.hs+2 ProjectM36/StaticOptimizer.hs+2−1 ProjectM36/TupleSet.hs+1−1 TutorialD/Interpreter.hs+1−2 benchmark/bigrel.hs+28−9

ProjectM36/Attribute.hs+1−10

@@ -6,7 +6,6 @@ import qualified Data.List as L

66import qualified Data.Vector as V

77import qualified Data.Hashable as Hash

88import qualified Data.HashSet as HS

9−import Data.Maybe

109

1110arity :: Attributes -> Int

1211arity = V.length

@@ -17,16 +16,8 @@ emptyAttributes = V.empty

1716null :: Attributes -> Bool

1817null = V.null

1918

20−--merges duplicates

2119attributesFromList :: [Attribute] -> Attributes

22−attributesFromList attrList = mergedAttributes

23− where

24− mergedAttributes = V.reverse $ V.foldr (\attr acc -> if containsAttributeName (attributeName attr) acc then

25− acc

26− else

27− acc `V.snoc` attr

28− ) V.empty $ V.fromList attrList

29− containsAttributeName name attrs = isJust $ V.find (\attr -> attributeName attr == name) attrs

20+attributesFromList = V.fromList -- . L.nub

3021

3122attributeName :: Attribute -> AttributeName

3223attributeName (Attribute name _) = name

ProjectM36/Base.hs+2

@@ -94,6 +94,7 @@ type RelVarName = StringType

9494

9595data RelationalExpr where

9696 MakeStaticRelation :: Attributes -> RelationTupleSet -> RelationalExpr

97+ ExistingRelation :: Relation -> RelationalExpr

9798 --MakeFunctionalRelation (creates a relation from a tuple-generating function, potentially infinite)

9899 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

99100 --relational variables should also be able to be explicitly-typed like in Haskell

@@ -189,3 +190,4 @@ instance Eq Transaction where

189190

190191instance Ord Transaction where

191192 compare (Transaction uuidA _ _) (Transaction uuidB _ _) = compare uuidA uuidB

193+

ProjectM36/Relation.hs+7−2

@@ -13,6 +13,7 @@ import ProjectM36.TupleSet

1313import ProjectM36.Error

1414import Prelude hiding (join)

1515import qualified Data.Text as T

16+import qualified Control.Parallel.Strategies as P

1617

1718attributes :: Relation -> Attributes

1819attributes (Relation attrs _ ) = attrs

@@ -201,7 +202,11 @@ attributesForRelval relvalAttrName (Relation attrs _) = case A.atomTypeForAttrib

201202 _ -> Left $ AttributeIsNotRelationValuedError relvalAttrName

202203

203204restrict :: (RelationTuple -> Bool) -> Relation -> Either RelationalError Relation

204−restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

205+--restrict rfilter (Relation attrs tupset) = Right $ Relation attrs $ HS.filter rfilter tupset

206+restrict rfilter (Relation attrs tupset) = Right $ Relation attrs processedTupSet

207+ where

208+ tupSetList = HS.toList tupset

209+ processedTupSet = HS.fromList ((filter rfilter tupSetList) `P.using` (P.parListChunk 1000 P.rdeepseq))

205210

206211--joins on columns with the same name- use rename to avoid this- base case: cartesian product

207212--after changing from string atoms, there needs to be a type-checking step!

@@ -260,7 +265,7 @@ imageRelationJoin rel1@(Relation attrNameSet1 tupSet1) rel2@(Relation attrNameSe

260265-- this is useful for performance and resource usage testing

261266matrixRelation :: Int -> Int -> Either RelationalError Relation

262267matrixRelation attributeCount tupleCount = do

263− let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ show c) IntAtomType) [0 .. attributeCount-1]

268+ let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]

264269 tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom tupleX))

265270 tupleSet = HS.fromList $ map (\c -> tuple c) [0 .. tupleCount]

266271 mkRelation attrs tupleSet

ProjectM36/Relation/Show/HTML.hs+5−4

@@ -7,12 +7,13 @@ import qualified Data.HashSet as HS

77import qualified Data.List as L

88import ProjectM36.Attribute

99import Data.Text (append, Text, pack)

10+import qualified Data.Text as T

1011import qualified Data.Text.IO as TIO

1112

1213attributesAsHTML :: Attributes -> Text

13−attributesAsHTML attrs = "<tr>" `append` (foldr folder "" attrNameList) `append` "</tr>"

14+attributesAsHTML attrs = "<tr>" `append` (T.concat $ map oneAttrHTML attrNameList) `append` "</tr>"

1415 where

15− folder attrName acc = acc `append` "<th>" `append` attrName `append` "</th>"

16+ oneAttrHTML attrName = "<th>" `append` attrName `append` "</th>"

1617 attrNameList = sortedAttributeNameList (attributeNameSet attrs)

1718

1819relationAsHTML :: Relation -> Text

@@ -32,9 +33,9 @@ atomAsHTML (IntAtom int) = pack (show int)

3233atomAsHTML (RelationAtom rel) = relationAsHTML rel

3334

3435tupleAsHTML :: RelationTuple -> Text

35−tupleAsHTML tuple = "<tr>" `append` L.foldr folder "" (tupleSortedAssocs tuple) `append` "</tr>"

36+tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

3637 where

37− folder tup acc = acc `append` "<td>" `append` (atomAsHTML (snd tup)) `append` "</td>"

38+ tupleFrag tup = "<td>" `append` atomAsHTML (snd tup) `append` "</td>"

3839

3940tupleSetAsHTML :: RelationTupleSet -> Text

4041tupleSetAsHTML tupSet = HS.foldr folder "" tupSet

ProjectM36/RelationalExpression.hs+2

@@ -48,6 +48,8 @@ evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) = do

4848 Right rel -> return $ Right rel

4949 Left err -> return $ Left err

5050

51+evalRelationalExpr (ExistingRelation rel) = return (Right rel)

52+

5153evalRelationalExpr (Rename oldAttrName newAttrName relExpr) = do

5254 evald <- evalRelationalExpr relExpr

5355 case evald of

ProjectM36/StaticOptimizer.hs+2−1

@@ -14,6 +14,8 @@ import Data.Either (rights, lefts)

1414applyStaticRelationalOptimization :: RelationalExpr -> DatabaseState (Either RelationalError RelationalExpr)

1515applyStaticRelationalOptimization e@(MakeStaticRelation _ _) = return $ Right e

1616

17+applyStaticRelationalOptimization e@(ExistingRelation _) = return $ Right e

18+

1719applyStaticRelationalOptimization e@(RelationVariable _) = return $ Right e

1820

1921--remove project of attributes which removes no attributes

@@ -140,6 +142,5 @@ applyStaticDatabaseOptimization (MultipleExpr exprs) = do

140142 --this error handling could be improved with some lifting presumably

141143 --restore original context

142144

143−

144145applyStaticPredicateOptimization :: RestrictionPredicateExpr -> DatabaseState (Either RelationalError RestrictionPredicateExpr)

145146applyStaticPredicateOptimization predicate = return $ Right predicate

ProjectM36/TupleSet.hs+1−1

@@ -19,7 +19,7 @@ singletonTupleSet = HS.singleton emptyTuple

1919verifyTupleSet :: Attributes -> RelationTupleSet -> Either RelationalError RelationTupleSet

2020verifyTupleSet attrs tupleSet = do

2121 --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 chunkSize P.rdeepseq

22+ let tupleList = (map (verifyTuple attrs) (HS.toList tupleSet)) `P.using` P.parListChunk chunkSize P.r0

2323 chunkSize = HS.size tupleSet `div` 24

2424 --let tupleList = P.parMap P.rdeepseq (verifyTuple attrs) (HS.toList tupleSet)

2525 if length (lefts tupleList) > 0 then

TutorialD/Interpreter.hs+1−2

@@ -487,7 +487,7 @@ interpret context tutdstring = case parseString tutdstring of

487487 Left err -> (Just err, context)

488488 Right parsed -> runState (evaluator parsed) context

489489 where

490− evaluator expr = do

490+ evaluator expr = do

491491 optExpr <- applyStaticDatabaseOptimization expr

492492 --case optExpr of

493493 case optExpr of

@@ -499,7 +499,6 @@ interpretNO :: DatabaseContext -> String -> (Maybe RelationalError, DatabaseCont

499499interpretNO context tutdstring = case parseString tutdstring of

500500 Left err -> (Just err, context)

501501 Right parsed -> runState (evalContextExpr parsed) context

502−

503502

504503-- for interpreter-specific operations

505504interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)

benchmark/bigrel.hs+28−9

@@ -3,35 +3,45 @@ import ProjectM36.Base

33import ProjectM36.Relation

44import ProjectM36.Tuple

55import ProjectM36.Relation.Show.CSV

6+import ProjectM36.Relation.Show.HTML

7+import TutorialD.Interpreter (interpret)

8+import ProjectM36.RelationalExpression

69import qualified Data.HashSet as HS

710import qualified Data.ByteString.Lazy.Char8 as BS

811import qualified Data.IntMap as IM

912import qualified Data.Hashable as Hash

1013import qualified Data.Vector as V

1114import Options.Applicative

15+import Control.Monad.State

16+import qualified Data.Map as M

17+import qualified Data.Text.IO as TIO

18+import System.IO

1219

1320dumpcsv :: Relation -> IO ()

1421dumpcsv = BS.putStrLn . relationAsCSV

1522

23+data BigrelArgs = BigrelArgs Int Int String

24+

1625parseAttributeCount :: Parser Int

1726parseAttributeCount = option auto (short 'a' <> long "attribute-count")

1827

1928parseTupleCount :: Parser Int

2029parseTupleCount = option auto (short 't' <> long "tuple-count")

21−

22−parseArgs :: Parser (Int, Int)

23−parseArgs = (,) <$> parseAttributeCount <*> parseTupleCount

2430

31+parseTutD :: Parser String

32+parseTutD = strOption (short 'd' <> long "tutoriald")

33+

34+parseArgs :: Parser BigrelArgs

35+parseArgs = BigrelArgs <$> parseAttributeCount <*> parseTupleCount <*> parseTutD

2536

2637main :: IO ()

2738main = do

28− (attributeCount, tupleCount) <- execParser $ info (helper <*> parseArgs) fullDesc

39+ bigrelArgs <- execParser $ info (helper <*> parseArgs) fullDesc

2940 --matrixRestrictRun

30− matrixRun attributeCount tupleCount

41+ matrixRun bigrelArgs

3142 --vectorMatrixRun

3243 --intmapMatrixRun

3344

34−-- takes 30 minutes to run and 1.1 GB

3545matrixRestrictRun :: IO ()

3646matrixRestrictRun = do

3747 case matrixRelation 100 1000000 of

@@ -40,11 +50,20 @@ matrixRestrictRun = do

4050 Left err -> putStrLn (show err)

4151 Right rel -> dumpcsv rel

4252

43−matrixRun :: Int -> Int -> IO ()

44−matrixRun attributeCount tupleCount= do

53+matrixRun :: BigrelArgs -> IO ()

54+matrixRun (BigrelArgs attributeCount tupleCount tutd) = do

4555 case matrixRelation attributeCount tupleCount of

4656 Left err -> putStrLn (show err)

47− Right rel -> putStrLn "Done"

57+ Right rel -> if tutd == "" then

58+ putStrLn "Done."

59+ else do

60+ let setx = Assign "x" (ExistingRelation rel)

61+ (_, context) = runState (evalContextExpr setx) dateExamples

62+ (err, context2) = interpret context tutd

63+ case err of

64+ Nothing -> TIO.putStrLn $ relationAsHTML ((relationVariables context2) M.! "x")

65+ Just err -> hPutStrLn stderr (show err)

66+

4867

4968intmapMatrixRun :: IO ()

5069intmapMatrixRun = do