{-# LANGUAGE DeriveTraversable #-}
{-|
== Edge-labeled/weighted graphs

There are useful definitions and algorithms in Data.Tree and Data.Graph but sadly these only deal
with unlabeled graphs.
Most definitions here mirror those in Data.Graph.

-}

module LabelledGraph
    ( LEdge
    , LGraph
    , LTree(..)
    , buildLG
    , dfsLTree
    , lTreeToTree
    ) where

import Data.Array
import Data.Graph
import Control.DeepSeq

type LEdge b = (Vertex, (b, Vertex))

type LGraph b = Array Vertex [(b, Vertex)]

data LTree b a = LNode
    { LTree b a -> a
rootLabelL :: a
    , LTree b a -> [(b, LTree b a)]
subForestL :: [(b, LTree b a)]
    } deriving (LTree b a -> LTree b a -> Bool
(LTree b a -> LTree b a -> Bool)
-> (LTree b a -> LTree b a -> Bool) -> Eq (LTree b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a. (Eq a, Eq b) => LTree b a -> LTree b a -> Bool
/= :: LTree b a -> LTree b a -> Bool
$c/= :: forall b a. (Eq a, Eq b) => LTree b a -> LTree b a -> Bool
== :: LTree b a -> LTree b a -> Bool
$c== :: forall b a. (Eq a, Eq b) => LTree b a -> LTree b a -> Bool
Eq, Int -> LTree b a -> ShowS
[LTree b a] -> ShowS
LTree b a -> String
(Int -> LTree b a -> ShowS)
-> (LTree b a -> String)
-> ([LTree b a] -> ShowS)
-> Show (LTree b a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. (Show a, Show b) => Int -> LTree b a -> ShowS
forall b a. (Show a, Show b) => [LTree b a] -> ShowS
forall b a. (Show a, Show b) => LTree b a -> String
showList :: [LTree b a] -> ShowS
$cshowList :: forall b a. (Show a, Show b) => [LTree b a] -> ShowS
show :: LTree b a -> String
$cshow :: forall b a. (Show a, Show b) => LTree b a -> String
showsPrec :: Int -> LTree b a -> ShowS
$cshowsPrec :: forall b a. (Show a, Show b) => Int -> LTree b a -> ShowS
Show, a -> LTree b b -> LTree b a
(a -> b) -> LTree b a -> LTree b b
(forall a b. (a -> b) -> LTree b a -> LTree b b)
-> (forall a b. a -> LTree b b -> LTree b a) -> Functor (LTree b)
forall a b. a -> LTree b b -> LTree b a
forall a b. (a -> b) -> LTree b a -> LTree b b
forall b a b. a -> LTree b b -> LTree b a
forall b a b. (a -> b) -> LTree b a -> LTree b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LTree b b -> LTree b a
$c<$ :: forall b a b. a -> LTree b b -> LTree b a
fmap :: (a -> b) -> LTree b a -> LTree b b
$cfmap :: forall b a b. (a -> b) -> LTree b a -> LTree b b
Functor, LTree b a -> Bool
(a -> m) -> LTree b a -> m
(a -> b -> b) -> b -> LTree b a -> b
(forall m. Monoid m => LTree b m -> m)
-> (forall m a. Monoid m => (a -> m) -> LTree b a -> m)
-> (forall m a. Monoid m => (a -> m) -> LTree b a -> m)
-> (forall a b. (a -> b -> b) -> b -> LTree b a -> b)
-> (forall a b. (a -> b -> b) -> b -> LTree b a -> b)
-> (forall b a. (b -> a -> b) -> b -> LTree b a -> b)
-> (forall b a. (b -> a -> b) -> b -> LTree b a -> b)
-> (forall a. (a -> a -> a) -> LTree b a -> a)
-> (forall a. (a -> a -> a) -> LTree b a -> a)
-> (forall a. LTree b a -> [a])
-> (forall a. LTree b a -> Bool)
-> (forall a. LTree b a -> Int)
-> (forall a. Eq a => a -> LTree b a -> Bool)
-> (forall a. Ord a => LTree b a -> a)
-> (forall a. Ord a => LTree b a -> a)
-> (forall a. Num a => LTree b a -> a)
-> (forall a. Num a => LTree b a -> a)
-> Foldable (LTree b)
forall a. Eq a => a -> LTree b a -> Bool
forall a. Num a => LTree b a -> a
forall a. Ord a => LTree b a -> a
forall m. Monoid m => LTree b m -> m
forall a. LTree b a -> Bool
forall a. LTree b a -> Int
forall a. LTree b a -> [a]
forall a. (a -> a -> a) -> LTree b a -> a
forall b a. Eq a => a -> LTree b a -> Bool
forall b a. Num a => LTree b a -> a
forall b a. Ord a => LTree b a -> a
forall m a. Monoid m => (a -> m) -> LTree b a -> m
forall b m. Monoid m => LTree b m -> m
forall b a. LTree b a -> Bool
forall b a. LTree b a -> Int
forall b a. LTree b a -> [a]
forall b a. (b -> a -> b) -> b -> LTree b a -> b
forall a b. (a -> b -> b) -> b -> LTree b a -> b
forall b a. (a -> a -> a) -> LTree b a -> a
forall b m a. Monoid m => (a -> m) -> LTree b a -> m
forall b b a. (b -> a -> b) -> b -> LTree b a -> b
forall b a b. (a -> b -> b) -> b -> LTree b a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LTree b a -> a
$cproduct :: forall b a. Num a => LTree b a -> a
sum :: LTree b a -> a
$csum :: forall b a. Num a => LTree b a -> a
minimum :: LTree b a -> a
$cminimum :: forall b a. Ord a => LTree b a -> a
maximum :: LTree b a -> a
$cmaximum :: forall b a. Ord a => LTree b a -> a
elem :: a -> LTree b a -> Bool
$celem :: forall b a. Eq a => a -> LTree b a -> Bool
length :: LTree b a -> Int
$clength :: forall b a. LTree b a -> Int
null :: LTree b a -> Bool
$cnull :: forall b a. LTree b a -> Bool
toList :: LTree b a -> [a]
$ctoList :: forall b a. LTree b a -> [a]
foldl1 :: (a -> a -> a) -> LTree b a -> a
$cfoldl1 :: forall b a. (a -> a -> a) -> LTree b a -> a
foldr1 :: (a -> a -> a) -> LTree b a -> a
$cfoldr1 :: forall b a. (a -> a -> a) -> LTree b a -> a
foldl' :: (b -> a -> b) -> b -> LTree b a -> b
$cfoldl' :: forall b b a. (b -> a -> b) -> b -> LTree b a -> b
foldl :: (b -> a -> b) -> b -> LTree b a -> b
$cfoldl :: forall b b a. (b -> a -> b) -> b -> LTree b a -> b
foldr' :: (a -> b -> b) -> b -> LTree b a -> b
$cfoldr' :: forall b a b. (a -> b -> b) -> b -> LTree b a -> b
foldr :: (a -> b -> b) -> b -> LTree b a -> b
$cfoldr :: forall b a b. (a -> b -> b) -> b -> LTree b a -> b
foldMap' :: (a -> m) -> LTree b a -> m
$cfoldMap' :: forall b m a. Monoid m => (a -> m) -> LTree b a -> m
foldMap :: (a -> m) -> LTree b a -> m
$cfoldMap :: forall b m a. Monoid m => (a -> m) -> LTree b a -> m
fold :: LTree b m -> m
$cfold :: forall b m. Monoid m => LTree b m -> m
Foldable, Functor (LTree b)
Foldable (LTree b)
Functor (LTree b)
-> Foldable (LTree b)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LTree b a -> f (LTree b b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LTree b (f a) -> f (LTree b a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LTree b a -> m (LTree b b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LTree b (m a) -> m (LTree b a))
-> Traversable (LTree b)
(a -> f b) -> LTree b a -> f (LTree b b)
forall b. Functor (LTree b)
forall b. Foldable (LTree b)
forall b (m :: * -> *) a. Monad m => LTree b (m a) -> m (LTree b a)
forall b (f :: * -> *) a.
Applicative f =>
LTree b (f a) -> f (LTree b a)
forall b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree b a -> m (LTree b b)
forall b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree b a -> f (LTree b b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => LTree b (m a) -> m (LTree b a)
forall (f :: * -> *) a.
Applicative f =>
LTree b (f a) -> f (LTree b a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree b a -> m (LTree b b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree b a -> f (LTree b b)
sequence :: LTree b (m a) -> m (LTree b a)
$csequence :: forall b (m :: * -> *) a. Monad m => LTree b (m a) -> m (LTree b a)
mapM :: (a -> m b) -> LTree b a -> m (LTree b b)
$cmapM :: forall b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree b a -> m (LTree b b)
sequenceA :: LTree b (f a) -> f (LTree b a)
$csequenceA :: forall b (f :: * -> *) a.
Applicative f =>
LTree b (f a) -> f (LTree b a)
traverse :: (a -> f b) -> LTree b a -> f (LTree b b)
$ctraverse :: forall b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree b a -> f (LTree b b)
$cp2Traversable :: forall b. Foldable (LTree b)
$cp1Traversable :: forall b. Functor (LTree b)
Traversable)

-- | Builds a LGraph from a list of LEdges. O(n + m) for bounds size n and m edges.
buildLG :: Bounds -> [LEdge b] -> LGraph b
buildLG :: Bounds -> [LEdge b] -> LGraph b
buildLG = ([(b, Int)] -> (b, Int) -> [(b, Int)])
-> [(b, Int)] -> Bounds -> [LEdge b] -> LGraph b
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (((b, Int) -> [(b, Int)] -> [(b, Int)])
-> [(b, Int)] -> (b, Int) -> [(b, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- | For a LGraph that is known to be a tree, returns its LTree representation. O(n).
dfsLTree :: LGraph b -> Vertex -> LTree b Vertex
dfsLTree :: LGraph b -> Int -> LTree b Int
dfsLTree LGraph b
g Int
u = Int -> Int -> LTree b Int
go Int
u Int
u where
    go :: Int -> Int -> LTree b Int
go Int
p Int
u = Int -> [(b, LTree b Int)] -> LTree b Int
forall b a. a -> [(b, LTree b a)] -> LTree b a
LNode Int
u [(b
l, Int -> Int -> LTree b Int
go Int
u Int
v) | (b
l, Int
v) <- LGraph b
gLGraph b -> Int -> [(b, Int)]
forall i e. Ix i => Array i e -> i -> e
!Int
u, Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
p]

-- | Drops labels from an LTree. O(n).
lTreeToTree :: LTree b a -> Tree a
lTreeToTree :: LTree b a -> Tree a
lTreeToTree (LNode a
a [(b, LTree b a)]
ts) = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Node a
a (Forest a -> Tree a) -> Forest a -> Tree a
forall a b. (a -> b) -> a -> b
$ ((b, LTree b a) -> Tree a) -> [(b, LTree b a)] -> Forest a
forall a b. (a -> b) -> [a] -> [b]
map (LTree b a -> Tree a
forall b a. LTree b a -> Tree a
lTreeToTree (LTree b a -> Tree a)
-> ((b, LTree b a) -> LTree b a) -> (b, LTree b a) -> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, LTree b a) -> LTree b a
forall a b. (a, b) -> b
snd) [(b, LTree b a)]
ts

--------------------------------------------------------------------------------
-- For tests

instance (NFData a, NFData b) => NFData (LTree b a) where
    rnf :: LTree b a -> ()
rnf (LNode a
u [(b, LTree b a)]
ts) = a -> ()
forall a. NFData a => a -> ()
rnf a
u () -> () -> ()
`seq` [(b, LTree b a)] -> ()
forall a. NFData a => a -> ()
rnf [(b, LTree b a)]
ts