82a6791 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

basic gnuplot relation rendering

82a6791AgentM11 years ago

ProjectM36/Attribute.hs+3

compare with master

unifiedsplit

@@ -25,6 +25,9 @@ attributeName (Attribute name _) = name

25atomType :: Attribute -> AtomType

26atomType (Attribute _ atype) = atype

28+atomTypes :: Attributes -> V.Vector AtomType

29+atomTypes attrs = V.map atomType attrs

30+

28isRelationAtomType :: AtomType -> Bool

31isRelationAtomType :: AtomType -> Bool

29isRelationAtomType (RelationAtomType _) = True

32isRelationAtomType (RelationAtomType _) = True

30isRelationAtomType _ = False

33isRelationAtomType _ = False

ProjectM36/Relation/Show/Gnuplot.hsnew file+95

@@ -0,0 +1,95 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module ProjectM36.Relation.Show.Gnuplot where

3+import ProjectM36.Base

4+import ProjectM36.Relation

5+import ProjectM36.Tuple

6+import qualified ProjectM36.Attribute as A

7+import Graphics.EasyPlot

8+import qualified Data.Vector as V

10+--this module support plotting relations containing integer attributes with arity 1,2, or 3 only

11+--nested relations?

12+

13+data PlotError = InvalidAttributeCountError |

14+ InvalidAttributeTypeError

15+ deriving (Show)

16+

17+--plotRelation :: Relation -> Either PlotError

18+

19+intFromAtomIndex :: Int -> RelationTuple -> Int

20+intFromAtomIndex index tup = (\(IntAtom i) -> i) $ (tupleAtoms tup) V.! index

21+

22+graph1DRelation :: Relation -> Graph2D Double Double

23+graph1DRelation rel = Data2D [Title "rel"] [] $ map (\i -> (fromIntegral i, 0.0)) (points1DRelation rel)

24+

25+points1DRelation :: Relation -> [Int]

26+points1DRelation rel = relFold folder [] rel

27+ where

28+ folder tup acc = intFromAtomIndex 0 tup : acc

29+

30+graph2DRelation :: Relation -> Graph2D Double Double

31+graph2DRelation rel = Data2D [Title "rel"] [Step 1.0] $ map (\(x,y) -> (fromIntegral x, fromIntegral y)) $ points2DRelation rel

32+

33+points2DRelation :: Relation -> [(Int, Int)]

34+points2DRelation rel = relFold folder [] rel

35+ where

36+ folder tup acc = (intFromAtomIndex 0 tup, intFromAtomIndex 1 tup) : acc

37+

38+graph3DRelation :: Relation -> Graph3D Double Double Double

39+graph3DRelation rel = Data3D [Title "rel"] [StepX 1.0, StepY 1.0] $ map (\(x,y,z) -> (fromIntegral x, fromIntegral y, fromIntegral z)) $ points3DRelation rel

40+

41+points3DRelation :: Relation -> [(Int, Int, Int)]

42+points3DRelation rel = relFold folder [] rel

43+ where

44+ folder tup acc = (intFromAtomIndex 0 tup, intFromAtomIndex 1 tup, intFromAtomIndex 2 tup) : acc

45+

46+sample1DRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType]) [[IntAtom 2], [IntAtom 3]] of

47+ Right rel -> rel

48+ Left _ -> undefined

49+

50+sample2dRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType, Attribute "y" IntAtomType]) [[IntAtom 2, IntAtom 3],

51+ [IntAtom 2, IntAtom 4]] of

52+ Right rel -> rel

53+ Left _ -> undefined

54+

55+sample3dRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType, Attribute "y" IntAtomType, Attribute "z" IntAtomType]) [[IntAtom 2, IntAtom 3, IntAtom 3],

56+ [IntAtom 2, IntAtom 4, IntAtom 4]] of

57+ Right rel -> rel

58+ Left _ -> undefined

59+

60+type G2D = Graph2D Double Double

61+type G3D = Graph3D Double Double Double

62+

63+plotRelation :: Relation -> Either PlotError (Either G2D G3D)

