{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
module Data.Graph.AdjacencyMatrix
( AdjacencyMatrix(..)
, AdjacencyMatrixGraph
, ask
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Data.Ix
import Data.Array.IArray
import Data.Graph.PropertyMap
import Data.Graph.Class
import Data.Graph.Class.AdjacencyMatrix
newtype AdjacencyMatrix arr i a = AdjacencyMatrix { AdjacencyMatrix arr i a -> arr (i, i) Bool -> a
runAdjacencyMatrix :: arr (i,i) Bool -> a }
ask :: AdjacencyMatrix arr i (arr (i, i) Bool)
ask :: AdjacencyMatrix arr i (arr (i, i) Bool)
ask = (arr (i, i) Bool -> arr (i, i) Bool)
-> AdjacencyMatrix arr i (arr (i, i) Bool)
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix arr (i, i) Bool -> arr (i, i) Bool
forall a. a -> a
id
instance Functor (AdjacencyMatrix arr i) where
fmap :: (a -> b) -> AdjacencyMatrix arr i a -> AdjacencyMatrix arr i b
fmap a -> b
f (AdjacencyMatrix arr (i, i) Bool -> a
g) = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix (a -> b
f (a -> b) -> (arr (i, i) Bool -> a) -> arr (i, i) Bool -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. arr (i, i) Bool -> a
g)
a
b <$ :: a -> AdjacencyMatrix arr i b -> AdjacencyMatrix arr i a
<$ AdjacencyMatrix arr i b
_ = a -> AdjacencyMatrix arr i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
instance Applicative (AdjacencyMatrix arr i) where
pure :: a -> AdjacencyMatrix arr i a
pure = (arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a)
-> (a -> arr (i, i) Bool -> a) -> a -> AdjacencyMatrix arr i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> arr (i, i) Bool -> a
forall a b. a -> b -> a
const
AdjacencyMatrix arr (i, i) Bool -> a -> b
f <*> :: AdjacencyMatrix arr i (a -> b)
-> AdjacencyMatrix arr i a -> AdjacencyMatrix arr i b
<*> AdjacencyMatrix arr (i, i) Bool -> a
a = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b)
-> (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
t -> arr (i, i) Bool -> a -> b
f arr (i, i) Bool
t (arr (i, i) Bool -> a
a arr (i, i) Bool
t)
instance Monad (AdjacencyMatrix arr i) where
#if !(MIN_VERSION_base(4,11,0))
return = AdjacencyMatrix . const
#endif
AdjacencyMatrix arr (i, i) Bool -> a
f >>= :: AdjacencyMatrix arr i a
-> (a -> AdjacencyMatrix arr i b) -> AdjacencyMatrix arr i b
>>= a -> AdjacencyMatrix arr i b
k = (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b)
-> (arr (i, i) Bool -> b) -> AdjacencyMatrix arr i b
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
t -> AdjacencyMatrix arr i b -> arr (i, i) Bool -> b
forall (arr :: * -> * -> *) i a.
AdjacencyMatrix arr i a -> arr (i, i) Bool -> a
runAdjacencyMatrix (a -> AdjacencyMatrix arr i b
k (arr (i, i) Bool -> a
f arr (i, i) Bool
t)) arr (i, i) Bool
t
instance Ord i => Graph (AdjacencyMatrix arr i) where
type Vertex (AdjacencyMatrix arr i) = i
type Edge (AdjacencyMatrix arr i) = (i, i)
vertexMap :: a -> AdjacencyMatrix arr i (VertexMap (AdjacencyMatrix arr i) a)
vertexMap = PropertyMap (AdjacencyMatrix arr i) i a
-> AdjacencyMatrix arr i (PropertyMap (AdjacencyMatrix arr i) i a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyMap (AdjacencyMatrix arr i) i a
-> AdjacencyMatrix arr i (PropertyMap (AdjacencyMatrix arr i) i a))
-> (a -> PropertyMap (AdjacencyMatrix arr i) i a)
-> a
-> AdjacencyMatrix arr i (PropertyMap (AdjacencyMatrix arr i) i a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PropertyMap (AdjacencyMatrix arr i) i a
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
v -> PropertyMap m k v
propertyMap
edgeMap :: a -> AdjacencyMatrix arr i (EdgeMap (AdjacencyMatrix arr i) a)
edgeMap = PropertyMap (AdjacencyMatrix arr i) (i, i) a
-> AdjacencyMatrix
arr i (PropertyMap (AdjacencyMatrix arr i) (i, i) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyMap (AdjacencyMatrix arr i) (i, i) a
-> AdjacencyMatrix
arr i (PropertyMap (AdjacencyMatrix arr i) (i, i) a))
-> (a -> PropertyMap (AdjacencyMatrix arr i) (i, i) a)
-> a
-> AdjacencyMatrix
arr i (PropertyMap (AdjacencyMatrix arr i) (i, i) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PropertyMap (AdjacencyMatrix arr i) (i, i) a
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
v -> PropertyMap m k v
propertyMap
instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where
edge :: Vertex (AdjacencyMatrix arr i)
-> Vertex (AdjacencyMatrix arr i)
-> AdjacencyMatrix arr i (Maybe (Edge (AdjacencyMatrix arr i)))
edge Vertex (AdjacencyMatrix arr i)
i Vertex (AdjacencyMatrix arr i)
j = (arr (i, i) Bool -> Maybe (i, i))
-> AdjacencyMatrix arr i (Maybe (i, i))
forall (arr :: * -> * -> *) i a.
(arr (i, i) Bool -> a) -> AdjacencyMatrix arr i a
AdjacencyMatrix ((arr (i, i) Bool -> Maybe (i, i))
-> AdjacencyMatrix arr i (Maybe (i, i)))
-> (arr (i, i) Bool -> Maybe (i, i))
-> AdjacencyMatrix arr i (Maybe (i, i))
forall a b. (a -> b) -> a -> b
$ \arr (i, i) Bool
a ->
if ((i, i), (i, i)) -> (i, i) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (arr (i, i) Bool -> ((i, i), (i, i))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds arr (i, i) Bool
a) (i, i)
ix Bool -> Bool -> Bool
&& (arr (i, i) Bool
a arr (i, i) Bool -> (i, i) -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (i, i)
ix)
then (i, i) -> Maybe (i, i)
forall a. a -> Maybe a
Just (i, i)
ix
else Maybe (i, i)
forall a. Maybe a
Nothing
where ix :: (i, i)
ix = (i
Vertex (AdjacencyMatrix arr i)
i, i
Vertex (AdjacencyMatrix arr i)
j)