Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 4 hours ago

total matches: more than 1000

algebraic-graphs-0.4
30 matches
src/Algebra/Graph/HigherKinded/Class.hs
-- stars [(x, [])]               == 'vertex' x
-- stars [(x, [y])]              == 'edge' x y
-- stars [(x, ys)]               == 'star' x ys
-- stars                         == 'overlays' . 'map' ('uncurry' 'star')
-- stars . 'adjacencyList'         == id
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: Graph g => [(a, [a])] -> g a
stars = overlays . map (uncurry star)

            
src/Algebra/Graph/HigherKinded/Class.hs
-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)
-- @
stars :: Graph g => [(a, [a])] -> g a
stars = overlays . map (uncurry star)

-- | The /tree graph/ constructed from a given 'Tree' data structure.
-- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the
-- given tree (i.e. the number of vertices in the tree).
--

            
src/Algebra/Graph/HigherKinded/Class.hs
-- @
tree :: Graph g => Tree a -> g a
tree (Node x []) = vertex x
tree (Node x f ) = star x (map rootLabel f)
         `overlay` forest (filter (not . null . subForest) f)

-- | The /forest graph/ constructed from a given 'Forest' data structure.
-- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the
-- given forest (i.e. the number of vertices in the forest).

            
src/Algebra/Graph/HigherKinded/Class.hs
-- forest []                                                  == 'empty'
-- forest [x]                                                 == 'tree' x
-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]
-- forest                                                     == 'overlays' . 'map' 'tree'
-- @
forest :: Graph g => Forest a -> g a
forest = overlays . map tree

-- | Construct a /mesh graph/ from two lists of vertices.
-- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the
-- lengths of the given lists.
--

            
src/Algebra/Graph/HigherKinded/Class.hs
--           deBruijn 2 "0"              == 'edge' "00" "00"
--           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")
--                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]
--           transpose   (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs
--           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n
-- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1)
-- @
deBruijn :: Graph g => Int -> [a] -> g [a]
deBruijn 0   _        = edge [] []

            
src/Algebra/Graph/HigherKinded/Class.hs
deBruijn 0   _        = edge [] []
deBruijn len alphabet = skeleton >>= expand
  where
    overlaps = mapM (const alphabet) [2..len]
    skeleton = edges    [        (Left s, Right s)   | s <- overlaps ]
    expand v = vertices [ either ([a] ++) (++ [a]) v | a <- alphabet ]

-- | Construct the /induced subgraph/ of a given graph by removing the
-- vertices that do not satisfy a given predicate.

            
src/Algebra/Graph/HigherKinded/Class.hs
-- replaceVertex x y            == 'mergeVertices' (== x) y
-- @
replaceVertex :: (Eq a, Graph g) => a -> a -> g a -> g a
replaceVertex u v = fmap $ \w -> if w == u then v else w

-- | Merge vertices satisfying a given predicate into a given vertex.
-- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes
-- /O(1)/ to be evaluated.
--

            
src/Algebra/Graph/HigherKinded/Class.hs
-- mergeVertices 'odd'  1 (3 + 4 * 5) == 4 * 1
-- @
mergeVertices :: Graph g => (a -> Bool) -> a -> g a -> g a
mergeVertices p v = fmap $ \w -> if p w then v else w

-- | Split a vertex into a list of vertices with the same connectivity.
-- Complexity: /O(s + k * L)/ time, memory and size, where /k/ is the number of
-- occurrences of the vertex in the expression and /L/ is the length of the
-- given list.

            
src/Algebra/Graph/Internal.hs
-- | An abstract list data type with /O(1)/ time concatenation (the current
-- implementation uses difference lists). Here @a@ is the type of list elements.
-- 'List' @a@ is a 'Monoid': 'mempty' corresponds to the empty list and two lists
-- can be concatenated with 'mappend' (or operator 'Data.Monoid.<>'). Singleton
-- lists can be constructed using the function 'pure' from the 'Applicative'
-- instance. 'List' @a@ is also an instance of 'IsList', therefore you can use
-- list literals, e.g. @[1,4]@ @::@ 'List' @Int@ is the same as 'pure' @1@
-- 'Data.Monoid.<>' 'pure' @4@; note that this requires the @OverloadedLists@
-- GHC extension. To extract plain Haskell lists you can use the 'toList'

            
src/Algebra/Graph/Internal.hs
#endif

instance Functor List where
    fmap f = Exts.fromList . map f . toList

instance Applicative List where
    pure    = List . Endo . (:)
    f <*> x = Exts.fromList (toList f <*> toList x)


            
