module ProjectM36.Relation.Show.Gnuplot where
import ProjectM36.Base
import ProjectM36.Relation
import ProjectM36.Tuple
import ProjectM36.AtomFunctions.Primitive
import qualified ProjectM36.Attribute as A
import qualified Data.Vector as V

import qualified Graphics.Gnuplot.Plot.ThreeDimensional as Plot3D
import qualified Graphics.Gnuplot.Graph.ThreeDimensional as Graph3D

import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D

import qualified Graphics.Gnuplot.Advanced as GPA

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

data PlotError = InvalidAttributeCountError |
                 InvalidAttributeTypeError
                 deriving (Int -> PlotError -> ShowS
[PlotError] -> ShowS
PlotError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlotError] -> ShowS
$cshowList :: [PlotError] -> ShowS
show :: PlotError -> String
$cshow :: PlotError -> String
showsPrec :: Int -> PlotError -> ShowS
$cshowsPrec :: Int -> PlotError -> ShowS
Show)

--plotRelation :: Relation -> Either PlotError

intFromAtomIndex :: Int -> RelationTuple -> Int --warning- clips or overflows Integer -> Int
intFromAtomIndex :: Int -> RelationTuple -> Int
intFromAtomIndex Int
index RelationTuple
tup = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Atom -> Int
castInt forall a b. (a -> b) -> a -> b
$ RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tup forall a. Vector a -> Int -> a
V.! Int
index

graph1DRelation :: Relation -> Plot2D.T Int Int
graph1DRelation :: Relation -> T Int Int
graph1DRelation Relation
rel = forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
Plot2D.list forall y. C y => T Int y y
Graph2D.listPoints forall a b. (a -> b) -> a -> b
$ Relation -> [Int]
points1DRelation Relation
rel

points1DRelation :: Relation -> [Int]
points1DRelation :: Relation -> [Int]
points1DRelation = forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold RelationTuple -> [Int] -> [Int]
folder []
  where
    folder :: RelationTuple -> [Int] -> [Int]
folder RelationTuple
tup [Int]
acc = Int -> RelationTuple -> Int
intFromAtomIndex Int
0 RelationTuple
tup forall a. a -> [a] -> [a]
: [Int]
acc

graph2DRelation :: Relation -> Plot2D.T Int Int
graph2DRelation :: Relation -> T Int Int
graph2DRelation Relation
rel = forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
Plot2D.list forall x y. (C x, C y) => T x y (x, y)
Graph2D.points (Relation -> [(Int, Int)]
points2DRelation Relation
rel)

points2DRelation :: Relation -> [(Int, Int)]
points2DRelation :: Relation -> [(Int, Int)]
points2DRelation = forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold RelationTuple -> [(Int, Int)] -> [(Int, Int)]
folder []
  where
    folder :: RelationTuple -> [(Int, Int)] -> [(Int, Int)]
folder RelationTuple
tup [(Int, Int)]
acc = (Int -> RelationTuple -> Int
intFromAtomIndex Int
0 RelationTuple
tup, Int -> RelationTuple -> Int
intFromAtomIndex Int
1 RelationTuple
tup) forall a. a -> [a] -> [a]
: [(Int, Int)]
acc

graph3DRelation :: Relation -> Plot3D.T Int Int Int
graph3DRelation :: Relation -> T Int Int Int
graph3DRelation Relation
rel =
  forall x y z a. (C x, C y, C z, C a) => T x y z a -> [a] -> T x y z
Plot3D.cloud forall x y z. (C x, C y, C z) => T x y z (x, y, z)
Graph3D.points forall a b. (a -> b) -> a -> b
$ Relation -> [(Int, Int, Int)]
points3DRelation Relation
rel

points3DRelation :: Relation -> [(Int, Int, Int)]
points3DRelation :: Relation -> [(Int, Int, Int)]
points3DRelation = forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold RelationTuple -> [(Int, Int, Int)] -> [(Int, Int, Int)]
folder []
  where
    folder :: RelationTuple -> [(Int, Int, Int)] -> [(Int, Int, Int)]
folder RelationTuple
tup [(Int, Int, Int)]
acc = (Int -> RelationTuple -> Int
intFromAtomIndex Int
0 RelationTuple
tup, Int -> RelationTuple -> Int
intFromAtomIndex Int
1 RelationTuple
tup, Int -> RelationTuple -> Int
intFromAtomIndex Int
2 RelationTuple
tup) forall a. a -> [a] -> [a]
: [(Int, Int, Int)]
acc

{-
sample1DRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType]) [[IntAtom 2], [IntAtom 3]] of
  Right rel -> rel
  Left _ -> undefined

sample2DRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType, Attribute "y" IntAtomType]) [[IntAtom 2, IntAtom 3],
                                                                                                                          [IntAtom 2, IntAtom 4]] of
                     Right rel -> rel
                     Left _ -> undefined

sample3DRelation = case mkRelationFromList (A.attributesFromList [Attribute "x" IntAtomType, Attribute "y" IntAtomType, Attribute "z" IntAtomType]) [[IntAtom 2, IntAtom 3, IntAtom 3],
                             [IntAtom 2, IntAtom 4, IntAtom 4]] of
                     Right rel -> rel
                     Left _ -> undefined

-}

plotRelation :: Relation -> IO (Maybe PlotError)
plotRelation :: Relation -> IO (Maybe PlotError)
plotRelation Relation
rel = let attrTypes :: Vector AtomType
attrTypes = forall a. Int -> a -> Vector a
V.replicate (Relation -> Int
arity Relation
rel) AtomType
IntAtomType in
  if Vector AtomType
attrTypes forall a. Eq a => a -> a -> Bool
/= Attributes -> Vector AtomType
A.atomTypes (Relation -> Attributes
attributes Relation
rel) then
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just PlotError
InvalidAttributeTypeError
  else
    case Relation -> Int
arity Relation
rel of
      Int
1 -> forall gfx. C gfx => gfx -> IO ExitCode
GPA.plotDefault (Relation -> T Int Int
graph1DRelation Relation
rel) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Int
2 -> forall gfx. C gfx => gfx -> IO ExitCode
GPA.plotDefault (Relation -> T Int Int
graph2DRelation Relation
rel) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Int
3 -> forall gfx. C gfx => gfx -> IO ExitCode
GPA.plotDefault (Relation -> T Int Int Int
graph3DRelation Relation
rel) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just PlotError
InvalidAttributeCountError


{-
--PNG
savePlottedRelation :: String -> Relation -> IO ()
savePlottedRelation path rel = case plotRelation rel of
  Left err -> putStrLn (show err)
  Right (Left g2d) -> plot' [] (PNG path) g2d >> return ()
  Right (Right g3d) -> plot' [] (PNG path) g3d >> return ()
-}