{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-|
Module      : Test.Matroid.Helpers
Description : 
Copyright   : (c) Immanuel Albrecht, 2020-202x
License     : BSD-3
Maintainer  : mail@immanuel-albrecht.de
Stability   : experimental
Portability : POSIX

This module contains helpers for the matroid unit tests.

-}

module Test.Matroid.Helpers where

import Data.List (foldl')
import Data.Set (Set)
import qualified Data.Set as S

-- | Tests whether a given integer valued set function is indeed monotone increasing in at most unit steps
isMonotoneUnitIncreasing :: Ord a => (Set a -> Int) {- ^ the rank function (or similar) -} 
                                      -> [a] {- ^ sequence to check monotonicity with -} 
                                      -> Bool
isMonotoneUnitIncreasing :: (Set a -> Int) -> [a] -> Bool
isMonotoneUnitIncreasing Set a -> Int
rk [a]
e = Bool
result
   where  (Set a
_,Bool
result,Int
_) = ((Set a, Bool, Int) -> a -> (Set a, Bool, Int))
-> (Set a, Bool, Int) -> [a] -> (Set a, Bool, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set a, Bool, Int) -> a -> (Set a, Bool, Int)
checkStep (forall a. Set a
S.empty :: Set a, Bool
True, Int
0 :: Int) [a]
e
          checkStep :: (Set a, Bool, Int) -> a -> (Set a, Bool, Int)
checkStep (Set a
x0,Bool
False,Int
r) a
_ = (Set a
x0,Bool
False,Int
r) -- propagate error
          checkStep (Set a
x0,Bool
True,Int
r)  a
x = let x1 :: Set a
x1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
x0
                                         r1 :: Int
r1 = Set a -> Int
rk Set a
x1
                                      in (Set a
x1, (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r1) Bool -> Bool -> Bool
&& (Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int
r1)

-- | Tests whether a given boolean valued set function indeed only flips from true to false once when adding elements to its argument
isMonotoneDecreasingBool :: Ord a => (Set a -> Bool) {- ^ the indep function (or similar) -}
                                    -> [a] {- ^ sequence to check monotonicity with -}
                                    -> Bool
isMonotoneDecreasingBool :: (Set a -> Bool) -> [a] -> Bool
isMonotoneDecreasingBool Set a -> Bool
indep [a]
e = Bool
result
   where (Set a
_,Bool
result,Bool
_) = ((Set a, Bool, Bool) -> a -> (Set a, Bool, Bool))
-> (Set a, Bool, Bool) -> [a] -> (Set a, Bool, Bool)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set a, Bool, Bool) -> a -> (Set a, Bool, Bool)
checkStep (forall a. Set a
S.empty :: Set a, Bool
True, Bool
True) [a]
e
         checkStep :: (Set a, Bool, Bool) -> a -> (Set a, Bool, Bool)
checkStep (Set a
x0,Bool
False,Bool
v)   a
_ = (Set a
x0,Bool
False,Bool
v) -- propagate error
         checkStep (Set a
x0,Bool
True,Bool
True) a
x = let x1 :: Set a
x1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
x0 
                                          v1 :: Bool
v1 = Set a -> Bool
indep Set a
x1
                                       in (Set a
x1,Bool
True,Bool
v1) -- we may flip here or later on
         checkStep (Set a
x0,Bool
True,Bool
False) a
x = let x1 :: Set a
x1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
x0
                                           v1 :: Bool
v1 = Set a -> Bool
indep Set a
x1 -- if this is True, then we have failed
                                        in (Set a
x1,Bool
v1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False,Bool
False) 
                                        
-- | Tests the exchange property of the indep function of a matroid
hasIndepExchangeProperty :: Ord a => (Set a -> Bool) {- ^ the indep function -}
                                  -> Set a {- ^ X -} 
                                  -> Set a {- ^ Y -} 
                                  -> Bool
hasIndepExchangeProperty :: (Set a -> Bool) -> Set a -> Set a -> Bool
hasIndepExchangeProperty Set a -> Bool
indep Set a
x Set a
y
    | Bool -> Bool
not ((Set a -> Bool
indep Set a
x) Bool -> Bool -> Bool
&& (Set a -> Bool
indep Set a
y))        = Bool
True -- vacuously true property
    | Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length 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
y                = Bool
True -- vacuously true property
    | Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
y                 = Set a -> [a] -> Bool
check Set a
y ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
y
    | Bool
otherwise                           = Set a -> [a] -> Bool
check Set a
x ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ Set a
y Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
x
    where check :: Set a -> [a] -> Bool
check Set a
x_ (a
x0:[a]
xs)
            | Set a -> Bool
indep (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a
x_ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` a -> Set a
forall a. a -> Set a
S.singleton a
x0 = Bool
True -- we found a candidate from Y\X that can be used to augment X
            | Bool
otherwise                            = Set a -> [a] -> Bool
check Set a
x_ [a]
xs -- try the other candidates
          check Set a
_ [a]
_ = Bool
False -- no candidates left, property is not satisfied
          
-- | Tests whether a given set valued set function is isotone in the set lattice
isIsotoneSetMap :: Ord a => (Set a -> Set a) {- ^ the cl function (or similar) -}
                                    -> [a] {- ^ sequence to check monotonicity with -}
                                    -> Bool
isIsotoneSetMap :: (Set a -> Set a) -> [a] -> Bool
isIsotoneSetMap Set a -> Set a
cl [a]
e = Bool
result
   where (Set a
_,Bool
result,Set a
_) = ((Set a, Bool, Set a) -> a -> (Set a, Bool, Set a))
-> (Set a, Bool, Set a) -> [a] -> (Set a, Bool, Set a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Set a, Bool, Set a) -> a -> (Set a, Bool, Set a)
checkStep (forall a. Set a
S.empty :: Set a, Bool
True, forall a. Set a
S.empty :: Set a) [a]
e
         checkStep :: (Set a, Bool, Set a) -> a -> (Set a, Bool, Set a)
checkStep (Set a
x0,Bool
False,Set a
c0)   a
_ = (Set a
x0,Bool
False,Set a
c0) -- propagate error
         checkStep (Set a
x0, Bool
True,Set a
c0)   a
x = let x1 :: Set a
x1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
x0
                                           c1 :: Set a
c1 = Set a -> Set a
cl Set a
x1
                                           isSuperset :: Bool
isSuperset = Set a
c0 Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set a
c1
                                        in (Set a
x1,Bool
isSuperset,Set a
c1)