on request_timeout help sign in
109 lines 4.3 kB history raw
1{-# LANGUAGE FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3import ProjectM36.Base
4import ProjectM36.Relation
5import ProjectM36.DateExamples
6import ProjectM36.Error
7import qualified ProjectM36.Attribute as A
8import qualified Data.Text as T
9import ProjectM36.Relation.Show.CSV
10import ProjectM36.Relation.Show.HTML
11import TutorialD.Interpreter.DatabaseContextExpr (interpretDatabaseContextExpr)
12import ProjectM36.RelationalExpression
13import qualified Data.HashSet as HS
14import qualified Data.ByteString.Lazy.Char8 as BS
15import qualified Data.IntMap as IM
16import qualified Data.Hashable as Hash
17import qualified Data.Vector as V
18import Options.Applicative
19import qualified Data.Map as M
20import qualified Data.Text.IO as TIO
21import System.IO
22import Control.Monad.State
23import Control.DeepSeq
24import Data.Text hiding (map)
25import Data.Monoid
27dumpcsv :: Relation -> IO ()
28dumpcsv rel = case relationAsCSV rel of
29 Left err -> hPutStrLn stderr (show err)
30 Right bsData -> BS.putStrLn bsData
32data BigrelArgs = BigrelArgs Int Int Text
34parseAttributeCount :: Parser Int
35parseAttributeCount = option auto (short 'a' <> long "attribute-count")
37parseTupleCount :: Parser Int
38parseTupleCount = option auto (short 't' <> long "tuple-count")
40parseTutD :: Parser String
41parseTutD = strOption (short 'd' <> long "tutoriald")
43parseArgs :: Parser BigrelArgs
44parseArgs = BigrelArgs <$> parseAttributeCount <*> parseTupleCount <*> (pack <$> parseTutD)
46main :: IO ()
47main = do
48 bigrelArgs <- execParser $ info (helper <*> parseArgs) fullDesc
49 --matrixRestrictRun
50 matrixRun bigrelArgs
51 --vectorMatrixRun
52 --intmapMatrixRun
54matrixRun :: BigrelArgs -> IO ()
55matrixRun (BigrelArgs attributeCount tupleCount tutd) = do
56 case matrixRelation attributeCount tupleCount of
57 Left err -> putStrLn (show err)
58 Right rel -> if tutd == "" then
59 putStrLn "Done."
60 else do
61 let setx = Assign "x" (ExistingRelation (force rel))
62 context = execState (evalContextExpr setx) dateExamples
63 interpreted = interpretDatabaseContextExpr context tutd
64 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd
65 --displayOpResult plan
66 case interpreted of
67 Right context' -> TIO.putStrLn $ relationAsHTML ((relationVariables context') M.! "x")
68 Left err -> hPutStrLn stderr (show err)
71intmapMatrixRun :: IO ()
72intmapMatrixRun = do
73 let matrix = intmapMatrixRelation 100 100000
74 putStrLn (show matrix)
76--compare IntMap speed and size
77--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB
78intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)
79intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
80 where
81 mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom tupCount)) [0..attributeCount]
83instance Hash.Hashable (IM.IntMap Atom) where
84 hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)
86vectorMatrixRun :: IO ()
87vectorMatrixRun = do
88 let matrix = vectorMatrixRelation 100 100000
89 putStrLn (show matrix)
91-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper
92--with IntAtom wrapper: 1m12s 90 MB
93vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)
94vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
95 where
96 mapper tupCount = V.replicate attributeCount (IntAtom tupCount)
98instance Hash.Hashable (V.Vector Atom) where
99 hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
101-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long
102-- this is useful for performance and resource usage testing
103matrixRelation :: Int -> Int -> Either RelationalError Relation
104matrixRelation attributeCount tupleCount = do
105 let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]
106 tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom tupleX))
107 tuples = map (\c -> tuple c) [0 .. tupleCount]
108 mkRelationDeferVerify attrs (RelationTupleSet tuples)