{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

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

This module provides implementations of graphic matroids.

-}

module Data.Matroid.Graphic
  ( GraphicMatroid
  , fromGraph
  , namedFromGraph
  , fromGraph'
  , mK
  ) where 

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

import qualified Data.Map as M

import Data.Matroid.Typeclass
import Data.Matroid.Graphic.Internal

-- | data type representing the cycle matroid (aka. polygon matroid) of a (multi-)graph
data GraphicMatroid v a = 
    MG String
       -- ^ given name of the matroid
       (Set a) 
       -- ^ ground set of M(G) = E for a (multi-)graph G = (V,E)
       (a -> (v,v)) 
       {- ^ map that maps the edge e to the set of its incident vertices {u,v}; 
            the order is ignored, and {v} is represented by (v,v) -}
         

instance Show a => Show (GraphicMatroid v a) where
    show :: GraphicMatroid v a -> String
show (MG String
name Set a
_ a -> (v, v)
_) = String
name

instance (Ord a, Ord v, Show a) => Matroid (GraphicMatroid v) a where
    groundset :: GraphicMatroid v a -> Set a
groundset (MG String
_ Set a
e a -> (v, v)
_) = Set a
e
    showName :: GraphicMatroid v a -> String
showName (MG String
name Set a
_ a -> (v, v)
_) = String
name
    -- | A set of edges of G=(V,E) is independent, if it contains no cycle. 
    indep :: GraphicMatroid v a -> Set a -> Bool
indep (MG String
_ Set a
_ a -> (v, v)
inc) Set a
x = Bool
result
         where (Bool
result,Forrest v a
_) = ((Bool, Forrest v a) -> a -> (Bool, Forrest v a))
-> (Bool, Forrest v a) -> Set a -> (Bool, Forrest v a)
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' (Bool, Forrest v a) -> a -> (Bool, Forrest v a)
step (Bool
True, Forrest v a
forall v a. Forrest v a
emptyForrest) Set a
x
               step :: (Bool, Forrest v a) -> a -> (Bool, Forrest v a)
step (Bool
False, Forrest v a
f) a
_ = (Bool
False, Forrest v a
f) -- propagate failure
               step (Bool
True, Forrest v a
f)  a
e = Forrest v a -> Either (Set a) (Forrest v a) -> (Bool, Forrest v a)
forall b a. b -> Either a b -> (Bool, b)
maybeContinue Forrest v a
f (Either (Set a) (Forrest v a) -> (Bool, Forrest v a))
-> Either (Set a) (Forrest v a) -> (Bool, Forrest v a)
forall a b. (a -> b) -> a -> b
$ 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 Forrest v a
f a
e ((v, v) -> Either (Set a) (Forrest v a))
-> (v, v) -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> (v, v)
inc a
e
               maybeContinue :: b -> Either a b -> (Bool, b)
maybeContinue b
f (Left a
_) = (Bool
False, b
f) -- edge e closes a cycle
               maybeContinue b
_ (Right b
f) = (Bool
True, b
f) -- edge e added to the forrest f
    -- | determine a spanning forrest of the vertices incident with the edges x
    basis :: GraphicMatroid v a -> Set a -> Set a
basis (MG String
_ Set a
_ a -> (v, v)
inc) Set a
x = (Set a -> Set a -> Set a) -> Set a -> Map Int (Set a) -> Set a
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
forall a. Set a
S.empty Map Int (Set a)
component_map
         where F Int
_ Map v Int
_ Map Int (Set a)
component_map = (Forrest v a -> a -> Forrest v a)
-> Forrest v a -> Set a -> Forrest v a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Forrest v a -> a -> Forrest v a
step Forrest v a
forall v a. Forrest v a
emptyForrest Set a
x 
               step :: Forrest v a -> a -> Forrest v a
step Forrest v a
f a
e = Forrest v a -> Either (Set a) (Forrest v a) -> Forrest v a
forall p a. p -> Either a p -> p
doContinue Forrest v a
f (Either (Set a) (Forrest v a) -> Forrest v a)
-> Either (Set a) (Forrest v a) -> Forrest v a
forall a b. (a -> b) -> a -> b
$ 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 Forrest v a
f a
e ((v, v) -> Either (Set a) (Forrest v a))
-> (v, v) -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> (v, v)
inc a
e
               doContinue :: p -> Either a p -> p
doContinue p
f (Left a
_) = p
f -- edge e closes a cycle, continue with previous forrest
               doContinue p
_ (Right p
f) = p
f -- edge e added to the forrest f
    -- | count the size while determining the spanning forrest
    rk :: GraphicMatroid v a -> Set a -> Int
rk (MG String
_ Set a
_ a -> (v, v)
inc) Set a
x = Int
result
       where (Forrest v a
_,Int
result) = ((Forrest v a, Int) -> a -> (Forrest v a, Int))
-> (Forrest v a, Int) -> Set a -> (Forrest v a, Int)
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' (Forrest v a, Int) -> a -> (Forrest v a, Int)
forall a. Num a => (Forrest v a, a) -> a -> (Forrest v a, a)
step (Forrest v a
forall v a. Forrest v a
emptyForrest, Int
0) Set a
x 
             step :: (Forrest v a, a) -> a -> (Forrest v a, a)