src/Algebra/Graph/Internal.hs
foldr1Safe f = foldr (maybeF f) Nothing
{-# INLINE [0] foldr1Safe #-}

-- | Tragetting 'map' directly
{-# RULES
"foldr1Safe/build"
  forall k f lst.
  foldr1Safe k (map f lst) = foldr (maybeF k . f) Nothing lst
 #-}

-- | Auxiliary function that try to apply a function to a base case and a 'Maybe'
-- value and return 'Just' the result or 'Just' the base case.
maybeF :: (a -> b -> a) -> a -> Maybe b -> Maybe a

            
src/Algebra/Graph/Label.hs
    (+) = liftA2 (+)
    (*) = liftA2 (*)

    negate = fmap negate
    signum = fmap signum
    abs    = fmap abs

-- | If @a@ is a monoid, 'Minimum' @a@ forms the following 'Dioid':
--
-- @
-- 'zero'  = 'pure' 'mempty'

            
src/Algebra/Graph/Label.hs
-- 'zero'  = 'pure' 'mempty'
-- 'one'   = 'noMinimum'
-- ('<+>') = 'liftA2' 'min'
-- ('<.>') = 'liftA2' 'mappend'
-- @
--
-- To create a singleton value of type 'Minimum' @a@ use the 'pure' function.
-- For example:
--

            
src/Algebra/Graph/Label.hs

instance (Monoid a, Ord a) => Semiring (Minimum a) where
    one = noMinimum
    (<.>) = liftA2 mappend

instance (Monoid a, Ord a) => Dioid (Minimum a)

instance (Num a, Show a) => Show (Minimum a) where
    show (Minimum Infinite  ) = "one"

            
src/Algebra/Graph/Label.hs
-- 'zero'    = PowerSet Set.'Set.empty'
-- 'one'     = PowerSet $ Set.'Set.singleton' 'mempty'
-- x '<+>' y = PowerSet $ Set.'Set.union' (getPowerSet x) (getPowerSet y)
-- x '<.>' y = PowerSet $ 'setProductWith' 'mappend' (getPowerSet x) (getPowerSet y)
-- @
newtype PowerSet a = PowerSet { getPowerSet :: Set a }
    deriving (Eq, Monoid, Ord, Semigroup, Show)

instance (Monoid a, Ord a) => Semiring (PowerSet a) where

            
src/Algebra/Graph/Label.hs

instance (Monoid a, Ord a) => Semiring (PowerSet a) where
    one                       = PowerSet (Set.singleton mempty)
    PowerSet x <.> PowerSet y = PowerSet (setProductWith mappend x y)

instance (Monoid a, Ord a) => StarSemiring (PowerSet a) where
    star _ = one

instance (Monoid a, Ord a) => Dioid (PowerSet a) where

            
src/Algebra/Graph/Label.hs

instance Monoid (Label a) where
    mempty  = Zero
    mappend = (<>)

instance Semiring (Label a) where
    one = One

    One  <.> x    = x

            
src/Algebra/Graph/Label.hs
-- See http://vlado.fmf.uni-lj.si/vlado/papers/SemiRingSNA.pdf
instance (Eq o, Monoid a, Monoid o) => Semigroup (Optimum o a) where
    Optimum o1 a1 <> Optimum o2 a2
        | o1 == o2  = Optimum o1 (mappend a1 a2)
        | otherwise = Optimum o a
            where
              o = mappend o1 o2
              a = if o == o1 then a1 else a2

instance (Eq o, Monoid a, Monoid o) => Monoid (Optimum o a) where
    mempty  = Optimum mempty mempty
    mappend = (<>)

            
src/Algebra/Graph/Label.hs

instance (Eq o, Monoid a, Monoid o) => Monoid (Optimum o a) where
    mempty  = Optimum mempty mempty
    mappend = (<>)

instance (Eq o, Semiring a, Semiring o) => Semiring (Optimum o a) where
    one = Optimum one one
    Optimum o1 a1 <.> Optimum o2 a2 = Optimum (o1 <.> o2) (a1 <.> a2)


            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : unstable
--
-- This module exposes the implementation of edge-labelled adjacency maps. The
-- API is unstable and unsafe, and is exposed only for documentation. You should
-- use the non-internal module "Algebra.Graph.Labelled.AdjdacencyMap" instead.
-----------------------------------------------------------------------------
module Algebra.Graph.Labelled.AdjacencyMap.Internal (
    -- * Labelled adjacency map implementation

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
-- use the non-internal module "Algebra.Graph.Labelled.AdjdacencyMap" instead.
-----------------------------------------------------------------------------
module Algebra.Graph.Labelled.AdjacencyMap.Internal (
    -- * Labelled adjacency map implementation
    AdjacencyMap (..), consistent
    ) where

import Prelude ()
import Prelude.Compat

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
-- and @True@ denote the lack of and the existence of an unlabelled edge,
-- respectively.
newtype AdjacencyMap e a = AM {
    -- | The /adjacency map/ of an edge-labelled graph: each vertex is
    -- associated with a map from its direct successors to the corresponding
    -- edge labels.
    adjacencyMap :: Map a (Map a e) } deriving (Eq, Generic, NFData)

instance (Ord a, Show a, Ord e, Show e) => Show (AdjacencyMap e a) where
    showsPrec p (AM m)

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
            | overlays [x, y] == y = LT
            | otherwise            = compare x y

-- Overlay a list of adjacency maps.
overlays :: (Eq e, Monoid e, Ord a) => [Map a (Map a e)] -> Map a (Map a e)
overlays = Map.unionsWith (\x -> Map.filter (/= zero) . Map.unionWith mappend x)

-- | __Note:__ this does not satisfy the usual ring laws; see 'AdjacencyMap'
-- for more details.
instance (Eq e, Dioid e, Num a, Ord a) => Num (AdjacencyMap e a) where
    fromInteger x = AM $ Map.singleton (fromInteger x) Map.empty

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs

-- | Check if the internal graph representation is consistent, i.e. that all
-- edges refer to existing vertices, and there are no 'zero'-labelled edges. It
-- should be impossible to create an inconsistent adjacency map, and we use this
-- function in testing.
-- /Note: this function is for internal use only/.
consistent :: (Ord a, Eq e, Monoid e) => AdjacencyMap e a -> Bool
consistent (AM m) = referredToVertexSet m `Set.isSubsetOf` Map.keysSet m
    && and [ e /= zero | (_, es) <- Map.toAscList m, (_, e) <- Map.toAscList es ]

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
consistent (AM m) = referredToVertexSet m `Set.isSubsetOf` Map.keysSet m
    && and [ e /= zero | (_, es) <- Map.toAscList m, (_, e) <- Map.toAscList es ]

-- The set of vertices that are referred to by the edges in an adjacency map
referredToVertexSet :: Ord a => Map a (Map a e) -> Set a
referredToVertexSet m = Set.fromList $ concat
    [ [x, y] | (x, ys) <- Map.toAscList m, (y, _) <- Map.toAscList ys ]

-- The list of edges in an adjacency map

            
src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs
referredToVertexSet m = Set.fromList $ concat
    [ [x, y] | (x, ys) <- Map.toAscList m, (y, _) <- Map.toAscList ys ]

-- The list of edges in an adjacency map
internalEdgeList :: Map a (Map a e) -> [(e, a, a)]
internalEdgeList m =
    [ (e, x, y) | (x, ys) <- Map.toAscList m, (y, e) <- Map.toAscList ys ]

            
src/Algebra/Graph/Labelled/AdjacencyMap.hs
    edgeList, vertexSet, edgeSet, preSet, postSet, skeleton,

    -- * Graph transformation
    removeVertex, removeEdge, replaceVertex, replaceEdge, transpose, gmap,
    emap, induce,

    -- * Relational operations
    closure, reflexiveClosure, symmetricClosure, transitiveClosure
  ) where


            
src/Algebra/Graph/Labelled/AdjacencyMap.hs
overlay :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
overlay (AM x) (AM y) = AM $ Map.unionWith nonZeroUnion x y

-- Union maps, removing zero elements from the result.
nonZeroUnion :: (Eq e, Monoid e, Ord a) => Map a e -> Map a e -> Map a e
nonZeroUnion x y = Map.filter (/= zero) $ Map.unionWith mappend x y

-- Drop all edges with zero labels.
trimZeroes :: (Eq e, Monoid e) => Map a (Map a e) -> Map a (Map a e)
trimZeroes = Map.map (Map.filter (/= zero))

-- | /Connect/ two graphs with edges labelled by a given label. When applied to
-- the same labels, this is an associative operation with the identity 'empty',
-- which distributes over 'overlay' and obeys the decomposition axiom.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the

            
src/Algebra/Graph/Labelled/AdjacencyMap.hs
-- 'vertexSet'   . vertices == Set.'Set.fromList'
-- @
vertices :: Ord a => [a] -> AdjacencyMap e a
vertices = AM . Map.fromList . map (, Map.empty)

-- | Construct the graph from a list of edges.
-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.
--
-- @

            
src/Algebra/Graph/Labelled/AdjacencyMap.hs
-- @
-- edges []        == 'empty'
-- edges [(e,x,y)] == 'edge' e x y
-- edges           == 'overlays' . 'map' (\\(e, x, y) -> 'edge' e x y)
-- @
edges :: (Eq e, Monoid e, Ord a) => [(e, a, a)] -> AdjacencyMap e a
edges es = fromAdjacencyMaps [ (x, Map.singleton y e) | (e, x, y) <- es ]

-- | Overlay a given list of graphs.