{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : OAlg.Entity.Sequence.Graph
-- Description : graphs of entities
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- graphs of entities in @__x__@.
module OAlg.Entity.Sequence.Graph
  ( -- * Graph
    Graph(..), gphLength, gphxs, gphSqc, gphLookup
  ) where

import Control.Monad hiding (sequence)

import Data.List (map,filter)

import OAlg.Prelude

import OAlg.Entity.Sequence.Set

--------------------------------------------------------------------------------
-- Graph -

-- | mapping from an ordered /index/ type @__i__@ to a 'Entity' type @__x__@.
--
--  __Property__ Let @g = 'Graph' ixs@ be in @'Graph' __i__ __x__@ for a ordered 'Entity'
-- type @__i__@ and 'Entity' type @__x__@, then holds:
--
-- (1) For all @..(i,_)':'(j,_)..@ in @ixs@ holds: @i '<' j@.
--
-- (2) @'lengthN' g '==' 'lengthN' ixs@.
newtype Graph i x = Graph [(i,x)] deriving (Int -> Graph i x -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i x. (Show i, Show x) => Int -> Graph i x -> ShowS
forall i x. (Show i, Show x) => [Graph i x] -> ShowS
forall i x. (Show i, Show x) => Graph i x -> String
showList :: [Graph i x] -> ShowS
$cshowList :: forall i x. (Show i, Show x) => [Graph i x] -> ShowS
show :: Graph i x -> String
$cshow :: forall i x. (Show i, Show x) => Graph i x -> String
showsPrec :: Int -> Graph i x -> ShowS
$cshowsPrec :: forall i x. (Show i, Show x) => Int -> Graph i x -> ShowS
Show,Graph i x -> Graph i x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i x. (Eq i, Eq x) => Graph i x -> Graph i x -> Bool
/= :: Graph i x -> Graph i x -> Bool
$c/= :: forall i x. (Eq i, Eq x) => Graph i x -> Graph i x -> Bool
== :: Graph i x -> Graph i x -> Bool
$c== :: forall i x. (Eq i, Eq x) => Graph i x -> Graph i x -> Bool
Eq,Graph i x -> N
forall x. (x -> N) -> LengthN x
forall i x. Graph i x -> N
lengthN :: Graph i x -> N
$clengthN :: forall i x. Graph i x -> N
LengthN)

relGraph :: (Entity x, Entity i, Ord i) => Graph i x -> Statement
relGraph :: forall x i. (Entity x, Entity i, Ord i) => Graph i x -> Statement
relGraph (Graph [])       = Statement
SValid
relGraph (Graph ((i, x)
ix:[(i, x)]
ixs)) = forall a. Validable a => a -> Statement
valid (i, x)
ix forall b. Boolean b => b -> b -> b
&& forall {b} {b} {t}.
(Validable b, Validable b, Ord b, Show t, Show b, Enum t) =>
t -> (b, b) -> [(b, b)] -> Statement
vld (N
0::N) (i, x)
ix [(i, x)]
ixs where
  vld :: t -> (b, b) -> [(b, b)] -> Statement
vld t
_ (b, b)
_ []                 = Statement
SValid
  vld t
k (b
i,b
_) (jx :: (b, b)
jx@(b
j,b
_):[(b, b)]
ixs) = [Statement] -> Statement
And [ forall a. Validable a => a -> Statement
valid (b, b)
jx
                                   , (b
iforall a. Ord a => a -> a -> Bool
<b
j) Bool -> Message -> Statement
:?> [Parameter] -> Message
Params [String
"k"String -> String -> Parameter
:=forall a. Show a => a -> String
show t
k,String
"(i,j)"String -> String -> Parameter
:=forall a. Show a => a -> String
show (b
i,b
j)]
                                   , t -> (b, b) -> [(b, b)] -> Statement
vld (forall a. Enum a => a -> a
succ t
k) (b, b)
jx [(b, b)]
ixs
                                   ]

instance (Entity x, Entity i, Ord i) => Validable (Graph i x) where
  valid :: Graph i x -> Statement
valid Graph i x
g = String -> Label
Label String
"Graph" Label -> Statement -> Statement
:<=>: forall x i. (Entity x, Entity i, Ord i) => Graph i x -> Statement
relGraph Graph i x
g

instance (Entity x, Entity i, Ord i) => Entity (Graph i x)

instance Functor (Graph i) where
  fmap :: forall a b. (a -> b) -> Graph i a -> Graph i b
fmap a -> b
f (Graph [(i, a)]
ixs) = forall i x. [(i, x)] -> Graph i x
Graph forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(i
i,a
x) -> (i
i, a -> b
f a
x)) [(i, a)]
ixs
  
--------------------------------------------------------------------------------
-- gphLookup -

-- | looks up the mapping of an index.
gphLookup :: Ord i => Graph i x -> i -> Maybe x
gphLookup :: forall i x. Ord i => Graph i x -> i -> Maybe x
gphLookup (Graph [(i, x)]
ixs) = forall {t} {a}. Ord t => [(t, a)] -> t -> Maybe a
lookup [(i, x)]
ixs where
  lookup :: [(t, a)] -> t -> Maybe a
lookup [] t
_           = forall a. Maybe a
Nothing
  lookup ((t
i',a
x):[(t, a)]
ixs) t
i = case t
i forall a. Ord a => a -> a -> Ordering
`compare` t
i' of
    Ordering
LT -> forall a. Maybe a
Nothing
    Ordering
EQ -> forall a. a -> Maybe a
Just a
x
    Ordering
GT -> [(t, a)] -> t -> Maybe a
lookup [(t, a)]
ixs t
i

--------------------------------------------------------------------------------
-- gphLength -

-- | the length of a graph.
gphLength :: Graph i x -> N
gphLength :: forall i x. Graph i x -> N
gphLength (Graph [(i, x)]
ixs) = forall x. LengthN x => x -> N
lengthN [(i, x)]
ixs

--------------------------------------------------------------------------------
-- gphxs -

-- | the underlying associations.
gphxs :: Graph i x -> [(i,x)]
gphxs :: forall i x. Graph i x -> [(i, x)]
gphxs (Graph [(i, x)]
ixs) = [(i, x)]
ixs

--------------------------------------------------------------------------------
-- gphSqc -

-- | the induced graph given by a set of indices and a mapping.
gphSqc :: (i -> Maybe x) -> Set i -> Graph i x
gphSqc :: forall i x. (i -> Maybe x) -> Set i -> Graph i x
gphSqc i -> Maybe x
mx (Set [i]
is)
  = forall i x. [(i, x)] -> Graph i x
Graph
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(i
i,Maybe x
jx) -> (i
i,forall a. HasCallStack => Maybe a -> a
fromJust Maybe x
jx))
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall a b. (a, b) -> b
snd)
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\i
i -> (i
i,i -> Maybe x
mx i
i)) [i]
is