step (Forrest v a
f,a
r) a
e = Forrest v a
-> a -> Either (Set a) (Forrest v a) -> (Forrest v a, a)
forall a a a. Num a => a -> a -> Either a a -> (a, a)
doContinue Forrest v a
f a
r (Either (Set a) (Forrest v a) -> (Forrest v a, a))
-> Either (Set a) (Forrest v a) -> (Forrest v a, a)
forall a b. (a -> b) -> a -> b
$ 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 Forrest v a
f a
e ((v, v) -> Either (Set a) (Forrest v a))
-> (v, v) -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> (v, v)
inc a
e
             doContinue :: a -> a -> Either a a -> (a, a)
doContinue a
f a
r (Left a
_) = (a
f,a
r) -- edge e closes a cycle, continue with previous forrest
             doContinue a
_ a
r (Right a
f) = (a
f,a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
1) -- edge e added to the forrest f
    -- | determine a spanning forrest of x, then add all elements from e\x that are either loops or stay within a single component
    cl :: GraphicMatroid v a -> Set a -> Set a
cl (MG String
_ Set a
e a -> (v, v)
inc) Set a
x = Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
cx
         where F Int
_ Map v Int
component_map Map Int (Set a)
_ = (Forrest v a -> a -> Forrest v a)
-> Forrest v a -> Set a -> Forrest v a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Forrest v a -> a -> Forrest v a
step Forrest v a
forall v a. Forrest v a
emptyForrest Set a
x 
               step :: Forrest v a -> a -> Forrest v a
step Forrest v a
f a
g = Forrest v a -> Either (Set a) (Forrest v a) -> Forrest v a
forall p a. p -> Either a p -> p
doContinue Forrest v a
f (Either (Set a) (Forrest v a) -> Forrest v a)
-> Either (Set a) (Forrest v a) -> Forrest v a
forall a b. (a -> b) -> a -> b
$ 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 Forrest v a
f a
g ((v, v) -> Either (Set a) (Forrest v a))
-> (v, v) -> Either (Set a) (Forrest v a)
forall a b. (a -> b) -> a -> b
$ a -> (v, v)
inc a
g
               doContinue :: p -> Either a p -> p
doContinue p
f (Left a
_) = p
f -- edge e closes a cycle, continue with previous forrest
               doContinue p
_ (Right p
f) = p
f -- edge e added to the forrest f
               cx :: Set a
cx = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter a -> Bool
inClosure (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set a
e Set a
x
               inClosure :: a -> Bool
inClosure a
y = let (v
u,v
v) = a -> (v, v)
inc a
y
                                 loop :: Bool
loop = v
u v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v
                                 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
component_map
                                 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
component_map
                                 single_component :: Bool
single_component = Maybe Int
uc Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
vc Bool -> Bool -> Bool
&& (Maybe Int
uc Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
forall a. Maybe a
Nothing)
                             in Bool
loop Bool -> Bool -> Bool
|| Bool
single_component

-- | constructs a 'GraphicMatroid' from a set of (abstract) edges and the incident-vertex map
fromGraph :: (Ord a, Show a) => Set a -- ^ set of edges of the (multi-)graph
                   -> (a -> (v,v))
                   {- ^ map that maps the edge e to the set of its incident vertices {u,v}; 
                        the order is ignored, and {v} is represented by (v,v) -}
                   -> GraphicMatroid v a
fromGraph :: Set a -> (a -> (v, v)) -> GraphicMatroid v a
fromGraph Set a
e = String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
forall a v.
Ord a =>
String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
namedFromGraph (String
"fromGraph (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set a -> String
forall a. Show a => a -> String
show Set a
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (incidence)") Set a
e

-- | constructs an unnamed 'GraphicMatroid' from a set of (abstract) edges and the incident-vertex map
fromGraph' :: (Ord a) => Set a -- ^ set of edges of the (multi-)graph
                   -> (a -> (v,v))
                   {- ^ map that maps the edge e to the set of its incident vertices {u,v}; 
                        the order is ignored, and {v} is represented by (v,v) -}
                   -> GraphicMatroid v a
fromGraph' :: Set a -> (a -> (v, v)) -> GraphicMatroid v a
fromGraph' = String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
forall a v.
Ord a =>
String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
namedFromGraph String
"M(G)"

-- | constructs a named 'GraphicMatroid' from a set of (abstract) edges and the incident-vertex map
namedFromGraph :: Ord a => 
                      String
                   -- ^ name of the matroid  
                   -> Set a 
                   -- ^ set of edges of the (multi-)graph
                   -> (a -> (v,v))
                   {- ^ map that maps the edge e to the set of its incident vertices {u,v}; 
                        the order is ignored, and {v} is represented by (v,v) -}
                   -> GraphicMatroid v a
namedFromGraph :: String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
namedFromGraph = String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
forall v a. String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
MG


-- | constructs the graphic matroid M(K_n) where K_n is the complete graph on n vertices
mK :: Int -- ^ n = number of vertices in K_n
      -> GraphicMatroid Int (Int,Int)
mK :: Int -> GraphicMatroid Int (Int, Int)
mK Int
n = String
-> Set (Int, Int)
-> ((Int, Int) -> (Int, Int))
-> GraphicMatroid Int (Int, Int)
forall a v.
Ord a =>
String -> Set a -> (a -> (v, v)) -> GraphicMatroid v a
namedFromGraph String
name Set (Int, Int)
e (Int, Int) -> (Int, Int)
forall a. a -> a
id
  where e :: Set (Int, Int)
e = [(Int, Int)] -> Set (Int, Int)
forall a. Ord a => [a] -> Set a
S.fromList [(Int
u,Int
v) | Int
u <- [Int
1..Int
n]
                              , Int
v <- [Int
1..Int
n]
                              , Int
u Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
v]
        name :: String
name = String
"mK " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n