packages feed

project-m36-0.8: src/bin/benchmark/bigrel.hs

{-# LANGUAGE FlexibleInstances, CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import ProjectM36.Base
import ProjectM36.Relation
import ProjectM36.DateExamples
import ProjectM36.Error
import ProjectM36.StaticOptimizer
import qualified ProjectM36.Attribute as A
import qualified Data.Text as T
--import ProjectM36.Relation.Show.CSV
import ProjectM36.Relation.Show.HTML
import ProjectM36.RelationalExpression
import ProjectM36.TransactionGraph
--import qualified Data.HashSet as HS
--import qualified Data.ByteString.Lazy.Char8 as BS
--import qualified Data.IntMap as IM
--import qualified Data.Hashable as Hash
import qualified Data.Vector as V
import Options.Applicative
import qualified Data.Text.IO as TIO
import System.IO
import Control.DeepSeq
import Data.Text hiding (map)
import Data.Time.Clock
import Data.UUID.V4
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif


{-
dumpcsv :: Relation -> IO ()
dumpcsv rel = case relationAsCSV rel of
  Left err -> hPrint stderr err
  Right bsData -> BS.putStrLn bsData
-}

data BigrelArgs = BigrelArgs Int Int Text

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

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

parseTutD :: Parser String
parseTutD = strOption (short 'd' <> long "tutoriald")

parseArgs :: Parser BigrelArgs
parseArgs =  BigrelArgs <$> parseAttributeCount <*> parseTupleCount <*> (pack <$> parseTutD)

main :: IO ()
main = do
  bigrelArgs <- execParser $ info (helper <*> parseArgs) fullDesc
  --matrixRestrictRun
  matrixRun bigrelArgs
    --vectorMatrixRun
    --intmapMatrixRun

matrixRun :: BigrelArgs -> IO ()
matrixRun (BigrelArgs attributeCount tupleCount tutd) =
  case matrixRelation attributeCount tupleCount of
    Left err -> print err
    Right rel -> if tutd == "" then
                   putStrLn "Done."
                 else do
                   now <- getCurrentTime
                   tid <- nextRandom
                   let setx = Assign "x" (ExistingRelation (force rel))
                       graph = bootstrapTransactionGraph now tid dateExamples
                       env = mkDatabaseContextEvalEnv tid graph
                       eNewState = runDatabaseContextEvalMonad dateExamples env (optimizeAndEvalDatabaseContextExpr True setx)
                       --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd
                   --displayOpResult plan
                   case eNewState of
                     Right newState -> do
                       let ctx = dbc_context newState
                           Right x = optimizeAndEvalRelationalExpr env' (RelationVariable "x" ())
                           env' = RelationalExprEnv ctx graph Nothing
                       TIO.putStrLn $ relationAsHTML x
                     Left err -> hPrint stderr err

{-
intmapMatrixRun :: IO ()
intmapMatrixRun = do
  let matrix = intmapMatrixRelation 100 100000
  print matrix
-}

--compare IntMap speed and size
--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB
{-
intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)
intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
  where
    mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom (fromIntegral tupCount))) [0..attributeCount]
-}
-- instance Hash.Hashable (IM.IntMap Atom) where
--  hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)

{-
vectorMatrixRun :: IO ()
vectorMatrixRun = do
  let matrix = vectorMatrixRelation 100 100000
  print matrix
-}
-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper
--with IntAtom wrapper: 1m12s 90 MB
{-


-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper
--with IntAtom wrapper: 1m12s 90 MB
{-                    

vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)
vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
  where
    mapper tupCount = V.replicate attributeCount (IntAtom (fromIntegral tupCount))
-}
instance Hash.Hashable (V.Vector Atom) where
  hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
-}
-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long
-- this is useful for performance and resource usage testing
matrixRelation :: Int -> Int -> Either RelationalError Relation
matrixRelation attributeCount tupleCount = do
  let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]
      tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom (fromIntegral tupleX)))
      tuples = map tuple [0 .. tupleCount]
  mkRelationDeferVerify attrs (RelationTupleSet tuples)