64+plotRelation rel = let attrTypes = V.replicate (arity rel) IntAtomType in

65+ if attrTypes /= A.atomTypes (attributes rel) then

66+ Left InvalidAttributeTypeError

67+ else

68+ case arity rel of

69+ 1 -> Right $ Left $ graph1DRelation rel

70+ 2 -> Right $ Left $ graph2DRelation rel

71+ 3 -> Right $ Right $ graph3DRelation rel

72+ _ -> Left InvalidAttributeCountError

73+

74+--PNG

75+savePlottedRelation :: String -> Relation -> IO ()

76+savePlottedRelation path rel = case plotRelation rel of

77+ Left err -> putStrLn (show err)

78+ Right (Left g2d) -> plot' [] (PNG path) g2d >> return ()

79+ Right (Right g3d) -> plot' [] (PNG path) g3d >> return ()

80+

81+--X11

82+showPlottedRelation :: Relation -> IO ()

83+showPlottedRelation rel = case plotRelation rel of

84+ Left err -> putStrLn (show err)

85+ Right (Left g2d) -> plot' [] X11 g2d >> return ()

86+ Right (Right g3d) -> plot' [] X11 g3d >> return ()

87+

88+

89+ezplot :: Relation -> IO ()

90+ezplot rel = do

91+ case plotRelation rel of

92+ Left err -> putStrLn $ show err

93+ Right (Left g2d) -> plot' [Interactive] X11 g2d >> return ()

94+ Right (Right g3d) -> plot' [Interactive] X11 g3d >> return ()

95+

TutorialD/Interpreter.hs+3

@@ -69,6 +69,9 @@ reprLoop currentTransaction graph = do

69 case interpret newUUID currentTransaction graph line of

70 (QuitResult, _, _) -> return ()

71 (DisplayErrorResult err, _, _) -> TIO.hPutStrLn stderr ("ERR: " `T.append` err) >> roloop

72+ (DisplayIOResult outio, updatedTrans, updatedGraph) -> do

73+ outio

74+ reprLoop updatedTrans updatedGraph

72 (DisplayResult out, updatedTrans, updatedGraph) -> do

75 (DisplayResult out, updatedTrans, updatedGraph) -> do

73 TIO.putStrLn out

76 TIO.putStrLn out

74 reprLoop updatedTrans updatedGraph

77 reprLoop updatedTrans updatedGraph

TutorialD/Interpreter/Base.hs+2

