{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

{-|
Module      : Data.Matroid.Graphic.Internal
Description : 
Copyright   : (c) Immanuel Albrecht, 2020-202x
License     : BSD-3
Maintainer  : mail@immanuel-albrecht.de
Stability   : experimental
Portability : POSIX

This module provides internal helpers used by the graphic matroid
module.

Although it is exported, using anything from this module that is 
not re-exported by another module may (and eventually will) break 
client side code. The main reason for exporting this is so anyone
can inspect internals using haddock; it's a little bit like an
open door policy for code.

-}
module Data.Matroid.Graphic.Internal where

import Data.Set (Set)
import qualified Data.Set as S
    

import Data.Map (Map)
import qualified Data.Map as M
            
-- | data type to keep track of forrests in a (multi-)graph
data Forrest v a = F Int {- ^ fresh component id counter -}
                     (Map v Int) {- ^ tracks which vertex belongs to which component -}
                     (Map Int (Set a)) {- ^ tracks which edges belong to which component -}
            deriving (Int -> Forrest v a -> ShowS
[Forrest v a] -> ShowS
Forrest v a -> String
(Int -> Forrest v a -> ShowS)
-> (Forrest v a -> String)
-> ([Forrest v a] -> ShowS)
-> Show (Forrest v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a. (Show v, Show a) => Int -> Forrest v a -> ShowS
forall v a. (Show v, Show a) => [Forrest v a] -> ShowS
forall v a. (Show v, Show a) => Forrest v a -> String
showList :: [Forrest v a] -> ShowS
$cshowList :: forall v a. (Show v, Show a) => [Forrest v a] -> ShowS
show :: Forrest v a -> String
$cshow :: forall v a. (Show v, Show a) => Forrest v a -> String
showsPrec :: Int -> Forrest v a -> ShowS
$cshowsPrec :: forall v a. (Show v, Show a) => Int -> Forrest v a -> ShowS
Show, Forrest v a -> Forrest v a -> Bool
(Forrest v a -> Forrest v a -> Bool)
-> (Forrest v a -> Forrest v a -> Bool) -> Eq (Forrest v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a. (Eq v, Eq a) => Forrest v a -> Forrest v a -> Bool
/= :: Forrest v a -> Forrest v a -> Bool
$c/= :: forall v a. (Eq v, Eq a) => Forrest v a -> Forrest v a -> Bool
== :: Forrest v a -> Forrest v a -> Bool
$c== :: forall v a. (Eq v, Eq a) => Forrest v a -> Forrest v a -> Bool
Eq, Eq (Forrest v a)
Eq (Forrest v a)
-> (Forrest v a -> Forrest v a -> Ordering)
-> (Forrest v a -> Forrest v a -> Bool)
-> (Forrest v a -> Forrest v a -> Bool)
-> (Forrest v a -> Forrest v a -> Bool)
-> (Forrest v a -> Forrest v a -> Bool)
-> (Forrest v a -> Forrest v a -> Forrest v a)
-> (Forrest v a -> Forrest v a -> Forrest v a)
-> Ord (Forrest v a)
Forrest v a -> Forrest v a -> Bool
Forrest v a -> Forrest v a -> Ordering
Forrest v a -> Forrest v a -> Forrest v a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v a. (Ord v, Ord a) => Eq (Forrest v a)
forall v a. (Ord v, Ord a) => Forrest v a -> Forrest v a -> Bool
forall v a.
(Ord v, Ord a) =>
Forrest v a -> Forrest v a -> Ordering
forall v a.
(Ord v, Ord a) =>
Forrest v a -> Forrest v a -> Forrest v a
min :: Forrest v a -> Forrest v a -> Forrest v a
$cmin :: forall v a.
(Ord v, Ord a) =>
Forrest v a -> Forrest v a -> Forrest v a
max :: Forrest v a -> Forrest v a -> Forrest v a
$cmax :: forall v a.
(Ord v, Ord a) =>
Forrest v a -> Forrest v a -> Forrest v a
>= :: Forrest v a -> Forrest v a -> Bool
$c>= :: forall v a. (Ord v, Ord a) => Forrest v a -> Forrest v a -> Bool
> :: Forrest v a -> Forrest v a -> Bool
$c> :: forall v a. (Ord v, Ord a) => Forrest v a -> Forrest v a -> Bool
<= :: Forrest v a -> Forrest v a -> Bool
$c<= :: forall v a. (Ord v, Ord a) => Forrest v a -> Forrest v a -> Bool
< :: Forrest v a -> Forrest v a -> Bool
$c< :: forall v a. (Ord v, Ord a) => Forrest v a -> Forrest v a -> Bool
compare :: Forrest v a -> Forrest v a -> Ordering
$ccompare :: forall v a.
(Ord v, Ord a) =>
Forrest v a -> Forrest v a -> Ordering
$cp1Ord :: forall v a. (Ord v, Ord a) => Eq (Forrest v a)
Ord)

-- | obtain an empty forrest
emptyForrest :: Forrest v a
emptyForrest :: Forrest v a
emptyForrest = Int -> Map v Int -> Map Int (Set a) -> Forrest v a
forall v a. Int -> Map v Int -> Map Int (Set a) -> Forrest v a
F Int
1 Map v Int
forall k a. Map k a
M.empty Map Int (Set a)
forall k a. Map k a
M.empty

{- | Takes a forrest and tries to add another edge to it.

 If possible ('Right'), then it returns the forrest with the edge added 
 otherwise ('Left') returns the component with a cycle after adding @e@.
 Please note that for a result @Left x@, the set @x@ contains a cycle, but it
 is not necessarily a cycle itself. (It's a cycle with trees on it)
-}
insertEdgeOrGetCycleComponent :: (Ord v, Ord a) => 
                        Forrest v a {- ^ forrest to insert into / find the cycle -} 
                     -> a {- ^ name of the edge -}
                     -> (v,v) {- ^ incidence tuple of the edge; @(x,x)@ represents a loop around the vertex @x@ -} 
                     -> Either (Set a) (Forrest v a)
insertEdgeOrGetCycleComponent :: Forrest v a -> a -> (v, v) -> Either (Set a) (Forrest v a)
insertEdgeOrGetCycleComponent (F Int
n Map v Int
c Map Int (Set a)
t) a
e (v
u,v
v) -- e is a non-loop edge
           | v
u v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v =  Set a -> Either (Set a) (Forrest v a)
forall a b. a -> Either a b
Left (Set a -> Either (Set a) (Forrest v a))
-> Set a -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> Set a
forall a. a -> Set a
S.singleton a
e -- a loop is a single edge cycle
           | Bool -> Bool
not (Bool
udef Bool -> Bool -> Bool
|| Bool
vdef) =           -- e is a new single-edge tree component
                                  let n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 
                                      c1 :: Map v Int
c1 = v -> Int -> Map v Int -> Map v Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert v
u Int
n (Map v Int -> Map v Int) -> Map v Int -> Map v Int
forall a b. (a -> b) -> a -> b
$ v -> Int -> Map v Int -> Map v Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert v
v Int
n Map v Int
c
                                      t1 :: Map Int (Set a)
t1 = Int -> Set a -> Map Int (Set a) -> Map Int (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
n (a -> Set a
forall a. a -> Set a
S.singleton a
e) Map Int (Set a)
t
                                   in Forrest v a -> Either (Set a) (Forrest v a)
forall a b. b -> Either a b
Right (Forrest v a -> Either (Set a) (Forrest v a))
-> Forrest v a -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ Int -> Map v Int -> Map Int (Set a) -> Forrest v a
forall v a. Int -> Map v Int -> Map Int (Set a) -> Forrest v a
F Int
n1 Map v Int
c1 Map Int (Set a)
t1
            -- at this point, at least udef or vdef is True
           | Maybe Int
uc Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
vc =                     -- this edge closes a loop with the tree; udef==vdef==True
                         let Just Int
cid = Maybe Int
uc
                             Just Set a
comp = Int -> Map Int (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
cid Map Int (Set a)
t
                          in Set a -> Either (Set a) (Forrest v a)
forall a b. a -> Either a b
Left (Set a -> Either (Set a) (Forrest v a))
-> Set a -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
e Set a
comp
           | Bool
udef Bool -> Bool -> Bool
&& Bool
vdef =                 -- the edge e connects two components of the forrest
                            let Just Int
uid = Maybe Int
uc
                                Just Int
vid = Maybe Int
vc
                                Just Set a
ut = Int -> Map Int (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
uid Map Int (Set a)
t
                                Just Set a
vt = Int -> Map Int (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
vid Map Int (Set a)
t
                                prj :: Int -> Int
prj Int
xid 
                                    | Int
xid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
vid = Int
uid -- map the component id of v to u
                                    | Bool
otherwise = Int
xid
                                c1 :: Map v Int
c1 = (Int -> Int) -> Map v Int -> Map v Int
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Int -> Int
prj Map v Int
c 
                                uvt :: Set a
uvt = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
e (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a
ut Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
vt
                                t1 :: Map Int (Set a)
t1 = Int -> Set a -> Map Int (Set a) -> Map Int (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
uid Set a
uvt (Map Int (Set a) -> Map Int (Set a))
-> Map Int (Set a) -> Map Int (Set a)
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Set a) -> Map Int (Set a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Int
vid Map Int (Set a)
t
                             in Forrest v a -> Either (Set a) (Forrest v a)
forall a b. b -> Either a b
Right (Forrest v a -> Either (Set a) (Forrest v a))
-> Forrest v a -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ Int -> Map v Int -> Map Int (Set a) -> Forrest v a
forall v a. Int -> Map v Int -> Map Int (Set a) -> Forrest v a
F Int
n Map v Int
c1 Map Int (Set a)
t1
            -- at this point, either vdef or udef is True, the other is False
           | Bool
vdef = Forrest v a -> a -> (v, v) -> Either (Set a) (Forrest v a)
forall v a.
(Ord v, Ord a) =>
Forrest v a -> a -> (v, v) -> Either (Set a) (Forrest v a)
insertEdgeOrGetCycleComponent (Int -> Map v Int -> Map Int (Set a) -> Forrest v a
forall v a. Int -> Map v Int -> Map Int (Set a) -> Forrest v a
F Int
n Map v Int
c Map Int (Set a)
t) a
e (v
v,v
u) -- bounce to next case
           | Bool
otherwise =  -- e connects the component of u with the new vertex v
                    let Just Int
uid = Maybe Int
uc
                        Just Set a
ut = Int -> Map Int (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
uid Map Int (Set a)
t
                        c1 :: Map v Int
c1 = v -> Int -> Map v Int -> Map v Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert v
v Int
uid Map v Int
c
                        ut1 :: Set a
ut1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
e Set a
ut
                        t1 :: Map Int (Set a)
t1 = Int -> Set a -> Map Int (Set a) -> Map Int (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
uid Set a
ut1 Map Int (Set a)
t
                     in Forrest v a -> Either (Set a) (Forrest v a)
forall a b. b -> Either a b
Right (Forrest v a -> Either (Set a) (Forrest v a))
-> Forrest v a -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ Int -> Map v Int -> Map Int (Set a) -> Forrest v a
forall v a. Int -> Map v Int -> Map Int (Set a) -> Forrest v a
F Int
n Map v Int
c1 Map Int (Set a)
t1
           where uc :: Maybe Int
uc = v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
u Map v Int
c
                 vc :: Maybe Int
vc = v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
v Map v Int
c
                 udef :: Bool
udef = Maybe Int
uc Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
forall a. Maybe a
Nothing
                 vdef :: Bool
vdef = Maybe Int
vc Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
forall a. Maybe a
Nothing