{-# LANGUAGE MultiParamTypeClasses #-}

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

This module provides default implementations for the members of the Matroid typeclass.

-}

module Data.Matroid.Typeclass.Defaults where
    
import Data.Set (Set)
import qualified Data.Set as S
        
    
-- | returns the rank of the set, wrt. to the given basis filter
rk :: (Set a -> Set a) -- ^ basis filter of the matroid
      -> Set a -- ^ set of matroid elements
      -> Int
rk :: (Set a -> Set a) -> Set a -> Int
rk Set a -> Set a
basis_m = Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Set a -> Int) -> (Set a -> Set a) -> Set a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set a
basis_m


-- | tests whether a given set is independent
indep :: (Set a -> Int) -- ^ the rank function of the matroid 
    -> Set a -- ^ set of matroid elements
    -> Bool
indep :: (Set a -> Int) -> Set a -> Bool
indep Set a -> Int
rk_m Set a
x = Set a -> Int
rk_m Set a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
x -- a set is independent iff its rank equals its cardinality

-- | obtains an independent subset with maximal cardinality
basis :: Ord a => (Set a -> Bool)-- ^ the independence test of the matroid
    -> Set a -- ^ set of matroid elements
    -> Set a
basis :: (Set a -> Bool) -> Set a -> Set a
basis Set a -> Bool
indep_m = (Set a -> a -> Set a) -> Set a -> Set a -> Set a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Set a -> a -> Set a
augmentIndep (forall a. Set a
S.empty :: Set a) -- beware that I have not tested this fold as of now
        where 
            augmentIndep :: Set a -> a -> Set a
augmentIndep Set a
b0 a
x {- adds x to b0 if b0 + {x} is independent -}
              | Set a -> Bool
indep_m Set a
b_aug = Set a
b_aug
              | Bool
otherwise = Set a
b0
              where 
                b_aug :: Set a
b_aug = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
b0
                
-- | computes the closure of a given set
cl :: Ord a => 
       (Set a -> Int) -- ^ the rank function of the matroid 
    -> Set a -- ^ the groundset of the matroid
    -> Set a -- ^ set of matroid elements 
    -> Set a
cl :: (Set a -> Int) -> Set a -> Set a -> Set a
cl Set a -> Int
rk_m Set a
groundset_m Set a
x = (Set a -> a -> Set a) -> Set a -> Set a -> Set a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Set a -> a -> Set a
augmentDep Set a
x (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a
groundset_m -- beware that I have not tested this fold as of now
    where 
        rank_x :: Int
rank_x = Set a -> Int
rk_m Set a
x
        augmentDep :: Set a -> a -> Set a
augmentDep Set a
f0 a
e {- adds e to f0 if the rank of f0+{e} stays the same -}
            | Set a -> Int
rk_m Set a
f_aug Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rank_x = Set a
f_aug
            | Bool
otherwise = Set a
f0
            where 
            f_aug :: Set a
f_aug = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
e Set a
f0
            

-- | returns the loops in the matroid
loops :: (Set a -> Set a) {- ^ the closure operator of the matroid -} -> Set a
loops :: (Set a -> Set a) -> Set a
loops Set a -> Set a
cl_m = Set a -> Set a
cl_m Set a
forall a. Set a
S.empty -- i.e. all elements e with rk({e}) = 0; i.e. all elements with not indep {e}; ...

-- | rank function of the dual matroid
coRk :: Ord a =>
      (Set a -> Int) {- ^ the rank function of the matroid -} 
    -> Set a {- ^ the ground set of the matroid -}
    -> Set a {- ^ set of matroid elements -} -> Int
coRk :: (Set a -> Int) -> Set a -> Set a -> Int
coRk Set a -> Int
rk_m Set a
groundset_m Set a
x = (Set a -> Int
rk_m Set a
e_minus_x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Set a -> Int
rk_m Set a
groundset_m)
    where e_minus_x :: Set a
e_minus_x = Set a
groundset_m Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
x
    
-- | returns the coloops in the matroid
coloops :: Ord a =>
           (Set a -> Int) {- ^ the rank function of the matroid -} 
        -> Set a {- ^ the ground set of the matroid -}
        -> Set a
coloops :: (Set a -> Int) -> Set a -> Set a
coloops Set a -> Int
rk_m Set a
e = a -> Bool
isColoop (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
`S.filter` Set a
e
    where   rkM :: Int
rkM = Set a -> Int
rk_m Set a
e
            isColoop :: a -> Bool
isColoop a
x = -- a coloop c is in every basis, thus a basis of E\{c} cannot be a basis of E. 
              Set a -> Int
rk_m (Set a
e Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` a -> Set a
forall a. a -> Set a
S.singleton a
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rkM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1