@@ -61,11 +61,13 @@ showRelationAttributes attrs = "{" `T.append` T.concat (L.intersperse ", " $ map

62data TutorialDOperatorResult = QuitResult |

63 DisplayResult StringType |

64+ DisplayIOResult (IO ()) |

64 DisplayErrorResult StringType |

65 DisplayErrorResult StringType |

65 QuietSuccessResult

66 QuietSuccessResult

67displayOpResult :: TutorialDOperatorResult -> IO ()

68displayOpResult :: TutorialDOperatorResult -> IO ()

68displayOpResult QuitResult = return ()

69displayOpResult QuitResult = return ()

69displayOpResult (DisplayResult out) = TIO.putStrLn out

70displayOpResult (DisplayResult out) = TIO.putStrLn out

71+displayOpResult (DisplayIOResult ioout) = ioout

70displayOpResult (DisplayErrorResult err) = TIO.hPutStrLn stderr ("ERR: " `T.append` err)

72displayOpResult (DisplayErrorResult err) = TIO.hPutStrLn stderr ("ERR: " `T.append` err)

71displayOpResult QuietSuccessResult = return ()

73displayOpResult QuietSuccessResult = return ()

TutorialD/Interpreter/RODatabaseContextOperator.hs+16−1

@@ -12,11 +12,13 @@ import TutorialD.Interpreter.DatabaseExpr

12import Control.Monad.State

13import qualified Data.Text as T

14import ProjectM36.Relation.Show.Term

15+import ProjectM36.Relation.Show.Gnuplot

15import qualified Data.Map as M

16import qualified Data.Map as M

17--operators which only rely on database context reading

18--operators which only rely on database context reading

18data RODatabaseContextOperator where

19data RODatabaseContextOperator where

19 ShowRelation :: RelationalExpr -> RODatabaseContextOperator

20 ShowRelation :: RelationalExpr -> RODatabaseContextOperator

21+ PlotRelation :: RelationalExpr -> RODatabaseContextOperator

20 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

22 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

21 ShowConstraint :: StringType -> RODatabaseContextOperator

23 ShowConstraint :: StringType -> RODatabaseContextOperator

22 ShowPlan :: DatabaseExpr -> RODatabaseContextOperator

24 ShowPlan :: DatabaseExpr -> RODatabaseContextOperator

@@ -51,10 +53,17 @@ showConstraintsP = do

51 reservedOp ":constraints"

53 reservedOp ":constraints"

52 constraintName <- option "" identifier

54 constraintName <- option "" identifier

53 return $ ShowConstraint (T.pack constraintName)

55 return $ ShowConstraint (T.pack constraintName)

56+

57+plotRelExprP :: Parser RODatabaseContextOperator

58+plotRelExprP = do

59+ reserved ":plotexpr"

60+ expr <- relExprP

61+ return $ PlotRelation expr

55roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

63roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

56roDatabaseContextOperatorP = typeP

64roDatabaseContextOperatorP = typeP

57 <|> showRelP

65 <|> showRelP

66+ <|> plotRelExprP

58 <|> showConstraintsP

67 <|> showConstraintsP

59 <|> showPlanP

68 <|> showPlanP

60 <|> quitP

69 <|> quitP

@@ -68,6 +77,10 @@ evalRODatabaseContextOp context (ShowRelation expr) = do

68 case runState (evalRelationalExpr expr) context of

77 case runState (evalRelationalExpr expr) context of

69 (Left err, _) -> DisplayErrorResult $ T.pack (show err)

78 (Left err, _) -> DisplayErrorResult $ T.pack (show err)

70 (Right rel, _) -> DisplayResult $ showRelation rel

79 (Right rel, _) -> DisplayResult $ showRelation rel

80+

81+evalRODatabaseContextOp context (PlotRelation expr) = case runState (evalRelationalExpr expr) context of

82+ (Left err, _) -> DisplayErrorResult $ T.pack (show err)

83+ (Right rel, _) -> DisplayIOResult $ showPlottedRelation rel

72evalRODatabaseContextOp context (ShowConstraint name) =

85evalRODatabaseContextOp context (ShowConstraint name) =

73 case name of

86 case name of

@@ -88,4 +101,6 @@ evalRODatabaseContextOp _ (Quit) = QuitResult

88interpretRODatabaseContextOp :: DatabaseContext -> String -> TutorialDOperatorResult

101interpretRODatabaseContextOp :: DatabaseContext -> String -> TutorialDOperatorResult

89interpretRODatabaseContextOp context tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of

102interpretRODatabaseContextOp context tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of

90 Left err -> DisplayErrorResult (T.pack (show err))

103 Left err -> DisplayErrorResult (T.pack (show err))

91− Right parsed -> evalRODatabaseContextOp context parsed

104+ Right parsed -> evalRODatabaseContextOp context parsed

105+

106+

project-m36.cabal+3−2

@@ -7,7 +7,7 @@ Category: Relational Algebra

7Cabal-Version: >= 1.2

9Library

10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers

10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers,easyplot

11 Exposed-Modules: ProjectM36.Error,

12 ProjectM36.Transaction,

13 ProjectM36.Transaction.Show,

@@ -23,7 +23,8 @@ Library

23 ProjectM36.Relation.Show.HTML,

24 ProjectM36.StaticOptimizer,

25 ProjectM36.Relation.Show.Term,

26− ProjectM36.Relation.Show.CSV

26+ ProjectM36.Relation.Show.CSV,

27+ ProjectM36.Relation.Show.Gnuplot

27 GHC-Options: -Wall -rtsopts

28 GHC-Options: -Wall -rtsopts

29Executable tutd

30Executable tutd